The WSAEnumProtocols
function is used to discover information about the collection of
transport protocols and protocol chains installed on the local computer.
Since layered protocols are only usable by applications when installed
in protocol chains, information on layered protocols is not included in
lpProtocolBuffer. The lpiProtocols parameter can be used as a filter to
constrain the amount of information provided. Often, lpiProtocols will
be specified as a NULL pointer that will cause the function to return
information on all available transport protocols and protocol chains.
A WSAPROTOCOL_INFO structure is provided in the buffer pointed to by
lpProtocolBuffer for each requested protocol. If the specified buffer is
not large enough (as indicated by the input value of lpdwBufferLength ),
the value pointed to by lpdwBufferLength will be updated to indicate the
required buffer size. The application should then obtain a large enough
buffer and call WSAEnumProtocols again.
The order in which the WSAPROTOCOL_INFO structures appear in the buffer
coincides with the order in which the protocol entries were registered
by the service provider using the WS2_32.DLL, or with any subsequent
reordering that occurred through the Windows Sockets application or DLL
supplied for establishing default TCP/IP providers.
This demo simply
returns the names of the installed protocols. The demo at
WSAEnumProtocols: Additional Data from Enumerated Windows Socket Protocols adds
to this code by providing additional information.
|
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const WS_VERSION_REQD As Long = &H101
Private Const MAX_PROTOCOL_CHAIN As Long = 7
Private Const IP_SUCCESS As Long = 0
Private Const WSABASEERR As Long = 10000
Private Const WSAENOBUFS As Long = WSABASEERR + 55
Private Const WSAPROTOCOL_LEN As Long = 255
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Type WSAPROTOCOLCHAIN
ChainLen As Long 'the length of thechain
'length = 0 means layered protocol
'length = 1 means base protocol
'length > 1 means protocol chain
ChainEntries(0 To MAX_PROTOCOL_CHAIN - 1) As Long 'a list of dwCatalogEntryIds
End Type
Private Type WSAPROTOCOL_INFO
dwServiceFlags1 As Long
dwServiceFlags2 As Long
dwServiceFlags3 As Long
dwServiceFlags4 As Long
dwProviderFlags As Long
ProviderId(0 To 15) As Byte
dwCatalogEntryId As Long
ProtocolChain As WSAPROTOCOLCHAIN
iVersion As Integer
iAddressFamily As Long
iMaxSockAddr As Long
iMinSockAddr As Long
iSocketType As Long
iProtocol As Long
iProtocolMaxOffset As Long
iNetworkByteOrder As Long
iSecurityScheme As Long
dwMessageSize As Long
dwProviderReserved As Long
szProtocol(0 To WSAPROTOCOL_LEN - 1) As Byte
End Type
Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Integer
wMaxUDPDG As Integer
dwVendorInfo As Long
End Type
Private Declare Function WSAStartup Lib "WSOCK32" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32" () As Long
Private Declare Function WSAEnumProtocols Lib "ws2_32.dll" _
Alias "WSAEnumProtocolsA" _
(ByVal lpiProtocols As Long, _
lpProtocolBuffer As Any, _
lpdwBufferLength As Long) As Long
Private Sub Form_Load()
Command1.Caption = "WSAEnumProtocols"
End Sub
Private Sub Command1_Click()
Dim cbBuff As Long
Dim numEntries As Long
Dim lpBuff() As WSAPROTOCOL_INFO
Dim ret As Long
Dim cnt As Long
'initialize Ws2_32.dll
If SocketsInitialize() Then
List1.Clear
'create a buffer too small to hold
'the results of the call
ReDim lpBuff(0) As WSAPROTOCOL_INFO
ret = WSAEnumProtocols(0&, lpBuff(0), cbBuff)
'the error indicates the buffer passed
'was insufficient, and cbBuffs specifies
'the size of the buffer required to retrieve
'all data
If ret = -1 And Err.LastDllError = WSAENOBUFS Then
'number of entries is buffer divided
'by size of one WSAPROTOCOL_INFO type
numEntries = (cbBuff) \ LenB(lpBuff(0))
'dimension to 0-base
ReDim lpBuff(0 To numEntries - 1) As WSAPROTOCOL_INFO
'and call again
If WSAEnumProtocols(0&, lpBuff(0), cbBuff) > 0 Then
'add the retrieved items to a listbox
For cnt = 0 To numEntries - 1
List1.AddItem StrConv(lpBuff(cnt).szProtocol, vbUnicode)
Next
End If 'WSAEnumProtocols
End If 'ret = -1
End If 'SocketsInitialize
SocketsCleanup
End Sub
Private Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function
Private Sub SocketsCleanup()
If WSACleanup() <> 0 Then
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
End If
End Sub |
