我正在尝试编写一个脚本,该脚本将从文本文件中提取计算机名称,然后查询远程注册表以查找 hkey_users\SID\network 下的任何子项。然后将 SID 转换为用户名,并将结果输出到以用户命名的文本文件中。
'Define variables, constants and objects
'define text file and username
Const ForAppending = 8
Const OverwriteExisting = TRUE
dim WSHNetwork, UserString
set WSHNetwork = CreateObject("WScript.Network")
UserString = WSHNetwork.UserName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile _
("" & UserString & ".txt", ForAppending, True)
' rest
strComputer="localhost"
Const HKEY_USERS = &H80000003
Set objWbem = GetObject("winmgmts:")
Set objRegistry = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'Go and get the currently logged on user by checking the owner of the Explorer.exe process.
Set colProc = objWmiService.ExecQuery("Select Name from Win32_Process" & " Where Name='explorer.exe' and SessionID=0")
If colProc.Count > 0 Then
For Each oProcess In colProc
oProcess.GetOwner sUser, sDomain
Next
End If
'Loop through the HKEY_USERS hive until (ignoring the .DEFAULT and _CLASSES trees) until we find the tree that
'corresponds to the currently logged on user.
lngRtn = objRegistry.EnumKey(HKEY_USERS, "", arrRegKeys)
For Each strKey In arrRegKeys
If UCase(strKey) = ".DEFAULT" Or UCase(Right(strKey, 8)) = "_CLASSES" Then
Else
Set objSID = objWbem.Get("Win32_SID.SID='" & strKey & "'")
'If the account name of the current sid we're checking matches the accountname we're looking for Then
'enumerate the Network subtree
If objSID.accountname = sUser Then
regpath2enumerate = strkey & "\Network" 'strkey is the SID
objRegistry.enumkey hkey_users, regpath2enumerate, arrkeynames
'If the array has elements, go and get the drives info from the registry
If Not (IsEmpty(arrkeynames)) Then
For Each subkey In arrkeynames
regpath = strkey & "\Network\" & subkey
regentry = "RemotePath"
objRegistry.getstringvalue hkey_users, regpath, regentry, dapath
objTextFile.WriteLine subkey & ":" & vbTab & dapath
Next
objTextFile.Close
End If
End If
End If
Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile "" & UserString & ".txt" , "\\servername\foldername\subfolder", OverwriteExisting
答案1
您将通过这种方式提取大量旧内容,而且正如您所发现的,这并不容易。为什么不将其作为域的登录脚本的一部分呢?这样,您只会从 HKCU 提取当前登录用户的最新内容,并且用户名更容易找到。