<% ' Zabbix API Configuration - uses ZABBIX_URL and ZABBIX_API_TOKEN from config.asp ' NOTE: config.asp must be included by the calling page (via sql.asp) before this file ' Function to make HTTP POST request to Zabbix API with Bearer token Function ZabbixAPICall(jsonRequest) On Error Resume Next Dim http, responseText, httpStatus Set http = Server.CreateObject("MSXML2.ServerXMLHTTP.6.0") ' Set aggressive timeouts (in milliseconds): resolve, connect, send, receive ' 2 seconds to resolve DNS, 3 seconds to connect, 3 seconds to send, 5 seconds to receive http.setTimeouts 2000, 3000, 3000, 5000 http.Open "POST", ZABBIX_URL, False http.setRequestHeader "Content-Type", "application/json-rpc" http.setRequestHeader "Authorization", "Bearer " & ZABBIX_API_TOKEN http.Send jsonRequest If Err.Number <> 0 Then ZabbixAPICall = "{""error"":""HTTP Error: " & Err.Description & " (Code: " & Err.Number & ")""}" Err.Clear Exit Function End If httpStatus = http.Status responseText = http.responseText ' Check HTTP status code If httpStatus <> 200 Then ZabbixAPICall = "{""error"":""HTTP Status: " & httpStatus & " - " & responseText & """}" Else ZabbixAPICall = responseText End If Set http = Nothing On Error Goto 0 End Function ' Function to verify API token works (returns 1 if successful, empty string if failed) Function ZabbixLogin() ' With API tokens, we just verify the token works by making a simple API call ' Use hostgroup.get instead of apiinfo.version (which doesn't allow auth header) Dim jsonRequest, response jsonRequest = "{" & _ """jsonrpc"":""2.0""," & _ """method"":""hostgroup.get""," & _ """params"":{" & _ """output"":[""groupid""]," & _ """limit"":1" & _ "}," & _ """id"":1" & _ "}" response = ZabbixAPICall(jsonRequest) ' Check if we got a valid response or error If InStr(response, """result"":[") > 0 Or InStr(response, """result"":[]") > 0 Then ZabbixLogin = "1" ' Success - got valid result (even if empty array) ElseIf InStr(response, """error""") > 0 Then ZabbixLogin = "ERROR: " & response ' Return error details Else ZabbixLogin = "UNKNOWN: " & response ' Return response for debugging End If End Function ' Function to get hostgroup ID by name Function GetHostGroupID(groupName) Dim jsonRequest, response, groupID jsonRequest = "{" & _ """jsonrpc"":""2.0""," & _ """method"":""hostgroup.get""," & _ """params"":{" & _ """output"":[""groupid""]," & _ """filter"":{" & _ """name"":[""" & groupName & """]" & _ "}" & _ "}," & _ """id"":2" & _ "}" response = ZabbixAPICall(jsonRequest) ' Parse response to get groupid If InStr(response, """groupid"":""") > 0 Then groupID = Mid(response, InStr(response, """groupid"":""") + 12) groupID = Left(groupID, InStr(groupID, """") - 1) GetHostGroupID = groupID Else GetHostGroupID = "" End If End Function ' Function to get all hosts in a hostgroup Function GetHostsInGroup(groupID) Dim jsonRequest jsonRequest = "{" & _ """jsonrpc"":""2.0""," & _ """method"":""host.get""," & _ """params"":{" & _ """output"":[""hostid"",""host"",""name""]," & _ """groupids"":[""" & groupID & """]," & _ """selectInterfaces"":[""ip""]" & _ "}," & _ """id"":3" & _ "}" GetHostsInGroup = ZabbixAPICall(jsonRequest) End Function ' Function to get items (toner levels) for a specific host by IP address Function GetPrinterTonerLevels(hostIP) Dim jsonRequest, response ' First, find the host by IP jsonRequest = "{" & _ """jsonrpc"":""2.0""," & _ """method"":""host.get""," & _ """params"":{" & _ """output"":[""hostid""]," & _ """filter"":{" & _ """host"":[""" & hostIP & """]" & _ "}" & _ "}," & _ """id"":4" & _ "}" response = ZabbixAPICall(jsonRequest) ' Check if result array is empty If InStr(response, """result"":[]") > 0 Then GetPrinterTonerLevels = "{""error"":""Host not found in Zabbix"",""ip"":""" & hostIP & """}" Exit Function End If ' Extract hostid from result array ' Look for "hostid":" and then extract the value between quotes Dim hostID, startPos, endPos startPos = InStr(response, """hostid"":""") If startPos > 0 Then ' Move past "hostid":" to get to the opening quote of the value startPos = startPos + 10 ' Length of "hostid":" ' Find the closing quote endPos = InStr(startPos, response, """") ' Extract the value hostID = Mid(response, startPos, endPos - startPos) Else GetPrinterTonerLevels = "{""error"":""Could not extract hostid"",""response"":""" & Left(response, 200) & """}" Exit Function End If ' Debug: Check hostID value If hostID = "" Or IsNull(hostID) Then GetPrinterTonerLevels = "{""error"":""HostID is empty"",""hostid"":""" & hostID & """}" Exit Function End If ' Now get items for this host with component:supplies AND type:level tags ' Build the item request using the extracted hostID Dim itemRequest itemRequest = "{" & _ """jsonrpc"":""2.0""," & _ """method"":""item.get""," & _ """params"":{" & _ """output"":[""itemid"",""name"",""lastvalue"",""lastclock"",""units"",""status"",""state""]," & _ """hostids"":[""" & hostID & """]," & _ """selectTags"":""extend""," & _ """evaltype"":0," & _ """tags"":[" & _ "{""tag"":""component"",""value"":""supplies"",""operator"":0}," & _ "{""tag"":""type"",""value"":""level"",""operator"":0}" & _ "]," & _ """sortfield"":""name""," & _ """monitored"":true" & _ "}," & _ """id"":5" & _ "}" ' Make the item.get call Dim itemResponse itemResponse = ZabbixAPICall(itemRequest) ' Return the item response GetPrinterTonerLevels = itemResponse End Function ' Function to get ICMP ping status for a printer Function GetPrinterPingStatus(hostIP) Dim jsonRequest, response ' First, find the host by IP jsonRequest = "{" & _ """jsonrpc"":""2.0""," & _ """method"":""host.get""," & _ """params"":{" & _ """output"":[""hostid""]," & _ """filter"":{" & _ """host"":[""" & hostIP & """]" & _ "}" & _ "}," & _ """id"":6" & _ "}" response = ZabbixAPICall(jsonRequest) ' Check if result array is empty If InStr(response, """result"":[]") > 0 Then GetPrinterPingStatus = "-1" ' Host not found Exit Function End If ' Extract hostid from result array Dim hostID, hostidPos hostidPos = InStr(response, """hostid"":""") If hostidPos > 0 Then hostID = Mid(response, hostidPos + 10) ' Find the closing quote Dim endPos endPos = InStr(1, hostID, """") hostID = Mid(hostID, 1, endPos - 1) Else GetPrinterPingStatus = "-1" ' Could not extract hostid Exit Function End If ' Get ICMP ping item jsonRequest = "{" & _ """jsonrpc"":""2.0""," & _ """method"":""item.get""," & _ """params"":{" & _ """output"":[""lastvalue""]," & _ """hostids"":[""" & hostID & """]," & _ """search"":{" & _ """key_"":""icmpping""" & _ "}" & _ "}," & _ """id"":7" & _ "}" response = ZabbixAPICall(jsonRequest) ' Extract ping status (1 = up, 0 = down) Dim valuePos valuePos = InStr(response, """lastvalue"":""") If valuePos > 0 Then Dim pingStatus, pingStart, pingEnd pingStart = valuePos + 13 ' Length of "lastvalue":" pingEnd = InStr(pingStart, response, """") pingStatus = Mid(response, pingStart, pingEnd - pingStart) GetPrinterPingStatus = pingStatus Else GetPrinterPingStatus = "-1" ' Item not found End If End Function ' Simple JSON parser for toner data (extracts color and level from tags) Function ParseTonerData(jsonResponse) Dim tonerArray() Dim resultStart, itemStart, itemEnd Dim validItems, i, searchPos ' Check if we have a valid result resultStart = InStr(jsonResponse, """result"":[") If resultStart = 0 Then ParseTonerData = tonerArray Exit Function End If ' First pass: count valid toner items (exclude drums and unsupported) validItems = 0 searchPos = resultStart Do While True itemStart = InStr(searchPos, jsonResponse, """name"":""") If itemStart = 0 Then Exit Do ' Check if this is a toner (not drum) and status is not unsupported Dim itemBlock itemEnd = InStr(itemStart, jsonResponse, "},") If itemEnd = 0 Then itemEnd = InStr(itemStart, jsonResponse, "}]") If itemEnd = 0 Then Exit Do itemBlock = Mid(jsonResponse, itemStart, itemEnd - itemStart) ' Only count if status is active (0) and NOT a drum If InStr(itemBlock, """status"":""0""") > 0 And InStr(LCase(itemBlock), "drum") = 0 Then validItems = validItems + 1 End If searchPos = itemEnd + 1 If searchPos > Len(jsonResponse) Then Exit Do Loop If validItems = 0 Then ParseTonerData = tonerArray Exit Function End If ReDim tonerArray(validItems - 1, 2) ' name, value, color ' Second pass: extract toner data i = 0 searchPos = resultStart Do While i < validItems itemStart = InStr(searchPos, jsonResponse, """name"":""") If itemStart = 0 Then Exit Do itemEnd = InStr(itemStart, jsonResponse, "},") If itemEnd = 0 Then itemEnd = InStr(itemStart, jsonResponse, "}]") If itemEnd = 0 Then Exit Do itemBlock = Mid(jsonResponse, itemStart, itemEnd - itemStart) ' Only process items with active status (exclude drums) If InStr(itemBlock, """status"":""0""") > 0 And InStr(LCase(itemBlock), "drum") = 0 Then Dim itemName, itemValue, itemColor Dim nameStart, nameEnd, valueStart, valueEnd, colorStart, colorEnd ' Extract name (find position after "name":") nameStart = InStr(itemBlock, """name"":""") If nameStart > 0 Then nameStart = nameStart + 8 ' Length of "name":" nameEnd = InStr(nameStart, itemBlock, """") itemName = Mid(itemBlock, nameStart, nameEnd - nameStart) Else itemName = "" End If ' Extract lastvalue (find position after "lastvalue":") valueStart = InStr(itemBlock, """lastvalue"":""") If valueStart > 0 Then valueStart = valueStart + 13 ' Length of "lastvalue":" valueEnd = InStr(valueStart, itemBlock, """") itemValue = Mid(itemBlock, valueStart, valueEnd - valueStart) Else itemValue = "0" End If ' Extract color from tags array itemColor = "" colorStart = InStr(itemBlock, """tag"":""color"",""value"":""") If colorStart > 0 Then colorStart = colorStart + 26 colorEnd = InStr(colorStart, itemBlock, """") itemColor = Mid(itemBlock, colorStart, colorEnd - colorStart) End If ' Normalize color tag (handle variations like matte_black, photo_black) If itemColor <> "" Then If InStr(itemColor, "black") > 0 Then itemColor = "black" If itemColor = "gray" Or itemColor = "grey" Then itemColor = "gray" End If ' If no color tag, try to determine from name If itemColor = "" Then Dim lowerName lowerName = LCase(itemName) If InStr(lowerName, "cyan") > 0 Then itemColor = "cyan" If InStr(lowerName, "magenta") > 0 Then itemColor = "magenta" If InStr(lowerName, "yellow") > 0 Then itemColor = "yellow" If InStr(lowerName, "black") > 0 Then itemColor = "black" If InStr(lowerName, "gray") > 0 Or InStr(lowerName, "grey") > 0 Then itemColor = "gray" End If tonerArray(i, 0) = itemName tonerArray(i, 1) = itemValue tonerArray(i, 2) = itemColor i = i + 1 End If searchPos = itemEnd + 1 If searchPos > Len(jsonResponse) Then Exit Do Loop ParseTonerData = tonerArray End Function %>