1. 启动一个新的 Visual Basic 标准 EXE 工程。 默认情况下会创建 Form 1。
2. 在 项目 菜单中上, 单击 删除 Form 1 。
3. 在 项目 菜单中上, 单击 添加模块 。 默认情况下会创建 Module 1。
4. 将以下代码粘贴到 Module 1 的通用声明部分中：
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 = 28
Type IP_ADDR_STRING
Next As Long
IpAddress As String * 16
IpMask As String * 16
Context As Long
End Type
Type 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 Type
Type 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 Type
Public 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
5. 按 F 5 键运行该项目，请单击每个消息框将显示并注意结果上的 确定 。