1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
| Option Explicit
Private 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
Private Declare Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long
Private Declare Function lstrcpyA Lib "kernel32" _
(lpString1 As Any, _
lpString2 As Any) As Long
Private Const SIZEOFPORT_INFO_2 = 20
Private Type PORT_INFO_2
pPortName As Long
pMonitorName As Long
pDescription As Long
fPortType As Long
Reserved As Long
End Type
Private Enum PortTypes
PORT_TYPE_WRITE = &H1
PORT_TYPE_READ = &H2
PORT_TYPE_REDIRECTED = &H4
PORT_TYPE_NET_ATTACHED = &H8
End Enum
Public Sub GetListePorts()
Dim pcbNeeded As Long
Dim pcReturned As Long
Dim PortI2() As PORT_INFO_2
Dim Boucle As Integer
Dim StrPortType As String
Call EnumPorts(vbNullString, 2, 0, 0, pcbNeeded, pcReturned)
If pcbNeeded Then
ReDim PortI2((pcbNeeded / SIZEOFPORT_INFO_2))
If EnumPorts(vbNullString, 2, PortI2(0), pcbNeeded, pcbNeeded, pcReturned) Then
For Boucle = 0 To (pcReturned - 1)
With PortI2(Boucle)
StrPortType = ""
If (.fPortType And PORT_TYPE_WRITE) Then StrPortType = "write "
If (.fPortType And PORT_TYPE_READ) Then StrPortType = StrPortType & "read "
If (.fPortType And PORT_TYPE_REDIRECTED) Then StrPortType = StrPortType & "redirected "
If (.fPortType And PORT_TYPE_NET_ATTACHED) Then StrPortType = StrPortType & "network"
MsgBox GetStrFromPtrA(.pPortName) '& " (" & StrPortType & ")"
End With
Next
End If
End If
End Sub
Public Function GetStrFromPtrA(lpszA As Long) As String
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
Public Sub main()
GetListePorts
End Sub |
Partager