I created a small script that checks for admin rights on a remote box. If there is an AD structure you are working with, this will give a few hints for the admin.
The script will first ping the remote computer, then query registry and AD properties.
Line breaks might be a bit confused by this text box, watch out
' Small scriptlet to determine who is logged on interactively to a computer and if this user has local admin rights
' script will terminate if computer is not reachable via ping
' no error checking if you dont have admin rights on the remote box
' usually there is only one person logged on, but this script does handle more in the outer Loop
' created by SvenHansK
' Constants for the NameTranslate object.
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
const HKEY_LOCAL_MACHINE = &H80000002
const HKEY_USERS = &H80000003
' reset objects for next use
Set objPing = Nothing
Set objgroup = Nothing
Set Users = Nothing
Set objTrans = Nothing
Set objUser = Nothing
set objWMIService = Nothing
Set objgroup = Nothing
set ObjAdminGroup = Nothing
Set ObjAdminGroupMember = Nothing
blIsAdmin = False
ComputerName = enterComputername("Enter the computername here")
who = "winmgmts:{impersonationLevel=impersonate}!//"& ComputerName &""
' check and verify if the machine is online, using Win32_PingStatus object
Set objPing = Nothing
Set objPing = GetObject("winmgmts:Win32_PingStatus.address='" & ComputerName & "'")
If IsNull(objPing.StatusCode) Or objPing.StatusCode <> 0 Then
wscript.echo ComputerName & " is not reachable, script will terminate!"
wscript.quit
End If
' use objPing.ProtocolAddress for the resolved adress of that computer
Set Users = GetObject( who ).InstancesOf ("Win32_ComputerSystem")
Set objTrans = CreateObject("NameTranslate")
for each User in Users
' the wmi Object connects to the remote computer
strNTName = User.UserName
' determine the real username after the backslash of the Netbios Name
strUser = mid(User.UserName,InStr(User.UserName,"\")+1,Len(User.UserName))
' use the AD translate to get the FQDN of the remote user who is logged on, tricky syntax
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_NT4, strNTName
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
strUserDN = Replace(strUserDN, "/", "\/")
Set objUser = GetObject("LDAP://" & strUserDN)
' get the SID of that user from the registry profile list in HKLM
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\"& ComputerName & "\root\default:StdRegProv")
objReg.EnumKey HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList",ArrKeys
for each Key in ArrKeys
objReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" & Key, "ProfileImagePath", ProfileImagePath
objReg.GetBinaryValue HKEY_LOCAL_MACHINE,"SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\" & Key, "Sid",arrSid
' get the SID from the profile list
strSID=""
for I = lbound(arrSid) to ubound(arrSid)
' add a leading zero if string is only length one
strSIDpart = cstr(hex(arrSid(i)))
if len(strSIDpart) = 1 then strSIDpart = "0" & strSIDpart
strSID = strSID & strSIDpart
next
strUsernameFromSID = right(ProfileImagePath,len(ProfileImagePath) - instrrev(ProfileImagePath,"\"))
' find the Active Directory SID from that user
arrADSID = objUser.get("ObjectSID")
strSidHex = OctetToHexStr(arrADSID)
if strSidHex = strSID then
' found the proper SID, there can only be one fitting to this SID and the LDAP the admin is connected to, find all printers and permanent Mapped Network Drives for that user
SID = Key
objReg.enumKey HKEY_USERS, SID & "\Printers\Connections", ArrPrinters
StrPrinter = ""
if isarray(ArrPrinters) then
for each printer in ArrPrinters
StrPrinter = StrPrinter & VBCR & printer
next
end if
objReg.enumKey HKEY_USERS, SID & "\Network", ArrNetworkDrives
StrNetworkdrives = ""
if isarray(ArrNetworkDrives) then
for each NetworkDrive in ArrNetworkDrives
objReg.GetStringValue HKEY_USERS, SID & "\Network\" & NetworkDrive, "RemotePath" , RemotePath
StrNetworkdrives = StrNetworkdrives & VBCR & NetworkDrive & ": " & RemotePath
next
end if
'Control Panel\Desktop Screensaver
objReg.GetStringValue HKEY_USERS, SID & "\Control Panel\Desktop","SCRNSAVE.EXE",SCREENSAVER
objReg.GetStringValue HKEY_USERS, SID & "\Control Panel\Desktop","ScreenSaveTimeOut",ScreenSaveTimeOut
' Proxy URL
objReg.GetStringValue HKEY_USERS, SID & "\Software\Microsoft\Windows\CurrentVersion\Internet Settings","AutoConfigURL",AutoConfigURL
end if
next
' get the groups from that remote box LDAP connection
Set objWMIService = GetObject("winmgmts:\\" & ComputerName & "\root\cimv2")
Set colGroups = objWMIService.ExecQuery("Select * from Win32_Group Where LocalAccount = True")
for each objgroup in colGroups
' this is the admin group SID
If objgroup.SID="S-1-5-32-544" then
' browse through Admin group to find the User
Set ObjAdminGroup = GetObject("WinNT://" & ComputerName & "/" & objgroup.Name)
for each ObjAdminGroupMember in ObjAdminGroup.Members
If ObjAdminGroupMember.Name = strUser then
blIsAdmin = True
end If
Next
end If
Next
MsgBox "Computername: " & ComputerName & ", IP: " & objPing.ProtocolAddress & VBCR & VBCR & "Username: " & User.UserName & VBCR & "DisplayName= " & objUser.DisplayName & VBCR & "SID: " & SID & VBCR & "Is a direct member of local admin group: " & blIsAdmin & VBCR & VBCR & "Homshare: " & objUser.HomeDirectory & VBCR & "Screensaver: "& SCREENSAVER & VBCR & "ScreenSaveTimeOut: " & ScreenSaveTimeOut & " seconds" & VBCR & "Proxy: " & AutoConfigURL & VBCR & VBCR & "Printer:" & strPrinter & VBCR & VBCR & "Permanent mapped drives:" & StrNetworkdrives
Next
' reset objects for next use
Set objPing = Nothing
Set objgroup = Nothing
Set Users = Nothing
Set objTrans = Nothing
Set objUser = Nothing
set objWMIService = Nothing
Set objgroup = Nothing
set ObjAdminGroup = Nothing
Set ObjAdminGroupMember = Nothing
Function enterComputername(StrTest)
ComputerName = InputBox("Enter the name of the computer you wish to query","Who Is on",strTest)
If ComputerName = vbNullString Then
wscript.quit
Else
If ComputerName = "Enter the computername here" or ComputerName = "Please enter a value here" Then
ComputerName=enterComputername("Please enter a value here")
end If
End If
enterComputername=ComputerName
End Function
Function OctetToHexStr(var_octet)
'Changes binary Octects into Hex values, works fine with english and german char sets
Dim n
OctetToHexStr = ""
For n = 1 To lenb(var_octet)
OctetToHexStr = OctetToHexStr & Right("0" & hex(ascb(midb(var_octet, n, 1))), 2)
Next
End Function
Comments