ge-aerospace/shopdb
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
603de062e55c98fe2b5b8752b50073c467470f3d
shopdb/api.asp
cproudlock 603de062e5 Remove idle time tracking from PC data collection 
- Remove idleMinutes parameter from api.asp updateCompleteAsset
- Remove idle time Win32 API collection from PowerShell script
- Clean up apishopfloor.asp (remove debug output)

Idle time tracking was added but user decided not to use this feature.

Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
2026-01-23 14:34:20 -05:00

2997 lines
110 KiB
Plaintext
Raw Blame History

<%@ Language=VBScript %>
<!--#include file="includes/config.asp"-->
<%
' ============================================================================
' DATABASE CONNECTION - Uses centralized config.asp
' ============================================================================
Dim objConn, rs
Session.Timeout = APP_SESSION_TIMEOUT
Set objConn = Server.CreateObject("ADODB.Connection")
objConn.ConnectionString = GetConnectionString()
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, pctypeid IS NOT NULL 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 "getHighUptimePCs"
GetHighUptimePCs()
Case "getRecordedIP"
GetRecordedIP()
Case "updateMachinePositions"
UpdateMachinePositions()
Case "getUDCPartRuns"
GetUDCPartRuns()
Case "getUDCOperatorStats"
GetUDCOperatorStats()
Case "getUDCMachineStats"
GetUDCMachineStats()
Case "getUDCManualTiming"
GetUDCManualTiming()
Case "getDeployableApps"
GetDeployableApps()
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") & "")
' Last boot time (optional) - accepts both lastBootUpTime and lastBootTime
Dim lastBootTime
lastBootTime = Trim(Request.Form("lastBootUpTime") & "")
If lastBootTime = "" Then
lastBootTime = Trim(Request.Form("lastBootTime") & "")
End If
' Installed apps (optional) - JSON array of tracked apps
Dim installedApps
installedApps = Request.Form("installedApps")
' 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 (all PCs use 33)
machineTypeId = 33
debugMsg = debugMsg & "7-machineTypeId=" & machineTypeId & ","
' Get PC type ID from pcType string (inlined to avoid function call issues)
Dim pctypeId, pcTypeClean
pcTypeClean = Trim(UCase(pcType))
Select Case pcTypeClean
Case "ENGINEER", "ENGINEERING"
pctypeId = 2
Case "SHOPFLOOR", "SHOP FLOOR"
pctypeId = 3
Case "CMM"
pctypeId = 5
Case "WAX TRACE", "WAXTRACE", "WAX", "WAX / TRACE"
pctypeId = 6
Case "KEYENCE"
pctypeId = 7
Case "GENSPECT", "EAS1000"
pctypeId = 8
Case "HEAT TREAT", "HEATTTREAT", "HEATTEAT", "HEAT_TREAT", "HEATTREAT"
pctypeId = 9
Case "PART MARKER", "PARTMARKER"
pctypeId = 10
Case "DASHBOARD"
pctypeId = 11
Case "LOBBY DISPLAY", "LOBBYDISPLAY", "LOBBY-DISPLAY"
pctypeId = 12
Case "MEASURING", "MEASURING TOOL"
pctypeId = 7
Case Else
pctypeId = 1
End Select
debugMsg = debugMsg & "7b-pctypeId=" & pctypeId & ","
' 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
' Build UPDATE with optional lastboottime
Dim lastBootPart
If lastBootTime <> "" Then
lastBootPart = ", lastboottime='" & Replace(lastBootTime, "'", "''") & "'"
Else
lastBootPart = ""
End If
strSQL = "UPDATE machines SET serialnumber='" & safeSerial & "', modelnumberid=" & modelId & ", machinetypeid=" & machineTypeId & ", pctypeid=" & pctypeId & ", osid=" & osid & ", isvnc=" & vncValue & ", iswinrm=" & winrmValue & lastBootPart & ", 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
' Build INSERT with optional lastboottime
Dim lastBootColInsert, lastBootValInsert
If lastBootTime <> "" Then
lastBootColInsert = ", lastboottime"
lastBootValInsert = ", '" & Replace(lastBootTime, "'", "''") & "'"
Else
lastBootColInsert = ""
lastBootValInsert = ""
End If
strSQL = "INSERT INTO machines (hostname, serialnumber, modelnumberid, machinetypeid, pctypeid, osid, machinestatusid, isvnc, iswinrm, lastupdated" & lastBootColInsert & ") VALUES ('" & safeHostname & "', '" & safeSerial & "', " & modelId & ", " & machineTypeId & ", " & pctypeId & ", " & osid & ", " & pcstatusid & ", " & vncValueInsert & ", " & winrmValueInsert & ", NOW()" & lastBootValInsert & ")"
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
' Update installed apps if provided
Dim installedAppsCount
installedAppsCount = 0
If installedApps <> "" Then
installedAppsCount = SaveInstalledApps(machineid, installedApps)
LogToFile "Installed apps saved: " & installedAppsCount
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
responseObj.Add "installedAppsCount", installedAppsCount
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, isActiveStr, isActive
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") & "")
' Get isactive status (for UDC/CLM process detection)
isActive = 1 ' Default to active
isActiveStr = Trim(GetJSONValue(appsArray(i), "isactive") & "")
If isActiveStr <> "" And IsNumeric(isActiveStr) Then isActive = CLng(isActiveStr)
LogToFile "App " & i & ": appid=" & appid & ", appname='" & appName & "', version='" & appVersion & "', isactive=" & isActive
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 with isactive status
If appversionid > 0 Then
insertSQL = "INSERT INTO installedapps (machineid, appid, appversionid, isactive) VALUES (" & CLng(machineid) & ", " & CLng(appid) & ", " & CLng(appversionid) & ", " & isActive & ")"
Else
insertSQL = "INSERT INTO installedapps (machineid, appid, isactive) VALUES (" & CLng(machineid) & ", " & CLng(appid) & ", " & isActive & ")"
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
' ============================================================================
' SaveInstalledApps - Save installed apps for a PC (callable from UpdateCompleteAsset)
' Returns: count of apps saved
' ============================================================================
Function SaveInstalledApps(machineid, installedAppsJson)
On Error Resume Next
SaveInstalledApps = 0
If machineid = 0 Or installedAppsJson = "" Then
Exit Function
End If
LogToFile "SaveInstalledApps: machineid=" & machineid & ", raw JSON length=" & Len(installedAppsJson)
' Parse JSON array of apps
Dim appsArray
appsArray = ParseJSONArray(installedAppsJson)
If Not IsArray(appsArray) Then
LogToFile "SaveInstalledApps: Failed to parse JSON array"
Exit Function
End If
LogToFile "SaveInstalledApps: Parsed " & (UBound(appsArray) + 1) & " apps"
' Clear existing app mappings for this PC
Dim deleteSQL
deleteSQL = "DELETE FROM installedapps WHERE machineid = " & CLng(machineid)
objConn.Execute deleteSQL
If Err.Number <> 0 Then
LogToFile "SaveInstalledApps: DELETE error: " & Err.Description
Err.Clear
End If
' Insert new app mappings
Dim appCount, i, appName, appVersion, appid, appversionid, appidStr, insertSQL
Dim safeVer, verSQL, rsVer, isActiveStr, isActive
appCount = 0
Err.Clear
For i = 0 To UBound(appsArray)
' Get appid directly (pre-mapped from PowerShell)
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") & "")
' Get isactive status (for UDC/CLM process detection)
isActive = 1 ' Default to active
isActiveStr = Trim(GetJSONValue(appsArray(i), "isactive") & "")
If isActiveStr <> "" And IsNumeric(isActiveStr) Then isActive = CLng(isActiveStr)
If appid > 0 Then
appversionid = 0
Err.Clear
' Version lookup and creation
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
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
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 with isactive status
If appversionid > 0 Then
insertSQL = "INSERT INTO installedapps (machineid, appid, appversionid, isactive) VALUES (" & CLng(machineid) & ", " & CLng(appid) & ", " & CLng(appversionid) & ", " & isActive & ")"
Else
insertSQL = "INSERT INTO installedapps (machineid, appid, isactive) VALUES (" & CLng(machineid) & ", " & CLng(appid) & ", " & isActive & ")"
End If
objConn.Execute insertSQL
If Err.Number = 0 Then
appCount = appCount + 1
Else
LogToFile "SaveInstalledApps: INSERT error for appid " & appid & ": " & Err.Description
Err.Clear
End If
End If
Next
LogToFile "SaveInstalledApps: Saved " & appCount & " apps"
SaveInstalledApps = appCount
End Function
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 PCs with shop floor IPs (10.134.*) for remote management
' This includes all PC types: Shopfloor, CMM, Wax Trace, Keyence, etc.
' PCs are identified by machinetypeid >= 33, pctypeid can be NULL
' Optional filters: pctypeid, businessunitid
On Error Resume Next
Dim rsPC, strSQL, pcList, pcCount, pcData
Dim filterPcTypeId, filterBusinessUnitId, whereClause
' Get optional filter parameters
filterPcTypeId = Request.QueryString("pctypeid")
filterBusinessUnitId = Request.QueryString("businessunitid")
' Build WHERE clause with optional filters
' Dashboard (11) and Lobby Display (12) can be on any subnet, others require 10.134.*
whereClause = "WHERE m.isactive = 1 " & _
"AND m.machinetypeid >= 33 "
' Add pctypeid filter if provided
If filterPcTypeId <> "" And IsNumeric(filterPcTypeId) Then
whereClause = whereClause & "AND m.pctypeid = " & CInt(filterPcTypeId) & " "
' Skip IP filter for Dashboard (11) and Lobby Display (12) - they can be on any subnet
If CInt(filterPcTypeId) <> 11 And CInt(filterPcTypeId) <> 12 Then
whereClause = whereClause & "AND EXISTS (SELECT 1 FROM communications c2 WHERE c2.machineid = m.machineid AND c2.address LIKE '10.134.%') "
End If
Else
' No pctype filter - only return shopfloor IPs (10.134.*) by default
whereClause = whereClause & "AND EXISTS (SELECT 1 FROM communications c2 WHERE c2.machineid = m.machineid AND c2.address LIKE '10.134.%') "
End If
' Add businessunitid filter if provided
If filterBusinessUnitId <> "" And IsNumeric(filterBusinessUnitId) Then
whereClause = whereClause & "AND m.businessunitid = " & CInt(filterBusinessUnitId) & " "
End If
' Query all active PCs with shop floor IP addresses (10.134.*)
' - machinetypeid >= 33 ensures we only get PCs (not equipment)
' - LEFT JOIN pctype to include PCs with NULL pctypeid
' - EXISTS subquery finds any PC with a 10.134.* address
strSQL = "SELECT m.machineid, m.hostname, m.machinenumber, m.serialnumber, " & _
"m.loggedinuser, m.lastupdated, m.pctypeid, m.businessunitid, " & _
"c.address AS ipaddress, " & _
"COALESCE(pt.typename, 'Uncategorized') AS pctype, " & _
"COALESCE(bu.businessunit, 'TBD') AS businessunit " & _
"FROM machines m " & _
"LEFT JOIN communications c ON m.machineid = c.machineid AND c.isprimary = 1 AND c.comstypeid = 1 " & _
"LEFT JOIN pctype pt ON m.pctypeid = pt.pctypeid " & _
"LEFT JOIN businessunits bu ON m.businessunitid = bu.businessunitid " & _
whereClause & _
"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") & "") & ""","
If IsNull(rsPC("pctypeid")) Then
pcData = pcData & """pctypeid"":null,"
Else
pcData = pcData & """pctypeid"":" & rsPC("pctypeid") & ","
End If
pcData = pcData & """businessunit"":""" & EscapeJSON(rsPC("businessunit") & "") & ""","
If IsNull(rsPC("businessunitid")) Then
pcData = pcData & """businessunitid"":null,"
Else
pcData = pcData & """businessunitid"":" & rsPC("businessunitid") & ","
End If
' 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 GetHighUptimePCs()
' Returns list of PCs with uptime >= specified days (for reboot management)
On Error Resume Next
Dim rsPC, strSQL, pcList, pcCount, pcData
Dim minUptime
' Get minimum uptime parameter (required)
minUptime = Request.QueryString("minUptime")
If minUptime = "" Or Not IsNumeric(minUptime) Then
minUptime = 10 ' Default to 10 days
Else
minUptime = CInt(minUptime)
End If
' Query PCs with high uptime
strSQL = "SELECT m.machineid, m.hostname, m.machinenumber, m.serialnumber, " & _
"m.loggedinuser, m.lastupdated, m.lastboottime, m.pctypeid, m.businessunitid, " & _
"DATEDIFF(NOW(), m.lastboottime) AS uptime_days, " & _
"c.address AS ipaddress, " & _
"COALESCE(pt.typename, 'Uncategorized') AS pctype, " & _
"COALESCE(bu.businessunit, 'TBD') AS businessunit " & _
"FROM machines m " & _
"LEFT JOIN communications c ON m.machineid = c.machineid AND c.isprimary = 1 AND c.comstypeid = 1 " & _
"LEFT JOIN pctype pt ON m.pctypeid = pt.pctypeid " & _
"LEFT JOIN businessunits bu ON m.businessunitid = bu.businessunitid " & _
"WHERE m.isactive = 1 " & _
"AND m.pctypeid IS NOT NULL " & _
"AND m.lastboottime IS NOT NULL " & _
"AND DATEDIFF(NOW(), m.lastboottime) >= " & minUptime & " " & _
"ORDER BY uptime_days DESC, 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") & "") & ""","
pcData = pcData & """uptime_days"":" & rsPC("uptime_days") & ","
' Handle lastboottime date
If Not IsNull(rsPC("lastboottime")) Then
pcData = pcData & """lastboottime"":""" & rsPC("lastboottime") & ""","
Else
pcData = pcData & """lastboottime"":null,"
End If
If IsNull(rsPC("pctypeid")) Then
pcData = pcData & """pctypeid"":null,"
Else
pcData = pcData & """pctypeid"":" & rsPC("pctypeid") & ","
End If
pcData = pcData & """businessunit"":""" & EscapeJSON(rsPC("businessunit") & "") & ""","
If IsNull(rsPC("businessunitid")) Then
pcData = pcData & """businessunitid"":null,"
Else
pcData = pcData & """businessunitid"":" & rsPC("businessunitid") & ","
End If
' 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 & ",""minUptime"":" & minUptime & ",""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.comid 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 and PC type ID
machineTypeId = GetMachineTypeIdFromPCType(pcType)
Dim pctypeId
pctypeId = GetPCTypeIdFromPCType(pcType)
' Override pctypeid based on machinenumber pattern
' WJPRT* = Wax Trace PC (pctypeid 6)
If machinenumber <> "" Then
If UCase(Left(machinenumber, 5)) = "WJPRT" Then
pctypeId = 6 ' Wax / Trace
LogToFile "Detected WJPRT pattern in machinenumber, setting pctypeid to 6 (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 = 33 ' PC
If Not IsNumeric(pctypeId) Or pctypeId = "" Then pctypeId = 1 ' Standard
LogToFile "Vendor ID: " & vendorId & ", Model ID: " & modelId & ", Machine Type ID: " & machineTypeId & ", PC Type ID: " & pctypeId
' Check if PC already exists (Phase 2: identify PCs by pctypeid IS NOT NULL)
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
' Build lastboottime part for UPDATE
Dim sqlLastBoot
If lastBootTime <> "" Then
sqlLastBoot = "lastboottime = '" & Replace(lastBootTime, "'", "''") & "', "
Else
sqlLastBoot = ""
End If
strSQL = "UPDATE machines SET " & _
"serialnumber = '" & safeSerial & "', " & _
"modelnumberid = " & sqlModelId & ", " & _
"machinetypeid = " & CLng(machineTypeId) & ", " & _
"pctypeid = " & CLng(pctypeId) & ", " & _
"loggedinuser = " & sqlUserId & ", " & _
"machinenumber = " & sqlMachineNum & ", " & _
"osid = " & sqlOsId & ", " & _
"machinestatusid = " & sqlStatusId & ", " & _
sqlLastBoot & _
"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
' Add lastboottime column if provided
Dim sqlLastBootCol, sqlLastBootVal
If lastBootTime <> "" Then
sqlLastBootCol = ", lastboottime"
sqlLastBootVal = ", '" & Replace(lastBootTime, "'", "''") & "'"
Else
sqlLastBootCol = ""
sqlLastBootVal = ""
End If
sqlPart1 = "INSERT INTO machines (hostname, serialnumber, modelnumberid, machinetypeid, pctypeid, loggedinuser, machinenumber, osid, machinestatusid, isactive, lastupdated" & sqlLastBootCol & ") VALUES ("
sqlPart2 = "'" & safeHostname & "', '" & safeSerial & "', "
If modelId > 0 Then
sqlPart2 = sqlPart2 & CLng(modelId) & ", "
Else
sqlPart2 = sqlPart2 & "NULL, "
End If
' machinetypeid and pctypeid are required for PCs
sqlPart2 = sqlPart2 & CLng(machineTypeId) & ", " & CLng(pctypeId) & ", "
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()" & sqlLastBootVal & ")"
Else
sqlPart3 = sqlPart3 & "NULL, 1, NOW()" & sqlLastBootVal & ")"
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 commconfig
Set cmdDelete = Server.CreateObject("ADODB.Command")
cmdDelete.ActiveConnection = objConn
cmdDelete.CommandText = "DELETE FROM commconfig WHERE machineid = ?"
cmdDelete.Parameters.Append cmdDelete.CreateParameter("@machineid", 3, 1, , CLng(machineid))
cmdDelete.Execute
LogToFile "Deleted " & cmdDelete.RecordsAffected & " comm config records"
' Delete from dncconfig
Set cmdDelete = Server.CreateObject("ADODB.Command")
cmdDelete.ActiveConnection = objConn
cmdDelete.CommandText = "DELETE FROM dncconfig 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
' Ignore JSON value, enforce by IP address pattern
Dim isPrimary
If Left(ipAddress, 7) = "10.134." Then
isPrimary = 1
Else
isPrimary = 0
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 commconfig (" & _
"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 dncconfig (" & _
"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 have pctypeid IS NOT NULL, Equipment has pctypeid IS NULL)
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 (Equipment -> PC, matching existing data pattern)
strSQL = "SELECT relationshipid FROM machinerelationships " & _
"WHERE machineid = " & CLng(equipmentMachineid) & " AND related_machineid = " & CLng(pcMachineid) & " 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 (Equipment -> PC)
' Equipment is machineid (source), PC is related_machineid (target)
' This matches existing relationship data pattern in the database
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("@equipmentid", 3, 1, , CLng(equipmentMachineid))
cmdInsert.Parameters.Append cmdInsert.CreateParameter("@pcid", 3, 1, , CLng(pcMachineid))
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
' Propagate controller to any dualpath machines
Dim dualpathCount
dualpathCount = PropagateControllerToDualpathMachinesAPI(CLng(equipmentMachineid), CLng(pcMachineid))
If dualpathCount > 0 Then
LogToFile "Propagated controller to " & dualpathCount & " dualpath machine(s)"
End If
CreatePCMachineRelationship = True
End If
End Function
' ============================================================================
' FUNCTION: PropagateControllerToDualpathMachinesAPI
' PURPOSE: When a PC controls a machine, also assign it to dualpath'd machines
' ============================================================================
Function PropagateControllerToDualpathMachinesAPI(equipmentMachineid, pcMachineid)
On Error Resume Next
Dim rsDP, rsDPCheck, controlsTypeID, dualpathMachineId, cnt
cnt = 0
' Get Controls relationship type ID
Set rsDP = objConn.Execute("SELECT relationshiptypeid FROM relationshiptypes WHERE relationshiptype = 'Controls'")
If rsDP.EOF Then
PropagateControllerToDualpathMachinesAPI = 0
rsDP.Close
Set rsDP = Nothing
Exit Function
End If
controlsTypeID = CLng(rsDP("relationshiptypeid"))
rsDP.Close
Set rsDP = Nothing
' Find all machines with dualpath relationship to this equipment
Set rsDP = objConn.Execute("SELECT related_machineid FROM machinerelationships mr " & _
"JOIN relationshiptypes rt ON mr.relationshiptypeid = rt.relationshiptypeid " & _
"WHERE mr.machineid = " & CLng(equipmentMachineid) & " " & _
"AND rt.relationshiptype = 'Dualpath' AND mr.isactive = 1")
Do While Not rsDP.EOF
dualpathMachineId = CLng(rsDP("related_machineid"))
' Check if this dualpath machine already has a Controls relationship with this PC
Set rsDPCheck = objConn.Execute("SELECT relationshipid FROM machinerelationships " & _
"WHERE machineid = " & CLng(pcMachineid) & " " & _
"AND related_machineid = " & dualpathMachineId & " " & _
"AND relationshiptypeid = " & controlsTypeID & " AND isactive = 1")
If rsDPCheck.EOF Then
' Create Controls relationship: PC -> Dualpath Machine
Dim cmdDPAPI
Set cmdDPAPI = Server.CreateObject("ADODB.Command")
cmdDPAPI.ActiveConnection = objConn
cmdDPAPI.CommandText = "INSERT INTO machinerelationships (machineid, related_machineid, relationshiptypeid, isactive) VALUES (?, ?, ?, 1)"
cmdDPAPI.Parameters.Append cmdDPAPI.CreateParameter("@pcid", 3, 1, , CLng(pcMachineid))
cmdDPAPI.Parameters.Append cmdDPAPI.CreateParameter("@equipid", 3, 1, , dualpathMachineId)
cmdDPAPI.Parameters.Append cmdDPAPI.CreateParameter("@reltypeid", 3, 1, , controlsTypeID)
cmdDPAPI.Execute
Set cmdDPAPI = Nothing
cnt = cnt + 1
LogToFile "Created dualpath Controls relationship: Equipment " & dualpathMachineId & " controlled by PC " & pcMachineid
End If
rsDPCheck.Close
Set rsDPCheck = Nothing
rsDP.MoveNext
Loop
rsDP.Close
Set rsDP = Nothing
PropagateControllerToDualpathMachinesAPI = cnt
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
' All PCs now use machinetypeid=33, with pctypeid determining the specific type
' GetMachineTypeIdFromPCType returns 33 for all PCs
' GetPCTypeIdFromPCType maps pcType string to pctypeid (1=Standard, 2=Engineer, etc.)
' 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)
' All PCs use machinetypeid = 33 (PC)
' The specific PC type is determined by pctypeid, not machinetypeid
GetMachineTypeIdFromPCType = 33
LogToFile "All PCs use machinetypeid 33, pcType '" & pcTypeString & "' -> pctypeid handles type"
End Function
Function GetPCTypeIdFromPCType(pcTypeString)
On Error Resume Next
' Map pcType parameter to pctypeid (from pctype table)
' pctypeid values: 1=Standard, 2=Engineer, 3=Shopfloor, 4=Uncategorized,
' 5=CMM, 6=Wax/Trace, 7=Keyence, 8=Genspect, 9=Heat Treat, 10=Part Marker
Dim pcTypeClean
pcTypeClean = Trim(UCase(pcTypeString))
Select Case pcTypeClean
Case "ENGINEER", "ENGINEERING"
GetPCTypeIdFromPCType = 2
Case "SHOPFLOOR", "SHOP FLOOR"
GetPCTypeIdFromPCType = 3
Case "CMM"
GetPCTypeIdFromPCType = 5
Case "WAX TRACE", "WAXTRACE", "WAX", "WAX / TRACE"
GetPCTypeIdFromPCType = 6
Case "KEYENCE"
GetPCTypeIdFromPCType = 7
Case "GENSPECT", "EAS1000"
GetPCTypeIdFromPCType = 8 ' Genspect / EAS1000
Case "HEAT TREAT", "HEATTTREAT", "HEATTEAT", "HEAT_TREAT", "HEATTREAT"
GetPCTypeIdFromPCType = 9
Case "PART MARKER", "PARTMARKER"
GetPCTypeIdFromPCType = 10
Case "DASHBOARD"
GetPCTypeIdFromPCType = 11
Case "LOBBY DISPLAY", "LOBBYDISPLAY", "LOBBY-DISPLAY"
GetPCTypeIdFromPCType = 12
Case "MEASURING", "MEASURING TOOL"
GetPCTypeIdFromPCType = 7 ' Default other measuring tools to Keyence
Case "STANDARD", ""
GetPCTypeIdFromPCType = 1
Case Else
LogToFile "Unknown pcType '" & pcTypeString & "' for pctypeid, defaulting to Standard (1)"
GetPCTypeIdFromPCType = 1
End Select
LogToFile "Mapped pcType '" & pcTypeString & "' to pctypeid: " & GetPCTypeIdFromPCType
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
' ============================================================================
' UPDATE MACHINE POSITIONS - Bulk update mapleft/maptop for machines
' ============================================================================
Sub UpdateMachinePositions()
On Error Resume Next
Dim changesJson, changes, i, updateCount, errorCount
changesJson = Request.Form("changes")
If changesJson = "" Then
SendError "Missing changes parameter"
Exit Sub
End If
LogToFile "UpdateMachinePositions: Received " & Len(changesJson) & " bytes"
' Parse JSON array
changes = ParseJSONArray(changesJson)
If Not IsArray(changes) Then
SendError "Invalid changes format"
Exit Sub
End If
updateCount = 0
errorCount = 0
' Update each machine position
For i = 0 To UBound(changes)
Dim machineId, newLeft, newTop, updateSQL
machineId = GetJSONValue(changes(i), "id")
newLeft = GetJSONValue(changes(i), "newLeft")
newTop = GetJSONValue(changes(i), "newTop")
If machineId <> "" And IsNumeric(machineId) And IsNumeric(newLeft) And IsNumeric(newTop) Then
updateSQL = "UPDATE machines SET mapleft = " & CLng(newLeft) & ", maptop = " & CLng(newTop) & _
" WHERE machineid = " & CLng(machineId)
objConn.Execute updateSQL
If Err.Number = 0 Then
updateCount = updateCount + 1
LogToFile " Updated machineid " & machineId & " to (" & newLeft & ", " & newTop & ")"
Else
errorCount = errorCount + 1
LogToFile " Error updating machineid " & machineId & ": " & Err.Description
Err.Clear
End If
Else
errorCount = errorCount + 1
LogToFile " Invalid data for change " & i
End If
Next
LogToFile "UpdateMachinePositions: Updated " & updateCount & ", Errors " & errorCount
' Send response
Response.ContentType = "application/json"
If errorCount = 0 Then
Response.Write "{""success"":true,""message"":""Updated " & updateCount & " position(s)"",""updated"":" & updateCount & "}"
Else
Response.Write "{""success"":true,""message"":""Updated " & updateCount & ", " & errorCount & " error(s)"",""updated"":" & updateCount & ",""errors"":" & errorCount & "}"
End If
End Sub
' ============================================================================
' UDC LOG DATA ENDPOINTS
' ============================================================================
Sub GetUDCPartRuns()
On Error Resume Next
' Get optional filters
Dim machinenumber, startdate, enddate, badgenumber
machinenumber = Trim(Request.QueryString("machinenumber") & "")
startdate = Trim(Request.QueryString("startdate") & "")
enddate = Trim(Request.QueryString("enddate") & "")
badgenumber = Trim(Request.QueryString("badgenumber") & "")
' Build query
Dim sql, conditions
sql = "SELECT p.partrunid, s.machinenumber, p.partnumber, p.opernumber, p.serialnumber, " & _
"p.programname, p.jobnumber, p.badgenumber, p.programstart, p.programend, " & _
"p.cycletime, p.changeover, p.measurementcount, p.manualcount, p.probecount, p.ootcount " & _
"FROM udcparts p " & _
"JOIN udcsessions s ON p.sessionid = s.sessionid "
conditions = ""
If machinenumber <> "" Then
conditions = conditions & " AND s.machinenumber = '" & Replace(machinenumber, "'", "''") & "'"
End If
If startdate <> "" Then
conditions = conditions & " AND p.programstart >= '" & Replace(startdate, "'", "''") & "'"
End If
If enddate <> "" Then
conditions = conditions & " AND p.programstart <= '" & Replace(enddate, "'", "''") & " 23:59:59'"
End If
If badgenumber <> "" Then
conditions = conditions & " AND p.badgenumber = '" & Replace(badgenumber, "'", "''") & "'"
End If
If conditions <> "" Then
sql = sql & " WHERE 1=1 " & conditions
End If
sql = sql & " ORDER BY p.programstart DESC LIMIT 1000"
Dim rs
Set rs = objConn.Execute(sql)
If Err.Number <> 0 Then
SendError "Database error: " & Err.Description
Exit Sub
End If
' Build JSON response
Dim json, first
json = "{""success"":true,""partruns"":["
first = True
Do While Not rs.EOF
If Not first Then json = json & ","
first = False
json = json & "{" & _
"""partrunid"":" & CLng(rs("partrunid") & "0") & "," & _
"""machinenumber"":""" & (rs("machinenumber") & "") & """," & _
"""partnumber"":""" & (rs("partnumber") & "") & """," & _
"""opernumber"":""" & (rs("opernumber") & "") & """," & _
"""serialnumber"":""" & (rs("serialnumber") & "") & """," & _
"""programname"":""" & (rs("programname") & "") & """," & _
"""jobnumber"":""" & (rs("jobnumber") & "") & """," & _
"""badgenumber"":""" & (rs("badgenumber") & "") & """," & _
"""programstart"":""" & (rs("programstart") & "") & """," & _
"""programend"":""" & (rs("programend") & "") & """," & _
"""cycletime"":" & CLng(rs("cycletime") & "0") & "," & _
"""changeover"":" & CLng(rs("changeover") & "0") & "," & _
"""measurementcount"":" & CLng(rs("measurementcount") & "0") & "," & _
"""manualcount"":" & CLng(rs("manualcount") & "0") & "," & _
"""probecount"":" & CLng(rs("probecount") & "0") & "," & _
"""ootcount"":" & CLng(rs("ootcount") & "0") & _
"}"
rs.MoveNext
Loop
json = json & "]}"
rs.Close
Set rs = Nothing
Response.ContentType = "application/json"
Response.Write json
End Sub
Sub GetUDCOperatorStats()
On Error Resume Next
Dim startdate, enddate
startdate = Trim(Request.QueryString("startdate") & "")
enddate = Trim(Request.QueryString("enddate") & "")
Dim sql, conditions
sql = "SELECT p.badgenumber, COUNT(*) AS partsrun, " & _
"AVG(p.cycletime) AS avgcycletime, AVG(p.changeover) AS avgchangeover, " & _
"SUM(p.measurementcount) AS totalmeasurements, SUM(p.manualcount) AS totalmanual, " & _
"SUM(p.ootcount) AS totaloot, MIN(p.programstart) AS firstrun, MAX(p.programend) AS lastrun, " & _
"(SELECT AVG(mr.responseseconds) FROM udcmanualrequests mr " & _
" JOIN udcparts p2 ON mr.partrunid = p2.partrunid WHERE p2.badgenumber = p.badgenumber) AS avgmanualtime " & _
"FROM udcparts p " & _
"WHERE p.badgenumber IS NOT NULL AND p.badgenumber != '' "
If startdate <> "" Then
sql = sql & " AND p.programstart >= '" & Replace(startdate, "'", "''") & "'"
End If
If enddate <> "" Then
sql = sql & " AND p.programstart <= '" & Replace(enddate, "'", "''") & " 23:59:59'"
End If
sql = sql & " GROUP BY p.badgenumber ORDER BY partsrun DESC"
Dim rs
Set rs = objConn.Execute(sql)
If Err.Number <> 0 Then
SendError "Database error: " & Err.Description
Exit Sub
End If
Dim json, first
Dim avgCycle, avgChange, avgManual
json = "{""success"":true,""operators"":["
first = True
Do While Not rs.EOF
If Not first Then json = json & ","
first = False
If IsNull(rs("avgcycletime")) Then avgCycle = 0 Else avgCycle = Round(CDbl(rs("avgcycletime")), 0)
If IsNull(rs("avgchangeover")) Then avgChange = 0 Else avgChange = Round(CDbl(rs("avgchangeover")), 0)
If IsNull(rs("avgmanualtime")) Then avgManual = 0 Else avgManual = Round(CDbl(rs("avgmanualtime")), 0)
json = json & "{" & _
"""badgenumber"":""" & (rs("badgenumber") & "") & """," & _
"""partsrun"":" & CLng(rs("partsrun") & "0") & "," & _
"""avgcycletime"":" & avgCycle & "," & _
"""avgchangeover"":" & avgChange & "," & _
"""avgmanualtime"":" & avgManual & "," & _
"""totalmeasurements"":" & CLng(rs("totalmeasurements") & "0") & "," & _
"""totalmanual"":" & CLng(rs("totalmanual") & "0") & "," & _
"""totaloot"":" & CLng(rs("totaloot") & "0") & "," & _
"""firstrun"":""" & (rs("firstrun") & "") & """," & _
"""lastrun"":""" & (rs("lastrun") & "") & """" & _
"}"
rs.MoveNext
Loop
json = json & "]}"
rs.Close
Set rs = Nothing
Response.ContentType = "application/json"
Response.Write json
End Sub
Sub GetUDCMachineStats()
On Error Resume Next
Dim startdate, enddate
startdate = Trim(Request.QueryString("startdate") & "")
enddate = Trim(Request.QueryString("enddate") & "")
Dim sql
sql = "SELECT s.machinenumber, COUNT(*) AS partsrun, " & _
"AVG(p.cycletime) AS avgcycletime, AVG(p.changeover) AS avgchangeover, " & _
"SUM(p.measurementcount) AS totalmeasurements, SUM(p.ootcount) AS totaloot, " & _
"MIN(p.programstart) AS firstrun, MAX(p.programend) AS lastrun " & _
"FROM udcparts p " & _
"JOIN udcsessions s ON p.sessionid = s.sessionid "
If startdate <> "" Or enddate <> "" Then
sql = sql & " WHERE 1=1 "
If startdate <> "" Then
sql = sql & " AND p.programstart >= '" & Replace(startdate, "'", "''") & "'"
End If
If enddate <> "" Then
sql = sql & " AND p.programstart <= '" & Replace(enddate, "'", "''") & " 23:59:59'"
End If
End If
sql = sql & " GROUP BY s.machinenumber ORDER BY partsrun DESC"
Dim rs
Set rs = objConn.Execute(sql)
If Err.Number <> 0 Then
SendError "Database error: " & Err.Description
Exit Sub
End If
Dim json, first
Dim avgCycle, avgChange
json = "{""success"":true,""machines"":["
first = True
Do While Not rs.EOF
If Not first Then json = json & ","
first = False
If IsNull(rs("avgcycletime")) Then avgCycle = 0 Else avgCycle = Round(CDbl(rs("avgcycletime")), 0)
If IsNull(rs("avgchangeover")) Then avgChange = 0 Else avgChange = Round(CDbl(rs("avgchangeover")), 0)
json = json & "{" & _
"""machinenumber"":""" & (rs("machinenumber") & "") & """," & _
"""partsrun"":" & CLng(rs("partsrun") & "0") & "," & _
"""avgcycletime"":" & avgCycle & "," & _
"""avgchangeover"":" & avgChange & "," & _
"""totalmeasurements"":" & CLng(rs("totalmeasurements") & "0") & "," & _
"""totaloot"":" & CLng(rs("totaloot") & "0") & "," & _
"""firstrun"":""" & (rs("firstrun") & "") & """," & _
"""lastrun"":""" & (rs("lastrun") & "") & """" & _
"}"
rs.MoveNext
Loop
json = json & "]}"
rs.Close
Set rs = Nothing
Response.ContentType = "application/json"
Response.Write json
End Sub
Sub GetUDCManualTiming()
On Error Resume Next
Dim machinenumber, startdate, enddate
machinenumber = Trim(Request.QueryString("machinenumber") & "")
startdate = Trim(Request.QueryString("startdate") & "")
enddate = Trim(Request.QueryString("enddate") & "")
Dim sql, conditions
sql = "SELECT mr.requestid, p.badgenumber, s.machinenumber, " & _
"mr.requesttime, mr.responsetime, mr.responseseconds, mr.description " & _
"FROM udcmanualrequests mr " & _
"JOIN udcparts p ON mr.partrunid = p.partrunid " & _
"JOIN udcsessions s ON p.sessionid = s.sessionid "
conditions = ""
If machinenumber <> "" Then
conditions = conditions & " AND s.machinenumber = '" & Replace(machinenumber, "'", "''") & "'"
End If
If startdate <> "" Then
conditions = conditions & " AND mr.requesttime >= '" & Replace(startdate, "'", "''") & "'"
End If
If enddate <> "" Then
conditions = conditions & " AND mr.requesttime <= '" & Replace(enddate, "'", "''") & " 23:59:59'"
End If
If conditions <> "" Then
sql = sql & " WHERE 1=1 " & conditions
End If
sql = sql & " ORDER BY mr.requesttime DESC LIMIT 1000"
Dim rs
Set rs = objConn.Execute(sql)
If Err.Number <> 0 Then
SendError "Database error: " & Err.Description
Exit Sub
End If
Dim json, first
json = "{""success"":true,""manualrequests"":["
first = True
Do While Not rs.EOF
If Not first Then json = json & ","
first = False
json = json & "{" & _
"""requestid"":" & CLng(rs("requestid") & "0") & "," & _
"""badgenumber"":""" & (rs("badgenumber") & "") & """," & _
"""machinenumber"":""" & (rs("machinenumber") & "") & """," & _
"""requesttime"":""" & (rs("requesttime") & "") & """," & _
"""responsetime"":""" & (rs("responsetime") & "") & """," & _
"""responseseconds"":" & CLng(rs("responseseconds") & "0") & "," & _
"""description"":""" & Replace(rs("description") & "", """", "\""") & """" & _
"}"
rs.MoveNext
Loop
json = json & "]}"
rs.Close
Set rs = Nothing
Response.ContentType = "application/json"
Response.Write json
End Sub
%>
Reference in New Issue View Git Blame Copy Permalink