Code: Select all
Private Type PORT_INFO_2
pPortName As String
pMonitorName As String
pDescription As String
fPortType As Long
Reserved As Long
End Type
Private comPorts(0 To 100) As PORT_INFO_2
Private 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 number 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 is aliased RtlMoveMemory
CopyMem PortsStruct(0), ByVal TempBuff, pcbNeeded
For i = 0 To pcReturned - 1
comPorts(i).pDescription = Ptr2Str(PortsStruct(i).pDescription)
comPorts(i).pPortName = Ptr2Str(PortsStruct(i).pPortName)
comPorts(i).pMonitorName = Ptr2Str(PortsStruct(i).pMonitorName)
comPorts(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 If
End FunctionThe data returned tend to contain duplicate entries which have to be filtered and also returns Infrared and other ports which also need filtering. In VB, I use the filtered results to add items to a Port menu.
