Функция EnumPorts

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

EnumPorts перечисляет порты, доступные для печати.

pName

Имя сервера. Для локального компьютера используется vbNullString

Level

Определяет тип информации, возвращаемой структурами PORT_INFO_1 или PORT_INFO_2

lpbPorts

Буфер, в который заносится массив указанных структур

cbBuf

Размер массива lpbPorts в байтах

pcbNeeded

Переменная, получающая число байт, успешно скопированных в массив lpbPorts. Если функция потерпела неудачу, то переменная содержит необходимый минимальный размер

pcReturned

Переменная, получающая число структур, возвращаемой буфером

Пример

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

Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long

Dim Ports(0 To 100) As PORT_INFO_2

Public 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

Public Function LPSTRtoSTRING(ByVal lngPointer As Long) As String
    Dim lngLength As Long
    ' Получим число символов в строке
    lngLength = lstrlenW(lngPointer) * 2
    ' Инициализируем строку
    LPSTRtoSTRING = String(lngLength, 0)
    'Копируем строку
    CopyMemory ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength
    ' Конвертируем в Unicode
    LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode))
End Function

' Используем ServerName для задания имени удаленного компьютера ("//WIN95WKST")
' или оставляем пустой ("") для получения портов локальной машины
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
    ' Получим число байта, необходимых для содержания данных
    ret = EnumPorts(ServerName, 2, TempBuff, 0, pcbNeeded, pcReturned)
    ' Выделяем буфер
    TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded)
    ret = EnumPorts(ServerName, 2, TempBuff, pcbNeeded, pcbNeeded, pcReturned)
    If ret Then
        ' Конвертируем полученную строку
        CopyMemory 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 Form_Load()
    Dim NumPorts As Long
    Dim i As Integer
    'Get the Numbers of Ports in the System
    'and Fill the Ports Structure
    NumPorts = GetAvailablePorts(vbNullString)
    
    Me.AutoRedraw = True
    For i = 0 To NumPorts - 1
        Me.Print Ports(i).pPortName
    Next
End Sub

Смотри также

AddPort, DeletePort

Категория

Принтеры