Binaryworld - How to find out available ports on Local System or Remote System using ... [ VB -> Printing ]

You can use EnumPorts API to find out available ports in a specified machine.

Step-By-Step Example

- Create a standard exe project, form1 is added by default
- Add one textbox, one command button and one listbox on the form1
- Place the following code in form code window

Click here to copy the following block

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

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

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

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
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

Private Sub Command1_Click()
  DisplayAllPorts
End Sub

Sub DisplayAllPorts()
  Dim NumPorts As Long
  Dim i As Integer

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

Private Sub Form_Load()
  Command1.Caption = "List All Ports"
End Sub

- Press F5 to run the project. List1 should be filled with all available ports in your system.