Получить список доступных портов

Private Sub Command1_Click() Dim NumPorts As Long Dim i As Integer NumPorts = GetAvailablePorts("") List1.Clear For i = 0 To NumPorts - 1 List1.AddItem Ports(i).pPortName Next End Sub

Option Explicit 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 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 Public Ports(0 To 100) As PORT_INFO_2 Public Function TrimStr(strName As String) As 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