可是使用 ip helper的GetNetworkParams api 窗体放一个按钮,两个label 用如下代码: Private Const MAX_HOSTNAME_LEN = 128 Private Const MAX_DOMAIN_NAME_LEN = 128 Private Const MAX_SCOPE_ID_LEN = 256 Private Const ERROR_SUCCESS As Long = 0Private Type IP_ADDRESS_STRING IpAddr(0 To 15) As Byte End TypePrivate Type IP_MASK_STRING IpMask(0 To 15) As Byte End TypePrivate Type IP_ADDR_STRING dwNext As Long IpAddress(0 To 15) As Byte IpMask(0 To 15) As Byte dwContext As Long End TypePrivate Type FIXED_INFO HostName(0 To (MAX_HOSTNAME_LEN + 3)) As Byte DomainName(0 To (MAX_DOMAIN_NAME_LEN + 3)) As Byte CurrentDnsServer As Long DnsServerList As IP_ADDR_STRING NodeType As Long ScopeId(0 To (MAX_SCOPE_ID_LEN + 3)) As Byte EnableRouting As Long EnableProxy As Long EnableDns As Long End TypePrivate Declare Function GetNetworkParams Lib "iphlpapi.dll" _ (pFixedInfo As Any, _ pOutBufLen As Long) As LongPrivate Declare Function lstrcpyA Lib "kernel32" _ (ByVal RetVal As String, ByVal ptr As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" _ (ByVal ptr As Any) As Long
Private Declare Function inet_ntoa Lib "wsock32.dll" _ (ByVal addr As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" _ (Destination As Any, _ Source As Any, _ ByVal Length As Long) Private Sub Form_Load() Command1.Caption = "Get DNS Servers"
End Sub Private Sub Command1_Click() Dim cnt As Long Dim success As Long Dim currserver As String Dim dnsservers() As String
'pass an empty string and string array 'to the function. Return value is the 'number of DNS servers found success = GetDNSServers(currserver, dnsservers())
'show the current DNS server found Label1.Caption = "Current DNS Server: " & _ vbNewLine & _ currserver
End IfEnd Sub Private Function GetDNSServers(sCurrentDNSServer As String, _ dnssvr() As String) As Long Dim buff() As Byte Dim cbRequired As Long Dim nStructSize As Long Dim ptr As Long Dim fi As FIXED_INFO Dim ipas As IP_ADDR_STRING Dim cnt As Long ReDim dnssvr(0) As String
nStructSize = LenB(ipas) 'call the api first to determine the 'size required for the values to be returned Call GetNetworkParams(ByVal 0&, cbRequired) If cbRequired > 0 Then
ReDim buff(0 To cbRequired - 1) As Byte
If GetNetworkParams(buff(0), cbRequired) = ERROR_SUCCESS Then
ptr = VarPtr(buff(0))
CopyMemory fi, ByVal ptr, Len(fi)
With fi
'identify the current dns server CopyMemory ipas, _ ByVal VarPtr(.CurrentDnsServer) + 4, _ nStructSize
sCurrentDNSServer = TrimNull(StrConv(ipas.IpAddress, vbUnicode)) 'obtain a pointer to the 'DnsServerList array ptr = VarPtr(.DnsServerList) 'the IP_ADDR_STRING dwNext member indicates 'that more than one DNS server may be listed, 'so a loop is needed Do While (ptr <> 0) 'copy each into an IP_ADDR_STRING type CopyMemory ipas, ByVal ptr, nStructSize With ipas 'extract the server address and 'cast to the array ReDim Preserve dnssvr(0 To cnt) As String dnssvr(cnt) = TrimNull(StrConv(ipas.IpAddress, vbUnicode)) ptr = .dwNext
End With cnt = cnt + 1 Loop
End With
End If 'If GetNetworkParams
End If 'If cbRequired > 0
'return number of servers found GetDNSServers = cnt
End Function Private Function TrimNull(item As String) Dim pos As Integer
pos = InStr(item, Chr$(0)) If pos Then TrimNull = Left$(item, pos - 1) Else: TrimNull = item End If
End Function Private Function GetInetStrFromPtr(Address As Long) As String
GetInetStrFromPtr = GetStrFromPtrA(inet_ntoa(Address))End Function Public Function GetStrFromPtrA(ByVal lpszA As Long) As String GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0) Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
窗体放一个按钮,两个label
用如下代码:
Private Const MAX_HOSTNAME_LEN = 128
Private Const MAX_DOMAIN_NAME_LEN = 128
Private Const MAX_SCOPE_ID_LEN = 256
Private Const ERROR_SUCCESS As Long = 0Private Type IP_ADDRESS_STRING
IpAddr(0 To 15) As Byte
End TypePrivate Type IP_MASK_STRING
IpMask(0 To 15) As Byte
End TypePrivate Type IP_ADDR_STRING
dwNext As Long
IpAddress(0 To 15) As Byte
IpMask(0 To 15) As Byte
dwContext As Long
End TypePrivate Type FIXED_INFO
HostName(0 To (MAX_HOSTNAME_LEN + 3)) As Byte
DomainName(0 To (MAX_DOMAIN_NAME_LEN + 3)) As Byte
CurrentDnsServer As Long
DnsServerList As IP_ADDR_STRING
NodeType As Long
ScopeId(0 To (MAX_SCOPE_ID_LEN + 3)) As Byte
EnableRouting As Long
EnableProxy As Long
EnableDns As Long
End TypePrivate Declare Function GetNetworkParams Lib "iphlpapi.dll" _
(pFixedInfo As Any, _
pOutBufLen As Long) As LongPrivate Declare Function lstrcpyA Lib "kernel32" _
(ByVal RetVal As String, ByVal ptr As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" _
(ByVal ptr As Any) As Long
Private Declare Function inet_ntoa Lib "wsock32.dll" _
(ByVal addr As Long) As LongPrivate Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Sub Form_Load() Command1.Caption = "Get DNS Servers"
End Sub
Private Sub Command1_Click() Dim cnt As Long
Dim success As Long
Dim currserver As String
Dim dnsservers() As String
'pass an empty string and string array
'to the function. Return value is the
'number of DNS servers found
success = GetDNSServers(currserver, dnsservers())
'show the current DNS server found
Label1.Caption = "Current DNS Server: " & _
vbNewLine & _
currserver
'show all servers found
If success > 0 Then
Label2.Caption = "DNS Server List: " & vbNewLine
For cnt = 0 To success - 1
Label2.Caption = Label2.Caption & _
dnsservers(cnt) & _
vbNewLine
Next
End IfEnd Sub
Private Function GetDNSServers(sCurrentDNSServer As String, _
dnssvr() As String) As Long Dim buff() As Byte
Dim cbRequired As Long
Dim nStructSize As Long
Dim ptr As Long
Dim fi As FIXED_INFO
Dim ipas As IP_ADDR_STRING
Dim cnt As Long
ReDim dnssvr(0) As String
nStructSize = LenB(ipas) 'call the api first to determine the
'size required for the values to be returned
Call GetNetworkParams(ByVal 0&, cbRequired) If cbRequired > 0 Then
ReDim buff(0 To cbRequired - 1) As Byte
If GetNetworkParams(buff(0), cbRequired) = ERROR_SUCCESS Then
ptr = VarPtr(buff(0))
CopyMemory fi, ByVal ptr, Len(fi)
With fi
'identify the current dns server
CopyMemory ipas, _
ByVal VarPtr(.CurrentDnsServer) + 4, _
nStructSize
sCurrentDNSServer = TrimNull(StrConv(ipas.IpAddress, vbUnicode)) 'obtain a pointer to the
'DnsServerList array
ptr = VarPtr(.DnsServerList) 'the IP_ADDR_STRING dwNext member indicates
'that more than one DNS server may be listed,
'so a loop is needed
Do While (ptr <> 0) 'copy each into an IP_ADDR_STRING type
CopyMemory ipas, ByVal ptr, nStructSize With ipas 'extract the server address and
'cast to the array
ReDim Preserve dnssvr(0 To cnt) As String
dnssvr(cnt) = TrimNull(StrConv(ipas.IpAddress, vbUnicode))
ptr = .dwNext
End With cnt = cnt + 1 Loop
End With
End If 'If GetNetworkParams
End If 'If cbRequired > 0
'return number of servers found
GetDNSServers = cnt
End Function
Private Function TrimNull(item As String) Dim pos As Integer
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else: TrimNull = item
End If
End Function
Private Function GetInetStrFromPtr(Address As Long) As String
GetInetStrFromPtr = GetStrFromPtrA(inet_ntoa(Address))End Function
Public Function GetStrFromPtrA(ByVal lpszA As Long) As String GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function