Categories: MSDN / DotNet / Java / Scripts / Linux / PHP Ask - La ask - La Answer

How do i detect how many comm prorts are in the computer.

How do i detect how many comm prorts are in the computer.
[57 byte] By [Code_Writer] at [2007-11-11 7:41:03]
# 1 Re: How do i detect how many comm prorts are in the computer.
Never Mind I Just Did A Loop To Detect Them
Code_Writer at 2007-11-11 17:26:41 >
# 2 Re: How do i detect how many comm prorts are in the computer.
Option Explicit
''
' Copyright 1996-2004 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
RHelliwell at 2007-11-11 17:27:32 >