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

因为正好有用到，整了个公用函数，一次获取本机全部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