'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