手头有段VB代码, 没翻译, 凑合着看吧...
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2003 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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 Const ERROR_SUCCESS As Long = 0
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 Sub Command1_Click()
Text1.Text = DhcpServerAddress()
End Sub
Private Function DhcpServerAddress() As String
'api vars
Dim cbRequired As Long
Dim buff() As Byte
Dim Adapter As IP_ADAPTER_INFO
Dim AdapterStr As IP_ADDR_STRING
'working vars
Dim ptr1 As Long
Dim ptr2 As Long
Dim sIPAddr As String
Dim found As Boolean
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) And (found = False)
'copy the data from the pointer to the
'first adapter into the IP_ADAPTER_INFO type
CopyMemory Adapter, ByVal ptr1, LenB(Adapter)
With Adapter
If .uDhcpEnabled Then
'the DHCP info is in the DhcpServer
'member of IP_ADAPTER_INFO. This is
'in the IP_ADDR_STRING format, so
'it needs to be copied to the
'IP_ADDR_STRING type
ptr2 = VarPtr(.DhcpServer)
'again, the IP_ADDR_STRING type has a
'dwNext member, indicating that more
'than one DHCP server may be listed,
'so another loop is needed
Do While (ptr2 <> 0)
CopyMemory AdapterStr, ByVal ptr2, LenB(AdapterStr)
With AdapterStr
'the IP address of the DHCP
'server for this adapter.
sIPAddr = TrimNull(StrConv(.IpAddress.IpAddr, vbUnicode))
'if something returned, exit the loop
'by setting a flag
If Len(sIPAddr) > 0 Then
found = True
Exit Do
End If
'check for another server
ptr2 = .dwNext
End With 'With AdapterStr
Loop 'Do While (ptr2 <> 0)
'check for another adapter
ptr1 = .dwNext
End If 'If .uDhcpEnabled
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
DhcpServerAddress = sIPAddr
End Function
Private Function TrimNull(item As String)
Dim pos As Integer
'double check that there is a chr$(0) in the string
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else: TrimNull = item
End If
End Function
'--end block--'
