Attribute VB_Name = "modNetFinder" 'Purpose:
' The Netfinder protocol allows a PC application to search for embedded systems on a network.
' For USB, the NetFinder Packet is used to Identify DPP devices
Option Explicit Public InetShareDpp As Boolean Public InetLockDpp As Boolean Public Const MAX_NETFINDER_ENTRIES = 10 Public Const NO_NETFINDER_ENTRIES = -1 Public Const MAX_NETFINDER_STRING = 80 Public Netfinder_active As Boolean Public Netfinder_Seq As Integer Public NewNetfinderRequest As Boolean Public NetfinderUnit As Integer Public EthernetConnectionStatus As Integer Public EthernetConnectionTicker As Integer Public UnitIP(MAX_NETFINDER_ENTRIES - 1, 3) ' capture up to 16 IPs per Netfinder? Public EthernetConnected As Boolean Public SearchIp As Long Public isDppFound(RS232 To ETHERNET) As Boolean Public Type NETDISPLAY_ENTRY alert_level As Byte event1_days As Long event1_hours As Byte event1_minutes As Byte event1_seconds As Byte event2_days As Long event2_hours As Byte event2_minutes As Byte event2_seconds As Byte mac(6) As Byte ip(4) As Byte port As Integer subnet(4) As Byte gateway(4) As Byte str_type As String str_description As String str_ev1 As String str_ev2 As String str_display As String ccConnectRGB As Long 'COLORREF HasData As Boolean SockAddr As Long SerNum As Long End Type Public NfPktEntries(MAX_NETFINDER_ENTRIES - 1) As NETDISPLAY_ENTRY 'RS232,USB,ETHERNET,SPARE Public DppEntries(MAX_NETFINDER_ENTRIES - 1) As NETDISPLAY_ENTRY Public Sub AddStr(ByRef strStr As String, str1 As String, Optional str2 As String = "", Optional AddNL As Boolean = True) Dim strNL As String strNL = "" If (AddNL) Then strNL = vbNewLine strStr = strStr & str1 & str2 & strNL End Sub 'Purpose: IpAddrConvert converts multiple IP address formats. '
'
'Returns:
' IpAddrConvert convertions with ToByteArray = False
' long to string
' byte array to string
' string to long

' ' IpAddrConvert convertions with ToByteArray = True
' long to byte array
' byte array to string (no change)
' string to byte array

