Dim ComputerName As String
ComputerName = "localhost"
Set OpSysSet = GetObject("winmgmts:{impersonationLevel=impersonate}//" & ComputerName).ExecQuery("SELECT index, IPAddress FROM Win32_NetworkAdapterConfiguration")
For Each OpSys In OpSysSet
If TypeName(OpSys.IPAddress) <> "Null" Then
For Each IP In OpSys.IPAddress
MsgBox IP, 64, "IP地址"
Next
End If
Next
End Sub
Function bytes2BSTR(vIn)
Dim strReturn As String, ThisCharCode As Long, NextCharCode As Long
Dim i As Long
strReturn = ""
For i = 1 To LenB(vIn)
ThisCharCode = AscB(MidB(vIn, i, 1))
If ThisCharCode < &H80 Then
strReturn = strReturn & Chr(ThisCharCode)
Else
NextCharCode = AscB(MidB(vIn, i + 1, 1))
strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
i = i + 1
End If
Next
bytes2BSTR = strReturn
End Function
Sub ipExternal()
Dim URL As String, NP, Data, Here As String, Hers As String
On Error Resume Next
URL = "http://www.ip138.com/ip2city.asp"
Set NP = CreateObject("Microsoft.XMLHTTP")
NP.Open "GET", URL, False
NP.Send
Data = NP.responsebody
Set NP = Nothing
Data = bytes2BSTR(Data)
Here = InStrRev(Data, "您的IP地址是:", -1, 0)
Data = Mid(Data, Here + 9, 13)
Hers = InStrRev(Data, "<", -1, 0)
MsgBox Data
End Sub