Results 1 to 2 of 2

Thread: Detecting com ports?

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Aug 2004

    Detecting com ports?

    Hi, may I know is there any codes to auto search for connected com ports in my application? So if com 1 is not connected, it will go to com 2 and so on. Please advice...
    Last edited by weisi; Apr 27th, 2006 at 11:07 PM.

  2. #2
    Super Moderator RobDog888's Avatar
    Join Date
    Apr 2001
    LA, Calif. Raiders #1 AKA:Gangsta Yoda™

    Re: Detecting com ports?

    This may help?
    VB Code:
    1. Private Type PORT_INFO_2
    2.     pPortName As String
    3.     pMonitorName As String
    4.     pDescription As String
    5.     fPortType As Long
    6.     Reserved As Long
    7. End Type
    8. Private Type API_PORT_INFO_2
    9.     pPortName As Long
    10.     pMonitorName As Long
    11.     pDescription As Long
    12.     fPortType As Long
    13.     Reserved As Long
    14. End Type
    15. 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
    16. Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
    17. Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
    18. Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
    19. Private Declare Function GetProcessHeap Lib "kernel32" () As Long
    20. Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
    21. Dim Ports(0 To 100) As PORT_INFO_2
    22. Public Function TrimStr(strName As String) As String
    23.     'Finds a null then trims the string
    24.     Dim x As Integer
    25.     x = InStr(strName, vbNullChar)
    26.     If x > 0 Then TrimStr = Left(strName, x - 1) Else TrimStr = strName
    27. End Function
    28. Public Function LPSTRtoSTRING(ByVal lngPointer As Long) As String
    29.     Dim lngLength As Long
    30.     'Get number of characters in string
    31.     lngLength = lstrlenW(lngPointer) * 2
    32.     'Initialize string so we have something to copy the string into
    33.     LPSTRtoSTRING = String(lngLength, 0)
    34.     'Copy the string
    35.     CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
    36.     'Convert to Unicode
    37.     LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))
    38. End Function
    39. 'Use ServerName to specify the name of a Remote Workstation i.e. "//WIN95WKST"
    40. 'or leave it blank "" to get the ports of the local Machine
    41. Public Function GetAvailablePorts(ServerName As String) As Long
    42.     Dim ret As Long
    43.     Dim PortsStruct(0 To 100) As API_PORT_INFO_2
    44.     Dim pcbNeeded As Long
    45.     Dim pcReturned As Long
    46.     Dim TempBuff As Long
    47.     Dim i As Integer
    48.     'Get the amount of bytes needed to contain the data returned by the API call
    49.     ret = EnumPorts(ServerName, 2, TempBuff, 0, pcbNeeded, pcReturned)
    50.     'Allocate the Buffer
    51.     TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded)
    52.     ret = EnumPorts(ServerName, 2, TempBuff, pcbNeeded, pcbNeeded, pcReturned)
    53.     If ret Then
    54.         'Convert the returned String Pointer Values to VB String Type
    55.         CopyMem PortsStruct(0), ByVal TempBuff, pcbNeeded
    56.         For i = 0 To pcReturned - 1
    57.             Ports(i).pDescription = LPSTRtoSTRING(PortsStruct(i).pDescription)
    58.             Ports(i).pPortName = LPSTRtoSTRING(PortsStruct(i).pPortName)
    59.             Ports(i).pMonitorName = LPSTRtoSTRING(PortsStruct(i).pMonitorName)
    60.             Ports(i).fPortType = PortsStruct(i).fPortType
    61.         Next
    62.     End If
    63.     GetAvailablePorts = pcReturned
    64.     'Free the Heap Space allocated for the Buffer
    65.     If TempBuff Then HeapFree GetProcessHeap(), 0, TempBuff
    66. End Function
    67. Private Sub Form_Load()
    68.     'KPD-Team 2000
    69.     'URL: [url][/url]
    70.     'E-Mail: [email][/email]
    71.     Dim NumPorts As Long
    72.     Dim i As Integer
    73.     'Get the Numbers of Ports in the System
    74.     'and Fill the Ports Structure
    75.     NumPorts = GetAvailablePorts("")
    76.     'Show the available Ports
    77.     Me.AutoRedraw = True
    78.     For i = 0 To NumPorts - 1
    79.         Me.Print Ports(i).pPortName
    80.     Next
    81. End Sub
    VB/Office Guru™ (AKA: Gangsta Yoda®)
    I dont answer coding questions via PM. Please post a thread in the appropriate forum.

    Microsoft MVP 2006-2011
    Office Development FAQ (C#, VB.NET, VB 6, VBA)
    Senior Jedi Software Engineer MCP (VB 6 & .NET), BSEE, CET
    If a post has helped you then Please Rate it!
    Reps & Rating PostsVS.NET on Vista Multiple .NET Framework Versions Office Primary Interop AssembliesVB/Office Guru™ Word SpellChecker™.NETVB/Office Guru™ Word SpellChecker™ VB6VB.NET Attributes Ex.Outlook Global Address ListAPI Viewer utility.NET API Viewer Utility
    System: Intel i7 6850K, Geforce GTX1060, Samsung M.2 1 TB & SATA 500 GB, 32 GBs DDR4 3300 Quad Channel RAM, 2 Viewsonic 24" LCDs, Windows 10, Office 2016, VS 2019, VB6 SP6

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Click Here to Expand Forum to Full Width