'
'
'Parameter: IPAddress IP Address to be converted. 'Parameter: ToByteArray IP Address convertion function. Public Function IpAddrConvert(IPAddress As Variant, Optional ToByteArray As Boolean = False) As Variant Dim idxByte As Long 'byte index Dim idxPos As Long 'position in hex string Dim idxPosOld As Long Dim strHex As String Dim strSep As String Dim ipByte As Byte Dim ipByteArr(3) As Byte Dim strIpAddr As String If IsNumeric(IPAddress) Then 'convert long strIpAddr = "" strSep = "" strHex = Hex(IPAddress) strHex = String(8 - Len(strHex), "0") & strHex For idxByte = 0 To 3 idxPos = 1 + (idxByte * 2) ipByte = CByte("&H" & Mid(strHex, idxPos, 2)) 'convert hex to byte ipByteArr(idxByte) = ipByte strIpAddr = strIpAddr & strSep & CStr(ipByte) strSep = "." Next If (ToByteArray) Then IpAddrConvert = ipByteArr Else IpAddrConvert = strIpAddr End If ElseIf IsArray(IPAddress) Then 'ByteArray(0-3) If ((TypeName(IPAddress) = "Byte()") And (UBound(IPAddress) = 3)) Then strIpAddr = "" strSep = "" For idxByte = 0 To 3 ipByte = IPAddress(idxByte) strIpAddr = strIpAddr & strSep & CStr(ipByte) strSep = "." Next IpAddrConvert = strIpAddr End If ElseIf (TypeName(IPAddress) = "String") Then 'String 0.0.0.0 idxPos = 1 idxPosOld = 0 strIpAddr = "" For idxByte = 0 To 3 idxPos = InStr(idxPosOld + 1, IPAddress, ".") If (idxPos = 0) Then idxPos = Len(IPAddress) + 1 'end of string ipByteArr(idxByte) = Val(Mid(IPAddress, idxPosOld + 1, (idxPos - idxPosOld) - 1)) And &HFF idxPosOld = idxPos strHex = Hex(ipByteArr(idxByte)) strHex = String(2 - Len(strHex), "0") & strHex strIpAddr = strIpAddr & strHex Next If (ToByteArray) Then IpAddrConvert = ipByteArr Else IpAddrConvert = CLng("&H" & strIpAddr) End If End If End Function 'IP Address Convert 'long . string >. string=IpAddrConvert(long) 'long . byte array >. byte array=IpAddrConvert(long,true) 'string . long >. long=IpAddrConvert(string) 'string . byte array >. byte array=IpAddrConvert(string,true) 'byte array . string >. string=IpAddrConvert(byte array) '(2 steps for byte array to long) 'byte array . long >. string=IpAddrConvert(byte array) >>. long=IpAddrConvert(string) Public Sub InitEntry(ByRef pEntry As NETDISPLAY_ENTRY) Dim idxInit As Long pEntry.alert_level = 0 pEntry.event1_days = 0 pEntry.event1_hours = 0 pEntry.event1_minutes = 0 pEntry.event2_days = 0 pEntry.event2_hours = 0 pEntry.event2_minutes = 0 pEntry.event1_seconds = 0 pEntry.event2_seconds = 0 pEntry.port = 0 ' Get port from UDP header For idxInit = 0 To MAX_DISPLAY_ENTRIES - 1 pEntry.mac(idxInit) = 0 pEntry.ip(idxInit) = 0 pEntry.subnet(idxInit) = 0 pEntry.gateway(idxInit) = 0 Next pEntry.mac(4) = 0 pEntry.mac(5) = 0 pEntry.str_type = "" pEntry.str_description = "" pEntry.str_ev1 = "" pEntry.str_ev2 = "" pEntry.str_display = "" pEntry.ccConnectRGB = colorWhite pEntry.HasData = False pEntry.SockAddr = 0 pEntry.SerNum = 0 End Sub Public Sub InitAllEntries(ByRef DppEntries() As NETDISPLAY_ENTRY) Dim idxEntry As Long Dim lMaxEntry As Long lMaxEntry = UBound(DppEntries) For idxEntry = 0 To lMaxEntry Call InitEntry(DppEntries(idxEntry)) Next End Sub Public Function AlertEntryToCOLORREF(pEntry As NETDISPLAY_ENTRY) As Long 'COLORREF AlertEntryToCOLORREF = AlertByteToCOLORREF(pEntry.alert_level) End Function Public Function AlertByteToCOLORREF(alert_level As Byte) As Long 'COLORREF Select Case alert_level ' Alert Level Case &H0: '0 = Interface is open (unconnected) AlertByteToCOLORREF = colorGreen Case &H1: '1 = Interface is connected (sharing is allowed) AlertByteToCOLORREF = colorYellow Case &H2: '2 = Interface is connected (sharing is not allowed) AlertByteToCOLORREF = colorRed Case &H3: '3 = Interface is locked AlertByteToCOLORREF = colorRed Case &H4: '4 = Interface is unavailable because USB is connected AlertByteToCOLORREF = colorSilver Case Else: 'Interface configuration unknown AlertByteToCOLORREF = colorWhite End Select End Function Public Function FindEntry(SockAddr As Long, DppEntries() As NETDISPLAY_ENTRY) As Long Dim idxEntry As Long Dim EntryFound As Long Dim lMaxEntry As Long lMaxEntry = UBound(DppEntries) EntryFound = NO_NETFINDER_ENTRIES For idxEntry = 0 To lMaxEntry If (SockAddr = DppEntries(idxEntry).SockAddr) Then EntryFound = idxEntry Exit For End If Next FindEntry = EntryFound End Function Public Sub AddEntry(ByRef pEntry As NETDISPLAY_ENTRY, Buffer() As Byte, destPort As Long) Dim idxBuffer As Long 'buffer index Dim nfVersion As Byte Dim RandSeqNumber As Long nfVersion = Buffer(&H0) 'byte 0 (for reference) pEntry.alert_level = Buffer(&H1) 'byte 1 RandSeqNumber = (CLng(Buffer(&H2)) * CLng(256)) + CLng(Buffer(&H3)) 'bytes 2 & 3 (for reference) pEntry.port = CInt("&H" & Hex(destPort And &HFFFF)) 'convert long containing unsigned short pEntry.event1_days = EventDays_ByteToULong(Buffer, &H4) 'Event 1 days bytes 4 & 5 pEntry.event1_hours = Buffer(&H6) 'Event 1 hours byte 6 pEntry.event1_minutes = Buffer(&H7) 'Event 1 minutes byte 7 pEntry.event2_days = EventDays_ByteToULong(Buffer, &H8) 'Event 2 days bytes 8 & 9 pEntry.event2_hours = Buffer(&HA) 'Event 2 hours byte 10 pEntry.event2_minutes = Buffer(&HB) 'Event 2 minutes byte 11 pEntry.event1_seconds = Buffer(&HC) 'Event 1 seconds byte 12 pEntry.event2_seconds = Buffer(&HD) 'Event 1 seconds byte 13 pEntry.mac(0) = Buffer(&HE) 'MAC Address byte 14 (6 bytes) pEntry.mac(1) = Buffer(&HF) pEntry.mac(2) = Buffer(&H10) pEntry.mac(3) = Buffer(&H11) pEntry.mac(4) = Buffer(&H12) pEntry.mac(5) = Buffer(&H13) pEntry.ip(0) = Buffer(&H14) 'IP Address byte 20 (4 bytes) pEntry.ip(1) = Buffer(&H15) pEntry.ip(2) = Buffer(&H16) pEntry.ip(3) = Buffer(&H17) pEntry.subnet(0) = Buffer(&H18) 'Subnet Mask byte 24 (4 bytes) pEntry.subnet(1) = Buffer(&H19) pEntry.subnet(2) = Buffer(&H1A) pEntry.subnet(3) = Buffer(&H1B) pEntry.gateway(0) = Buffer(&H1C) 'Default Gateway byte 28 (4 bytes) pEntry.gateway(1) = Buffer(&H1D) pEntry.gateway(2) = Buffer(&H1E) pEntry.gateway(3) = Buffer(&H1F) idxBuffer = &H20 'start of variable Length Null-Terminated strings byte 32 'buffer index incremented to start of next string pEntry.str_type = GetNetFinderString(Buffer, idxBuffer) 'get embedded system pEntry.SerNum = GetSerialNumber(pEntry.str_type) 'get serial number pEntry.str_description = GetNetFinderString(Buffer, idxBuffer) 'get description pEntry.str_ev1 = GetNetFinderString(Buffer, idxBuffer) 'get event 1 description pEntry.str_ev2 = GetNetFinderString(Buffer, idxBuffer) 'get event 2 description pEntry.str_ev1 = pEntry.str_ev1 & ": " pEntry.str_ev2 = pEntry.str_ev2 & ": " pEntry.ccConnectRGB = AlertByteToCOLORREF(pEntry.alert_level) pEntry.HasData = True pEntry.SockAddr = SockAddr_ByteToULong(Buffer, &H14) 'IP Address (starts at byte 20) pEntry.str_display = EntryToStr(pEntry) ' Convert Entry infor to string End Sub Private Function GetNetFinderString(Buffer() As Byte, ByRef Index As Long) As String Dim idxCh As Long Dim strCh As String strCh = "" idxCh = Index Do If (Buffer(idxCh) > 0) And (idxCh < UBound(Buffer)) Then strCh = strCh + Chr(Buffer(idxCh)) idxCh = idxCh + 1 Else idxCh = idxCh + 1 'start of next string Exit Do End If Loop Index = idxCh 'update index to next position GetNetFinderString = strCh End Function Private Function GetSerialNumber(str_type As String) As Long Dim lSerNum As Long Dim lPos As Long Dim strSerNum As String lSerNum = 0 If (Len(str_type) > 0) Then lPos = InStr(1, str_type, "S/N", vbTextCompare) If (lPos > 0) Then If ((lPos + 3) < Len(str_type)) Then lSerNum = CLng(Val(Mid(str_type, lPos + 3))) End If End If End If GetSerialNumber = lSerNum End Function Private Function EventDays_ByteToULong(Buffer() As Byte, Index As Long) As Long Dim lngDays As Long lngDays = CLng(Buffer(Index)) * 256 lngDays = lngDays + CLng(Buffer(Index + 1)) EventDays_ByteToULong = lngDays End Function Private Function SockAddr_ByteToULong(Buffer() As Byte, Index As Long) As Long Dim idxIp As Long Dim byteIp(3) As Byte Dim strIp As String For idxIp = 0 To 3 byteIp(idxIp) = Buffer(Index + idxIp) Next strIp = IpAddrConvert(byteIp) SockAddr_ByteToULong = IpAddrConvert(strIp) End Function Private Function inc(ByRef varIndex As Variant) As Long varIndex = varIndex + 1 inc = CLng(varIndex) End Function Public Function EntryToStr(ByRef pEntry As NETDISPLAY_ENTRY) As String Dim cstrAlertLevel As String Dim strDeviceType As String Dim cstrIpAddress As String Dim cstrEvent1, cstrEvent2 As String Dim cstrAdditionalDesc As String Dim cstrMacAddress As String Dim cstrEntry As String Dim temp_str, temp_str2 As String Dim idxVal As Long Dim strSep As String cstrAlertLevel = "Connection: " Select Case (pEntry.alert_level) ' Alert Level Case &H0: '0 = Interface is open (unconnected) cstrAlertLevel = cstrAlertLevel + "Interface is open (unconnected)" Case &H1: '1 = Interface is connected (sharing is allowed) cstrAlertLevel = cstrAlertLevel + "Interface is connected (sharing is allowed)" Case &H2: '2 = Interface is connected (sharing is not allowed) cstrAlertLevel = cstrAlertLevel + "Interface is connected (sharing is not allowed)" Case &H3: '3 = Interface is locked cstrAlertLevel = cstrAlertLevel + "Interface is locked" Case &H4: '4 = Interface is unavailable because USB is connected cstrAlertLevel = cstrAlertLevel + "Interface is unavailable because USB is connected" Case Else: cstrAlertLevel = cstrAlertLevel + "Interface configuration unknown" End Select strDeviceType = pEntry.str_type ' Device Name/Type cstrIpAddress = "IP Address: " & IpAddrConvert(pEntry.SockAddr) ' IP Address String cstrAdditionalDesc = pEntry.str_description ' Additional Description cstrMacAddress = "MAC Address: " ' MacAddress strSep = "" For idxVal = 0 To 5 cstrMacAddress = cstrMacAddress & strSep & FmtHex(pEntry.mac(idxVal), 2) strSep = "-" Next temp_str = pEntry.str_ev1 + " " ' Event1 Time temp_str2 = FormatNetFinderTime(pEntry, 1) cstrEvent1 = temp_str + temp_str2 temp_str = pEntry.str_ev2 + " " temp_str2 = FormatNetFinderTime(pEntry, 2) ' Event2 Time cstrEvent2 = temp_str + temp_str2 cstrEntry = strDeviceType & vbNewLine cstrEntry = cstrEntry + cstrAlertLevel & vbNewLine cstrEntry = cstrEntry + cstrIpAddress & vbNewLine cstrEntry = cstrEntry + cstrAdditionalDesc & vbNewLine cstrEntry = cstrEntry + cstrMacAddress & vbNewLine cstrEntry = cstrEntry + cstrEvent1 & vbNewLine cstrEntry = cstrEntry + cstrEvent2 & vbNewLine EntryToStr = cstrEntry End Function Public Function EntryToStrUSB(ByRef pEntry As NETDISPLAY_ENTRY, strPort As String) As String Dim cstrAlertLevel As String Dim strDeviceType As String Dim cstrIpAddress As String Dim cstrEvent1, cstrEvent2 As String Dim cstrAdditionalDesc As String Dim cstrMacAddress As String Dim cstrEntry As String Dim temp_str, temp_str2 As String Dim idxVal As Long Dim strSep As String cstrAlertLevel = "Connection: " cstrAlertLevel = cstrAlertLevel & strPort strDeviceType = pEntry.str_type ' Device Name/Type cstrIpAddress = "IP Address: " & IpAddrConvert(pEntry.SockAddr) ' IP Address String cstrAdditionalDesc = pEntry.str_description ' Additional Description cstrMacAddress = "MAC Address: " ' MacAddress strSep = "" For idxVal = 0 To 5 cstrMacAddress = cstrMacAddress & strSep & FmtHex(pEntry.mac(idxVal), 2) strSep = "-" Next temp_str = pEntry.str_ev1 + " " ' Event1 Time temp_str2 = FormatNetFinderTime(pEntry, 1) cstrEvent1 = temp_str + temp_str2 temp_str = pEntry.str_ev2 + " " ' Event2 Time temp_str2 = FormatNetFinderTime(pEntry, 2) cstrEvent2 = temp_str + temp_str2 cstrEntry = strDeviceType & vbNewLine cstrEntry = cstrEntry + cstrAlertLevel & vbNewLine cstrEntry = cstrEntry + cstrAdditionalDesc & vbNewLine cstrEntry = cstrEntry + cstrEvent1 & vbNewLine EntryToStrUSB = cstrEntry End Function Public Function FormatNetFinderTime(pEntry As NETDISPLAY_ENTRY, NetFinderEvent As Byte) As String Dim event_days As Long Dim event_hours As Byte Dim event_minutes As Byte Dim event_seconds As Byte Dim strTime(3) As String Dim idxValue As Long Dim idxStart As Long Dim strEventTime As String If (NetFinderEvent = 1) Then event_days = pEntry.event1_days event_hours = pEntry.event1_hours event_minutes = pEntry.event1_minutes event_seconds = pEntry.event1_seconds ElseIf (NetFinderEvent = 2) Then event_days = pEntry.event2_days event_hours = pEntry.event2_hours event_minutes = pEntry.event2_minutes event_seconds = pEntry.event2_seconds Else FormatNetFinderTime = "" Exit Function End If strTime(0) = CStr(event_days) & " days," strTime(1) = CStr(event_hours) & " hours," strTime(2) = CStr(event_minutes) & " minutes," strTime(3) = CStr(event_seconds) & " seconds" idxStart = 0 If (CBool(event_days)) Then idxStart = 0 ElseIf (CBool(event_hours)) Then idxStart = 1 ElseIf (CBool(event_minutes)) Then idxStart = 2 Else idxStart = 3 End If strEventTime = "" For idxValue = idxStart To 3 strEventTime = strEventTime & strTime(idxValue) Next FormatNetFinderTime = strEventTime End Function