<%@ Language=VBScript %> <% Option Explicit Response.Buffer = True Response.ContentType = "application/json" ' Declare and create database connection Dim objConn, rs Set objConn = Server.CreateObject("ADODB.Connection") objConn.ConnectionString = "Driver={MySQL ODBC 9.4 Unicode Driver};" & _ "Server=192.168.122.1;" & _ "Port=3306;" & _ "Database=shopdb;" & _ "User=570005354;" & _ "Password=570005354;" & _ "Option=3;" objConn.Open Set rs = Server.CreateObject("ADODB.Recordset") ' ============================================================================ ' ShopDB API - PowerShell Data Collection Endpoint ' ============================================================================ ' Purpose: Receive PC asset data from PowerShell scripts and store in Phase 2 schema ' Created: 2025-11-13 ' Modified: 2025-11-13 - Fixed objConn scoping, machinetypeid Phase 2 fix ' Schema: Phase 2 (machines table, machinetypeid 33/34/35 for PCs) ' ============================================================================ ' Error handling wrapper On Error Resume Next ' Get action from POST or GET Dim action action = Request.Form("action") If action = "" Then action = Request.QueryString("action") ' Route to appropriate handler Select Case action Case "updateCompleteAsset" UpdateCompleteAsset() Case "updatePrinterMapping" UpdatePrinterMapping() Case "updateInstalledApps" UpdateInstalledApps() Case "getDashboardData" GetDashboardData() Case Else SendError "Invalid action: " & action End Select ' Clean up If Not objConn Is Nothing Then If objConn.State = 1 Then objConn.Close Set objConn = Nothing End If ' ============================================================================ ' MAIN HANDLERS ' ============================================================================ Sub UpdateCompleteAsset() On Error Resume Next ' Log request LogToFile "=== NEW updateCompleteAsset REQUEST ===" LogToFile "Hostname: " & Request.Form("hostname") LogToFile "Serial: " & Request.Form("serialNumber") LogToFile "PC Type: " & Request.Form("pcType") ' Get all POST parameters Dim hostname, serialnumber, manufacturer, model, pcType Dim loggedinuser, machinenumber, osVersion, osid, pcstatusid Dim warrantyEndDate, warrantyStatus, warrantyServiceLevel, warrantyDaysRemaining Dim networkInterfaces, commConfigs, dncConfig Dim dncDualPathEnabled, dncPath1Name, dncPath2Name Dim dncGeRegistry32Bit, dncGeRegistry64Bit, dncGeRegistryNotes ' Basic PC info hostname = Trim(Request.Form("hostname") & "") serialnumber = Trim(Request.Form("serialNumber") & "") manufacturer = Trim(Request.Form("manufacturer") & "") model = Trim(Request.Form("model") & "") pcType = Trim(Request.Form("pcType") & "") loggedinuser = Trim(Request.Form("loggedInUser") & "") machinenumber = Trim(Request.Form("machineNo") & "") osVersion = Trim(Request.Form("osVersion") & "") ' Warranty data (optional) warrantyEndDate = Request.Form("warrantyEndDate") warrantyStatus = Trim(Request.Form("warrantyStatus") & "") warrantyServiceLevel = Trim(Request.Form("warrantyServiceLevel") & "") warrantyDaysRemaining = Request.Form("warrantyDaysRemaining") ' Shopfloor data (optional) networkInterfaces = Request.Form("networkInterfaces") commConfigs = Request.Form("commConfigs") dncConfig = Request.Form("dncConfig") ' DNC/GE registry data dncDualPathEnabled = Request.Form("dncDualPathEnabled") dncPath1Name = Trim(Request.Form("dncPath1Name") & "") dncPath2Name = Trim(Request.Form("dncPath2Name") & "") dncGeRegistry32Bit = Request.Form("dncGeRegistry32Bit") dncGeRegistry64Bit = Request.Form("dncGeRegistry64Bit") dncGeRegistryNotes = Trim(Request.Form("dncGeRegistryNotes") & "") ' Validate required fields If hostname = "" Or serialnumber = "" Then SendError "hostname and serialNumber are required" Exit Sub End If ' Get OS ID osid = GetOrCreateOSID(osVersion) pcstatusid = 3 ' Default to "In Use" ' Clear existing shopfloor data if this is a shopfloor PC Dim machineid If pcType = "Shopfloor" Then ClearShopfloorData hostname End If ' Insert or update PC record machineid = InsertOrUpdatePC(hostname, serialnumber, manufacturer, model, pcType, _ loggedinuser, machinenumber, osid, pcstatusid, _ warrantyEndDate, warrantyStatus, warrantyServiceLevel, warrantyDaysRemaining) If Err.Number <> 0 Then SendError "Failed to insert/update PC: " & Err.Description Exit Sub End If If machineid = 0 Then SendError "Failed to get machineid after insert/update" Exit Sub End If LogToFile "PC record created/updated. machineid: " & machineid ' Insert network interfaces Dim interfaceCount interfaceCount = 0 If networkInterfaces <> "" Then interfaceCount = InsertNetworkInterfaces(machineid, networkInterfaces) LogToFile "Network interfaces inserted: " & interfaceCount End If ' Insert communication configs (serial ports) Dim commConfigCount commConfigCount = 0 If commConfigs <> "" Then commConfigCount = InsertCommConfigs(machineid, commConfigs) LogToFile "Comm configs inserted: " & commConfigCount End If ' Insert DNC config Dim dncSuccess dncSuccess = False If dncConfig <> "" Then dncSuccess = InsertDNCConfig(machineid, dncConfig, dncDualPathEnabled, dncPath1Name, dncPath2Name, _ dncGeRegistry32Bit, dncGeRegistry64Bit, dncGeRegistryNotes) LogToFile "DNC config inserted: " & dncSuccess End If ' Create PC-to-machine relationship if machine number provided Dim relationshipCreated relationshipCreated = False If machinenumber <> "" Then relationshipCreated = CreatePCMachineRelationship(machineid, machinenumber) LogToFile "PC-Machine relationship created: " & relationshipCreated End If ' Update warranty data in separate table If warrantyEndDate <> "" Then UpdateWarrantyData machineid, warrantyEndDate, warrantyStatus, warrantyServiceLevel, warrantyDaysRemaining End If ' Send success response Dim responseObj Set responseObj = Server.CreateObject("Scripting.Dictionary") responseObj.Add "success", True responseObj.Add "message", "PC asset data updated successfully" responseObj.Add "machineid", machineid responseObj.Add "hostname", hostname responseObj.Add "operation", "complete" Dim dataObj Set dataObj = Server.CreateObject("Scripting.Dictionary") dataObj.Add "networkInterfaces", interfaceCount dataObj.Add "commConfigs", commConfigCount dataObj.Add "dncConfig", dncSuccess dataObj.Add "relationshipCreated", relationshipCreated responseObj.Add "data", dataObj SendResponse responseObj End Sub Sub UpdatePrinterMapping() On Error Resume Next Dim hostname, printerFQDN hostname = Trim(Request.Form("hostname") & "") printerFQDN = Trim(Request.Form("printerFQDN") & "") If hostname = "" Or printerFQDN = "" Then SendError "hostname and printerFQDN are required" Exit Sub End If LogToFile "UpdatePrinterMapping: hostname=" & hostname & ", printerFQDN=" & printerFQDN ' Get machineid for this hostname Dim machineid machineid = GetMachineidByHostname(hostname) If machineid = 0 Then SendError "PC not found: " & hostname Exit Sub End If ' Find printer by FQDN (try name match, IP match, or alias match) Dim printerid, matchMethod printerid = 0 matchMethod = "" ' Try exact printer name match Dim strSQL, rsResult strSQL = "SELECT printerid FROM printers WHERE printername = ?" Set rsResult = ExecuteParameterizedQuery(objConn, strSQL, Array(printerFQDN)) If Not rsResult.EOF Then printerid = rsResult("printerid") matchMethod = "name" End If rsResult.Close Set rsResult = Nothing ' Try IP address match if FQDN looks like an IP If printerid = 0 And IsIPAddress(printerFQDN) Then strSQL = "SELECT p.printerid FROM printers p " & _ "INNER JOIN machines m ON p.machineid = m.machineid " & _ "LEFT JOIN communications c ON m.machineid = c.machineid AND c.isprimary = 1 " & _ "WHERE c.address = ?" Set rsResult = ExecuteParameterizedQuery(objConn, strSQL, Array(printerFQDN)) If Not rsResult.EOF Then printerid = rsResult("printerid") matchMethod = "ip" End If rsResult.Close Set rsResult = Nothing End If If printerid = 0 Then SendError "Printer not found: " & printerFQDN Exit Sub End If ' Update machine record to link to this printer Dim cmdUpdate Set cmdUpdate = Server.CreateObject("ADODB.Command") cmdUpdate.ActiveConnection = objConn cmdUpdate.CommandText = "UPDATE machines SET printerid = ? WHERE machineid = ?" cmdUpdate.Parameters.Append cmdUpdate.CreateParameter("@printerid", 3, 1, , CLng(printerid)) cmdUpdate.Parameters.Append cmdUpdate.CreateParameter("@machineid", 3, 1, , CLng(machineid)) cmdUpdate.Execute If Err.Number <> 0 Then SendError "Failed to update printer mapping: " & Err.Description Exit Sub End If ' Send success response Dim responseObj Set responseObj = Server.CreateObject("Scripting.Dictionary") responseObj.Add "success", True responseObj.Add "message", "Printer mapping updated" Dim dataObj Set dataObj = Server.CreateObject("Scripting.Dictionary") dataObj.Add "printerId", printerid dataObj.Add "machinesUpdated", 1 dataObj.Add "matchMethod", matchMethod responseObj.Add "data", dataObj SendResponse responseObj End Sub Sub UpdateInstalledApps() On Error Resume Next Dim hostname, installedApps hostname = Trim(Request.Form("hostname") & "") installedApps = Request.Form("installedApps") If hostname = "" Or installedApps = "" Then SendError "hostname and installedApps are required" Exit Sub End If LogToFile "UpdateInstalledApps: hostname=" & hostname ' Get machineid for this hostname Dim machineid machineid = GetMachineidByHostname(hostname) If machineid = 0 Then SendError "PC not found: " & hostname Exit Sub End If ' Parse JSON array of apps (simple parsing) Dim appsArray appsArray = ParseJSONArray(installedApps) LogToFile "Parsed apps array, count: " & (UBound(appsArray) + 1) ' Clear existing app mappings for this PC Dim cmdDelete Set cmdDelete = Server.CreateObject("ADODB.Command") cmdDelete.ActiveConnection = objConn cmdDelete.CommandText = "DELETE FROM machineapplications WHERE machineid = ?" cmdDelete.Parameters.Append cmdDelete.CreateParameter("@machineid", 3, 1, , CLng(machineid)) cmdDelete.Execute ' Insert new app mappings Dim appCount, i appCount = 0 For i = 0 To UBound(appsArray) Dim appName, appVersion ' PowerShell sends lowercase 'name' and 'version' keys appName = Trim(GetJSONValue(appsArray(i), "name") & "") appVersion = Trim(GetJSONValue(appsArray(i), "version") & "") LogToFile "App " & i & ": name='" & appName & "', version='" & appVersion & "'" If appName <> "" Then ' Get or create application ID Dim appid appid = GetOrCreateApplication(appName, appVersion) LogToFile "GetOrCreateApplication returned appid: " & appid If appid > 0 Then ' Insert mapping Dim cmdInsert Set cmdInsert = Server.CreateObject("ADODB.Command") cmdInsert.ActiveConnection = objConn cmdInsert.CommandText = "INSERT INTO machineapplications (machineid, applicationid) VALUES (?, ?)" cmdInsert.Parameters.Append cmdInsert.CreateParameter("@machineid", 3, 1, , CLng(machineid)) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@appid", 3, 1, , CLng(appid)) cmdInsert.Execute If Err.Number = 0 Then appCount = appCount + 1 End If End If End If Next LogToFile "Installed apps inserted: " & appCount ' Send success response Dim responseObj Set responseObj = Server.CreateObject("Scripting.Dictionary") responseObj.Add "success", True responseObj.Add "message", "Installed applications updated" Dim dataObj Set dataObj = Server.CreateObject("Scripting.Dictionary") dataObj.Add "appsProcessed", appCount responseObj.Add "data", dataObj SendResponse responseObj End Sub Sub GetDashboardData() ' Simple health check endpoint Dim responseObj Set responseObj = Server.CreateObject("Scripting.Dictionary") responseObj.Add "success", True responseObj.Add "message", "ShopDB API is online" responseObj.Add "version", "1.0" responseObj.Add "schema", "Phase 2" SendResponse responseObj End Sub ' ============================================================================ ' HELPER FUNCTIONS - PC MANAGEMENT ' ============================================================================ Function InsertOrUpdatePC(hostname, serialnumber, manufacturer, model, pcType, _ loggedinuser, machinenumber, osid, pcstatusid, _ warrantyEndDate, warrantyStatus, warrantyServiceLevel, warrantyDaysRemaining) On Error Resume Next ' Get or create vendor/model IDs and determine machine type Dim vendorId, modelId, machineTypeId vendorId = GetOrCreateVendor(objConn, manufacturer) modelId = GetOrCreateModel(objConn, model, vendorId) machineTypeId = GetMachineTypeIdFromPCType(pcType) ' Ensure all IDs are numeric (fallback to safe defaults if empty) If Not IsNumeric(vendorId) Or vendorId = "" Then vendorId = 0 If Not IsNumeric(modelId) Or modelId = "" Then modelId = 1 ' TBD model If Not IsNumeric(machineTypeId) Or machineTypeId = "" Then machineTypeId = 33 ' Standard PC LogToFile "Vendor ID: " & vendorId & ", Model ID: " & modelId & ", Machine Type ID: " & machineTypeId ' Check if PC already exists (Phase 2: identify PCs by machinetypeid 33,34,35) Dim strSQL, rsResult, safeHostname safeHostname = Replace(hostname, "'", "''") strSQL = "SELECT machineid FROM machines WHERE hostname = '" & safeHostname & "' AND machinetypeid IN (33,34,35)" Set rsResult = objConn.Execute(strSQL) Dim machineid machineid = 0 If Err.Number <> 0 Then LogToFile "ERROR checking for existing PC: " & Err.Description InsertOrUpdatePC = 0 Exit Function End If ' Declare string sanitization variables for both UPDATE and INSERT paths Dim safeSerial, safeUser, safeMachineNum If Not rsResult.EOF Then ' PC exists - UPDATE machineid = rsResult("machineid") rsResult.Close Set rsResult = Nothing LogToFile "Updating existing PC, machineid: " & machineid ' Build UPDATE with direct values safeSerial = Replace(serialnumber, "'", "''") If loggedinuser <> "" Then safeUser = Replace(loggedinuser, "'", "''") Else safeUser = "" End If If machinenumber <> "" Then safeMachineNum = Replace(machinenumber, "'", "''") Else safeMachineNum = "" End If ' Build UPDATE SQL with proper conditional logic (VBScript doesn't have IIf) Dim sqlModelId, sqlUserId, sqlMachineNum, sqlOsId, sqlStatusId If modelId > 0 Then sqlModelId = CLng(modelId) Else sqlModelId = "NULL" End If If safeUser <> "" Then sqlUserId = "'" & safeUser & "'" Else sqlUserId = "NULL" End If If safeMachineNum <> "" Then sqlMachineNum = "'" & safeMachineNum & "'" Else sqlMachineNum = "NULL" End If If osid > 0 Then sqlOsId = CLng(osid) Else sqlOsId = "NULL" End If If pcstatusid > 0 Then sqlStatusId = CLng(pcstatusid) Else sqlStatusId = "NULL" End If strSQL = "UPDATE machines SET " & _ "serialnumber = '" & safeSerial & "', " & _ "modelnumberid = " & sqlModelId & ", " & _ "machinetypeid = " & CLng(machineTypeId) & ", " & _ "loggedinuser = " & sqlUserId & ", " & _ "machinenumber = " & sqlMachineNum & ", " & _ "osid = " & sqlOsId & ", " & _ "machinestatusid = " & sqlStatusId & ", " & _ "lastupdated = NOW() " & _ "WHERE machineid = " & CLng(machineid) & " AND machinetypeid IN (33,34,35)" LogToFile "UPDATE SQL built: " & Left(strSQL, 200) & "..." objConn.Execute strSQL If Err.Number <> 0 Then LogToFile "ERROR updating PC: " & Err.Description InsertOrUpdatePC = 0 Exit Function End If Else ' PC doesn't exist - INSERT rsResult.Close Set rsResult = Nothing LogToFile "Inserting new PC" ' Build INSERT with direct values (sanitize strings) safeSerial = Replace(serialnumber, "'", "''") If loggedinuser <> "" Then safeUser = Replace(loggedinuser, "'", "''") Else safeUser = "" End If If machinenumber <> "" Then safeMachineNum = Replace(machinenumber, "'", "''") Else safeMachineNum = "" End If LogToFile "Building INSERT SQL..." LogToFile "Values: hostname=" & safeHostname & ", serial=" & safeSerial ' Build SQL in parts to isolate error Dim sqlPart1, sqlPart2, sqlPart3 sqlPart1 = "INSERT INTO machines (hostname, serialnumber, modelnumberid, machinetypeid, loggedinuser, machinenumber, osid, machinestatusid, isactive, lastupdated) VALUES (" sqlPart2 = "'" & safeHostname & "', '" & safeSerial & "', " If modelId > 0 Then sqlPart2 = sqlPart2 & CLng(modelId) & ", " Else sqlPart2 = sqlPart2 & "NULL, " End If ' machinetypeid is required for PCs (33=Standard, 34=Engineering, 35=Shopfloor) sqlPart2 = sqlPart2 & CLng(machineTypeId) & ", " If safeUser <> "" Then sqlPart2 = sqlPart2 & "'" & safeUser & "', " Else sqlPart2 = sqlPart2 & "NULL, " End If If safeMachineNum <> "" Then sqlPart2 = sqlPart2 & "'" & safeMachineNum & "', " Else sqlPart2 = sqlPart2 & "NULL, " End If If osid > 0 Then sqlPart3 = CLng(osid) & ", " Else sqlPart3 = "NULL, " End If If pcstatusid > 0 Then sqlPart3 = sqlPart3 & CLng(pcstatusid) & ", 1, NOW())" Else sqlPart3 = sqlPart3 & "NULL, 1, NOW())" End If strSQL = sqlPart1 & sqlPart2 & sqlPart3 LogToFile "SQL built successfully, executing..." objConn.Execute strSQL If Err.Number <> 0 Then LogToFile "ERROR inserting PC: " & Err.Description InsertOrUpdatePC = 0 Exit Function End If ' Get the new machineid strSQL = "SELECT LAST_INSERT_ID() AS newid" Set rsResult = objConn.Execute(strSQL) If Not rsResult.EOF Then machineid = CLng(rsResult("newid")) LogToFile "Retrieved new machineid from LAST_INSERT_ID: " & machineid Else machineid = 0 LogToFile "ERROR: LAST_INSERT_ID returned no rows" End If rsResult.Close Set rsResult = Nothing End If LogToFile "InsertOrUpdatePC returning machineid: " & machineid InsertOrUpdatePC = machineid End Function Function GetMachineidByHostname(hostname) On Error Resume Next Dim strSQL, rsResult, safeHostname safeHostname = Replace(hostname, "'", "''") strSQL = "SELECT machineid FROM machines WHERE hostname = '" & safeHostname & "' AND machinetypeid IN (33,34,35)" Set rsResult = objConn.Execute(strSQL) If Not rsResult.EOF Then GetMachineidByHostname = CLng(rsResult("machineid")) Else GetMachineidByHostname = 0 End If rsResult.Close Set rsResult = Nothing End Function Sub ClearShopfloorData(hostname) On Error Resume Next Dim machineid machineid = GetMachineidByHostname(hostname) If machineid = 0 Then LogToFile "ClearShopfloorData: Cannot find machineid for hostname: " & hostname Exit Sub End If LogToFile "ClearShopfloorData: Clearing data for machineid " & machineid ' Delete from communications table Dim cmdDelete Set cmdDelete = Server.CreateObject("ADODB.Command") cmdDelete.ActiveConnection = objConn cmdDelete.CommandText = "DELETE FROM communications WHERE machineid = ?" cmdDelete.Parameters.Append cmdDelete.CreateParameter("@machineid", 3, 1, , CLng(machineid)) cmdDelete.Execute LogToFile "Deleted " & cmdDelete.RecordsAffected & " communications records" ' Delete from pc_comm_config Set cmdDelete = Server.CreateObject("ADODB.Command") cmdDelete.ActiveConnection = objConn cmdDelete.CommandText = "DELETE FROM pc_comm_config WHERE machineid = ?" cmdDelete.Parameters.Append cmdDelete.CreateParameter("@machineid", 3, 1, , CLng(machineid)) cmdDelete.Execute LogToFile "Deleted " & cmdDelete.RecordsAffected & " comm config records" ' Delete from pc_dnc_config Set cmdDelete = Server.CreateObject("ADODB.Command") cmdDelete.ActiveConnection = objConn cmdDelete.CommandText = "DELETE FROM pc_dnc_config WHERE machineid = ?" cmdDelete.Parameters.Append cmdDelete.CreateParameter("@machineid", 3, 1, , CLng(machineid)) cmdDelete.Execute LogToFile "Deleted " & cmdDelete.RecordsAffected & " DNC config records" End Sub ' ============================================================================ ' HELPER FUNCTIONS - NETWORK & COMMUNICATION ' ============================================================================ Function InsertNetworkInterfaces(machineid, networkInterfacesJSON) On Error Resume Next Dim interfacesArray interfacesArray = ParseJSONArray(networkInterfacesJSON) Dim count, i count = 0 For i = 0 To UBound(interfacesArray) Dim ipAddress, macAddress, subnetMask, gateway, interfaceName, isMachineNetwork ipAddress = Trim(GetJSONValue(interfacesArray(i), "IPAddress") & "") macAddress = Trim(GetJSONValue(interfacesArray(i), "MACAddress") & "") subnetMask = Trim(GetJSONValue(interfacesArray(i), "SubnetMask") & "") gateway = Trim(GetJSONValue(interfacesArray(i), "DefaultGateway") & "") interfaceName = Trim(GetJSONValue(interfacesArray(i), "InterfaceName") & "") isMachineNetwork = GetJSONValue(interfacesArray(i), "IsMachineNetwork") If interfaceName = "" Then interfaceName = "Interface " & (i + 1) ' Determine if primary (first interface with valid IP) Dim isPrimary isPrimary = 0 If i = 0 And ipAddress <> "" Then isPrimary = 1 ' Insert into communications table Dim cmdInsert Set cmdInsert = Server.CreateObject("ADODB.Command") cmdInsert.ActiveConnection = objConn cmdInsert.CommandText = "INSERT INTO communications (" & _ "machineid, comstypeid, address, macaddress, " & _ "subnetmask, gateway, interfacename, isprimary, isactive" & _ ") VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)" ' Prepare parameter values (VBScript doesn't have IIf) Dim paramAddress, paramMacAddress, paramSubnet, paramGateway If ipAddress <> "" Then paramAddress = ipAddress Else paramAddress = Null If macAddress <> "" Then paramMacAddress = macAddress Else paramMacAddress = Null If subnetMask <> "" Then paramSubnet = subnetMask Else paramSubnet = Null If gateway <> "" Then paramGateway = gateway Else paramGateway = Null cmdInsert.Parameters.Append cmdInsert.CreateParameter("@machineid", 3, 1, , CLng(machineid)) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@comstypeid", 3, 1, , 1) ' 1 = Network Interface cmdInsert.Parameters.Append cmdInsert.CreateParameter("@address", 200, 1, 45, paramAddress) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@macaddress", 200, 1, 17, paramMacAddress) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@subnetmask", 200, 1, 45, paramSubnet) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@gateway", 200, 1, 45, paramGateway) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@interfacename", 200, 1, 50, interfaceName) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@isprimary", 3, 1, , isPrimary) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@isactive", 3, 1, , 1) cmdInsert.Execute If Err.Number = 0 Then count = count + 1 Else LogToFile "ERROR inserting network interface: " & Err.Description End If Next InsertNetworkInterfaces = count End Function Function InsertCommConfigs(machineid, commConfigsJSON) On Error Resume Next Dim configsArray configsArray = ParseJSONArray(commConfigsJSON) Dim count, i count = 0 For i = 0 To UBound(configsArray) Dim portName, baudRate, dataBits, parity, stopBits, flowControl portName = Trim(GetJSONValue(configsArray(i), "PortName") & "") baudRate = GetJSONValue(configsArray(i), "BaudRate") dataBits = GetJSONValue(configsArray(i), "DataBits") parity = Trim(GetJSONValue(configsArray(i), "Parity") & "") stopBits = Trim(GetJSONValue(configsArray(i), "StopBits") & "") flowControl = Trim(GetJSONValue(configsArray(i), "FlowControl") & "") If portName <> "" Then Dim cmdInsert Set cmdInsert = Server.CreateObject("ADODB.Command") cmdInsert.ActiveConnection = objConn cmdInsert.CommandText = "INSERT INTO pc_comm_config (" & _ "machineid, portname, baudrate, databits, parity, stopbits, flowcontrol" & _ ") VALUES (?, ?, ?, ?, ?, ?, ?)" ' Prepare parameter values (VBScript doesn't have IIf) Dim paramBaud, paramDataBits, paramParity, paramStopBits, paramFlowControl If IsNumeric(baudRate) Then paramBaud = CLng(baudRate) Else paramBaud = Null If IsNumeric(dataBits) Then paramDataBits = CLng(dataBits) Else paramDataBits = Null If parity <> "" Then paramParity = parity Else paramParity = Null If stopBits <> "" Then paramStopBits = stopBits Else paramStopBits = Null If flowControl <> "" Then paramFlowControl = flowControl Else paramFlowControl = Null cmdInsert.Parameters.Append cmdInsert.CreateParameter("@machineid", 3, 1, , CLng(machineid)) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@portname", 200, 1, 50, portName) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@baudrate", 3, 1, , paramBaud) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@databits", 3, 1, , paramDataBits) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@parity", 200, 1, 20, paramParity) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@stopbits", 200, 1, 20, paramStopBits) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@flowcontrol", 200, 1, 50, paramFlowControl) cmdInsert.Execute If Err.Number = 0 Then count = count + 1 Else LogToFile "ERROR inserting comm config: " & Err.Description End If End If Next InsertCommConfigs = count End Function Function InsertDNCConfig(machineid, dncConfigJSON, dualPathEnabled, path1Name, path2Name, _ geRegistry32Bit, geRegistry64Bit, geRegistryNotes) On Error Resume Next ' Parse DNC config JSON Dim dncObj Set dncObj = ParseJSONObject(dncConfigJSON) If dncObj Is Nothing Then InsertDNCConfig = False Exit Function End If ' Extract DNC values Dim site, cnc, ncif, machineNumber, hostType Dim ftpHostPrimary, ftpHostSecondary, ftpAccount Dim debug, uploads, scanner, dripFeed, additionalSettings site = Trim(GetDictValue(dncObj, "Site") & "") cnc = Trim(GetDictValue(dncObj, "CNC") & "") ncif = Trim(GetDictValue(dncObj, "NCIF") & "") machineNumber = Trim(GetDictValue(dncObj, "MachineNumber") & "") hostType = Trim(GetDictValue(dncObj, "HostType") & "") ftpHostPrimary = Trim(GetDictValue(dncObj, "FTPHostPrimary") & "") ftpHostSecondary = Trim(GetDictValue(dncObj, "FTPHostSecondary") & "") ftpAccount = Trim(GetDictValue(dncObj, "FTPAccount") & "") debug = Trim(GetDictValue(dncObj, "Debug") & "") uploads = Trim(GetDictValue(dncObj, "Uploads") & "") scanner = Trim(GetDictValue(dncObj, "Scanner") & "") dripFeed = Trim(GetDictValue(dncObj, "DripFeed") & "") additionalSettings = Trim(GetDictValue(dncObj, "AdditionalSettings") & "") ' Convert boolean strings to integers Dim dualPathInt, geRegistry32Int, geRegistry64Int dualPathInt = ConvertBoolToInt(dualPathEnabled) geRegistry32Int = ConvertBoolToInt(geRegistry32Bit) geRegistry64Int = ConvertBoolToInt(geRegistry64Bit) ' Insert DNC config Dim cmdInsert Set cmdInsert = Server.CreateObject("ADODB.Command") cmdInsert.ActiveConnection = objConn cmdInsert.CommandText = "INSERT INTO pc_dnc_config (" & _ "machineid, site, cnc, ncif, machinenumber, hosttype, " & _ "ftphostprimary, ftphostsecondary, ftpaccount, " & _ "debug, uploads, scanner, dripfeed, additionalsettings, " & _ "dualpath_enabled, path1_name, path2_name, " & _ "ge_registry_32bit, ge_registry_64bit, ge_registry_notes, " & _ "lastupdated" & _ ") VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, NOW())" ' Prepare parameter values (VBScript doesn't have IIf) Dim pSite, pCnc, pNcif, pMachineNum, pHostType, pFtpPri, pFtpSec, pFtpAcct Dim pDebug, pUploads, pScanner, pDripFeed, pAddSet, pDualPath, pPath1, pPath2, pGe32, pGe64, pGeNotes If site <> "" Then pSite = site Else pSite = Null If cnc <> "" Then pCnc = cnc Else pCnc = Null If ncif <> "" Then pNcif = ncif Else pNcif = Null If machineNumber <> "" Then pMachineNum = machineNumber Else pMachineNum = Null If hostType <> "" Then pHostType = hostType Else pHostType = Null If ftpHostPrimary <> "" Then pFtpPri = ftpHostPrimary Else pFtpPri = Null If ftpHostSecondary <> "" Then pFtpSec = ftpHostSecondary Else pFtpSec = Null If ftpAccount <> "" Then pFtpAcct = ftpAccount Else pFtpAcct = Null If debug <> "" Then pDebug = debug Else pDebug = Null If uploads <> "" Then pUploads = uploads Else pUploads = Null If scanner <> "" Then pScanner = scanner Else pScanner = Null If dripFeed <> "" Then pDripFeed = dripFeed Else pDripFeed = Null If additionalSettings <> "" Then pAddSet = additionalSettings Else pAddSet = Null If dualPathInt >= 0 Then pDualPath = dualPathInt Else pDualPath = Null If path1Name <> "" Then pPath1 = path1Name Else pPath1 = Null If path2Name <> "" Then pPath2 = path2Name Else pPath2 = Null If geRegistry32Int >= 0 Then pGe32 = geRegistry32Int Else pGe32 = Null If geRegistry64Int >= 0 Then pGe64 = geRegistry64Int Else pGe64 = Null If geRegistryNotes <> "" Then pGeNotes = geRegistryNotes Else pGeNotes = Null cmdInsert.Parameters.Append cmdInsert.CreateParameter("@machineid", 3, 1, , CLng(machineid)) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@site", 200, 1, 50, pSite) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@cnc", 200, 1, 50, pCnc) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@ncif", 200, 1, 50, pNcif) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@machinenum", 200, 1, 50, pMachineNum) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@hosttype", 200, 1, 50, pHostType) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@ftppri", 200, 1, 100, pFtpPri) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@ftpsec", 200, 1, 100, pFtpSec) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@ftpacct", 200, 1, 100, pFtpAcct) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@debug", 200, 1, 50, pDebug) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@uploads", 200, 1, 100, pUploads) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@scanner", 200, 1, 50, pScanner) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@dripfeed", 200, 1, 50, pDripFeed) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@addset", 200, 1, 255, pAddSet) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@dualpath", 3, 1, , pDualPath) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@path1", 200, 1, 100, pPath1) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@path2", 200, 1, 100, pPath2) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@ge32", 3, 1, , pGe32) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@ge64", 3, 1, , pGe64) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@genotes", 200, 1, 255, pGeNotes) cmdInsert.Execute If Err.Number <> 0 Then LogToFile "ERROR inserting DNC config: " & Err.Description InsertDNCConfig = False Else InsertDNCConfig = True End If End Function ' ============================================================================ ' HELPER FUNCTIONS - RELATIONSHIPS & WARRANTY ' ============================================================================ Function CreatePCMachineRelationship(pcMachineid, machineNumber) On Error Resume Next If machineNumber = "" Then CreatePCMachineRelationship = False Exit Function End If ' Find equipment by machine number (Phase 2: PCs are machinetypeid 33-35, Equipment is 1-32) Dim strSQL, rsResult, safeMachineNumber safeMachineNumber = Replace(machineNumber, "'", "''") strSQL = "SELECT machineid FROM machines WHERE machinenumber = '" & safeMachineNumber & "' AND machinetypeid NOT IN (33,34,35)" LogToFile "CreatePCMachineRelationship: Executing SQL: " & strSQL Set rsResult = objConn.Execute(strSQL) Dim equipmentMachineid If Not rsResult.EOF Then equipmentMachineid = CLng(rsResult("machineid")) LogToFile "CreatePCMachineRelationship: Found equipment machineid=" & equipmentMachineid & " for machine number: " & machineNumber If Err.Number <> 0 Then LogToFile "CreatePCMachineRelationship: ERROR reading machineid: " & Err.Description Err.Clear rsResult.Close Set rsResult = Nothing CreatePCMachineRelationship = False Exit Function End If Else LogToFile "CreatePCMachineRelationship: Equipment not found for machine number: " & machineNumber rsResult.Close Set rsResult = Nothing CreatePCMachineRelationship = False Exit Function End If rsResult.Close Set rsResult = Nothing LogToFile "CreatePCMachineRelationship: Creating relationship PC " & pcMachineid & " → Controls → Equipment " & equipmentMachineid ' Get "Controls" relationship type ID strSQL = "SELECT relationshiptypeid FROM relationshiptypes WHERE relationshiptype = 'Controls'" Set rsResult = objConn.Execute(strSQL) Dim relationshiptypeid If Not rsResult.EOF Then relationshiptypeid = rsResult("relationshiptypeid") Else LogToFile "CreatePCMachineRelationship: Controls relationship type not found" rsResult.Close Set rsResult = Nothing CreatePCMachineRelationship = False Exit Function End If rsResult.Close Set rsResult = Nothing ' Check if relationship already exists (PC → Equipment) strSQL = "SELECT relationshipid FROM machinerelationships " & _ "WHERE machineid = " & CLng(pcMachineid) & " AND related_machineid = " & CLng(equipmentMachineid) & " AND relationshiptypeid = " & CLng(relationshiptypeid) LogToFile "CreatePCMachineRelationship: Checking for duplicate: " & strSQL Set rsResult = objConn.Execute(strSQL) If Not rsResult.EOF Then ' Relationship already exists LogToFile "CreatePCMachineRelationship: Relationship already exists (relationshipid=" & rsResult("relationshipid") & ")" rsResult.Close Set rsResult = Nothing CreatePCMachineRelationship = True Exit Function End If LogToFile "CreatePCMachineRelationship: No duplicate found, proceeding with INSERT" rsResult.Close Set rsResult = Nothing ' Create new Controls relationship (PC → Equipment) ' Fixed: PC should be machineid, Equipment should be related_machineid Dim cmdInsert Set cmdInsert = Server.CreateObject("ADODB.Command") cmdInsert.ActiveConnection = objConn cmdInsert.CommandText = "INSERT INTO machinerelationships (" & _ "machineid, related_machineid, relationshiptypeid, isactive" & _ ") VALUES (?, ?, ?, 1)" cmdInsert.Parameters.Append cmdInsert.CreateParameter("@pcid", 3, 1, , CLng(pcMachineid)) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@equipmentid", 3, 1, , CLng(equipmentMachineid)) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@reltypeid", 3, 1, , CLng(relationshiptypeid)) cmdInsert.Execute If Err.Number <> 0 Then LogToFile "ERROR creating PC-machine relationship: " & Err.Description CreatePCMachineRelationship = False Else LogToFile "Created Controls relationship: Equipment " & equipmentMachineid & " controlled by PC " & pcMachineid CreatePCMachineRelationship = True End If End Function Sub UpdateWarrantyData(machineid, warrantyEndDate, warrantyStatus, warrantyServiceLevel, warrantyDaysRemaining) On Error Resume Next If warrantyEndDate = "" Then Exit Sub ' Check if warranty record exists Dim strSQL, rsResult strSQL = "SELECT warrantyid FROM warranties WHERE machineid = ?" Set rsResult = ExecuteParameterizedQuery(objConn, strSQL, Array(machineid)) If Not rsResult.EOF Then ' UPDATE existing warranty Dim warrantyid warrantyid = rsResult("warrantyid") rsResult.Close Set rsResult = Nothing Dim cmdUpdate Set cmdUpdate = Server.CreateObject("ADODB.Command") cmdUpdate.ActiveConnection = objConn cmdUpdate.CommandText = "UPDATE warranties SET " & _ "enddate = ?, servicelevel = ?, status = ?, daysremaining = ?, " & _ "lastcheckeddate = NOW() " & _ "WHERE warrantyid = ?" ' Prepare parameter values (VBScript doesn't have IIf) Dim pServiceLevel, pStatus, pDaysRemaining If warrantyServiceLevel <> "" Then pServiceLevel = warrantyServiceLevel Else pServiceLevel = Null If warrantyStatus <> "" Then pStatus = warrantyStatus Else pStatus = Null If IsNumeric(warrantyDaysRemaining) Then pDaysRemaining = CLng(warrantyDaysRemaining) Else pDaysRemaining = Null cmdUpdate.Parameters.Append cmdUpdate.CreateParameter("@enddate", 135, 1, , CDate(warrantyEndDate)) cmdUpdate.Parameters.Append cmdUpdate.CreateParameter("@servicelevel", 200, 1, 100, pServiceLevel) cmdUpdate.Parameters.Append cmdUpdate.CreateParameter("@status", 200, 1, 50, pStatus) cmdUpdate.Parameters.Append cmdUpdate.CreateParameter("@daysrem", 3, 1, , pDaysRemaining) cmdUpdate.Parameters.Append cmdUpdate.CreateParameter("@warrantyid", 3, 1, , CLng(warrantyid)) cmdUpdate.Execute Else ' INSERT new warranty rsResult.Close Set rsResult = Nothing Dim cmdInsert Set cmdInsert = Server.CreateObject("ADODB.Command") cmdInsert.ActiveConnection = objConn cmdInsert.CommandText = "INSERT INTO warranties (" & _ "machineid, enddate, servicelevel, status, daysremaining, lastcheckeddate" & _ ") VALUES (?, ?, ?, ?, ?, NOW())" ' Prepare parameter values (VBScript doesn't have IIf) Dim pServiceLevel2, pStatus2, pDaysRemaining2 If warrantyServiceLevel <> "" Then pServiceLevel2 = warrantyServiceLevel Else pServiceLevel2 = Null If warrantyStatus <> "" Then pStatus2 = warrantyStatus Else pStatus2 = Null If IsNumeric(warrantyDaysRemaining) Then pDaysRemaining2 = CLng(warrantyDaysRemaining) Else pDaysRemaining2 = Null cmdInsert.Parameters.Append cmdInsert.CreateParameter("@machineid", 3, 1, , CLng(machineid)) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@enddate", 135, 1, , CDate(warrantyEndDate)) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@servicelevel", 200, 1, 100, pServiceLevel2) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@status", 200, 1, 50, pStatus2) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@daysrem", 3, 1, , pDaysRemaining2) cmdInsert.Execute End If End Sub ' ============================================================================ ' HELPER FUNCTIONS - LOOKUPS ' ============================================================================ Function GetOrCreateVendor(conn, vendorName) On Error Resume Next If vendorName = "" Then GetOrCreateVendor = 0 Exit Function End If ' Sanitize vendor name (prevent SQL injection) Dim safeName safeName = Replace(vendorName, "'", "''") ' Check if vendor exists Dim strSQL, rsResult strSQL = "SELECT vendorid FROM vendors WHERE vendor = '" & safeName & "'" Set rsResult = conn.Execute(strSQL) If Err.Number <> 0 Then LogToFile "ERROR querying vendor: " & Err.Description GetOrCreateVendor = 0 Exit Function End If If Not rsResult.EOF Then GetOrCreateVendor = CLng(rsResult("vendorid")) rsResult.Close Set rsResult = Nothing LogToFile "Found existing vendor ID: " & GetOrCreateVendor Exit Function End If rsResult.Close Set rsResult = Nothing ' Create new vendor strSQL = "INSERT INTO vendors (vendor) VALUES ('" & safeName & "')" conn.Execute strSQL If Err.Number <> 0 Then LogToFile "ERROR creating vendor: " & Err.Description GetOrCreateVendor = 0 Exit Function End If ' Get new vendor ID strSQL = "SELECT LAST_INSERT_ID() AS newid" Set rsResult = conn.Execute(strSQL) GetOrCreateVendor = CLng(rsResult("newid")) rsResult.Close Set rsResult = Nothing LogToFile "Created new vendor ID: " & GetOrCreateVendor End Function Function GetOrCreateModel(conn, modelName, vendorId) On Error Resume Next If modelName = "" Then GetOrCreateModel = 1 ' Return TBD model Exit Function End If If vendorId = 0 Then GetOrCreateModel = 1 Exit Function End If ' Check if model exists for this vendor Dim strSQL, rsResult strSQL = "SELECT modelnumberid FROM models WHERE modelnumber = ? AND vendorid = ?" Set rsResult = ExecuteParameterizedQuery(conn, strSQL, Array(modelName, vendorId)) If Not rsResult.EOF Then GetOrCreateModel = rsResult("modelnumberid") rsResult.Close Set rsResult = Nothing Exit Function End If rsResult.Close Set rsResult = Nothing ' Create new model Dim cmdInsert Set cmdInsert = Server.CreateObject("ADODB.Command") cmdInsert.ActiveConnection = conn cmdInsert.CommandText = "INSERT INTO models (modelnumber, vendorid, notes, isactive) VALUES (?, ?, ?, 1)" cmdInsert.Parameters.Append cmdInsert.CreateParameter("@model", 200, 1, 100, modelName) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@vendorid", 3, 1, , CLng(vendorId)) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@notes", 200, 1, 255, "Auto-imported via PowerShell") cmdInsert.Execute If Err.Number <> 0 Then LogToFile "ERROR creating model: " & Err.Description GetOrCreateModel = 1 Exit Function End If ' Get new model ID strSQL = "SELECT LAST_INSERT_ID() AS newid" Set rsResult = conn.Execute(strSQL) GetOrCreateModel = rsResult("newid") rsResult.Close Set rsResult = Nothing End Function ' ============================================================================ ' LEGACY FUNCTION REMOVED: GetOrCreatePCType ' This function was replaced by GetMachineTypeIdFromPCType which maps ' PC type strings directly to machinetypeid (33=Standard, 34=Engineer, 35=Shopfloor) ' Removed: 2025-11-17 during Phase 2 migration from pc/pctype to machines/machinetypes ' ============================================================================ Function GetOrCreateOSID(osVersion) On Error Resume Next If osVersion = "" Then GetOrCreateOSID = 0 Exit Function End If ' Sanitize OS name Dim safeName safeName = Replace(osVersion, "'", "''") ' Check if OS exists Dim strSQL, rsResult strSQL = "SELECT osid FROM operatingsystems WHERE operatingsystem = '" & safeName & "'" Set rsResult = objConn.Execute(strSQL) If Err.Number <> 0 Then LogToFile "ERROR querying OS: " & Err.Description GetOrCreateOSID = 0 Exit Function End If If Not rsResult.EOF Then GetOrCreateOSID = CLng(rsResult("osid")) rsResult.Close Set rsResult = Nothing Exit Function End If rsResult.Close Set rsResult = Nothing ' Create new OS strSQL = "INSERT INTO operatingsystems (operatingsystem) VALUES ('" & safeName & "')" objConn.Execute strSQL If Err.Number <> 0 Then LogToFile "ERROR creating OS: " & Err.Description GetOrCreateOSID = 0 Exit Function End If ' Get new OS ID strSQL = "SELECT LAST_INSERT_ID() AS newid" Set rsResult = objConn.Execute(strSQL) GetOrCreateOSID = CLng(rsResult("newid")) rsResult.Close Set rsResult = Nothing End Function Function GetOrCreateApplication(appName, appVersion) On Error Resume Next LogToFile "GetOrCreateApplication called with appName='" & appName & "', appVersion='" & appVersion & "'" If appName = "" Then LogToFile "ERROR: appName is empty" GetOrCreateApplication = 0 Exit Function End If ' Check if application exists Dim strSQL, rsResult strSQL = "SELECT applicationid FROM applications WHERE applicationname = ?" Set rsResult = ExecuteParameterizedQuery(objConn, strSQL, Array(appName)) If Err.Number <> 0 Then LogToFile "ERROR querying applications: " & Err.Description GetOrCreateApplication = 0 Exit Function End If If Not rsResult.EOF Then GetOrCreateApplication = rsResult("applicationid") LogToFile "Found existing applicationid: " & GetOrCreateApplication rsResult.Close Set rsResult = Nothing Exit Function End If rsResult.Close Set rsResult = Nothing LogToFile "Application not found, creating new..." ' Create new application ' Prepare parameter value (VBScript doesn't have IIf) Dim pVersion If appVersion <> "" Then pVersion = appVersion Else pVersion = Null Dim cmdInsert Set cmdInsert = Server.CreateObject("ADODB.Command") cmdInsert.ActiveConnection = objConn cmdInsert.CommandText = "INSERT INTO applications (applicationname, version) VALUES (?, ?)" cmdInsert.Parameters.Append cmdInsert.CreateParameter("@appname", 200, 1, 255, appName) cmdInsert.Parameters.Append cmdInsert.CreateParameter("@version", 200, 1, 50, pVersion) cmdInsert.Execute If Err.Number <> 0 Then LogToFile "ERROR creating application: " & Err.Description GetOrCreateApplication = 0 Exit Function End If ' Get new application ID strSQL = "SELECT LAST_INSERT_ID() AS newid" Set rsResult = objConn.Execute(strSQL) GetOrCreateApplication = rsResult("newid") LogToFile "Created new application with id: " & GetOrCreateApplication rsResult.Close Set rsResult = Nothing End Function Function GetMachineTypeIdFromPCType(pcTypeString) On Error Resume Next ' Direct mapping from pcType parameter to machinetypeid (Phase 2 schema) ' Phase 2 PC Machine Types: 33=Standard PC, 34=Engineering PC, 35=Shopfloor PC Dim pcTypeClean pcTypeClean = Trim(UCase(pcTypeString)) Select Case pcTypeClean Case "ENGINEER", "ENGINEERING" GetMachineTypeIdFromPCType = 34 ' Engineering PC Case "SHOPFLOOR", "SHOP FLOOR" GetMachineTypeIdFromPCType = 35 ' Shopfloor PC Case "STANDARD", "" GetMachineTypeIdFromPCType = 33 ' Standard PC Case Else LogToFile "Unknown pcType '" & pcTypeString & "', defaulting to Standard PC (33)" GetMachineTypeIdFromPCType = 33 ' Default to Standard PC End Select LogToFile "Mapped pcType '" & pcTypeString & "' to machinetypeid: " & GetMachineTypeIdFromPCType End Function ' ============================================================================ ' HELPER FUNCTIONS - JSON PARSING (Simple) ' ============================================================================ Function ParseJSONArray(jsonString) ' Very simple JSON array parser - splits by objects ' Assumes format: [{"key":"value",...},{"key":"value",...}] If jsonString = "" Or IsNull(jsonString) Then ParseJSONArray = Array() Exit Function End If ' Remove outer brackets and whitespace Dim cleaned cleaned = Trim(jsonString) If Left(cleaned, 1) = "[" Then cleaned = Mid(cleaned, 2) If Right(cleaned, 1) = "]" Then cleaned = Left(cleaned, Len(cleaned) - 1) ' Split by },{ Dim items items = Split(cleaned, "},{") ' Clean up each item (add back braces) Dim i For i = 0 To UBound(items) items(i) = Trim(items(i)) If Left(items(i), 1) <> "{" Then items(i) = "{" & items(i) If Right(items(i), 1) <> "}" Then items(i) = items(i) & "}" Next ParseJSONArray = items End Function Function ParseJSONObject(jsonString) ' Return a dictionary for simple JSON parsing Dim dict Set dict = Server.CreateObject("Scripting.Dictionary") If jsonString = "" Or IsNull(jsonString) Then Set ParseJSONObject = dict Exit Function End If ' Simple key-value extraction Dim cleaned cleaned = Trim(jsonString) If Left(cleaned, 1) = "{" Then cleaned = Mid(cleaned, 2) If Right(cleaned, 1) = "}" Then cleaned = Left(cleaned, Len(cleaned) - 1) ' Split by comma (simple approach) Dim pairs, pair, i pairs = Split(cleaned, ",") For i = 0 To UBound(pairs) pair = Trim(pairs(i)) If InStr(pair, ":") > 0 Then Dim key, value key = Trim(Split(pair, ":")(0)) value = Trim(Split(pair, ":")(1)) ' Remove quotes key = Replace(Replace(key, """", ""), "'", "") value = Replace(Replace(value, """", ""), "'", "") dict.Add key, value End If Next Set ParseJSONObject = dict End Function Function GetJSONValue(jsonObjectString, keyName) ' Extract a single value from JSON object string ' Format: {"Key":"Value",...} If jsonObjectString = "" Or IsNull(jsonObjectString) Then GetJSONValue = "" Exit Function End If Dim pattern pattern = """" & keyName & """\s*:\s*""([^""]*)""|""" & keyName & """\s*:\s*([^,}]*)" Dim regex Set regex = New RegExp regex.Pattern = pattern regex.IgnoreCase = True Dim matches Set matches = regex.Execute(jsonObjectString) If matches.Count > 0 Then If matches(0).SubMatches(0) <> "" Then GetJSONValue = matches(0).SubMatches(0) Else GetJSONValue = Trim(matches(0).SubMatches(1)) End If Else GetJSONValue = "" End If End Function Function GetDictValue(dict, keyName) If dict.Exists(keyName) Then GetDictValue = dict(keyName) Else GetDictValue = "" End If End Function ' ============================================================================ ' HELPER FUNCTIONS - UTILITIES ' ============================================================================ Function ConvertBoolToInt(value) ' Convert various boolean representations to 0/1 or -1 for NULL If IsNull(value) Or value = "" Then ConvertBoolToInt = -1 Exit Function End If Dim strValue strValue = LCase(Trim(CStr(value))) Select Case strValue Case "true", "1", "yes" ConvertBoolToInt = 1 Case "false", "0", "no" ConvertBoolToInt = 0 Case Else ConvertBoolToInt = -1 End Select End Function Function IsIPAddress(value) ' Simple IP address validation If value = "" Then IsIPAddress = False Exit Function End If Dim regex Set regex = New RegExp regex.Pattern = "^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$" IsIPAddress = regex.Test(value) End Function ' ============================================================================ ' HELPER FUNCTIONS - RESPONSE & LOGGING ' ============================================================================ Sub SendResponse(responseDict) ' Convert dictionary to JSON and send Response.Clear Response.ContentType = "application/json" Response.Write DictToJSON(responseDict) Response.End End Sub Sub SendError(message) Response.Clear Response.ContentType = "application/json" Response.Write "{""success"":false,""error"":""" & EscapeJSON(message) & """}" Response.End End Sub Function DictToJSON(dict) ' Simple dictionary to JSON converter Dim json, key, value json = "{" Dim first first = True For Each key In dict.Keys If Not first Then json = json & "," first = False value = dict(key) json = json & """" & EscapeJSON(key) & """:" If IsObject(value) Then ' Nested dictionary json = json & DictToJSON(value) ElseIf IsNull(value) Then json = json & "null" ElseIf VarType(value) = vbBoolean Then If value Then json = json & "true" Else json = json & "false" End If ElseIf IsNumeric(value) Then json = json & value Else json = json & """" & EscapeJSON(CStr(value)) & """" End If Next json = json & "}" DictToJSON = json End Function Function EscapeJSON(value) ' Escape special characters for JSON Dim result result = CStr(value) result = Replace(result, "\", "\\") result = Replace(result, """", "\""") result = Replace(result, vbCr, "\r") result = Replace(result, vbLf, "\n") result = Replace(result, vbTab, "\t") EscapeJSON = result End Function Sub LogToFile(message) On Error Resume Next Dim fso, logFile, logPath logPath = Server.MapPath("./logs/api.log") Set fso = Server.CreateObject("Scripting.FileSystemObject") ' Create logs directory if it doesn't exist Dim logsDir logsDir = Server.MapPath("./logs") If Not fso.FolderExists(logsDir) Then fso.CreateFolder logsDir End If ' Append to log file Set logFile = fso.OpenTextFile(logPath, 8, True) ' 8 = ForAppending logFile.WriteLine Now() & " - " & message logFile.Close Set logFile = Nothing Set fso = Nothing End Sub %>