Visual Basic System Services
CreateFile: Determine Available COM Ports
     
Posted:   Wednesday June 02, 2004
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

ConfigurePort: Determine Available COM Ports with the MSCOMM Control
     
 Prerequisites
None.

CreateFile can not only be used to create and open files, but also to access COM ports, system devices, services, or consoles. By applying it to COM ports, a simple routine can enumerate probable COM ports returning the availability of a given port. The code presented here contains two key functions.

GetInstalledCOMPorts() passes a series of port numbers (1 through 16 in this demo) to the worker COMCheckPort function, which uses CreateFile to open a COM port returning True or False if a file handle was obtained for each of the the specified COM ports. The function closes the port immediately after the call so as to restore the system to its available state. The results of each call are entered to a list indicating which ports are available for use.

GetFirstAvailableCOMPort() also uses COMCheckPort as well, but this routine exits once the first available port has been determined. For demo purposes the result is displayed in the list box as well.

The Open COM/Close COM buttons open COM1 (if available/unused) to demo how the code works against different COM port states. Also included is the API call to display the ConfigurePort dialog allowing the user to customize the COM port baud rate, bits, parity, stop bits and flow control, as well as restore the default settings.  As ConfigurePort only shows the config dialog, no data changed or set by the user is returned.  Rather, the dialog returns 1 (vbOK) if the OK button was pressed, or 0 if cancelled (not vbCancel - that has a value of 2!).

 BAS Module Code
None.

 Form Code
To a form, add a list box (List1), five command buttons (Command1-Command5), and two option buttons (Option1, Option2). Add the following code:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'var used to track the handle
'to the opened port, to ensure
'it is released when the form closes
Private hFakePort As Long

Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const FILE_ATTRIBUTE_NORMAL = &H80

Private Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Long
End Type

Private Declare Function CreateFile Lib "kernel32" _
   Alias "CreateFileA" _
  (ByVal lpFileName As String, _
   ByVal dwDesiredAccess As Long, _
   ByVal dwShareMode As Long, _
   lpSecurityAttributes As SECURITY_ATTRIBUTES, _
   ByVal dwCreationDisposition As Long, _
   ByVal dwFlagsAndAttributes As Long, _
   ByVal hTemplateFile As Long) As Long
   
Private Declare Function CloseHandle Lib "kernel32" _
  (ByVal hObject As Long) As Long

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"
   Command5.Enabled = False
   Option1.Caption = "COM1:"
   Option2.Caption = "COM2:"
   Option1.Value = True
   
End Sub


Private Sub Form_Unload(Cancel As Integer)

   If hFakePort > 0 Then
      CloseHandle hFakePort
   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()

  'open COM1 to place it in-use 
  'in order to test the enumeration 
  'and 'first available' functions 
   Call OpenPort("COM1:")

   Command4.Enabled = hFakePort = 0
   Command5.Enabled = hFakePort <> 0

End Sub


Private Sub Command5_Click()

   If hFakePort <> 0 Then
      CloseHandle hFakePort
      hFakePort = 0
   End If
   
   Command4.Enabled = hFakePort = 0
   Command5.Enabled = hFakePort <> 0
   
End Sub


Private Function COMCheckPort(Port As Long) As Boolean

  'handle to the port
   Dim hPort As Long
   
  'string representing port
   Dim sPort As String
   Dim sa As SECURITY_ATTRIBUTES
  
   If Val(Port) > 0 Then

     'note-no trailing colon (e.g. not COM1:)
      sPort = "\\.\COM" & Port
      
     'attempt to open the port      
      hPort = CreateFile(sPort, _
                         0, _
                         FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                         sa, _
                         OPEN_EXISTING, _
                         FILE_ATTRIBUTE_NORMAL, _
                         0)
       
     'we're done, so close it
      If hPort Then CloseHandle hPort
      
     'return True if the call 
     'returned a valid port handle 
     '(on failure hPort = -1, so care 
     'must be taken to ensure True is 
     'returned only when the function 
     'succeeded)
      COMCheckPort = hPort > 0
       
   Else
      COMCheckPort = False
   End If
   
End Function


Private Function COMConfigPort(Port As Long) As Boolean

   Dim sPort As String
   
   If Val(Port) > 0 Then
       
     '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.
     
     'The port string for this call must be
     'in the format COM<portnumber>:     
      sPort = "COM" & Port & ":"
      COMConfigPort = ConfigurePort(vbNullString, 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(sPort As String) As Boolean

   Dim sa As SECURITY_ATTRIBUTES
  
   hFakePort = CreateFile(sPort, _
                          0, _
                          FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                          sa, _
                          OPEN_EXISTING, _
                          FILE_ATTRIBUTE_NORMAL, _
                          0)
    
   OpenPort = hFakePort <> -1
    
End Function
 Comments
 

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter