Binaryworld - Enumerate the Ports available in the Local System or in a Remote PC us ... [ VB -> System ]

API Declarations

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

Click here to copy the following block

'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

Usage

Click here to copy the following block

Option Explicit

'Create a Form with a Command Button and a List
Private Sub Command1_Click()
  Dim NumPorts As Long
  Dim i As Integer

  'Get the Numbers of Ports in the System
  'and Fill the Ports Structure
  NumPorts = GetAvailablePorts("")
  'Fill the List with the available Ports
  List1.Clear
  For i = 0 To NumPorts - 1
    List1.AddItem Ports(i).pPortName
  Next
End Sub