Option Explicit
Public RS232HeaderReceived As Boolean
Public RS232PacketPtr As Integer
Public RS232ComPortTest As Boolean
Public Const MAX_DISPLAY_ENTRIES = 4
Public Sub NetFinderSearch() ' DP5 Netfinder Search
Dim idxEntry As Long
Dim IdRequest(5) As Byte 'Broadcast Identity Request (Note: Silicon Labs = 4 bytes, Amptek = 6 bytes)
On Error GoTo NetFinderSearchErr
'If (NetFinderWinSockError) Then Exit Sub
'NetFinderWinSock.RemoteHost = "255.255.255.255" ' this gets set to the responding IP, so reset it each time
Netfinder_Seq = Rnd * 32767 ' 15-bit random seq number, so don't have to screw around with signed INT
IdRequest(0) = 0 ' Netfinder version/type
IdRequest(1) = 0 ' reserved
IdRequest(2) = (Netfinder_Seq And &HFF00) \ 256 'MSB
IdRequest(3) = Netfinder_Seq And 255 ' LSB
IdRequest(4) = &HF4 ' append validation bytes
IdRequest(5) = &HFA
For idxEntry = 0 To 3 'initialize entries
frmDP5_Connect.cmdSelectIP(idxEntry).Visible = False
frmDP5_Connect.lblUnit(idxEntry).Caption = ""
frmDP5_Connect.lblUnit(idxEntry).BackColor = &H80000005
frmDP5_Connect.lblUnit(idxEntry).ForeColor = &H80000012
InitEntry DppEntries(idxEntry)
Next
NewNetfinderRequest = True
frmDP5.NetFinderWinSock.RemoteHost = "255.255.255.255" 'this gets set to the responding IP, so reset it each time
frmDP5.NetFinderWinSock.SendData IdRequest() 'send 3 times - DP5 will respond to only first one it sees
frmDP5_Connect.lblNetFinderErrors.Caption = ""
Exit Sub
NetFinderSearchErr:
frmDP5_Connect.lblNetFinderErrors.Caption = "Net Finder Socket Error:" & vbNewLine & Err.Description
End Sub
Public Function SendPacketRS232(IntCtrl As Object, ByRef Buffer() As Byte, ByRef PacketIn() As Byte) As Boolean
Dim bytesWritten As Long, bytesRead As Long
Dim success As Boolean
Dim curStartTime As Currency
Dim isExpired As Boolean
Dim strLog As String
Dim i As Long
Dim PLen As Long
PLen = (Buffer(4) * 256) + Buffer(5) + 7
ACK_Received = False
Packet_Received = False ' a response packet is always expected
PIN.STATUS = &HFF ' packet invalid - will be overwritten soon by response/ACK packet
' send the packet
'For i = 0 To POUT.LEN + 7
For i = 0 To PLen
IntCtrl.OutPut = Chr(Buffer(i))
Next i
Timeout_flag = False
curStartTime = msTimeStart()
Do
DoEvents ' receive bytes and parse packet
isExpired = msTimeExpired(curStartTime, 1000)
If (isExpired) Then Timeout_flag = True
Loop While (PIN.STATUS = &HFF) And (Timeout_flag = False) ' wait for ACK or timeout
If Timeout_flag Then
strLog = strLog + "Timeout: no response packet!" + vbCrLf
SendPacketRS232 = False
Else
SendPacketRS232 = True
End If
End Function
Public Function SendPacketInet(IntCtrl As Object, ByRef Buffer() As Byte, ByRef PacketIn() As Byte) As Boolean
Dim bytesWritten As Long, bytesRead As Long
Dim success As Boolean
Dim curStartTime As Currency
Dim isExpired As Boolean
Dim strLog As String
Dim idxData As Long
Dim PLen As Long
Dim Buffer_Eth() As Byte
On Error GoTo SendPacketInetErr
UDP_offset = 0 ' start at the beginning of InPacket()
PLen = (Buffer(4) * 256) + Buffer(5) + 7
ReDim Buffer_Eth(PLen) 'make a buffer the size of the data
ACK_Received = False
Packet_Received = False ' a response packet is always expected
PIN.STATUS = &HFF ' packet invalid - will be overwritten soon by response/ACK packet
For idxData = 0 To PLen
Buffer_Eth(idxData) = Buffer(idxData)
Next
IntCtrl.SendData Buffer_Eth()
SendPacketInet = True
Exit Function
SendPacketInetErr:
SendPacketInet = False
End Function
Public Function EntryToStrRS232(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
' 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 + cstrAdditionalDesc & vbNewLine
cstrEntry = cstrEntry + cstrEvent1 & vbNewLine
EntryToStrRS232 = cstrEntry
End Function
Public Function GetWinSockStateString(wSock As Winsock) As String
Select Case wSock.State
Case sckClosed '0 Default.
GetWinSockStateString = "Closed"
Case sckOpen '1
GetWinSockStateString = "Open"
Case sckListening '2
GetWinSockStateString = "Listening"
Case sckConnectionPending '3
GetWinSockStateString = "Connection pending"
Case sckResolvingHost '4
GetWinSockStateString = "Resolving host"
Case sckHostResolved '5
GetWinSockStateString = "Host resolved"
Case sckConnecting '6
GetWinSockStateString = "Connecting"
Case sckConnected '7
GetWinSockStateString = "Connected"
Case sckClosing '8
GetWinSockStateString = "Peer is closing the connection"
Case sckError '9
GetWinSockStateString = "Error"
Case Else
GetWinSockStateString = "Unknown"
End Select
End Function