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,tpBuffer,1024,lngBytesReturned,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