' 侦测目前设备上所使用的 IP 地址' 设定在您的计算机上，最多可能使用 5 组 IP 地址，并且用来产生缓冲区 Private Const MAX_IP = 10Private 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 TypePrivate Type MIB_IPADDRTABLE dwEntrys As Long ' 窗体中登录的数量 arIPInfo(MAX_IP) As IPINFO ' IP 地址登录数组 End TypePrivate Type IP_Array mBuffer As MIB_IPADDRTABLE ' IP 地址清单数组 BufferLen As Long ' 缓冲区长度 End TypePrivate 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 FunctionPrivate Sub Form_Load() Text1.Text = "" Me.Caption = "取得计算机上所使用的 IP 地址" Text1.Font.Size = 11 Start End SubPrivate Sub Form_Resize() Text1.Height = Me.Height - 38 * Screen.TwipsPerPixelY Text1.Width = Me.Width - 20 * Screen.TwipsPerPixelX End SubPrivate Sub Start() Dim lRet As Long, I As Long Dim Buffer() As Byte Dim ListDatas As MIB_IPADDRTABLEText1 = ""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
Public Const MAX_HOSTNAME_LEN = 132 Public Const MAX_DOMAIN_NAME_LEN = 132 Public Const MAX_SCOPE_ID_LEN = 260 Public Const MAX_ADAPTER_NAME_LENGTH = 260 Public Const MAX_ADAPTER_ADDRESS_LENGTH = 8 Public Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132 Public Const ERROR_BUFFER_OVERFLOW = 111 Public Const MIB_IF_TYPE_ETHERNET = 6 Public Const MIB_IF_TYPE_TOKENRING = 9 Public Const MIB_IF_TYPE_FDDI = 15 Public Const MIB_IF_TYPE_PPP = 23 Public Const MIB_IF_TYPE_LOOPBACK = 24 Public Const MIB_IF_TYPE_SLIP = 28Type IP_ADDR_STRING Next As Long IpAddress As String * 16 IpMask As String * 16 Context As Long End TypeType IP_ADAPTER_INFO Next As Long ComboIndex As Long AdapterName As String * MAX_ADAPTER_NAME_LENGTH Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH AddressLength As Long Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte Index As Long Type As Long DhcpEnabled As Long CurrentIpAddress As Long IpAddressList As IP_ADDR_STRING GatewayList As IP_ADDR_STRING DhcpServer As IP_ADDR_STRING HaveWins As Byte PrimaryWinsServer As IP_ADDR_STRING SecondaryWinsServer As IP_ADDR_STRING LeaseObtained As Long LeaseExpires As Long End TypeType FIXED_INFO HostName As String * MAX_HOSTNAME_LEN DomainName As String * MAX_DOMAIN_NAME_LEN CurrentDnsServer As Long DnsServerList As IP_ADDR_STRING NodeType As Long ScopeId As String * MAX_SCOPE_ID_LEN EnableRouting As Long EnableProxy As Long EnableDns As Long End TypePublic Declare Function GetNetworkParams Lib "IPHlpApi.dll" _ (FixedInfo As Any, pOutBufLen As Long) As Long Public Declare Function GetAdaptersInfo Lib "IPHlpApi.dll" _ (IpAdapterInfo As Any, pOutBufLen As Long) As Long Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (Destination As Any, Source As Any, ByVal Length As Long)Sub main() Dim error As Long Dim FixedInfoSize As Long Dim AdapterInfoSize As Long Dim i As Integer Dim PhysicalAddress As String Dim NewTime As Date Dim AdapterInfo As IP_ADAPTER_INFO Dim AddrStr As IP_ADDR_STRING Dim FixedInfo As FIXED_INFO Dim Buffer As IP_ADDR_STRING Dim pAddrStr As Long Dim pAdapt As Long Dim Buffer2 As IP_ADAPTER_INFO Dim FixedInfoBuffer() As Byte Dim AdapterInfoBuffer() As Byte ' Get the main IP configuration information for this machine ' using a FIXED_INFO structure. FixedInfoSize = 0 error = GetNetworkParams(ByVal 0&, FixedInfoSize) If error <> 0 Then If error <> ERROR_BUFFER_OVERFLOW Then MsgBox "GetNetworkParams sizing failed with error " & error Exit Sub End If End If ReDim FixedInfoBuffer(FixedInfoSize - 1) error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize) If error = 0 Then CopyMemory FixedInfo, FixedInfoBuffer(0), FixedInfoSize MsgBox "Host Name: " & FixedInfo.HostName MsgBox "DNS Servers: " & FixedInfo.DnsServerList.IpAddress pAddrStr = FixedInfo.DnsServerList.Next Do While pAddrStr <> 0 CopyMemory Buffer, ByVal pAddrStr, LenB(Buffer) MsgBox "DNS Servers: " & Buffer.IpAddress pAddrStr = Buffer.Next Loop Select Case FixedInfo.NodeType Case 1 MsgBox "Node type: Broadcast" Case 2 MsgBox "Node type: Peer to peer" Case 4 MsgBox "Node type: Mixed" Case 8 MsgBox "Node type: Hybrid" Case Else MsgBox "Unknown node type" End Select MsgBox "NetBIOS Scope ID: " & FixedInfo.ScopeId If FixedInfo.EnableRouting Then MsgBox "IP Routing Enabled " Else MsgBox "IP Routing not enabled" End If If FixedInfo.EnableProxy Then MsgBox "WINS Proxy Enabled " Else MsgBox "WINS Proxy not Enabled " End If If FixedInfo.EnableDns Then MsgBox "NetBIOS Resolution Uses DNS " Else MsgBox "NetBIOS Resolution Does not use DNS " End If Else MsgBox "GetNetworkParams failed with error " & error Exit Sub End If
' Enumerate all of the adapter specific information using the ' IP_ADAPTER_INFO structure. ' Note: IP_ADAPTER_INFO contains a linked list of adapter entries. AdapterInfoSize = 0 error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize) If error <> 0 Then If error <> ERROR_BUFFER_OVERFLOW Then MsgBox "GetAdaptersInfo sizing failed with error " & error Exit Sub End If End If ReDim AdapterInfoBuffer(AdapterInfoSize - 1) ' Get actual adapter information error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize) If error <> 0 Then MsgBox "GetAdaptersInfo failed with error " & error Exit Sub End If ' Allocate memory CopyMemory AdapterInfo, AdapterInfoBuffer(0), AdapterInfoSize pAdapt = AdapterInfo.Next Do CopyMemory Buffer2, AdapterInfo, AdapterInfoSize Select Case Buffer2.Type Case MIB_IF_TYPE_ETHERNET MsgBox "Adapter name: Ethernet adapter " Case MIB_IF_TYPE_TOKENRING MsgBox "Adapter name: Token Ring adapter " Case MIB_IF_TYPE_FDDI MsgBox "Adapter name: FDDI adapter " Case MIB_IF_TYPE_PPP MsgBox "Adapter name: PPP adapter" Case MIB_IF_TYPE_LOOPBACK MsgBox "Adapter name: Loopback adapter " Case MIB_IF_TYPE_SLIP MsgBox "Adapter name: Slip adapter " Case Else MsgBox "Adapter name: Other adapter " End Select MsgBox "AdapterDescription: " & Buffer2.Description PhysicalAddress = "" For i = 0 To Buffer2.AddressLength - 1 PhysicalAddress = PhysicalAddress & Hex(Buffer2.Address(i)) If i < Buffer2.AddressLength - 1 Then PhysicalAddress = PhysicalAddress & "-" End If Next MsgBox "Physical Address: " & PhysicalAddress If Buffer2.DhcpEnabled Then MsgBox "DHCP Enabled " Else MsgBox "DHCP disabled" End If MsgBox "IP Address: " & Buffer2.IpAddressList.IpAddress MsgBox "Subnet Mask: " & Buffer2.IpAddressList.IpMask pAddrStr = Buffer2.IpAddressList.Next Do While pAddrStr <> 0 CopyMemory Buffer, Buffer2.IpAddressList, LenB(Buffer) MsgBox "IP Address: " & Buffer.IpAddress MsgBox "Subnet Mask: " & Buffer.IpMask pAddrStr = Buffer.Next If pAddrStr <> 0 Then CopyMemory Buffer2.IpAddressList, ByVal pAddrStr, _ LenB(Buffer2.IpAddressList) End If Loop MsgBox "Default Gateway: " & Buffer2.GatewayList.IpAddress pAddrStr = Buffer2.GatewayList.Next Do While pAddrStr <> 0 CopyMemory Buffer, Buffer2.GatewayList, LenB(Buffer) MsgBox "IP Address: " & Buffer.IpAddress pAddrStr = Buffer.Next If pAddrStr <> 0 Then CopyMemory Buffer2.GatewayList, ByVal pAddrStr, _ LenB(Buffer2.GatewayList) End If Loop MsgBox "DHCP Server: " & Buffer2.DhcpServer.IpAddress MsgBox "Primary WINS Server: " & _ Buffer2.PrimaryWinsServer.IpAddress MsgBox "Secondary WINS Server: " & _ Buffer2.SecondaryWinsServer.IpAddress ' Display time. NewTime = DateAdd("s", Buffer2.LeaseObtained, #1/1/1970#) MsgBox "Lease Obtained: " & _ CStr(Format(NewTime, "dddd, mmm d hh:mm:ss yyyy")) NewTime = DateAdd("s", Buffer2.LeaseExpires, #1/1/1970#) MsgBox "Lease Expires : " & _ CStr(Format(NewTime, "dddd, mmm d hh:mm:ss yyyy")) pAdapt = Buffer2.Next If pAdapt <> 0 Then CopyMemory AdapterInfo, ByVal pAdapt, AdapterInfoSize End If Loop Until pAdapt = 0 End Sub
该说的大家都说了呀 我再提供一个比较 wo tuo 的方法ipconfig /all >> c:\temp.txt再分析这个txt文件^^" 不要扔鸡蛋 这也是个思路拉
Private Const MAX_IP = 10Private 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 TypePrivate Type MIB_IPADDRTABLE
dwEntrys As Long ' 窗体中登录的数量
arIPInfo(MAX_IP) As IPINFO ' IP 地址登录数组
End TypePrivate Type IP_Array
mBuffer As MIB_IPADDRTABLE ' IP 地址清单数组
BufferLen As Long ' 缓冲区长度
End TypePrivate 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 FunctionPrivate Sub Form_Load()
Text1.Text = ""
Me.Caption = "取得计算机上所使用的 IP 地址"
Text1.Font.Size = 11
Start
End SubPrivate Sub Form_Resize()
Text1.Height = Me.Height - 38 * Screen.TwipsPerPixelY
Text1.Width = Me.Width - 20 * Screen.TwipsPerPixelX
End SubPrivate Sub Start()
Dim lRet As Long, I As Long
Dim Buffer() As Byte
Dim ListDatas As MIB_IPADDRTABLEText1 = ""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
NextExit Sub
Errors:End Sub
Public Const MAX_DOMAIN_NAME_LEN = 132
Public Const MAX_SCOPE_ID_LEN = 260
Public Const MAX_ADAPTER_NAME_LENGTH = 260
Public Const MAX_ADAPTER_ADDRESS_LENGTH = 8
Public Const MAX_ADAPTER_DESCRIPTION_LENGTH = 132
Public Const ERROR_BUFFER_OVERFLOW = 111
Public Const MIB_IF_TYPE_ETHERNET = 6
Public Const MIB_IF_TYPE_TOKENRING = 9
Public Const MIB_IF_TYPE_FDDI = 15
Public Const MIB_IF_TYPE_PPP = 23
Public Const MIB_IF_TYPE_LOOPBACK = 24
Public Const MIB_IF_TYPE_SLIP = 28Type IP_ADDR_STRING
Next As Long
IpAddress As String * 16
IpMask As String * 16
Context As Long
End TypeType IP_ADAPTER_INFO
Next As Long
ComboIndex As Long
AdapterName As String * MAX_ADAPTER_NAME_LENGTH
Description As String * MAX_ADAPTER_DESCRIPTION_LENGTH
AddressLength As Long
Address(MAX_ADAPTER_ADDRESS_LENGTH - 1) As Byte
Index As Long
Type As Long
DhcpEnabled As Long
CurrentIpAddress As Long
IpAddressList As IP_ADDR_STRING
GatewayList As IP_ADDR_STRING
DhcpServer As IP_ADDR_STRING
HaveWins As Byte
PrimaryWinsServer As IP_ADDR_STRING
SecondaryWinsServer As IP_ADDR_STRING
LeaseObtained As Long
LeaseExpires As Long
End TypeType FIXED_INFO
HostName As String * MAX_HOSTNAME_LEN
DomainName As String * MAX_DOMAIN_NAME_LEN
CurrentDnsServer As Long
DnsServerList As IP_ADDR_STRING
NodeType As Long
ScopeId As String * MAX_SCOPE_ID_LEN
EnableRouting As Long
EnableProxy As Long
EnableDns As Long
End TypePublic Declare Function GetNetworkParams Lib "IPHlpApi.dll" _
(FixedInfo As Any, pOutBufLen As Long) As Long
Public Declare Function GetAdaptersInfo Lib "IPHlpApi.dll" _
(IpAdapterInfo As Any, pOutBufLen As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)Sub main()
Dim error As Long
Dim FixedInfoSize As Long
Dim AdapterInfoSize As Long
Dim i As Integer
Dim PhysicalAddress As String
Dim NewTime As Date
Dim AdapterInfo As IP_ADAPTER_INFO
Dim AddrStr As IP_ADDR_STRING
Dim FixedInfo As FIXED_INFO
Dim Buffer As IP_ADDR_STRING
Dim pAddrStr As Long
Dim pAdapt As Long
Dim Buffer2 As IP_ADAPTER_INFO
Dim FixedInfoBuffer() As Byte
Dim AdapterInfoBuffer() As Byte ' Get the main IP configuration information for this machine
' using a FIXED_INFO structure.
FixedInfoSize = 0
error = GetNetworkParams(ByVal 0&, FixedInfoSize)
If error <> 0 Then
If error <> ERROR_BUFFER_OVERFLOW Then
MsgBox "GetNetworkParams sizing failed with error " & error
Exit Sub
End If
End If
ReDim FixedInfoBuffer(FixedInfoSize - 1) error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize)
If error = 0 Then
CopyMemory FixedInfo, FixedInfoBuffer(0), FixedInfoSize
MsgBox "Host Name: " & FixedInfo.HostName
MsgBox "DNS Servers: " & FixedInfo.DnsServerList.IpAddress
pAddrStr = FixedInfo.DnsServerList.Next
Do While pAddrStr <> 0
CopyMemory Buffer, ByVal pAddrStr, LenB(Buffer)
MsgBox "DNS Servers: " & Buffer.IpAddress
pAddrStr = Buffer.Next
Loop Select Case FixedInfo.NodeType
Case 1
MsgBox "Node type: Broadcast"
Case 2
MsgBox "Node type: Peer to peer"
Case 4
MsgBox "Node type: Mixed"
Case 8
MsgBox "Node type: Hybrid"
Case Else
MsgBox "Unknown node type"
End Select MsgBox "NetBIOS Scope ID: " & FixedInfo.ScopeId
If FixedInfo.EnableRouting Then
MsgBox "IP Routing Enabled "
Else
MsgBox "IP Routing not enabled"
End If
If FixedInfo.EnableProxy Then
MsgBox "WINS Proxy Enabled "
Else
MsgBox "WINS Proxy not Enabled "
End If
If FixedInfo.EnableDns Then
MsgBox "NetBIOS Resolution Uses DNS "
Else
MsgBox "NetBIOS Resolution Does not use DNS "
End If
Else
MsgBox "GetNetworkParams failed with error " & error
Exit Sub
End If
' Enumerate all of the adapter specific information using the
' IP_ADAPTER_INFO structure.
' Note: IP_ADAPTER_INFO contains a linked list of adapter entries. AdapterInfoSize = 0
error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize)
If error <> 0 Then
If error <> ERROR_BUFFER_OVERFLOW Then
MsgBox "GetAdaptersInfo sizing failed with error " & error
Exit Sub
End If
End If
ReDim AdapterInfoBuffer(AdapterInfoSize - 1) ' Get actual adapter information
error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize)
If error <> 0 Then
MsgBox "GetAdaptersInfo failed with error " & error
Exit Sub
End If ' Allocate memory
CopyMemory AdapterInfo, AdapterInfoBuffer(0), AdapterInfoSize
pAdapt = AdapterInfo.Next Do
CopyMemory Buffer2, AdapterInfo, AdapterInfoSize
Select Case Buffer2.Type
Case MIB_IF_TYPE_ETHERNET
MsgBox "Adapter name: Ethernet adapter "
Case MIB_IF_TYPE_TOKENRING
MsgBox "Adapter name: Token Ring adapter "
Case MIB_IF_TYPE_FDDI
MsgBox "Adapter name: FDDI adapter "
Case MIB_IF_TYPE_PPP
MsgBox "Adapter name: PPP adapter"
Case MIB_IF_TYPE_LOOPBACK
MsgBox "Adapter name: Loopback adapter "
Case MIB_IF_TYPE_SLIP
MsgBox "Adapter name: Slip adapter "
Case Else
MsgBox "Adapter name: Other adapter "
End Select
MsgBox "AdapterDescription: " & Buffer2.Description PhysicalAddress = ""
For i = 0 To Buffer2.AddressLength - 1
PhysicalAddress = PhysicalAddress & Hex(Buffer2.Address(i))
If i < Buffer2.AddressLength - 1 Then
PhysicalAddress = PhysicalAddress & "-"
End If
Next
MsgBox "Physical Address: " & PhysicalAddress If Buffer2.DhcpEnabled Then
MsgBox "DHCP Enabled "
Else
MsgBox "DHCP disabled"
End If MsgBox "IP Address: " & Buffer2.IpAddressList.IpAddress
MsgBox "Subnet Mask: " & Buffer2.IpAddressList.IpMask
pAddrStr = Buffer2.IpAddressList.Next
Do While pAddrStr <> 0
CopyMemory Buffer, Buffer2.IpAddressList, LenB(Buffer)
MsgBox "IP Address: " & Buffer.IpAddress
MsgBox "Subnet Mask: " & Buffer.IpMask
pAddrStr = Buffer.Next
If pAddrStr <> 0 Then
CopyMemory Buffer2.IpAddressList, ByVal pAddrStr, _
LenB(Buffer2.IpAddressList)
End If
Loop MsgBox "Default Gateway: " & Buffer2.GatewayList.IpAddress
pAddrStr = Buffer2.GatewayList.Next
Do While pAddrStr <> 0
CopyMemory Buffer, Buffer2.GatewayList, LenB(Buffer)
MsgBox "IP Address: " & Buffer.IpAddress
pAddrStr = Buffer.Next
If pAddrStr <> 0 Then
CopyMemory Buffer2.GatewayList, ByVal pAddrStr, _
LenB(Buffer2.GatewayList)
End If
Loop MsgBox "DHCP Server: " & Buffer2.DhcpServer.IpAddress
MsgBox "Primary WINS Server: " & _
Buffer2.PrimaryWinsServer.IpAddress
MsgBox "Secondary WINS Server: " & _
Buffer2.SecondaryWinsServer.IpAddress ' Display time.
NewTime = DateAdd("s", Buffer2.LeaseObtained, #1/1/1970#)
MsgBox "Lease Obtained: " & _
CStr(Format(NewTime, "dddd, mmm d hh:mm:ss yyyy")) NewTime = DateAdd("s", Buffer2.LeaseExpires, #1/1/1970#)
MsgBox "Lease Expires : " & _
CStr(Format(NewTime, "dddd, mmm d hh:mm:ss yyyy"))
pAdapt = Buffer2.Next
If pAdapt <> 0 Then
CopyMemory AdapterInfo, ByVal pAdapt, AdapterInfoSize
End If
Loop Until pAdapt = 0
End Sub
我再提供一个比较 wo tuo 的方法ipconfig /all >> c:\temp.txt再分析这个txt文件^^" 不要扔鸡蛋 这也是个思路拉