If Ret <= 0 Then Exit Sub
ReDim bBytes(0 To Ret - 1) As Byte
GetIpAddrTable bBytes(0), Ret, False
CopyMemory Listing.dEntrys, bBytes(0), 4
CopyMemory Listing.mIPInfo(0), bBytes(4), Len(Listing.mIPInfo(0))
'在這裏取得IP
T_ip.Text = ConvertAddressToString(Listing.mIPInfo(0).dwAddr)
-------------------------------------------------------------------------
Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Const MAX_IP = 5
Type IPINFO
dwAddr As Long
dwIndex As Long
dwMask As Long
dwBCastAddr As Long
dwReasmSize As Long
unused1 As Integer
unused2 As Integer
End Type
Type MIB_IPADDRTABLE
dEntrys As Long
mIPInfo(MAX_IP) As IPINFO
End Type
Type IP_Array
mBuffer As MIB_IPADDRTABLE
BufferLen As Long
End Type
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
yadianer:
僅僅是針對本機，最簡單的辦法是用winsock了，如樓上
下面是用API
偵測目前設備上所使用的 IP 地址
' 設定在您的計算機上，最多可能使用 5 組 IP 地址，並且用來產生緩沖區
Private Const MAX_IP = 10
Private Type IPINFO
dwAddr As Long ' IP 地址
dwNICIndex As Long ' NIC 界面索引
dwSubnetMask As Long ' 子網掩碼
dwBroadCastAddr As Long ' 封包廣播地址
dwReAssemblySize As Long ' 組譯大小
unused1 As Integer ' 暫不使用
unused2 As Integer ' 暫不使用
End Type
Private Type MIB_IPADDRTABLE
dwEntrys As Long ' 窗體中登錄的數量
arIPInfo(MAX_IP) As IPINFO ' IP 地址登錄數組
End Type
Private Type IP_Array
mBuffer As MIB_IPADDRTABLE ' IP 地址清單數組
BufferLen As Long ' 緩沖區長度
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
' 將長整數轉換為字符串
Public Function ConvertAddr2Str(LongAddress As Long) As String
Dim addrByte(3) As Byte
Dim Cnt As Long
CopyMemory addrByte(0), LongAddress, 4
For Cnt = 0 To 3
ConvertAddr2Str = ConvertAddr2Str + CStr(addrByte(Cnt)) + "."
Next Cnt
ConvertAddr2Str = Left$(ConvertAddr2Str, Len(ConvertAddr2Str) - 1)
End Function
Private Sub Form_Load()
Text1.Text = ""
Me.Caption = "取得計算機上所使用的 IP 地址"
Text1.Font.Size = 11
Start
End Sub
Private Sub Form_Resize()
Text1.Height = Me.Height - 38 * Screen.TwipsPerPixelY
Text1.Width = Me.Width - 20 * Screen.TwipsPerPixelX
End Sub
Private Sub Start()
Dim lRet As Long, I As Long
Dim Buffer() As Byte
Dim ListDatas As MIB_IPADDRTABLE
Text1 = ""
On Error GoTo Errors
GetIpAddrTable ByVal 0&, lRet, True
If lRet <= 0 Then Exit Sub
ReDim Buffer(0 To lRet - 1) As Byte
' 取回 IP 地址的相關數據
GetIpAddrTable Buffer(0), lRet, False
Debug.Print Buffer(0)
' 利用已經安裝 IP 地址的前四個字節，來取得登錄的信息
CopyMemory ListDatas.dwEntrys, Buffer(0), 4
Text1 = "在您的計算機上，***有 " & ListDatas.dwEntrys & " 組已經設定使用的 IP 地址" & vbCrLf
Text1 = Text1 & String(45, "=") & vbCrLf
For I = 0 To ListDatas.dwEntrys - 1
' 將存在內存之中的地址結構，復制到清單之中
CopyMemory ListDatas.arIPInfo(I), Buffer(4 + (I * Len(ListDatas.arIPInfo(0)))), Len(ListDatas.arIPInfo(I))
Text1 = Text1 & "IP 地址 ：" & ConvertAddr2Str(ListDatas.arIPInfo(I).dwAddr) & vbCrLf
Text1 = Text1 & "IP 子網掩碼：" & ConvertAddr2Str(ListDatas.arIPInfo(I).dwSubnetMask) & vbCrLf
Text1 = Text1 & "IP 廣播地址 ：" & ConvertAddr2Str(ListDatas.arIPInfo(I).dwBroadCastAddr) & vbCrLf
Text1 = Text1 & String(45, "*") & vbCrLf & vbCrLf
Next
Exit Sub
Errors:
End Sub
yadianer:
如果是針外網，可以用下面的：原理是根據訪問網頁得到
Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_ADAPTER_NAME_LENGTH As Long = 256
Private Const MAX_ADAPTER_DESCRIPTION_LENGTH As Long = 128
Private Const MAX_ADAPTER_ADDRESS_LENGTH As Long = 8
Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End Type
Private Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End Type
Private Type IP_ADDR_STRING
dwNext As Long
IpAddress As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
dwContext As Long
End Type
Private Type IP_ADAPTER_INFO
dwNext As Long
ComboIndex As Long 'reserved
sAdapterName(0 To (MAX_ADAPTER_NAME_LENGTH + 3)) As Byte
sDescription(0 To (MAX_ADAPTER_DESCRIPTION_LENGTH + 3)) As Byte
dwAddressLength As Long
sIPAddress(0 To (MAX_ADAPTER_ADDRESS_LENGTH - 1)) As Byte
dwIndex As Long
uType As Long
uDhcpEnabled As Long
CurrentIpAddress As Long
IpAddressList As IP_ADDR_STRING
GatewayList As IP_ADDR_STRING
DhcpServer As IP_ADDR_STRING
bHaveWins As Long
PrimaryWinsServer As IP_ADDR_STRING
SecondaryWinsServer As IP_ADDR_STRING
LeaseObtained As Long
LeaseExpires As Long
End Type
Private Declare Function GetAdaptersInfo Lib "iphlpapi.dll" _
(pTcpTable As Any, _
pdwSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(dst As Any, _
src As Any, _
ByVal bcount As Long)
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String) As Long
Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Sub Form_Load()
Command1.Caption = "Get Public IP"
Text1.Text = LocalIPAddress()
Text2.Text = ""
End Sub
Private Sub Command1_Click()
Text2.Text = GetPublicIP()
End Sub
Private Function GetPublicIP()
Dim sSourceUrl As String
Dim sLocalFile As String
Dim hfile As Long
Dim buff As String
Dim pos1 As Long
Dim pos2 As Long
'site returning IP address
sSourceUrl = ".mvps.org/resources/tools/getpublicip.shtml"
sLocalFile = "c:\ip.txt"
'ensure this file does not exist in the cache
Call DeleteUrlCacheEntry(sSourceUrl)
'download the public IP file,
'read into a buffer and delete
If DownloadFile(sSourceUrl, sLocalFile) Then
hfile = FreeFile
Open sLocalFile For Input As #hfile
buff = Input$(LOF(hfile), hfile)
Close #hfile
'look for the IP line
pos1 = InStr(buff, "var ip =")
'if found,
If pos1 Then
'get position of first and last single
'quotes around address (e.g. '11.22.33.44')
pos1 = InStr(pos1 + 1, buff, "'", vbTextCompare) + 1
pos2 = InStr(pos1 + 1, buff, "'", vbTextCompare) '- 1
'return the IP address
GetPublicIP = Mid$(buff, pos1, pos2 - pos1)
Else
GetPublicIP = "(unable to parse IP)"
End If 'pos1
Kill sLocalFile
Else
GetPublicIP = "(unable to access shtml page)"
End If 'DownloadFile
End Function
Private Function DownloadFile(ByVal sURL As String, _
ByVal sLocalFile As String) As Boolean
DownloadFile = URLDownloadToFile(0, sURL, sLocalFile, 0, 0) = ERROR_SUCCESS
End Function
Private Function LocalIPAddress() As String
Dim cbRequired As Long
Dim buff() As Byte
Dim ptr1 As Long
Dim sIPAddr As String
Dim Adapter As IP_ADAPTER_INFO
Call GetAdaptersInfo(ByVal 0&, cbRequired)
If cbRequired > 0 Then
ReDim buff(0 To cbRequired - 1) As Byte
If GetAdaptersInfo(buff(0), cbRequired) = ERROR_SUCCESS Then
'get a pointer to the data stored in buff()
ptr1 = VarPtr(buff(0))
Do While (ptr1 <> 0)
'copy the data from the pointer to the
'first adapter into the IP_ADAPTER_INFO type
CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
With Adapter
'the DHCP IP address is in the
'IpAddress.IpAddr member
sIPAddr = TrimNull(StrConv(.IpAddressList.IpAddress.IpAddr, vbUnicode))
If Len(sIPAddr) > 0 Then Exit Do
ptr1 = .dwNext
End With 'With Adapter
'ptr1 is 0 when (no more adapters)
Loop 'Do While (ptr1 <> 0)
End If 'If GetAdaptersInfo
End If 'If cbRequired > 0
'return any string found
LocalIPAddress = sIPAddr
End Function
Private Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function