Option Explicit
Public bDoNotConnect As Boolean
Private Sub btnOK_Click()
Dim strSelectedComm As String
bDoNotConnect = False
strSelectedComm = "Select Communications"
Select Case s.CurrentInterface 'if found display...
Case RS232 'display com port
If (isDppFound(RS232)) Then
strSelectedComm = "RS232 - " & "COM" & frmDP5.DppComm.CommPort
s.isDppConnected = True
End If
Case USB 'display WinUSB
If (isDppFound(USB)) Then
strSelectedComm = "USB - " & "WinUSB"
s.isDppConnected = True
End If
Case ETHERNET 'display ip address
If (isDppFound(ETHERNET)) Then
strSelectedComm = "IP - " & frmDP5.DppWinsock.RemoteHost
s.isDppConnected = True
End If
Case Else
s.isDppConnected = False
End Select
frmDP5.lblSelectCommunications.Caption = strSelectedComm
's.SockAddr =
SaveApplicationSettings Me, True, False, True
Unload Me
End Sub
Private Sub cboRS232Comm_Click()
RS232ComPortTest = False 'turn comport test off if running
txtRS232Status.Text = ""
lblDppFound(RS232).Visible = False
isDppFound(RS232) = False
If (cboRS232Comm.ListIndex >= 0) Then
s.ComPort = cboRS232Comm.ItemData(cboRS232Comm.ListIndex)
'Call SetComPort
End If
If (frmDP5.DppComm.PortOpen) Then
cmdRequestDataAndStatus.Enabled = True
Else
cmdRequestDataAndStatus.Enabled = False
End If
End Sub
Private Sub chkLock_Click()
InetLockDpp = CBool(chkLock.Value)
If (Not InetLockDpp) Then
InetShareDpp = True
chkShare.Enabled = True
Else
InetShareDpp = False
chkShare.Enabled = False
End If
End Sub
Private Sub chkShare_Click()
InetShareDpp = CBool(chkShare.Value)
End Sub
Private Sub cmdCloseDevice_Click()
If (USBDeviceConnected) Then
CloseDeviceHandle DppWinUSB
cmdDisableUSBNotify_Click
USBDeviceConnected = False
End If
End Sub
Private Sub cmdCountDevices_Click()
NumUSBDevices = CountDP5WinusbDevices()
lblNumUSBDevices = NumUSBDevices
If (NumUSBDevices > 1) Then
If (CurrentUSBDevice > NumUSBDevices) Then
CurrentUSBDevice = NumUSBDevices
udSelectDevice.Value = CurrentUSBDevice
End If
udSelectDevice.Max = NumUSBDevices
udSelectDevice.Enabled = True
Else 'disable spin and device selection
udSelectDevice.Enabled = False
CurrentUSBDevice = 1
udSelectDevice.Value = 1
udSelectDevice.Max = 1
End If
End Sub
Private Sub cmdDisableUSBNotify_Click()
If USBDeviceNotificationHandle <> 0 Then
Call UnregisterDeviceNotification(USBDeviceNotificationHandle) 'Stop receiving notification messages.
End If
SetWindowLong Me.hwnd, GWL_WNDPROC, glngPrevWndProc 'pass control back to previous windows
End Sub
Private Sub EthernetConnect() ' this is Public so Form2 can call it
Dim P As Integer
If frmDP5.DppWinsock.State > 0 Then
frmDP5.DppWinsock.Close
End If
frmDP5.DppWinsock.RemoteHost = Trim(txtIP(0).Text) + "." + Trim(txtIP(1).Text) + "." + Trim(txtIP(2).Text) + "." + Trim(txtIP(3).Text)
frmDP5.DppWinsock.RemotePort = txtUDPPort.Text
s.CurrentInterface = ETHERNET
End Sub
Private Sub cmdDoNotConnect_Click()
bDoNotConnect = True
s.isDppConnected = False
DoEvents
frmDP5.lblSelectCommunications.Caption = "Select Communications"
s.isDppConnected = False
DoEvents
Unload Me
End Sub
Private Sub cmdRequestDataAndStatus_Click()
RS232ComPortTest = True
txtRS232Status.Text = ""
lblDppFound(RS232).Visible = False
isDppFound(RS232) = False
s.CurrentInterface = RS232
Call SetComPort
frmDP5.cmdRS232ComPortTest
End Sub
Private Sub cmdSelectIP_Click(Index As Integer)
lblUnit_Click Index
End Sub
Private Sub Form_Load()
Dim idxCommType As Long
Dim byteSockAddr As Variant
Dim idxIp As Long
Dim iCurrentPort As Integer
Dim bHaveComPort As Boolean
bDoNotConnect = True
iCurrentPort = 0
bHaveComPort = False
'The port must be closed to scan for available ports
If (frmDP5.DppComm.PortOpen) Then
frmDP5.DppComm.PortOpen = False
End If
CreateComPortResource cboRS232Comm
If (cboRS232Comm.ListCount > 0) Then
If (IsPortInList(cboRS232Comm, s.ComPort)) Then
If (frmDP5.DppComm.CommPort <> s.ComPort) Then
frmDP5.DppComm.CommPort = s.ComPort
End If
cboRS232Comm.ListIndex = GetPortListIndex(cboRS232Comm, s.ComPort)
bHaveComPort = True
Else 'have ports but not on list
cboRS232Comm.ListIndex = 0
End If
If (bHaveComPort) Then
'if ports available and port is closed open port
If (Not frmDP5.DppComm.PortOpen) Then
frmDP5.DppComm.PortOpen = True
End If
End If
End If
If (s.CurrentInterface = USB) Then
cmdCloseDevice_Click
End If
For idxIp = 0 To 3
lblIpId(idxIp).Caption = "I" & vbNewLine & "P" & vbNewLine & CStr(idxIp + 1)
lblIpId(idxIp).BorderStyle = ccNone
lblIpId(idxIp).Visible = False
Next
lblNetFinderErrors = ""
'start/clear netfinder search when form loaded
NewNetfinderRequest = True
NetfinderUnit = 0
InitAllEntries DppEntries
LoadApplicationSettings Me, True, False, False
strCommStatus = ""
lblIpFound.BorderStyle = vbBSNone
lblIpFound = ""
For idxCommType = 0 To 2
lblDppFound(idxCommType).BackColor = colorLightSteelBlue
lblDppFound(idxCommType).ForeColor = colorLightSlateGray
lblDppFound(idxCommType).Visible = False
isDppFound(idxCommType) = False
Next
If (s.SockAddr <> 0) Then
byteSockAddr = IpAddrConvert(s.SockAddr, True)
txtIP(0) = (CStr(byteSockAddr(0)))
txtIP(1) = (CStr(byteSockAddr(1)))
txtIP(2) = (CStr(byteSockAddr(2)))
txtIP(3) = (CStr(byteSockAddr(3)))
End If
If ((s.InetPort > 0) And (s.InetPort < &HFFFF)) Then
txtUDPPort = CStr(s.InetPort)
End If
cmdCountDevices_Click
Select Case s.CurrentInterface
Case RS232
optComm_Click RS232
Case USB
optComm_Click USB
Case ETHERNET
optComm_Click ETHERNET
Case Else
optComm_Click USB
End Select
End Sub
Private Sub Form_Paint()
DoEvents
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
'btnOK_Click
Unload Me
End Sub
Private Sub lblIpId_Click(Index As Integer)
lblUnit_Click Index
End Sub
Private Sub lblUnit_Click(Index As Integer)
If (DppEntries(Index).SockAddr = 0) Then Exit Sub
s.SockAddr = DppEntries(Index).SockAddr
s.cstrSockAddr = IpAddrConvert(s.SockAddr)
s.InetPort = CLng(Val(txtUDPPort.Text))
If ((s.InetPort <= 0) Or (s.InetPort >= &HFFFF)) Then
s.InetPort = 10001
End If
txtIP(0) = (CStr(DppEntries(Index).ip(0)))
txtIP(1) = (CStr(DppEntries(Index).ip(1)))
txtIP(2) = (CStr(DppEntries(Index).ip(2)))
txtIP(3) = (CStr(DppEntries(Index).ip(3)))
EthernetConnect
End Sub
Public Sub cmdFindDevice_Click()
' Search for a specific device.
Dim isDetected As Boolean
'On Error GoTo cmdFindDevice_ClickErr
cmdFindDevice.Enabled = False
'Uses DppWinUSB defined in DppWinUSB
cmdCloseDevice_Click
isDetected = OpenDevice(frmDP5.hwnd, DppWinUSB, USBDeviceConnected, USBDevicePathName, CurrentUSBDevice - 1)
DeviceConnectedDisplay rtbStatus, USBDeviceConnected
DeviceConnectedDisplay frmDP5.rtbStatus, USBDeviceConnected
cmdFindDevice.Enabled = True
If (USBDeviceConnected) Then
lblDppFound(USB).Visible = True
isDppFound(USB) = True
s.CurrentInterface = USB
USBDeviceTest = True
frmDP5.cmdUSBDeviceTest
Else
lblDppFound(USB).Visible = False
isDppFound(USB) = False
End If
Exit Sub
cmdFindDevice_ClickErr:
Call ProcessError(Err)
End Sub
Private Sub btnFindIP_Click()
Dim strSearchIp As String
isDppFound(ETHERNET) = False
lblDppFound(ETHERNET).Visible = False
lblIpFound.Caption = ""
strSearchIp = txtIP(0).Text + "." + txtIP(1).Text + "." + txtIP(2).Text + "." + txtIP(3).Text
SearchIp = IpAddrConvert(strSearchIp)
NetFinderSearch
End Sub
Private Function SetComPort() As Integer
On Error Resume Next
Dim OldCommPort As Integer
Dim iPort As Integer
iPort = cboRS232Comm.ItemData(cboRS232Comm.ListIndex)
If (cboRS232Comm.ListCount > 0) Then
If (iPort < 1) Then
cboRS232Comm.ListIndex = 0
iPort = cboRS232Comm.ItemData(cboRS232Comm.ListIndex)
End If
End If
OldCommPort = frmDP5.DppComm.CommPort 'Save the current port
SetComPort = 0
If (iPort <> OldCommPort) Then 'the port is not set, update the port number
If (frmDP5.DppComm.PortOpen) Then frmDP5.DppComm.PortOpen = False 'close port if open
frmDP5.DppComm.CommPort = iPort 'set the port
If (Not frmDP5.DppComm.PortOpen) Then frmDP5.DppComm.PortOpen = True 'reopen the port
If (Err.Number <> 0) Then 'port error
MsgBox Err.Description & vbNewLine & " Setting to old port COM" & OldCommPort
Err.Clear
If (frmDP5.DppComm.PortOpen) Then frmDP5.DppComm.PortOpen = False
frmDP5.DppComm.CommPort = OldCommPort
If (Not frmDP5.DppComm.PortOpen) Then frmDP5.DppComm.PortOpen = True
If (Err.Number <> 0) Then 'port error
MsgBox Err.Description & vbNewLine & " Cannot set COM Port."
Err.Clear
Else
SetComPort = OldCommPort
End If
Else
SetComPort = iPort
End If
Else 'open the port if closed
If (Not frmDP5.DppComm.PortOpen) Then frmDP5.DppComm.PortOpen = True
If (Err.Number <> 0) Then 'port error
MsgBox "SetComPort Error: " & Err.Description
Err.Clear
Else
SetComPort = iPort
End If
End If
Debug.Print "SetComPort = " & iPort
End Function
Private Sub EnableRS232Controls(Optional EnRS232Cmds As Boolean, Optional EnRS232StatusCmd As Boolean = False)
Dim bPortOpen As Boolean
bPortOpen = frmDP5.DppComm.PortOpen
cboRS232Comm.Enabled = EnRS232Cmds
txtRS232Status.Enabled = EnRS232Cmds
cmdRequestDataAndStatus.Enabled = EnRS232StatusCmd And bPortOpen
If (EnRS232Cmds) Then
txtRS232Status.BackColor = &H80000005
Else
txtRS232Status.BackColor = &H8000000F
End If
lblDppFound(RS232).Enabled = EnRS232Cmds
End Sub
Private Sub EnableUSBControls(Optional EnUSBCmds As Boolean)
cmdFindDevice.Enabled = EnUSBCmds
cmdDisableUSBNotify.Enabled = EnUSBCmds
rtbStatus.Enabled = EnUSBCmds
lblDppFound(USB).Enabled = EnUSBCmds
cmdCountDevices.Enabled = EnUSBCmds
lblNumUSBDevices.Enabled = EnUSBCmds
lblSelectDevice.Enabled = EnUSBCmds
udSelectDevice.Enabled = EnUSBCmds
lblCurrentDevice.Enabled = EnUSBCmds
cmdCloseDevice.Enabled = EnUSBCmds
End Sub
Private Sub EnableINETControls(Optional EnInetCmds As Boolean)
Dim idxComm As Long
For idxComm = 0 To 3
txtIP(idxComm).Enabled = EnInetCmds
lblUnit(idxComm).Enabled = EnInetCmds
cmdSelectIP(idxComm).Enabled = EnInetCmds
If (EnInetCmds) Then
txtIP(idxComm).BackColor = &H80000005 'white
If (DppEntries(idxComm).SockAddr <> 0) Then
lblUnit(idxComm).BackColor = AlertEntryToCOLORREF(DppEntries(idxComm))
Else
lblUnit(idxComm).BackColor = &H80000005 'white
End If
Else
lblUnit(idxComm).BackColor = &H8000000F 'buttonface
txtIP(idxComm).BackColor = &H8000000F 'buttonface
End If
Next
txtUDPPort.Enabled = EnInetCmds
btnFindIP.Enabled = EnInetCmds
lblInet_IPAddress.Enabled = EnInetCmds
chkLock.Enabled = EnInetCmds
chkShare.Enabled = EnInetCmds
lblInet_Port.Enabled = EnInetCmds
lblIpFound.Enabled = EnInetCmds
lblDppFound(ETHERNET).Enabled = EnInetCmds
cmdSelectIP(0).Enabled = EnInetCmds
cmdSelectIP(1).Enabled = EnInetCmds
cmdSelectIP(2).Enabled = EnInetCmds
cmdSelectIP(3).Enabled = EnInetCmds
If (EnInetCmds) Then
txtUDPPort.BackColor = &H80000005
Else
txtUDPPort.BackColor = &H8000000F
End If
End Sub
Private Sub EnableCommControls(CurrentInterface As Byte)
Dim idxIp As Long
txtRS232Status.Visible = False
rtbStatus.Visible = False
For idxIp = 0 To 3
lblUnit(idxIp).Visible = False
lblIpId(idxIp).Visible = False
Next
EnableRS232Controls False
EnableUSBControls False
EnableINETControls False
s.CurrentInterface = CurrentInterface
Select Case CurrentInterface
Case RS232
EnableRS232Controls True
txtRS232Status.Visible = True
Case USB
EnableUSBControls True
rtbStatus.Visible = True
Case ETHERNET
EnableINETControls True
For idxIp = 0 To 3
lblUnit(idxIp).Visible = True
lblIpId(idxIp).Visible = True
Next
End Select
End Sub
'frmDP5.lblSelectCommunications
Private Sub optComm_Click(Index As Integer)
Dim idxComm As Long
RS232ComPortTest = False 'turn comport test off if running
USBDeviceTest = False
optComm(Index).Value = True
Select Case Index
Case RS232
EnableCommControls RS232 's.CurrentInterface = RS232
idxComm = SetComPort()
If (idxComm > 0) Then
strCommStatus = "RS232 COM" & idxComm
DppState.Interface = commRS232
Else
strCommStatus = "RS232 COM NOT SET"
DppState.Interface = commNone
End If
If (frmDP5.DppComm.PortOpen) Then
cmdRequestDataAndStatus.Enabled = True
Else
cmdRequestDataAndStatus.Enabled = False
End If
Call cmdRequestDataAndStatus_Click
Case USB
EnableCommControls USB 's.CurrentInterface = USB
strCommStatus = "USB"
Call cmdFindDevice_Click
DppState.Interface = commUSB
Case ETHERNET
EnableCommControls ETHERNET 's.CurrentInterface = ETHERNET
DppState.Interface = commSockets
strCommStatus = "ETHERNET"
If frmDP5.DppWinsock.State > 0 Then
frmDP5.DppWinsock.Close
End If
frmDP5.DppWinsock.RemoteHost = txtIP(0).Text + "." + txtIP(1).Text + "." + txtIP(2).Text + "." + txtIP(3).Text
frmDP5.DppWinsock.RemotePort = txtUDPPort.Text
'DppWinsock.LocalPort = txtUDPPort.Text
Netfinder_active = False
Call btnFindIP_Click
End Select
End Sub
Private Sub udSelectDevice_Change()
CurrentUSBDevice = udSelectDevice.Value
lblCurrentDevice = CurrentUSBDevice
End Sub