Visual Basic Enumeration/Callback Routines

EnumPorts: Identify Windows' Available Ports
Posted:   Friday September 17, 1999
Updated:   Monday December 26, 2011
Applies to:   VB5, VB6
Developed with:   VB6, Windows NT4
OS restrictions:   None
Author:   Richard Cardarelle, Brad Martinez, VBnet - Randy Birch


AddPort: Adding and Deleting Application-Defined Ports
AddPrinter: Add/Delete Local/Remote Printers using Existing Drivers
EnumPorts: Identify Windows' Available Ports

The method shows how to enumerate the installed ports that are available for printing on a specified server using the EnumPorts API. The method populates an array of PORT_INFO_2 UDTs, extracting the values returned using lstrcpyA.

This sample is based on initial code by Richard Cardarelle, and simplified greatly by Brad Martinez.

 BAS Module Code
Place the following code into the general declarations area of a bas module:

Option Explicit
' Copyright 1996-2011 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.
Public Enum PortTypes
End Enum

Public Type PORT_INFO_2
  pPortName    As Long
  pMonitorName As Long
  pDescription As Long
  fPortType    As Long
  Reserved     As Long
End Type
'SIZEOFxxx is a non-windows constant defined for this method
Public Const SIZEOFPORT_INFO_2 = 20
Public Const LB_SETTABSTOPS As Long = &H192

'EnumPorts member descriptions:
'pName: String specifying the name of the server whose
'printer ports you wish to enumerate. If pName is
'vbNullString, the function enumerates the local
'machine's printer ports.
'nLevel: Specifies the type of information returned in
'the lpbPorts buffer. If nLevel is 1, lpbPorts receives
'an array of PORT_INFO_1 structures. If nLevel is 2,
'lpbPorts receives an array of PORT_INFO_2 structures.

'lpbPorts: Pointer to a buffer that receives an array of
'PORT_INFO_1 or PORT_INFO_2 structures. Each structure
'contains data that describes an available printer port.
'The buffer must be large enough to store the strings
'pointed to by the structure members.

'cbBuf: the size, in bytes, of the buffer pointed to by lpbPorts.
'pcbNeeded: receives the number of bytes copied to the lpbPorts
'buffer. If the the buffer is too small, the function fails and
'the variable receives the number of bytes required.
'pcReturned: variable that receives the number of PORT_INFO_1 or
'PORT_INFO_2 structures returned in the pPorts buffer. This
'corresponds to the number of printer ports that are available
'on the specified machine.

Public Declare Function EnumPorts Lib "winspool.drv" _
   Alias "EnumPortsA" _
  (ByVal pName As String, _
   ByVal nLevel As Long, _
   lpbPorts As Any, _
   ByVal cbBuf As Long, _
   pcbNeeded As Long, _
   pcReturned As Long) As Long

Public Declare Function lstrlenA Lib "kernel32" _
   (lpString As Any) As Long

Public Declare Function lstrcpyA Lib "kernel32" _
   (lpString1 As Any, lpString2 As Any) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long
 Form Code
On a form add a command button, a listbox and a label for the number of ports returned. Label other items as desired. Add:

Option Explicit

Private Sub Form_Load()

   ReDim TabArray(0 To 2) As Long
   TabArray(0) = 65
   TabArray(1) = 129
   TabArray(2) = 188
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 3&, TabArray(0))

End Sub

Private Sub Command1_Click()

   Dim numPorts As Long

   numPorts = GetAvailablePorts(List1)
   Label1.Caption = CStr(numPorts) & " ports found."

End Sub

Public Function GetStrFromPtrA(lpszA As Long) As String

   GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
   Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function

Private Function GetAvailablePorts(ctl As Control) As Long

   Dim pcbNeeded As Long
   Dim pcReturned As Long
   Dim pi2() As PORT_INFO_2
   Dim i As Integer
   Dim sPortType As String
  'To determine the required buffer size, call EnumPorts with
  'cbBuf set to zero. EnumPorts fails, and Err.LastDLLError
  'returns ERROR_INSUFFICIENT_BUFFER, filling in the pcbNeeded
  'parameter with the size, in bytes, of the buffer required to
  'hold the array of structures and their data.

   Call EnumPorts(vbNullString, 2, 0, 0, pcbNeeded, pcReturned)
   If pcbNeeded Then
     'The strings pointed to by each PORT_INFO_2 struct's members
     'reside in memory after the end of the array of structs. So we're
     'not only allocating memory for the structs themselves, but all the
     'strings pointed to by each struct's member as well. Use floating
     'point division, and add an extra struct to the array for padding.
      ReDim pi2((pcbNeeded / SIZEOFPORT_INFO_2))

      If EnumPorts(vbNullString, 2, pi2(0), pcbNeeded, pcbNeeded, pcReturned) Then
         For i = 0 To (pcReturned - 1)
            With pi2(i)
               If (.fPortType And PORT_TYPE_WRITE) Then sPortType = "write "
               If (.fPortType And PORT_TYPE_READ) Then sPortType = sPortType & "read "
               If (.fPortType And PORT_TYPE_REDIRECTED) Then sPortType = sPortType & "redirected "
               If (.fPortType And PORT_TYPE_NET_ATTACHED) Then sPortType = sPortType & "network"
               ctl.AddItem GetStrFromPtrA(.pPortName) & vbTab & _
                           GetStrFromPtrA(.pDescription) & vbTab & _
                           .fPortType & "-" & sPortType & vbTab & _
            End With
      End If   'EnumPorts
  End If   'pcbNeeded
'return the number of ports found
  GetAvailablePorts = pcReturned
End Function
The MSDN states that while the function returns a value of nonzero when it succeeds, or zero if it fails, that EnumPorts can succeed even if the server specified by pName does not have a printer defined.


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy



Hit Counter