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