Get list of available comm port-VBForums
Results 1 to 2 of 2

Thread: Get list of available comm port

  1. #1

    Thread Starter
    Fanatic Member
    Join Date
    Nov 2003
    Posts
    727

    Get list of available comm port

    Dear All,

    How to get list of available comm port thru VB6's code? .. please advise ..

    Regards
    Winanjaya

  2. #2
    PowerPoster RhinoBull's Avatar
    Join Date
    Mar 2004
    Location
    New Amsterdam
    Posts
    24,135

    Re: Get list of available comm port

    Would this sample from allapi network help you?
    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]http://www.allapi.net/[/url]
    70.     'E-Mail: [email]KPDTeam@Allapi.net[/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

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.