7451
社区成员
- 主页
用最简洁的代码，获取本机所在的域名称（如果不在，获取工作组名称）
（1）获取本机所在的域名称（如果不在，获取工作组名称）
（2）判断这台计算机在不在一个已知的域（记当前用户是不是域登陆？）
（2）判断这台计算机在不在一个已知的域（记当前用户是不是域登陆？）
...全文
请发表友善的回复…
发表回复
quanquan626 2004-02-28
up
rainstormmaster 2004-02-27
建议你到：
http://vbnet.mvps.org/index.html?code/network/
看看，有很多好东东
http://vbnet.mvps.org/index.html?code/network/
看看，有很多好东东
rainstormmaster 2004-02-27
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 = 256
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 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 Type
Private Declare Function GetNetworkParams Lib "iphlpapi.dll" _
(pFixedInfo As Any, _
pOutBufLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Sub Command1_Click()
MsgBox GetDomainName
End 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 > 0
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
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 = 256
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 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 Type
Private Declare Function GetNetworkParams Lib "iphlpapi.dll" _
(pFixedInfo As Any, _
pOutBufLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Sub Command1_Click()
MsgBox GetDomainName
End 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 > 0
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
yoki 2004-02-27
读取注册表下
HKEY_LOCAL-MACHINE\System\CurrentControlSet\Services\VxD\VNETSUP 下Workgroup的值
HKEY_LOCAL-MACHINE\System\CurrentControlSet\Services\VxD\VNETSUP 下Workgroup的值
captainivy 2004-02-27
注册表搜不到
谁能给个位置？
谁能给个位置？
aoenzh 2003-12-15
最简单就是API了
cow_boys 2003-12-15
读注册表吧。
noApple 2003-12-15
item.Status 是什么意思呢？
脆皮大雪糕 2003-12-12
先把自己的机器加入网络上的域或者组，然后到注册表里面搜索域名，确定其在注册表中的位置，然后编程到这个位置获取你想要的名字
noApple 2003-12-12
还有吗？
hhjjhjhj 2003-12-11
Function TranslateDomainRole(ByVal roleID)
Dim a
Select Case roleID
Case 0
a = "Standalone Workstation"
Case 1
a = "Member Workstation"
Case 2
a = "Standalone Server"
Case 3
a = "Member Server"
Case 4
a = "Backup Domain Controller"
Case 5
a = "Primary Domain Controller"
End Select
TranslateDomainRole = a
End Function
Sub t()
Dim s, System, item
Set System = GetObject("winmgmts:").instancesOf("Win32_ComputerSystem")
For Each item In System
s = "Computer Info" & vbCrLf
s = s & "***********************" & vbCrLf
s = s & "Name: " & item.Name & vbCrLf
s = s & "Status: " & item.Status & vbCrLf
s = s & "Type: " & item.SystemType & vbCrLf
s = s & "Mfg: " & item.Manufacturer & vbCrLf
s = s & "Model: " & item.Model & vbCrLf
s = s & "RAM: ~" & item.TotalPhysicalMemory \ 1024000 & "mb" & vbCrLf
s = s & "Domain: " & item.Domain & vbCrLf
s = s & "Role: " & TranslateDomainRole(item.DomainRole) & vbCrLf
s = s & "Current User: " & item.UserName & vbCrLf
MsgBox s
Next
End Sub
Dim a
Select Case roleID
Case 0
a = "Standalone Workstation"
Case 1
a = "Member Workstation"
Case 2
a = "Standalone Server"
Case 3
a = "Member Server"
Case 4
a = "Backup Domain Controller"
Case 5
a = "Primary Domain Controller"
End Select
TranslateDomainRole = a
End Function
Sub t()
Dim s, System, item
Set System = GetObject("winmgmts:").instancesOf("Win32_ComputerSystem")
For Each item In System
s = "Computer Info" & vbCrLf
s = s & "***********************" & vbCrLf
s = s & "Name: " & item.Name & vbCrLf
s = s & "Status: " & item.Status & vbCrLf
s = s & "Type: " & item.SystemType & vbCrLf
s = s & "Mfg: " & item.Manufacturer & vbCrLf
s = s & "Model: " & item.Model & vbCrLf
s = s & "RAM: ~" & item.TotalPhysicalMemory \ 1024000 & "mb" & vbCrLf
s = s & "Domain: " & item.Domain & vbCrLf
s = s & "Role: " & TranslateDomainRole(item.DomainRole) & vbCrLf
s = s & "Current User: " & item.UserName & vbCrLf
MsgBox s
Next
End Sub