Private Declare Function ConfigurePort Lib "winspool.drv" _
   Alias "ConfigurePortA" _
  (ByVal pName As Any, _
   ByVal hwnd As Long, _
   ByVal pPortName As String) As Long



Private Sub Form_Load()

   Command1.Caption = "Get Installed COM Ports"
   Command2.Caption = "Get First Available Port (API)"
   Command3.Caption = "Configure Port Dialog"
   Command4.Caption = "Open COM1"
   Command5.Caption = "Close COM1"
   
   Option1.Caption = "COM1:"
   Option2.Caption = "COM2:"
   Option1.Value = True
   
End Sub


Private Sub Form_Unload(Cancel As Integer)

   If MSComm2.PortOpen = True Then
      MSComm2.PortOpen = False
   End If
   
End Sub

Private Sub Command1_Click()

   List1.Clear
   Call GetInstalledCOMPorts(List1)
   
End Sub


Private Sub Command2_Click()

   Dim nPort As Long
   
   List1.Clear
   nPort = GetFirstAvailableCOMPort()
   
   If nPort > 0 Then
      List1.AddItem "COM" & nPort & "  is the first available port"
   End If
   
End Sub


Private Sub Command3_Click()

   Dim Port As Long
   Dim result As Boolean
   
   List1.Clear
   
   Port = GetSelectedOptionIndex() + 1
   
   If COMConfigPort(Port) = 1 Then
      List1.AddItem "COM" & Port & "  - User pressed OK"
   Else
      List1.AddItem "COM" & Port & "  - User pressed Cancel"
   End If

End Sub


Private Sub Command4_Click()

   Call OpenPort(1)
   Command4.Enabled = MSComm2.PortOpen = False

End Sub


Private Sub Command5_Click()

   If MSComm2.PortOpen = True Then
      MSComm2.PortOpen = False
   End If
   
   Command4.Enabled = MSComm2.PortOpen = False
   
End Sub


Private Function COMCheckPort(Port As Long) As Boolean

  'Returns false if port cannot be opened or does not exist
  'Returns true if port is available and can be opened
   
  'Handle all errors
   On Error GoTo OpenCom_Error
   
  'Set port number for test
   MSComm1.CommPort = Port
   
   If MSComm1.PortOpen = True Then
      COMCheckPort = False
      Exit Function
   Else
     'Test the port by opening and closing it
      MSComm1.PortOpen = True
      MSComm1.PortOpen = False
      COMCheckPort = True
      Exit Function
   End If
   
OpenCom_Error:
   COMCheckPort = False
   
End Function


Private Function COMConfigPort(Port As Long) As Boolean

   Dim sPort As String
   
   If Val(Port) > 0 Then
   
      sPort = "COM" & Port & ":"
   
      If Right$(sPort, 1) <> ":" Then
         sPort = sPort & ":"
      End If
            
     'Configure the port on the local machine.
     'This API can also be used to configure
     'COM and LPTP ports on remote machines
     'and servers by passing the machine name
     'as the first parameter in the format
     ' "\\servername". ByVal vbNullString or
     'ByRef 0& can be passed to configure the
     'local machine. The hwnd parameter specified
     'the window that owns the dialog - it will
     'appear modal to the specified window.
     'Returns 1 if OK is pressed, or 0 if Cancelled.
     '
     'This call does not return the values set or
     'changed in the dialog, nor does it indicate
     'whether the user pressed Apply prior to
     'pressing OK or Cancel. This is important
     'in so far as changes made and Applied are
     'set even if the dialog is cancelled.
      COMConfigPort = ConfigurePort(ByVal "\\vbnetdev", Me.hwnd, sPort)
            
   End If

End Function


Private Function GetFirstAvailableCOMPort() As Long

   Dim Port As Long
   
  'Find first port not already in use.
  'Return either the port number if
  'available, or zero otherwise
   For Port = 1 To 16
       
      If COMCheckPort(Port) = True Then
         GetFirstAvailableCOMPort = Port
         Exit Function
      End If
   
   Next Port
   
  'No useable port was found
   GetFirstAvailableCOMPort = 0

End Function


Private Function GetInstalledCOMPorts(lst As ListBox) As Long

   Dim Port As Long
   
  'simply loop through a range of
  'possible ports and pass to the
  'COMCheckPort function
   For Port = 1 To 16
   
      If COMCheckPort(Port) Then
         lst.AddItem "COM" & Port & "  available"
      Else
         lst.AddItem "COM" & Port & "  (not available or no such port)"
      End If
      
   Next

End Function


Private Function GetSelectedOptionIndex() As Long

  'returns the selected item index from
  'a set of option buttons. Use in place
  'of multiple If...Then statements!
  'To add more option buttons to this function
  'just append them to the test condition,
  'setting the multiplier to the next negative
  'value (eg Option3.Value * -2, Option4.Value * -3)
  'Also see GetSelectedOptionIndex in the Core
  'routines for a control array method.
   GetSelectedOptionIndex = Option1.Value * 0 Or _
                            Option2.Value * -1
                            
End Function

Private Function OpenPort(Port As Long) As Boolean

  'Handle all errors
   On Error GoTo OpenPort_Error
   
  'Set port number for test
   MSComm2.CommPort = Port
   
   If MSComm2.PortOpen = True Then
      OpenPort = False
      Exit Function
   Else
     'Test the port by opening and closing it
      MSComm2.PortOpen = True
      
      OpenPort = True
      Exit Function
   End If
   
OpenPort_Error:
   OpenPort = False

End Function