 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!). |
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
|
