GetInternetIP

来源:互联网 发布:淘宝首页怎么设计 编辑:程序博客网 时间:2024/04/27 20:38

'if user is not connected to internet, it will return the Lan IP
Const MAX_IP = 5   'To make a buffer..
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 GetInternetIP() 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 ErrorEND
    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
    GetInternetIP = TempIP 'Return The TempIP

Exit Function

ErrorEND:
    GetInternetIP = ""
End Function
Private Sub Form_Load()
    MsgBox GetInternetIP
End Sub