Option Strict Off Option Explicit On Module 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
Public InetShareDpp As Boolean Public InetLockDpp As Boolean Public Const MAX_NETFINDER_ENTRIES As Short = 5 Public Const NO_NETFINDER_ENTRIES As Short = -1 Public Const MAX_NETFINDER_STRING As Short = 80 Public Netfinder_active As Boolean Public Netfinder_Seq As Short Public NewNetfinderRequest As Boolean Public NetfinderUnit As Short Public EthernetConnectionStatus As Short Public EthernetConnectionTicker As Short Public EthernetConnected As Boolean Public SearchIp As Integer Public Structure NETDISPLAY_ENTRY Dim alert_level As Byte Dim event1_days As Integer Dim event1_hours As Byte Dim event1_minutes As Byte Dim event1_seconds As Byte Dim event2_days As Integer Dim event2_hours As Byte Dim event2_minutes As Byte Dim event2_seconds As Byte Dim mac() As Byte Dim ip() As Byte Dim port As Short Dim subnet() As Byte Dim gateway() As Byte Dim str_type As String Dim str_description As String Dim str_ev1 As String Dim str_ev2 As String Dim str_display As String Dim ccConnectRGB As Integer 'COLORREF Dim HasData As Boolean Dim SockAddr As UInt32 Dim SerNum As UInt32 Public Sub Initialize() ReDim mac(6) ReDim ip(4) ReDim subnet(4) ReDim gateway(4) End Sub End Structure Public NfPktEntries(MAX_NETFINDER_ENTRIES - 1) As NETDISPLAY_ENTRY Public DppEntries(MAX_NETFINDER_ENTRIES - 1) As NETDISPLAY_ENTRY Public Sub AddStr(ByRef strStr As String, ByRef str1 As String, Optional ByRef str2 As String = "", Optional ByRef 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(ByRef IPAddress As Object, Optional ByRef ToByteArray As Boolean = False) As Object Dim idxByte As Integer 'byte index Dim idxPos As Integer 'position in hex string Dim idxPosOld As Integer Dim strHex As String Dim strSep As String Dim ipByte As Byte Dim ipByteArr(3) As Byte Dim iAddr32 As UInt32 Dim strIpAddr As String IpAddrConvert = IPAddress If IsNumeric(IPAddress) Then 'convert long strIpAddr = "" strSep = "" strHex = Hex(IPAddress) strHex = New String("0", 8 - Len(strHex)) & 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 = VB6.CopyArray(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 &HFFS idxPosOld = idxPos strHex = Hex(ipByteArr(idxByte)) strHex = New String("0", 2 - Len(strHex)) & strHex strIpAddr = strIpAddr & strHex Next If (ToByteArray) Then IpAddrConvert = VB6.CopyArray(ipByteArr) Else iAddr32 = CULng("&H" & strIpAddr) IpAddrConvert = iAddr32 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 Integer 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 pEntry.Initialize() For idxInit = 0 To MAX_NETFINDER_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 Integer Dim lMaxEntry As Integer lMaxEntry = UBound(DppEntries) For idxEntry = 0 To lMaxEntry Call InitEntry(DppEntries(idxEntry)) Next End Sub Public Function AlertEntryToCOLORREF(ByRef pEntry As NETDISPLAY_ENTRY) As Integer 'COLORREF AlertEntryToCOLORREF = AlertByteToCOLORREF(pEntry.alert_level) End Function Public Function AlertByteToCOLORREF(ByRef alert_level As Byte) As Integer 'COLORREF Select Case alert_level ' Alert Level Case &H0s '0 = Interface is open (unconnected) AlertByteToCOLORREF = colorGreen Case &H1s '1 = Interface is connected (sharing is allowed) AlertByteToCOLORREF = colorYellow Case &H2s '2 = Interface is connected (sharing is not allowed) AlertByteToCOLORREF = colorRed Case &H3s '3 = Interface is locked AlertByteToCOLORREF = colorRed Case &H4s '4 = Interface is unavailable because USB is connected AlertByteToCOLORREF = colorSilver Case Else 'Interface configuration unknown AlertByteToCOLORREF = colorWhite End Select End Function Public Function FindEntry(ByRef SockAddr As Integer, ByRef DppEntries() As NETDISPLAY_ENTRY) As Integer Dim idxEntry As Integer Dim EntryFound As Integer Dim lMaxEntry As Integer 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, ByRef Buffer() As Byte, ByRef destPort As Integer) Dim idxBuffer As Integer 'buffer index Dim nfVersion As Byte Dim RandSeqNumber As Integer nfVersion = Buffer(&H0s) 'byte 0 (for reference) pEntry.alert_level = Buffer(&H1S) 'byte 1 RandSeqNumber = (CInt(Buffer(&H2S)) * CInt(256)) + CInt(Buffer(&H3S)) 'bytes 2 & 3 (for reference) pEntry.port = CShort("&H" & Hex(destPort And &HFFFFs)) 'convert long containing unsigned short 'Event 1 pEntry.event1_days = EventDays_ByteToULong(Buffer, &H4s) 'Event 1 days bytes 4 & 5 pEntry.event1_hours = Buffer(&H6S) 'Event 1 hours byte 6 pEntry.event1_minutes = Buffer(&H7S) 'Event 1 minutes byte 7 'Event 2 pEntry.event2_days = EventDays_ByteToULong(Buffer, &H8S) 'Event 2 days bytes 8 & 9 pEntry.event2_hours = Buffer(&HAS) 'Event 2 hours byte 10 pEntry.event2_minutes = Buffer(&HBS) 'Event 2 minutes byte 11 'Event 1 & 2 seconds pEntry.event1_seconds = Buffer(&HCS) 'Event 1 seconds byte 12 pEntry.event2_seconds = Buffer(&HDS) 'Event 1 seconds byte 13 pEntry.mac(0) = Buffer(&HES) 'MAC Address byte 14 (6 bytes) pEntry.mac(1) = Buffer(&HFS) pEntry.mac(2) = Buffer(&H10S) pEntry.mac(3) = Buffer(&H11S) pEntry.mac(4) = Buffer(&H12S) pEntry.mac(5) = Buffer(&H13S) pEntry.ip(0) = Buffer(&H14S) 'IP Address byte 20 (4 bytes) pEntry.ip(1) = Buffer(&H15S) pEntry.ip(2) = Buffer(&H16S) pEntry.ip(3) = Buffer(&H17S) pEntry.subnet(0) = Buffer(&H18S) 'Subnet Mask byte 24 (4 bytes) pEntry.subnet(1) = Buffer(&H19S) pEntry.subnet(2) = Buffer(&H1AS) pEntry.subnet(3) = Buffer(&H1BS) pEntry.gateway(0) = Buffer(&H1CS) 'Default Gateway byte 28 (4 bytes) pEntry.gateway(1) = Buffer(&H1DS) pEntry.gateway(2) = Buffer(&H1ES) pEntry.gateway(3) = Buffer(&H1FS) idxBuffer = &H20s '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 ' Copy the Event1+2 text descripion without the ": " pEntry.str_ev1 = GetNetFinderString(Buffer, idxBuffer) 'get event 1 description pEntry.str_ev2 = GetNetFinderString(Buffer, idxBuffer) 'get event 2 description ' Add ": " to str_ev1 and str_ev2 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, &H14S) 'IP Address (starts at byte 20) pEntry.str_display = EntryToStr(pEntry) ' Convert Entry infor to string 'MsgBox pEntry.str_display End Sub Private Function GetNetFinderString(ByRef Buffer() As Byte, ByRef Index As Integer) As String Dim idxCh As Integer 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(ByVal str_type As String) As Integer Dim lSerNum As Integer Dim lPos As Integer Dim strSerNum As String = "" lSerNum = 0 If (Len(str_type) > 0) Then lPos = InStr(1, str_type, "S/N", CompareMethod.Text) If (lPos > 0) Then If ((lPos + 3) < Len(str_type)) Then lSerNum = CLng(Math.Truncate(Convert.ToDouble(Mid(str_type, lPos+3)))) End If End If End If GetSerialNumber = lSerNum End Function Private Function EventDays_ByteToULong(ByRef Buffer() As Byte, ByRef Index As Integer) As UInt32 Dim lngDays As Integer lngDays = CInt(Buffer(Index)) * 256 lngDays = lngDays + CInt(Buffer(Index + 1)) EventDays_ByteToULong = lngDays End Function Private Function SockAddr_ByteToULong(ByRef Buffer() As Byte, ByRef Index As Integer) As UInt32 Dim idxIp As Integer 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 Object) As Integer varIndex = varIndex + 1 inc = CInt(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 As String = "" Dim cstrEvent2 As String = "" Dim cstrAdditionalDesc As String = "" Dim cstrMacAddress As String = "" Dim cstrEntry As String = "" Dim temp_str As String = "" Dim temp_str2 As String = "" Dim idxVal As Integer Dim strSep As String = "" cstrAlertLevel = "Connection: " Select Case (pEntry.alert_level) ' Alert Level Case &H0s '0 = Interface is open (unconnected) cstrAlertLevel = cstrAlertLevel & "Interface is open (unconnected)" Case &H1s '1 = Interface is connected (sharing is allowed) cstrAlertLevel = cstrAlertLevel & "Interface is connected (sharing is allowed)" Case &H2s '2 = Interface is connected (sharing is not allowed) cstrAlertLevel = cstrAlertLevel & "Interface is connected (sharing is not allowed)" Case &H3s '3 = Interface is locked cstrAlertLevel = cstrAlertLevel & "Interface is locked" Case &H4s '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 & " " ' Event2 Time temp_str2 = FormatNetFinderTime(pEntry, 2) 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 EntryToStrRS232(ByRef pEntry As NETDISPLAY_ENTRY, ByRef strPort As String) As String Dim cstrAlertLevel As String = "" Dim strDeviceType As String = "" Dim cstrIpAddress As String = "" Dim cstrEvent1 As String = "" Dim cstrEvent2 As String = "" Dim cstrAdditionalDesc As String = "" Dim cstrMacAddress As String = "" Dim cstrEntry As String = "" Dim temp_str As String = "" Dim temp_str2 As String = "" Dim idxVal As Integer Dim strSep As String = "" cstrAlertLevel = "Connection: " cstrAlertLevel = cstrAlertLevel & strPort strDeviceType = pEntry.str_type ' Device Name/Type ' IP Address String cstrIpAddress = "IP Address: " & IpAddrConvert(pEntry.SockAddr) cstrAdditionalDesc = pEntry.str_description ' Additional Description ' MacAddress cstrMacAddress = "MAC Address: " strSep = "" For idxVal = 0 To 5 cstrMacAddress = cstrMacAddress & strSep & FmtHex(pEntry.mac(idxVal), 2) strSep = "-" Next ' Event1 Time temp_str = pEntry.str_ev1 & " " temp_str2 = FormatNetFinderTime(pEntry, 1) cstrEvent1 = temp_str + temp_str2 ' Event2 Time temp_str = pEntry.str_ev2 & " " temp_str2 = FormatNetFinderTime(pEntry, 2) 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 EntryToStrRS232 = cstrEntry End Function Public Function EntryToStrUSB(ByRef pEntry As NETDISPLAY_ENTRY, ByRef strPort As String) As String Dim cstrAlertLevel As String = "" Dim strDeviceType As String = "" Dim cstrIpAddress As String = "" Dim cstrEvent1 As String = "" Dim cstrEvent2 As String = "" Dim cstrAdditionalDesc As String = "" Dim cstrMacAddress As String = "" Dim cstrEntry As String = "" Dim temp_str As String = "" Dim temp_str2 As String = "" Dim idxVal As Integer 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 Private Function FormatNetFinderTime(ByRef pEntry As NETDISPLAY_ENTRY, ByRef NetFinderEvent As Byte) As String Dim event_days As Integer Dim event_hours As Byte Dim event_minutes As Byte Dim event_seconds As Byte Dim strTime(3) As String Dim idxValue As Integer Dim idxStart As Integer 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 End Module