659e8bad4b
- PCs identified by pctypeid IS NOT NULL instead of machinetypeid list - Equipment identified by pctypeid IS NULL instead of NOT IN list - Fixed devicecamera.asp: IDF dropdown uses machinetypeid 17, not 34 - Fixed displaypcs.asp: measuring tool filter uses pctypeid = 7 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude <noreply@anthropic.com>
2223 lines
80 KiB
Plaintext
2223 lines
80 KiB
Plaintext
<%@ Language=VBScript %>
|
|
<%
|
|
' ============================================================================
|
|
' DATABASE CONNECTION - Created directly in api.asp to avoid scoping issues
|
|
' ============================================================================
|
|
Dim objConn, rs, DB_CONN_STRING
|
|
' Use direct MySQL ODBC driver connection (same as sql.asp) instead of DSN
|
|
DB_CONN_STRING = "Driver={MySQL ODBC 9.4 Unicode Driver};" & _
|
|
"Server=192.168.122.1;" & _
|
|
"Port=3306;" & _
|
|
"Database=shopdb;" & _
|
|
"User=570005354;" & _
|
|
"Password=570005354;" & _
|
|
"Option=3;" & _
|
|
"Pooling=True;Max Pool Size=100;"
|
|
Session.Timeout = 15
|
|
Set objConn = Server.CreateObject("ADODB.Connection")
|
|
objConn.ConnectionString = DB_CONN_STRING
|
|
objConn.Open
|
|
Set rs = Server.CreateObject("ADODB.Recordset")
|
|
|
|
Response.Buffer = True
|
|
Response.ContentType = "application/json"
|
|
|
|
' ============================================================================
|
|
' 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-21 - Use sql.asp include for database connection
|
|
' Schema: Phase 2 (machines table, machinetypeid 33-43 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 "updateWinRMStatus"
|
|
UpdateWinRMStatus()
|
|
Case "getDashboardData"
|
|
GetDashboardData()
|
|
Case "getShopfloorPCs"
|
|
GetShopfloorPCs()
|
|
Case "getRecordedIP"
|
|
GetRecordedIP()
|
|
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")
|
|
|
|
' VNC detection (optional)
|
|
Dim hasVnc
|
|
hasVnc = Trim(Request.Form("hasVnc") & "")
|
|
|
|
' WinRM detection (optional)
|
|
Dim hasWinRM
|
|
hasWinRM = Trim(Request.Form("hasWinRM") & "")
|
|
|
|
' 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 (inlined to avoid VBScript scoping issues)
|
|
osid = 0
|
|
If osVersion <> "" Then
|
|
Dim safeOsVersion, rsOS
|
|
safeOsVersion = Replace(osVersion, "'", "''")
|
|
Set rsOS = objConn.Execute("SELECT osid FROM operatingsystems WHERE operatingsystem = '" & safeOsVersion & "'")
|
|
If Not rsOS.EOF Then
|
|
osid = CLng(rsOS("osid"))
|
|
Else
|
|
objConn.Execute "INSERT INTO operatingsystems (operatingsystem) VALUES ('" & safeOsVersion & "')"
|
|
Set rsOS = objConn.Execute("SELECT LAST_INSERT_ID() AS newid")
|
|
osid = CLng(rsOS("newid"))
|
|
End If
|
|
rsOS.Close
|
|
Set rsOS = Nothing
|
|
End If
|
|
pcstatusid = 3 ' Default to "In Use"
|
|
|
|
' Clear existing shopfloor data if this is a shopfloor PC
|
|
Dim machineid
|
|
If pcType = "Shopfloor" Then
|
|
ClearShopfloorData hostname
|
|
If Err.Number <> 0 Then
|
|
Err.Clear
|
|
End If
|
|
End If
|
|
|
|
' Clear any previous errors before InsertOrUpdatePC
|
|
Err.Clear
|
|
|
|
' Inline PC insert/update logic (avoids function scoping issues on production IIS)
|
|
Dim debugMsg
|
|
debugMsg = ""
|
|
|
|
' Check objConn
|
|
If objConn Is Nothing Then
|
|
SendError debugMsg & "1-objConn is Nothing"
|
|
Exit Sub
|
|
End If
|
|
debugMsg = debugMsg & "1-OK,"
|
|
|
|
If objConn.State <> 1 Then
|
|
SendError debugMsg & "2-objConn not open state=" & objConn.State
|
|
Exit Sub
|
|
End If
|
|
debugMsg = debugMsg & "2-OK,"
|
|
|
|
' Get vendor ID inline
|
|
Dim vendorId, modelId, machineTypeId
|
|
Dim safeManufacturer, safeModel, rsVendor, rsModel
|
|
vendorId = 0
|
|
modelId = 1
|
|
|
|
If manufacturer <> "" Then
|
|
safeManufacturer = Replace(manufacturer, "'", "''")
|
|
Set rsVendor = objConn.Execute("SELECT vendorid FROM vendors WHERE vendor = '" & safeManufacturer & "'")
|
|
If Err.Number <> 0 Then
|
|
SendError debugMsg & "3-vendor query failed: " & Err.Description
|
|
Exit Sub
|
|
End If
|
|
debugMsg = debugMsg & "3-OK,"
|
|
|
|
If Not rsVendor.EOF Then
|
|
vendorId = CLng(rsVendor("vendorid"))
|
|
debugMsg = debugMsg & "3a-found " & vendorId & ","
|
|
Else
|
|
objConn.Execute "INSERT INTO vendors (vendor) VALUES ('" & safeManufacturer & "')"
|
|
If Err.Number <> 0 Then
|
|
SendError debugMsg & "3b-vendor insert failed: " & Err.Description
|
|
Exit Sub
|
|
End If
|
|
Set rsVendor = objConn.Execute("SELECT LAST_INSERT_ID() AS newid")
|
|
vendorId = CLng(rsVendor("newid"))
|
|
debugMsg = debugMsg & "3b-created " & vendorId & ","
|
|
End If
|
|
rsVendor.Close
|
|
Set rsVendor = Nothing
|
|
End If
|
|
debugMsg = debugMsg & "4-vendorId=" & vendorId & ","
|
|
|
|
' Get model ID inline
|
|
If model <> "" And vendorId > 0 Then
|
|
safeModel = Replace(model, "'", "''")
|
|
Set rsModel = objConn.Execute("SELECT modelnumberid FROM models WHERE modelnumber = '" & safeModel & "' AND vendorid = " & vendorId)
|
|
If Err.Number <> 0 Then
|
|
SendError debugMsg & "5-model query failed: " & Err.Description
|
|
Exit Sub
|
|
End If
|
|
debugMsg = debugMsg & "5-OK,"
|
|
|
|
If Not rsModel.EOF Then
|
|
modelId = CLng(rsModel("modelnumberid"))
|
|
Else
|
|
objConn.Execute "INSERT INTO models (modelnumber, vendorid, notes, isactive) VALUES ('" & safeModel & "', " & vendorId & ", 'Auto-imported', 1)"
|
|
If Err.Number <> 0 Then
|
|
SendError debugMsg & "5b-model insert failed: " & Err.Description
|
|
Exit Sub
|
|
End If
|
|
Set rsModel = objConn.Execute("SELECT LAST_INSERT_ID() AS newid")
|
|
modelId = CLng(rsModel("newid"))
|
|
End If
|
|
rsModel.Close
|
|
Set rsModel = Nothing
|
|
End If
|
|
debugMsg = debugMsg & "6-modelId=" & modelId & ","
|
|
|
|
' Get machine type ID
|
|
Select Case LCase(pcType)
|
|
Case "standard"
|
|
machineTypeId = 33
|
|
Case "engineer", "engineering"
|
|
machineTypeId = 34
|
|
Case "shopfloor", "shop floor"
|
|
machineTypeId = 35
|
|
Case "cmm"
|
|
machineTypeId = 41
|
|
Case "wax trace", "waxtrace", "wax"
|
|
machineTypeId = 42
|
|
Case "keyence", "measuring", "measuring tool"
|
|
machineTypeId = 43
|
|
Case Else
|
|
machineTypeId = 33
|
|
End Select
|
|
debugMsg = debugMsg & "7-typeId=" & machineTypeId & ","
|
|
|
|
' Check if PC exists
|
|
Dim strSQL, rsResult, safeHostname, safeSerial
|
|
safeHostname = Replace(hostname, "'", "''")
|
|
strSQL = "SELECT machineid FROM machines WHERE hostname = '" & safeHostname & "' AND pctypeid IS NOT NULL"
|
|
Set rsResult = objConn.Execute(strSQL)
|
|
If Err.Number <> 0 Then
|
|
SendError debugMsg & "8-PC check failed: " & Err.Description
|
|
Exit Sub
|
|
End If
|
|
debugMsg = debugMsg & "8-OK,"
|
|
|
|
If Not rsResult.EOF Then
|
|
' PC exists - UPDATE
|
|
machineid = rsResult("machineid")
|
|
rsResult.Close
|
|
Set rsResult = Nothing
|
|
debugMsg = debugMsg & "9-UPDATE id=" & machineid & ","
|
|
|
|
safeSerial = Replace(serialnumber, "'", "''")
|
|
|
|
' Determine VNC value (1 or 0)
|
|
Dim vncValue
|
|
If hasVnc = "1" Then
|
|
vncValue = 1
|
|
Else
|
|
vncValue = 0
|
|
End If
|
|
|
|
' Determine WinRM value (1 or 0)
|
|
Dim winrmValue
|
|
If hasWinRM = "1" Then
|
|
winrmValue = 1
|
|
Else
|
|
winrmValue = 0
|
|
End If
|
|
|
|
strSQL = "UPDATE machines SET serialnumber='" & safeSerial & "', modelnumberid=" & modelId & ", machinetypeid=" & machineTypeId & ", osid=" & osid & ", isvnc=" & vncValue & ", iswinrm=" & winrmValue & ", lastupdated=NOW() WHERE machineid=" & machineid
|
|
objConn.Execute strSQL
|
|
If Err.Number <> 0 Then
|
|
SendError debugMsg & "10-UPDATE failed: " & Err.Description
|
|
Exit Sub
|
|
End If
|
|
debugMsg = debugMsg & "10-OK,"
|
|
Else
|
|
' PC doesn't exist - INSERT
|
|
rsResult.Close
|
|
Set rsResult = Nothing
|
|
debugMsg = debugMsg & "9-INSERT,"
|
|
|
|
safeSerial = Replace(serialnumber, "'", "''")
|
|
|
|
' Determine VNC value for insert (reuse logic from update branch)
|
|
Dim vncValueInsert
|
|
If hasVnc = "1" Then
|
|
vncValueInsert = 1
|
|
Else
|
|
vncValueInsert = 0
|
|
End If
|
|
|
|
' Determine WinRM value for insert
|
|
Dim winrmValueInsert
|
|
If hasWinRM = "1" Then
|
|
winrmValueInsert = 1
|
|
Else
|
|
winrmValueInsert = 0
|
|
End If
|
|
|
|
strSQL = "INSERT INTO machines (hostname, serialnumber, modelnumberid, machinetypeid, osid, machinestatusid, isvnc, iswinrm, lastupdated) VALUES ('" & safeHostname & "', '" & safeSerial & "', " & modelId & ", " & machineTypeId & ", " & osid & ", " & pcstatusid & ", " & vncValueInsert & ", " & winrmValueInsert & ", NOW())"
|
|
objConn.Execute strSQL
|
|
If Err.Number <> 0 Then
|
|
SendError debugMsg & "10-INSERT failed: " & Err.Description
|
|
Exit Sub
|
|
End If
|
|
Set rsResult = objConn.Execute("SELECT LAST_INSERT_ID() AS newid")
|
|
machineid = CLng(rsResult("newid"))
|
|
rsResult.Close
|
|
Set rsResult = Nothing
|
|
debugMsg = debugMsg & "10-OK id=" & machineid & ","
|
|
End If
|
|
|
|
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
|
|
|
|
' Clear existing network interfaces before inserting new ones (prevents duplicates on re-scan)
|
|
If networkInterfaces <> "" Then
|
|
Dim cmdClearInterfaces
|
|
Set cmdClearInterfaces = Server.CreateObject("ADODB.Command")
|
|
cmdClearInterfaces.ActiveConnection = objConn
|
|
cmdClearInterfaces.CommandText = "DELETE FROM communications WHERE machineid = ? AND comstypeid = 1"
|
|
cmdClearInterfaces.Parameters.Append cmdClearInterfaces.CreateParameter("@machineid", 3, 1, , CLng(machineid))
|
|
cmdClearInterfaces.Execute
|
|
LogToFile "Cleared " & cmdClearInterfaces.RecordsAffected & " existing network interfaces"
|
|
Set cmdClearInterfaces = Nothing
|
|
End If
|
|
|
|
' 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 (flattened to avoid nested dictionary issues)
|
|
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"
|
|
responseObj.Add "networkInterfacesCount", interfaceCount
|
|
responseObj.Add "commConfigsCount", commConfigCount
|
|
responseObj.Add "dncConfigSuccess", dncSuccess
|
|
responseObj.Add "relationshipCreated", relationshipCreated
|
|
|
|
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 = ""
|
|
Dim safePrinterFQDN
|
|
safePrinterFQDN = Replace(printerFQDN, "'", "''")
|
|
|
|
' Try exact FQDN match first
|
|
Dim strSQL, rsResult
|
|
strSQL = "SELECT printerid FROM printers WHERE fqdn = '" & safePrinterFQDN & "'"
|
|
Set rsResult = objConn.Execute(strSQL)
|
|
If Not rsResult.EOF Then
|
|
printerid = rsResult("printerid")
|
|
matchMethod = "fqdn"
|
|
End If
|
|
rsResult.Close
|
|
Set rsResult = Nothing
|
|
|
|
' Try printer windows name match
|
|
If printerid = 0 Then
|
|
strSQL = "SELECT printerid FROM printers WHERE printerwindowsname = '" & safePrinterFQDN & "'"
|
|
Set rsResult = objConn.Execute(strSQL)
|
|
If Not rsResult.EOF Then
|
|
printerid = rsResult("printerid")
|
|
matchMethod = "windowsname"
|
|
End If
|
|
rsResult.Close
|
|
Set rsResult = Nothing
|
|
End If
|
|
|
|
' Try IP address match
|
|
If printerid = 0 And IsIPAddress(printerFQDN) Then
|
|
strSQL = "SELECT printerid FROM printers WHERE ipaddress = '" & safePrinterFQDN & "'"
|
|
Set rsResult = objConn.Execute(strSQL)
|
|
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 (flattened to avoid nested dictionary issues)
|
|
Dim responseObj
|
|
Set responseObj = Server.CreateObject("Scripting.Dictionary")
|
|
responseObj.Add "success", True
|
|
responseObj.Add "message", "Printer mapping updated"
|
|
responseObj.Add "printerId", printerid
|
|
responseObj.Add "machinesUpdated", 1
|
|
responseObj.Add "matchMethod", matchMethod
|
|
|
|
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)
|
|
LogToFile "Raw installedApps: " & installedApps
|
|
|
|
Dim appsArray
|
|
appsArray = ParseJSONArray(installedApps)
|
|
|
|
LogToFile "Parsed apps array, count: " & (UBound(appsArray) + 1)
|
|
|
|
' Debug: show first parsed item
|
|
If UBound(appsArray) >= 0 Then
|
|
LogToFile "First item after parse: " & appsArray(0)
|
|
End If
|
|
|
|
' Clear existing app mappings for this PC using direct SQL
|
|
Dim deleteSQL
|
|
deleteSQL = "DELETE FROM installedapps WHERE machineid = " & CLng(machineid)
|
|
LogToFile "DELETE SQL: " & deleteSQL
|
|
objConn.Execute deleteSQL
|
|
|
|
If Err.Number <> 0 Then
|
|
LogToFile "ERROR on DELETE: " & Err.Number & " - " & Err.Description
|
|
Err.Clear
|
|
Else
|
|
LogToFile "DELETE completed successfully"
|
|
End If
|
|
|
|
' Insert new app mappings
|
|
Dim appCount, i, appName, appVersion, appid, appversionid, cmdInsert, appidStr, insertSQL
|
|
Dim debugLoopError, safeVer, verSQL, rsVer
|
|
debugLoopError = ""
|
|
appCount = 0
|
|
Err.Clear
|
|
|
|
For i = 0 To UBound(appsArray)
|
|
' Get appid directly (pre-mapped from CSV)
|
|
appid = 0
|
|
appidStr = Trim(GetJSONValue(appsArray(i), "appid") & "")
|
|
If appidStr <> "" And IsNumeric(appidStr) Then appid = CLng(appidStr)
|
|
|
|
' Get version and app name for logging
|
|
appVersion = Trim(GetJSONValue(appsArray(i), "version") & "")
|
|
appName = Trim(GetJSONValue(appsArray(i), "appname") & "")
|
|
|
|
LogToFile "App " & i & ": appid=" & appid & ", appname='" & appName & "', version='" & appVersion & "'"
|
|
|
|
If appid > 0 Then
|
|
appversionid = 0
|
|
Err.Clear
|
|
|
|
' Version lookup and creation using global rs recordset
|
|
If appVersion <> "" And Not IsNull(appVersion) Then
|
|
safeVer = Replace(appVersion, "'", "''")
|
|
verSQL = "SELECT appversionid FROM appversions WHERE appid = " & CLng(appid) & " AND version = '" & safeVer & "'"
|
|
|
|
rs.Open verSQL, objConn, 0, 1
|
|
If Err.Number <> 0 Then
|
|
debugLoopError = debugLoopError & " | rs.Open err:" & Err.Number
|
|
Err.Clear
|
|
ElseIf Not rs.EOF Then
|
|
appversionid = CLng(rs("appversionid"))
|
|
Else
|
|
' Version not found - create it
|
|
If rs.State = 1 Then rs.Close
|
|
verSQL = "INSERT INTO appversions (appid, version) VALUES (" & CLng(appid) & ", '" & safeVer & "')"
|
|
objConn.Execute verSQL
|
|
If Err.Number = 0 Then
|
|
' Get the new ID
|
|
rs.Open "SELECT LAST_INSERT_ID() AS newid", objConn, 0, 1
|
|
If Err.Number = 0 And Not rs.EOF Then
|
|
appversionid = CLng(rs("newid"))
|
|
End If
|
|
If Err.Number <> 0 Then Err.Clear
|
|
Else
|
|
Err.Clear
|
|
End If
|
|
End If
|
|
If rs.State = 1 Then rs.Close
|
|
End If
|
|
|
|
' Insert app
|
|
If appversionid > 0 Then
|
|
insertSQL = "INSERT INTO installedapps (machineid, appid, appversionid) VALUES (" & CLng(machineid) & ", " & CLng(appid) & ", " & CLng(appversionid) & ")"
|
|
Else
|
|
insertSQL = "INSERT INTO installedapps (machineid, appid) VALUES (" & CLng(machineid) & ", " & CLng(appid) & ")"
|
|
End If
|
|
objConn.Execute insertSQL
|
|
|
|
If Err.Number = 0 Then
|
|
appCount = appCount + 1
|
|
Else
|
|
debugLoopError = debugLoopError & " | INSERT error: " & Err.Number & " - " & Err.Description
|
|
Err.Clear
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
LogToFile "Installed apps inserted: " & appCount
|
|
|
|
' Send success response with debug info
|
|
Dim responseObj
|
|
Set responseObj = Server.CreateObject("Scripting.Dictionary")
|
|
responseObj.Add "success", True
|
|
responseObj.Add "message", "Installed applications updated"
|
|
responseObj.Add "appsProcessed", appCount
|
|
responseObj.Add "machineid", machineid
|
|
responseObj.Add "debugError", debugLoopError
|
|
|
|
SendResponse responseObj
|
|
End Sub
|
|
|
|
Sub GetDashboardData()
|
|
' Simple health check endpoint
|
|
Dim responseObj, connStatus
|
|
Set responseObj = Server.CreateObject("Scripting.Dictionary")
|
|
responseObj.Add "success", True
|
|
responseObj.Add "message", "ShopDB API is online - v13 (inlined all queries)"
|
|
responseObj.Add "version", "1.0"
|
|
responseObj.Add "schema", "Phase 2"
|
|
|
|
' Debug: check objConn status
|
|
If objConn Is Nothing Then
|
|
connStatus = "objConn is Nothing"
|
|
ElseIf objConn.State = 1 Then
|
|
connStatus = "objConn is Open"
|
|
Else
|
|
connStatus = "objConn state=" & objConn.State
|
|
End If
|
|
responseObj.Add "connStatus", connStatus
|
|
|
|
SendResponse responseObj
|
|
End Sub
|
|
|
|
Sub GetShopfloorPCs()
|
|
' Returns list of all active shopfloor PCs for remote management
|
|
On Error Resume Next
|
|
|
|
Dim rsPC, strSQL, pcList, pcCount, pcData
|
|
|
|
' Query active shopfloor PCs only (pctype = 'Shopfloor')
|
|
' Include hostname, machineid, machinenumber (equipment), IP address, last updated
|
|
strSQL = "SELECT m.machineid, m.hostname, m.machinenumber, m.serialnumber, " & _
|
|
"m.loggedinuser, m.lastupdated, " & _
|
|
"c.address AS ipaddress, " & _
|
|
"pt.typename AS pctype " & _
|
|
"FROM machines m " & _
|
|
"LEFT JOIN communications c ON m.machineid = c.machineid AND c.isprimary = 1 AND c.comstypeid = 1 " & _
|
|
"INNER JOIN pctype pt ON m.pctypeid = pt.pctypeid " & _
|
|
"WHERE m.isactive = 1 " & _
|
|
"AND pt.typename = 'Shopfloor' " & _
|
|
"ORDER BY m.hostname ASC"
|
|
|
|
Set rsPC = objConn.Execute(strSQL)
|
|
|
|
If Err.Number <> 0 Then
|
|
SendError "Database error: " & Err.Description
|
|
Exit Sub
|
|
End If
|
|
|
|
' Build JSON array of PCs
|
|
pcList = ""
|
|
pcCount = 0
|
|
|
|
Do While Not rsPC.EOF
|
|
If pcList <> "" Then pcList = pcList & ","
|
|
|
|
' Build individual PC object
|
|
pcData = "{"
|
|
pcData = pcData & """machineid"":" & rsPC("machineid") & ","
|
|
pcData = pcData & """hostname"":""" & EscapeJSON(rsPC("hostname") & "") & ""","
|
|
pcData = pcData & """machinenumber"":""" & EscapeJSON(rsPC("machinenumber") & "") & ""","
|
|
pcData = pcData & """serialnumber"":""" & EscapeJSON(rsPC("serialnumber") & "") & ""","
|
|
pcData = pcData & """ipaddress"":""" & EscapeJSON(rsPC("ipaddress") & "") & ""","
|
|
pcData = pcData & """loggedinuser"":""" & EscapeJSON(rsPC("loggedinuser") & "") & ""","
|
|
pcData = pcData & """pctype"":""" & EscapeJSON(rsPC("pctype") & "") & ""","
|
|
|
|
' Handle lastupdated date
|
|
If Not IsNull(rsPC("lastupdated")) Then
|
|
pcData = pcData & """lastupdated"":""" & FormatDateTime(rsPC("lastupdated"), 2) & " " & FormatDateTime(rsPC("lastupdated"), 4) & """"
|
|
Else
|
|
pcData = pcData & """lastupdated"":null"
|
|
End If
|
|
|
|
pcData = pcData & "}"
|
|
pcList = pcList & pcData
|
|
pcCount = pcCount + 1
|
|
|
|
rsPC.MoveNext
|
|
Loop
|
|
|
|
rsPC.Close
|
|
Set rsPC = Nothing
|
|
|
|
' Send response
|
|
Response.Write "{""success"":true,""count"":" & pcCount & ",""data"":[" & pcList & "]}"
|
|
End Sub
|
|
|
|
Sub GetRecordedIP()
|
|
On Error Resume Next
|
|
Err.Clear
|
|
|
|
Dim hostname, ipaddress
|
|
hostname = Trim(Request.Form("hostname"))
|
|
|
|
If hostname = "" Then
|
|
SendError "Missing hostname parameter"
|
|
Exit Sub
|
|
End If
|
|
|
|
' Look up primary IP (10.134.*.*) from communications table for this hostname
|
|
Dim cmd, rs
|
|
Set cmd = Server.CreateObject("ADODB.Command")
|
|
cmd.ActiveConnection = objConn
|
|
cmd.CommandText = "SELECT c.address FROM communications c " & _
|
|
"INNER JOIN machines m ON c.machineid = m.machineid " & _
|
|
"WHERE m.hostname = ? AND c.address LIKE '10.134.%' " & _
|
|
"ORDER BY c.isprimary DESC, c.communicationid ASC LIMIT 1"
|
|
cmd.Parameters.Append cmd.CreateParameter("@hostname", 200, 1, 50, hostname)
|
|
|
|
Set rs = cmd.Execute()
|
|
|
|
If Err.Number <> 0 Then
|
|
SendError "Database error: " & Err.Description
|
|
Exit Sub
|
|
End If
|
|
|
|
If Not rs.EOF Then
|
|
ipaddress = rs("address") & ""
|
|
Response.Write "{""success"":true,""hostname"":""" & hostname & """,""ipaddress"":""" & ipaddress & """}"
|
|
Else
|
|
Response.Write "{""success"":false,""hostname"":""" & hostname & """,""ipaddress"":null,""message"":""No 10.134.*.* IP found""}"
|
|
End If
|
|
|
|
rs.Close
|
|
Set rs = Nothing
|
|
Set cmd = Nothing
|
|
End Sub
|
|
|
|
' ============================================================================
|
|
' HELPER FUNCTIONS - PC MANAGEMENT
|
|
' ============================================================================
|
|
|
|
Function InsertOrUpdatePC(conn, hostname, serialnumber, manufacturer, model, pcType, _
|
|
loggedinuser, machinenumber, osid, pcstatusid, _
|
|
warrantyEndDate, warrantyStatus, warrantyServiceLevel, warrantyDaysRemaining)
|
|
On Error Resume Next
|
|
Err.Clear
|
|
|
|
' Step 1: Check conn (passed as parameter)
|
|
If conn Is Nothing Then
|
|
Err.Raise 1001, "InsertOrUpdatePC", "conn is Nothing"
|
|
InsertOrUpdatePC = 0
|
|
Exit Function
|
|
End If
|
|
|
|
If conn.State <> 1 Then
|
|
Err.Raise 1002, "InsertOrUpdatePC", "conn not open, state=" & conn.State
|
|
InsertOrUpdatePC = 0
|
|
Exit Function
|
|
End If
|
|
|
|
' Step 2: Get vendor ID (inlined to avoid VBScript scoping issues)
|
|
Dim vendorId, modelId, machineTypeId
|
|
Dim safeManufacturer, safeModel, rsVendor, rsModel
|
|
vendorId = 0
|
|
modelId = 1
|
|
|
|
If manufacturer <> "" Then
|
|
safeManufacturer = Replace(manufacturer, "'", "''")
|
|
Set rsVendor = objConn.Execute("SELECT vendorid FROM vendors WHERE vendor = '" & safeManufacturer & "'")
|
|
If Not rsVendor.EOF Then
|
|
vendorId = CLng(rsVendor("vendorid"))
|
|
Else
|
|
' Create new vendor
|
|
objConn.Execute "INSERT INTO vendors (vendor) VALUES ('" & safeManufacturer & "')"
|
|
Set rsVendor = objConn.Execute("SELECT LAST_INSERT_ID() AS newid")
|
|
vendorId = CLng(rsVendor("newid"))
|
|
End If
|
|
rsVendor.Close
|
|
Set rsVendor = Nothing
|
|
End If
|
|
|
|
' Step 3: Get model ID (inlined)
|
|
If model <> "" And vendorId > 0 Then
|
|
safeModel = Replace(model, "'", "''")
|
|
Set rsModel = objConn.Execute("SELECT modelnumberid FROM models WHERE modelnumber = '" & safeModel & "' AND vendorid = " & vendorId)
|
|
If Not rsModel.EOF Then
|
|
modelId = CLng(rsModel("modelnumberid"))
|
|
Else
|
|
' Create new model
|
|
objConn.Execute "INSERT INTO models (modelnumber, vendorid, notes, isactive) VALUES ('" & safeModel & "', " & vendorId & ", 'Auto-imported via PowerShell', 1)"
|
|
Set rsModel = objConn.Execute("SELECT LAST_INSERT_ID() AS newid")
|
|
modelId = CLng(rsModel("newid"))
|
|
End If
|
|
rsModel.Close
|
|
Set rsModel = Nothing
|
|
End If
|
|
|
|
' Step 4: Get machine type ID
|
|
machineTypeId = GetMachineTypeIdFromPCType(pcType)
|
|
|
|
' Override machineTypeId based on machinenumber pattern
|
|
' WJPRT* = Wax Trace PC (42)
|
|
If machinenumber <> "" Then
|
|
If UCase(Left(machinenumber, 5)) = "WJPRT" Then
|
|
machineTypeId = 42 ' PC - Wax Trace
|
|
LogToFile "Detected WJPRT pattern in machinenumber, setting machineTypeId to 42 (PC - Wax Trace)"
|
|
End If
|
|
End If
|
|
|
|
' 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 = 36 ' PC - Standard
|
|
|
|
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 pctypeid IS NOT NULL"
|
|
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 pctypeid IS NOT NULL"
|
|
|
|
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 pctypeid IS NOT NULL"
|
|
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 - 10.134.*.* is always primary for shopfloor PCs
|
|
Dim isPrimary, isPrimaryFromJson
|
|
isPrimary = 0
|
|
isPrimaryFromJson = GetJSONValue(interfacesArray(i), "IsPrimary")
|
|
If isPrimaryFromJson = True Or isPrimaryFromJson = "true" Or isPrimaryFromJson = "True" Then
|
|
isPrimary = 1
|
|
ElseIf Left(ipAddress, 7) = "10.134." Then
|
|
' Fallback: 10.134.*.* is always primary
|
|
isPrimary = 1
|
|
End If
|
|
|
|
' 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, defaultgateway, 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-43, Equipment is 1-32)
|
|
Dim strSQL, rsResult, safeMachineNumber
|
|
safeMachineNumber = Replace(machineNumber, "'", "''")
|
|
strSQL = "SELECT machineid FROM machines WHERE machinenumber = '" & safeMachineNumber & "' AND pctypeid IS NULL"
|
|
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 = " & CLng(machineid)
|
|
Set rsResult = objConn.Execute(strSQL)
|
|
|
|
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(connString, vendorName)
|
|
On Error Resume Next
|
|
Err.Clear
|
|
|
|
If vendorName = "" Then
|
|
GetOrCreateVendor = 0
|
|
Exit Function
|
|
End If
|
|
|
|
' Create local connection for this function
|
|
Dim localConn
|
|
Set localConn = Server.CreateObject("ADODB.Connection")
|
|
localConn.ConnectionString = connString
|
|
localConn.Open
|
|
|
|
If Err.Number <> 0 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 = localConn.Execute(strSQL)
|
|
|
|
If Err.Number <> 0 Then
|
|
LogToFile "ERROR querying vendor: " & Err.Description
|
|
localConn.Close
|
|
Set localConn = Nothing
|
|
GetOrCreateVendor = 0
|
|
Exit Function
|
|
End If
|
|
|
|
If Not rsResult.EOF Then
|
|
GetOrCreateVendor = CLng(rsResult("vendorid"))
|
|
rsResult.Close
|
|
Set rsResult = Nothing
|
|
localConn.Close
|
|
Set localConn = 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 & "')"
|
|
localConn.Execute strSQL
|
|
|
|
If Err.Number <> 0 Then
|
|
LogToFile "ERROR creating vendor: " & Err.Description
|
|
localConn.Close
|
|
Set localConn = Nothing
|
|
GetOrCreateVendor = 0
|
|
Exit Function
|
|
End If
|
|
|
|
' Get new vendor ID
|
|
strSQL = "SELECT LAST_INSERT_ID() AS newid"
|
|
Set rsResult = localConn.Execute(strSQL)
|
|
GetOrCreateVendor = CLng(rsResult("newid"))
|
|
rsResult.Close
|
|
Set rsResult = Nothing
|
|
localConn.Close
|
|
Set localConn = 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, safeModelName
|
|
safeModelName = Replace(modelName, "'", "''")
|
|
strSQL = "SELECT modelnumberid FROM models WHERE modelnumber = '" & safeModelName & "' AND vendorid = " & CLng(vendorId)
|
|
Set rsResult = conn.Execute(strSQL)
|
|
|
|
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 (applications table has appid and appname columns)
|
|
Dim strSQL, rsResult, safeAppName
|
|
safeAppName = Replace(appName, "'", "''")
|
|
strSQL = "SELECT appid FROM applications WHERE appname = '" & safeAppName & "'"
|
|
Set rsResult = objConn.Execute(strSQL)
|
|
|
|
If Err.Number <> 0 Then
|
|
LogToFile "ERROR querying applications: " & Err.Description
|
|
GetOrCreateApplication = 0
|
|
Exit Function
|
|
End If
|
|
|
|
If Not rsResult.EOF Then
|
|
GetOrCreateApplication = rsResult("appid")
|
|
LogToFile "Found existing appid: " & GetOrCreateApplication
|
|
rsResult.Close
|
|
Set rsResult = Nothing
|
|
Exit Function
|
|
End If
|
|
rsResult.Close
|
|
Set rsResult = Nothing
|
|
|
|
LogToFile "Application not found, creating new..."
|
|
|
|
' Create new application
|
|
Dim cmdInsert
|
|
Set cmdInsert = Server.CreateObject("ADODB.Command")
|
|
cmdInsert.ActiveConnection = objConn
|
|
cmdInsert.CommandText = "INSERT INTO applications (appname, appdescription, isactive) VALUES (?, ?, ?)"
|
|
cmdInsert.Parameters.Append cmdInsert.CreateParameter("@appname", 200, 1, 50, appName)
|
|
cmdInsert.Parameters.Append cmdInsert.CreateParameter("@description", 200, 1, 255, "Auto-detected application")
|
|
cmdInsert.Parameters.Append cmdInsert.CreateParameter("@isactive", 11, 1, , 1)
|
|
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 GetOrCreateAppVersion(conn, appId, appVersion)
|
|
' Returns appversionid for the given app and version
|
|
' Creates the version record if it doesn't exist
|
|
' conn parameter passed explicitly to avoid VBScript scoping issues
|
|
On Error Resume Next
|
|
Err.Clear
|
|
|
|
LogToFile "GetOrCreateAppVersion called with appId=" & appId & ", appVersion='" & appVersion & "'"
|
|
|
|
' Validate connection object first
|
|
If conn Is Nothing Then
|
|
LogToFile "ERROR: conn parameter is Nothing"
|
|
GetOrCreateAppVersion = 0
|
|
Err.Clear
|
|
Exit Function
|
|
End If
|
|
|
|
If conn.State <> 1 Then
|
|
LogToFile "ERROR: conn is not open, state=" & conn.State
|
|
GetOrCreateAppVersion = 0
|
|
Err.Clear
|
|
Exit Function
|
|
End If
|
|
|
|
If appId = 0 Or appId = "" Then
|
|
LogToFile "ERROR: appId is empty or zero"
|
|
GetOrCreateAppVersion = 0
|
|
Err.Clear
|
|
Exit Function
|
|
End If
|
|
|
|
' If no version provided, return 0 (NULL will be stored)
|
|
If appVersion = "" Or IsNull(appVersion) Then
|
|
LogToFile "No version provided, returning 0"
|
|
GetOrCreateAppVersion = 0
|
|
Err.Clear
|
|
Exit Function
|
|
End If
|
|
|
|
' Check if version exists for this app
|
|
Dim strSQL, rsResult, safeVersion
|
|
safeVersion = Replace(appVersion, "'", "''")
|
|
strSQL = "SELECT appversionid FROM appversions WHERE appid = " & CLng(appId) & " AND version = '" & safeVersion & "'"
|
|
LogToFile "SELECT SQL: " & strSQL
|
|
Set rsResult = conn.Execute(strSQL)
|
|
|
|
If Err.Number <> 0 Then
|
|
LogToFile "ERROR querying appversions: " & Err.Number & " - " & Err.Description
|
|
Err.Clear
|
|
GetOrCreateAppVersion = 0
|
|
Exit Function
|
|
End If
|
|
|
|
' Check if recordset is valid
|
|
If rsResult Is Nothing Then
|
|
LogToFile "ERROR: rsResult is Nothing after Execute"
|
|
GetOrCreateAppVersion = 0
|
|
Err.Clear
|
|
Exit Function
|
|
End If
|
|
|
|
If Not rsResult.EOF Then
|
|
GetOrCreateAppVersion = rsResult("appversionid")
|
|
LogToFile "Found existing appversionid: " & GetOrCreateAppVersion
|
|
rsResult.Close
|
|
Set rsResult = Nothing
|
|
Err.Clear
|
|
Exit Function
|
|
End If
|
|
rsResult.Close
|
|
Set rsResult = Nothing
|
|
|
|
LogToFile "Version not found, creating new..."
|
|
|
|
' Create new version record using direct SQL (omit isactive - let it default, BIT column causes type mismatch)
|
|
Dim insertSQL
|
|
insertSQL = "INSERT INTO appversions (appid, version) VALUES (" & CLng(appId) & ", '" & safeVersion & "')"
|
|
LogToFile "INSERT SQL: " & insertSQL
|
|
conn.Execute insertSQL
|
|
|
|
If Err.Number <> 0 Then
|
|
LogToFile "ERROR creating app version: " & Err.Number & " - " & Err.Description
|
|
Err.Clear
|
|
GetOrCreateAppVersion = 0
|
|
Exit Function
|
|
End If
|
|
|
|
' Get new version ID
|
|
strSQL = "SELECT LAST_INSERT_ID() AS newid"
|
|
Set rsResult = conn.Execute(strSQL)
|
|
|
|
If Err.Number <> 0 Then
|
|
LogToFile "ERROR getting LAST_INSERT_ID: " & Err.Number & " - " & Err.Description
|
|
Err.Clear
|
|
GetOrCreateAppVersion = 0
|
|
Exit Function
|
|
End If
|
|
|
|
If Not rsResult.EOF Then
|
|
GetOrCreateAppVersion = CLng(rsResult("newid"))
|
|
LogToFile "Created new app version with id: " & GetOrCreateAppVersion
|
|
Else
|
|
LogToFile "ERROR: LAST_INSERT_ID returned no rows"
|
|
GetOrCreateAppVersion = 0
|
|
End If
|
|
rsResult.Close
|
|
Set rsResult = Nothing
|
|
Err.Clear
|
|
End Function
|
|
|
|
Function GetMachineTypeIdFromPCType(pcTypeString)
|
|
On Error Resume Next
|
|
|
|
' Direct mapping from pcType parameter to machinetypeid (Phase 2 schema)
|
|
' Phase 2 PC Machine Types:
|
|
' 36=PC - Standard, 37=PC - Shopfloor, 38=PC - Engineer
|
|
' 41=PC - CMM, 42=PC - Wax Trace, 43=PC - Measuring Tool
|
|
|
|
Dim pcTypeClean
|
|
pcTypeClean = Trim(UCase(pcTypeString))
|
|
|
|
Select Case pcTypeClean
|
|
Case "ENGINEER", "ENGINEERING"
|
|
GetMachineTypeIdFromPCType = 38 ' PC - Engineer
|
|
Case "SHOPFLOOR", "SHOP FLOOR"
|
|
GetMachineTypeIdFromPCType = 37 ' PC - Shopfloor
|
|
Case "CMM"
|
|
GetMachineTypeIdFromPCType = 41 ' PC - CMM (runs PC-DMIS, goCMM, DODA)
|
|
Case "WAX TRACE", "WAXTRACE", "WAX"
|
|
GetMachineTypeIdFromPCType = 42 ' PC - Wax Trace (runs Formtracepak, FormStatusMonitor)
|
|
Case "KEYENCE"
|
|
GetMachineTypeIdFromPCType = 43 ' PC - Measuring Tool - Keyence (runs Keyence VR Series)
|
|
Case "EAS1000"
|
|
GetMachineTypeIdFromPCType = 43 ' PC - Measuring Tool - EAS1000 (runs GageCal, NI Software)
|
|
Case "PART MARKER", "PARTMARKER"
|
|
GetMachineTypeIdFromPCType = 43 ' PC - Measuring Tool - Part Marker (0615 machines)
|
|
Case "MEASURING", "MEASURING TOOL"
|
|
GetMachineTypeIdFromPCType = 43 ' PC - Measuring Tool (generic)
|
|
Case "STANDARD", ""
|
|
GetMachineTypeIdFromPCType = 36 ' PC - Standard
|
|
Case Else
|
|
LogToFile "Unknown pcType '" & pcTypeString & "', defaulting to PC - Standard (36)"
|
|
GetMachineTypeIdFromPCType = 36 ' Default to PC - Standard
|
|
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
|
|
|
|
Function ExecuteParameterizedQuery(conn, strSQL, params)
|
|
On Error Resume Next
|
|
|
|
Dim cmd, i
|
|
Set cmd = Server.CreateObject("ADODB.Command")
|
|
cmd.ActiveConnection = conn
|
|
cmd.CommandText = strSQL
|
|
cmd.CommandType = 1 ' adCmdText
|
|
|
|
' Add parameters
|
|
If IsArray(params) Then
|
|
For i = 0 To UBound(params)
|
|
If IsNull(params(i)) Then
|
|
cmd.Parameters.Append cmd.CreateParameter("p" & i, 200, 1, 255, Null)
|
|
ElseIf IsNumeric(params(i)) Then
|
|
cmd.Parameters.Append cmd.CreateParameter("p" & i, 3, 1, , CLng(params(i)))
|
|
Else
|
|
cmd.Parameters.Append cmd.CreateParameter("p" & i, 200, 1, 255, CStr(params(i)))
|
|
End If
|
|
Next
|
|
End If
|
|
|
|
Set ExecuteParameterizedQuery = cmd.Execute
|
|
End Function
|
|
|
|
Sub LogToFile(message)
|
|
On Error Resume Next
|
|
|
|
Dim fso, logFile, logPath
|
|
' Create daily log files: api-2025-11-21.log
|
|
Dim logFileName
|
|
logFileName = "api-" & Year(Now()) & "-" & Right("0" & Month(Now()), 2) & "-" & Right("0" & Day(Now()), 2) & ".log"
|
|
logPath = Server.MapPath("./logs/" & logFileName)
|
|
|
|
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
|
|
|
|
' ============================================================================
|
|
' UPDATE WINRM STATUS
|
|
' Called when remote PowerShell script successfully connects to a PC
|
|
' ============================================================================
|
|
Sub UpdateWinRMStatus()
|
|
On Error Resume Next
|
|
|
|
Dim hostname, hasWinRM
|
|
hostname = Trim(Request.Form("hostname") & "")
|
|
hasWinRM = Trim(Request.Form("hasWinRM") & "")
|
|
|
|
' Also accept query string for GET requests
|
|
If hostname = "" Then hostname = Trim(Request.QueryString("hostname") & "")
|
|
If hasWinRM = "" Then hasWinRM = Trim(Request.QueryString("hasWinRM") & "")
|
|
|
|
' Validate
|
|
If hostname = "" Then
|
|
SendError "hostname is required"
|
|
Exit Sub
|
|
End If
|
|
|
|
' Default to enabled if not specified
|
|
Dim winrmValue
|
|
If hasWinRM = "0" Then
|
|
winrmValue = 0
|
|
Else
|
|
winrmValue = 1
|
|
End If
|
|
|
|
' Find PC by hostname
|
|
Dim safeHostname, strSQL, rs
|
|
safeHostname = Replace(hostname, "'", "''")
|
|
strSQL = "SELECT machineid FROM machines WHERE hostname = '" & safeHostname & "' AND pctypeid IS NOT NULL"
|
|
Set rs = objConn.Execute(strSQL)
|
|
|
|
If rs.EOF Then
|
|
rs.Close
|
|
Set rs = Nothing
|
|
SendError "PC not found: " & hostname
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim machineid
|
|
machineid = rs("machineid")
|
|
rs.Close
|
|
Set rs = Nothing
|
|
|
|
' Update WinRM status
|
|
strSQL = "UPDATE machines SET iswinrm = " & winrmValue & " WHERE machineid = " & machineid
|
|
objConn.Execute strSQL
|
|
|
|
If Err.Number <> 0 Then
|
|
SendError "Update failed: " & Err.Description
|
|
Exit Sub
|
|
End If
|
|
|
|
LogMessage "WinRM status updated for " & hostname & " (machineid=" & machineid & ") to " & winrmValue
|
|
|
|
' Send success response
|
|
Response.ContentType = "application/json"
|
|
Response.Write "{""success"":true,""message"":""WinRM status updated"",""hostname"":""" & hostname & """,""iswinrm"":" & winrmValue & "}"
|
|
End Sub
|
|
|
|
%>
|