Private Const ERROR_SUCCESS As Long = 0 Private Const MAX_DOMAIN_NAME_LEN As Long = 128 Private Const MAX_HOSTNAME_LEN As Long = 128 Private Const MAX_SCOPE_ID_LEN As Long = 256Private 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 As IP_ADDRESS_STRING IpMask As IP_MASK_STRING 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 IP_ADDR_STRING 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 Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" _ (Destination As Any, _ Source As Any, _ ByVal Length As Long) Private Sub Command1_Click() MsgBox GetDomainNameEnd Sub Public Function GetDomainName() As String Dim buff() As Byte Dim cbRequired As Long Dim nStructSize As Long Dim Info As FIXED_INFO 'Call the api passing null as pFixedInfo. 'The required size of the buffer for the 'data is returned in cbRequired Call GetNetworkParams(ByVal 0&, cbRequired) If cbRequired > 0 Then
'create a buffer of the needed size ReDim buff(0 To cbRequired - 1) As Byte
'and call again If GetNetworkParams(buff(0), cbRequired) = ERROR_SUCCESS Then
'copy the buffer into a FIXED_INFO type CopyMemory Info, ByVal VarPtr(buff(0)), LenB(Info)
'and retrieve the domain name GetDomainName = TrimNull(StrConv(Info.DomainName, vbUnicode)) End If 'If GetNetworkParams End If 'If cbRequired > 0End 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
Private Const MAX_DOMAIN_NAME_LEN As Long = 128
Private Const MAX_HOSTNAME_LEN As Long = 128
Private Const MAX_SCOPE_ID_LEN As Long = 256Private 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 As IP_ADDRESS_STRING
IpMask As IP_MASK_STRING
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 IP_ADDR_STRING
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 Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Sub Command1_Click() MsgBox GetDomainNameEnd Sub
Public Function GetDomainName() As String Dim buff() As Byte
Dim cbRequired As Long
Dim nStructSize As Long
Dim Info As FIXED_INFO 'Call the api passing null as pFixedInfo.
'The required size of the buffer for the
'data is returned in cbRequired
Call GetNetworkParams(ByVal 0&, cbRequired) If cbRequired > 0 Then
'create a buffer of the needed size
ReDim buff(0 To cbRequired - 1) As Byte
'and call again
If GetNetworkParams(buff(0), cbRequired) = ERROR_SUCCESS Then
'copy the buffer into a FIXED_INFO type
CopyMemory Info, ByVal VarPtr(buff(0)), LenB(Info)
'and retrieve the domain name
GetDomainName = TrimNull(StrConv(Info.DomainName, vbUnicode))
End If 'If GetNetworkParams
End If 'If cbRequired > 0End 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那我就照帖下代码，哈哈