VB6获取本机所有IP地址公用函数

Option Explicit

Private Declare Function WSAstartup Lib "WSOCK32.DLL" Alias "WSAStartup" (ByVal wVersionRequired As Integer, ByRef lpWSAData As WSAdata) As Long
Private Declare Function WsACleanup Lib "WSOCK32.DLL" Alias "WSACleanup" () As Long
Private Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Any, ByVal cbInBuffer As Long, lpvOutBuffer As Any, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long
Private Declare Function socket Lib "WSOCK32.DLL" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Private Declare Function closesocket Lib "WSOCK32.DLL" (ByVal s As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Type sockaddr
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type

Private Type sockaddr_gen
AddressIn As sockaddr
filler(0 To 7) As Byte
End Type

Private Type INTERFACE_INFO
iiFlags As Long
iiAddress As sockaddr_gen
iiBroadcastAddress As sockaddr_gen
iiNetmask As sockaddr_gen
End Type

Private Type INTERFACEINFO
iInfo(0 To 7) As INTERFACE_INFO
End Type

Private Type WSAdata
wVersion As Integer
wHighVersion As Integer
szDescription As String * 255
szSystemStatus As String * 128
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type

Private Const AF_INET = 2
Private Const SOCK_STREAM = 1
Private Const INVALID_SOCKET = -1
Private Const SIO_GET_INTERFACE_LIST As Long = &H4004747F

Private Function GetStrIPFromLong(nIP As Long) As String
On Error Resume Next
Dim btBuffer(3) As Byte
Call CopyMemory(ByVal VarPtr(btBuffer(0)), ByVal VarPtr(nIP), 4)
Let GetStrIPFromLong = btBuffer(0) & "." & btBuffer(1) & "." & btBuffer(2) & "." & btBuffer(3)
End Function

Public Function EnumLocalIpAddress() As String()
On Error GoTo Z
Dim lngSocketHandle       As Long
Dim lngBytesReturned      As Long
Dim tpBuffer              As INTERFACEINFO
Dim nNumInterfaces        As Integer
Dim i                     As Integer
Dim StartupInfo           As WSAdata
Dim strIPBuffer()         As String

If WSAstartup(&H202, StartupInfo) <> 0 Then
Exit Function
End If

lngSocketHandle = socket(AF_INET, SOCK_STREAM, 0)
If lngSocketHandle = INVALID_SOCKET Then
Exit Function
End If

If WSAIoctl(lngSocketHandle, SIO_GET_INTERFACE_LIST, ByVal 0, ByVal 0, tpBuffer, 1024, lngBytesReturned, ByVal 0, ByVal 0) Then
closesocket lngSocketHandle
Exit Function
End If

nNumInterfaces = CInt(lngBytesReturned / 76)

ReDim strIPBuffer(nNumInterfaces - 1)

For i = 0 To nNumInterfaces - 1
strIPBuffer(i) = GetStrIPFromLong(tpBuffer.iInfo(i).iiAddress.AddressIn.sin_addr)
Next i

EnumLocalIpAddress = strIPBuffer
closesocket lngSocketHandle
WsACleanup
Exit Function
Z:
End Function

Dim i As Long, strIPAdd() As String
strIPAdd = EnumLocalIpAddress
If SafeArrayGetDim(strIPAdd) > 0 Then
For i = 0 To UBound(strIPAdd)
Debug.Print strIPAdd(i)
Next
End If