numbers of available comm ports

[nastya]

hello
I'd like to find out all available ports in OS.
Iv'e found some vb code that lists this properties of all available ports:
Private Type PORT_INFO_2
pPortName As String
pMonitorName As String
pDescription As String
fPortType As Long
Reserved As Long
End Type

But i need the port number property, so i'll be able to use it with MSCOMM control.. (open.. close..in/out.)
Can i modify this type? or How can i get port number using port name?

10x

here is the code :

Option Explicit

'API calls
Private Declare Function EnumPorts Lib "winspool.drv" Alias "EnumPortsA" (ByVal pName As String, ByVal Level As Long, ByVal lpbPorts As Long, ByVal cbBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As Long) As Long
Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function HeapAlloc Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32.dll" () As Long
Private Declare Function HeapFree Lib "kernel32.dll" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long

'API Structures
Private Type PORT_INFO_2
pPortName As String
pMonitorName As String
pDescription As String
fPortType As Long
Reserved As Long
End Type

Private Type API_PORT_INFO_2
pPortName As Long
pMonitorName As Long
pDescription As Long
fPortType As Long
Reserved As Long
End Type

'''''''''''Module

'Public Data Structure - up to 100 Ports Information
Public Ports(0 To 100) As PORT_INFO_2

Public Function TrimStr(strName As String) As String
'Finds a null then trims the string
Dim x As Integer

x = InStr(strName, vbNullChar)
If x > 0 Then TrimStr = Left(strName, x - 1) Else TrimStr = strName
End Function

Public Function LPSTRtoSTRING(ByVal lngPointer As Long) As String
Dim lngLength As Long

'Get number of characters in string
lngLength = lstrlenW(lngPointer) * 2
'Initialize string so we have something to copy the string into
LPSTRtoSTRING = String(lngLength, 0)
'Copy the string
CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
'Convert to Unicode
LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))
End Function

'Use ServerName to specify the name of a Remote Workstation i.e. "//WIN95WKST"
'or leave it blank "" to get the ports of the local Machine
Public Function GetAvailablePorts(ServerName As String) As Long
Dim ret As Long
Dim PortsStruct(0 To 100) As API_PORT_INFO_2
Dim pcbNeeded As Long
Dim pcReturned As Long
Dim TempBuff As Long
Dim i As Integer

'Get the amount of bytes needed to contain the data returned by the API call
ret = EnumPorts(ServerName, 2, TempBuff, 0, pcbNeeded, pcReturned)
'Allocate the Buffer
TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded)
ret = EnumPorts(ServerName, 2, TempBuff, pcbNeeded, pcbNeeded, pcReturned)
If ret Then
'Convert the returned String Pointer Values to VB String Type
CopyMem PortsStruct(0), ByVal TempBuff, pcbNeeded
For i = 0 To pcReturned - 1
Ports(i).pDescription = LPSTRtoSTRING(PortsStruct(i).pDescription)
Ports(i).pPortName = LPSTRtoSTRING(PortsStruct(i).pPortName)
Ports(i).pMonitorName = LPSTRtoSTRING(PortsStruct(i).pMonitorName)
Ports(i).fPortType = PortsStruct(i).fPortType
Next
End If
GetAvailablePorts = pcReturned
'Free the Heap Space allocated for the Buffer
If TempBuff Then HeapFree GetProcessHeap(), 0, TempBuff
End Function

[Hack]

If you format your code with [vbcode][/vbcode] tags, it makes things easier to read. Try this. I can't remember where I got it.

Private Declare Function CreateFile _
 Lib "kernel32.dll" 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.dll" ( _
 ByVal hObject As Long) As Long
 
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type
 
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const FILE_ATTRIBUTE_NORMAL = &H80
 
Public Function COMAvailable(ByVal iPortNum As Integer) As Boolean
    Dim hCOM As Long
    Dim ret As Long
    Dim sec As SECURITY_ATTRIBUTES
 
    'try to open the COM port
    hCOM = CreateFile("COM" & iPortNum & "", 0, FILE_SHARE_READ + FILE_SHARE_WRITE, _
     sec, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    If hCOM = -1 Then
        COMAvailable = False
    Else
        COMAvailable = True
        'close the COM port
        ret = CloseHandle(hCOM)
    End If
End Function
 
Private Sub Command1_Click()
Dim i As Long
For i = 1 To 16
    If COMAvailable(i) Then
        List1.AddItem "COM" & i & " is available"
    Else
        List1.AddItem "COM" & i & " is not available"
    End If
Next
End Sub