在vb中怎么能得到本机的IP地址？

[duranduan]

多谢

[TechnoFantasy]

Option Explicit





'in a module:
'******************************************************************
'Origin Created By Verburgh Peter.
'Modified By TapTapYu ([e-mail])
'The origin example to get the list of IP already very good, i modified it, so
'if user is connected to internet, it will not return the Lan IP
'******************************************************************

Const MAX_IP = 5 'To make a buffer... i dont think you have more than 5 ip on your pc..
Type IPINFO
dwAddr As Long ' IP address
dwIndex As Long ' interface index
dwMask As Long ' subnet mask
dwBCastAddr As Long ' broadcast address
dwReasmSize As Long ' assembly size
unused1 As Integer ' not currently used
unused2 As Integer '; not currently used
End Type
Type MIB_IPADDRTABLE
dEntrys As Long 'number of entries in the table
mIPInfo(MAX_IP) As IPINFO 'array of IP address entries
End Type
Type IP_Array
mBuffer As MIB_IPADDRTABLE
BufferLen As Long
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)

Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
'converts a Long to a string
Public Function ConvertAddressToString(longAddr As Long) As String
Dim myByte(3) As Byte
Dim Cnt As Long
CopyMemory myByte(0), longAddr, 4
For Cnt = 0 To 3
ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
Next Cnt
ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function
Public Function GetWanIP() As String
Dim Ret As Long, Tel As Long
Dim bBytes() As Byte
Dim TempList() As String
Dim TempIP As String
Dim Tempi As Long
Dim Listing As MIB_IPADDRTABLE
Dim L3 As String


On Error GoTo END1
GetIpAddrTable ByVal 0&, Ret, True


If Ret <= 0 Then Exit Function
ReDim bBytes(0 To Ret - 1) As Byte
ReDim TempList(0 To Ret - 1) As String

'retrieve the data
GetIpAddrTable bBytes(0), Ret, False

'Get the first 4 bytes to get the entry's.. ip installed
CopyMemory Listing.dEntrys, bBytes(0), 4

For Tel = 0 To Listing.dEntrys - 1
'Copy whole structure to Listing..
CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
TempList(Tel) = ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr)
Next Tel
'Sort Out The IP For WAN
TempIP = TempList(0)
For Tempi = 0 To Listing.dEntrys - 1
L3 = Left(TempList(Tempi), 3)
If L3 <> "169" And L3 <> "127" And L3 <> "192" Then
TempIP = TempList(Tempi)
End If
Next Tempi
GetWanIP = TempIP 'Return The TempIP


Exit Function
END1:
GetWanIP = ""
End Function

[TechnoFantasy]

或者：

Option Explicit

Const MAXLEN_PHYSADDR = 8
Private Type MIB_IPNETROW
dwIndex As Long
dwPhysAddrLen As Long
bPhysAddr(0 To MAXLEN_PHYSADDR - 1) As Byte
dwAddr As Long
dwType As Long
End Type
Private Declare Function GetIpNetTable Lib "Iphlpapi" (pIpNetTable As Byte, pdwSize As Long, ByVal bOrder As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Sub Form_Load()
'KPD-Team 2001
'URL: http://www.allapi.net/
'E-Mail: [e-mail]
Dim Listing() As MIB_IPNETROW, Ret As Long, Cnt As Long
Dim bBytes() As Byte, bTemp(0 To 3) As Byte
'set the graphics mode of this form to persistent
Me.AutoRedraw = True
'call the function to retrieve how many bytes are needed
GetIpNetTable ByVal 0&, Ret, False
'if it failed, exit the sub
If Ret <= 0 Then Exit Sub
'redimension our buffer
ReDim bBytes(0 To Ret - 1) As Byte
'retireve the data
GetIpNetTable bBytes(0), Ret, False
'copy the number of entries to the 'Ret' variable
CopyMemory Ret, bBytes(0), 4
'redimension the Listing
If Ret > 0 Then ReDim Listing(0 To Ret - 1) As MIB_IPNETROW
'show the data
Me.Print "Contents of address mapping table (items: " + CStr(Ret) + ")"
For Cnt = 0 To Ret - 1
CopyMemory Listing(Cnt), bBytes(4 + 24 * Cnt), 24
CopyMemory bTemp(0), Listing(Cnt).dwAddr, 4
Me.Print " Item " + CStr(Listing(Cnt).dwIndex)
Me.Print " address " + ConvertAddressToString(bTemp(), 4)
Me.Print " physical address " + ConvertAddressToString(Listing(Cnt).bPhysAddr, Listing(Cnt).dwPhysAddrLen)
Select Case Listing(Cnt).dwType
Case 4 'Static
Me.Print " type: Static"
Case 3 'Dynamic
Me.Print " type: Dynamic"
Case 2 'Invalid
Me.Print " type: Invalid"
Case 1 'Other
Me.Print " type: Other"
End Select
Next Cnt
End Sub
'converts a byte array to a string
Public Function ConvertAddressToString(bArray() As Byte, lLength As Long) As String
Dim Cnt As Long
For Cnt = 0 To lLength - 1
ConvertAddressToString = ConvertAddressToString + CStr(bArray(Cnt)) + "."
Next Cnt
ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function