Find Users E-Mail via SID using VBScript and Active Directory - windows

I am parsing log messages about changes to user accounts on a windows system.
I want to notify the user about the changes so I need to retrieve their personal
information (First,Last, E-Mail) from Active Directory.
I already found a way to retrieve the username but that is only via WMI and not ADSI:
Function FindUser(Message)
Dim objWMIService
Dim strAccountRegex
Dim objRegex
Dim objMatch
Dim strComputer
Dim objUser
Dim objShell
strAccountRegex = "(\%\{[A-Z,0-9,\-]*\})"
strComputer = "."
Wscript.StdOut.writeLine "Querying WMI to retrieve user-data"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objShell = WScript.CreateObject("WScript.Shell")
Set objRegex = new RegExp
objRegex.Pattern= strAccountRegex
for each objMatch in objRegex.Execute(Message)
REM Wscript.StdOut.writeLine "Found an Account ID: " & objMatch.value
Dim strSID
strSID=NormalizeSID(objMatch.value)
REM Wscript.Echo "SID after escaping: " & strSID
Set objUser = objWMIService.Get _
("Win32_SID.SID='" & strSID & "'")
next
FindUser=objUser.ReferencedDomainName & "\" & objUser.AccountName
End Function
It works fine, but I would like to do it via Active Directory instead of going via WMI.
Can you help me?

OK. I found a way to do this via Active Directory.
For compeleteness here is the code:
REM Converts the SID into a from, that can be processed by WMI
Function NormalizeSid(strSidToNormalize)
Dim regEx,strReplace
strReplace=""
' Create regular expression.
Set regEx = New RegExp
regEx.Global = True
regEx.Pattern = "(%|{|})"
regEx.IgnoreCase = True
' Make replacement.
NormalizeSid = regEx.Replace(strSidToNormalize, strReplace)
End Function
REM Searches for a SID the in the Message that was passed as argument
REM SID returned will be of the form %{S-1-5-21-3968247570-3627839482-368725868-1110}
REM NOTE: Neither WMI nor ADSI will accept this. Use NormalizeSid like in FindUser
Function FindSidInMessage(Message)
Dim strAccountRegex
Dim objRegex
Dim objMatch
Dim strSID
strAccountRegex = "(\%\{S\-[,0-9,\-]*\})"
Set objRegex = new RegExp
objRegex.Pattern= strAccountRegex
for each objMatch in objRegex.Execute(Message)
REM Wscript.StdOut.writeLine "Found an Account ID: " & objMatch.value
strSID=objMatch.value
next
FindSidInMessage=strSID
End Function
REM Searches Directory for the User matching the SID passed as parameter
Function FindUser(userSID)
Dim normalizedSID
Dim objUser
normalizedSID=NormalizeSid(userSID)
Wscript.Echo "SID after escaping: " & normalizedSID
Wscript.StdOut.writeLine "Querying AD to retrieve user-data"
Set objUser = GetObject("LDAP://<SID="& normalizedSID & ">")
FindUser=objUser.EmailAddress
End Function
Hope this will be useful to others.

Related

VB6 'run-time error '424': Object Required' error

I am testing code before adding to an existing project. It ran perfectly when it looked like this:
Option Explicit
Dim objShell As Object
Dim m_EngineRun As Object
Sub main()
Set objShell = CreateObject("WScript.Shell")
Set m_EngineRun = objShell.Exec("notepad.exe")
Dim objWMIService As Object
Dim colProcessList As Object
MsgBox m_EngineRun.ProcessID
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where ProcessID = " & m_EngineRun.ProcessID)
If colProcessList.Count = 1 Then
objShell.run "TASKKILL /F /IM " & m_EngineRun.ProcessID, , True
MsgBox m_EngineRun.ProcessID & (" terminated")
Else
MsgBox m_EngineRun.ProcessID & (" does not exist")
End If
End Sub
Then I added the lines below and it fails with the 424 error.
Option Explicit
Dim objShell As Object
Dim m_EngineRun As Object
'Added this line
Dim m_PID As Object
Sub main()
Set objShell = CreateObject("WScript.Shell")
Set m_EngineRun = objShell.Exec("notepad.exe")
'And this line
Set m_PID = m_EngineRun.ProcessID
Dim objWMIService As Object
Dim colProcessList As Object
'And changed this one
MsgBox m_PID
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where ProcessID = " & m_EngineRun.ProcessID)
If colProcessList.Count = 1 Then
objShell.run "TASKKILL /F /IM " & m_EngineRun.ProcessID, , True
MsgBox m_EngineRun.ProcessID & (" terminated")
Else
MsgBox m_EngineRun.ProcessID & (" does not exist")
End If
End Sub
It is definitely the Set m_PID = m_EngineRun.ProcessID line that is the troublemaker.
I simply haven't been able to find an answer that pertains my specific issue. I feel like maybe m_PID shouldn't be an object? But if so, what should it be?
Any help is greatly appreciated.
ProcessID isn't an object; it's an integer (the numeric process ID).
Remove the As Object and Set, and just assign directly:
Dim m_PID
'....
m_PID = m_EngineRun.ProcessID
It's probably better to not presume that everything is an object, because the vast majority of things you'll encounter are probably not. I'd start with not expecting an object unless you know otherwise, and then move to trying object if you encounter issues.

Attempting to extract printers from users machine and then outputting to a text fill.

I am attempting to extract the printers from a users machine and then output to a text file but when I run the test I get a invalid procedure call or argument for this specific line of code.
Set objOutputFile = objFSO.OpenTextFile(outFile, ForAppending, True)
I have attempted to change OpenTextFileto CreateTextFile but I need the lines to appended to file as it will be running as a log on script.
I have done some research and used the Microsoft developer articles to help me debug the issue in the code but I don't have much experience in Visual Basic.
I have added the entire script to give context to the what is going on.
dim objComputerName, ObjNetwork , strText , objfile, StrComputer
dim wshnetwork
Set wshnetwork = CreateObject ("Wscript.network")
StrComputer = WshNetwork.ComputerName
If IsEmpty(StrComputer) Then Wscript.Quit
Set WshNetwork = CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = objWMIService.ExecQuery("Select * from Win32_Printer")
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
outFile = "C:\scripts\Printers" & StrComputer
Set objOutputFile = objFSO.OpenTextFile(outFile, ForAppending, True)
For Each objPrinter in colInstalledPrinters
strTest = Left(objPrinter.Name, 2)
objOutputFile.WriteLine(objPrinter.Name)
objfile.close
Next
Set objPrinter = WshNetwork.EnumPrinterConnections
'Set objOutputFile = objFSO.OpenTextFile (filOutput, ForAppending, True)
If objPrinter.Count = 0 Then
WScript.Echo "No Printers Mapped "
else
For intDrive = 0 To (objPrinter.Count -1) Step 2
intNetLetter = IntNetLetter +1
printer = "UNC Path " & objPrinter.Item(intDrive) & " = " & objPrinter.Item(intDrive +1) & " Printer : " & intDrive
objOutputFile.WriteLine(printer)
Next
end if
objOutputFile.Close``*
Invalid procedure call or argument
You passed an invalid parameter in your procedure call. This could be because the parameter was out of range, or contained invalid data. Alternately, you may have invoked a procedure at an unexpected time.
To correct this error
Verify that the parameters being passed to the procedure are valid.
Verify that you are calling the function at an appropriate time.
My guess is this line is an ilegal filename.
outFile = "C:\scripts\Printers" & StrComputer
On my computer this is c:\scripts\PrintersSerenity which is probably not right that your text file is called PrintersSerenity without an extension.

How can I pull the correct data from the HK Current User registry key instead of temp profile information

I am working on a script to pull the value in the key
HKCurrentUser\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Desktop
Currently all it is returning is:
C:\WINDOWS\system32\config\systemprofile\Desktop
When I want/think it should return:
%USERPROFILE%\Desktop
Below is the script that is pulling the infomration from the key and as far as I can tell it should be pulling the correct information. Just wondering if someone can enlighten me as to what I am missing. It also returns the computer name and the logged in username which both return correctly. This is going to be run on quite a few machines remotely.
'These are the constants for the following KEYS'
Const HKClassesRoot = &H80000000 'HKEY_CLASSES_ROOT
Const HKCurrentUser = &H80000001 'HKEY_CURRENT_USER
Const HKLocalMachine = &H80000002 'HKEY_LOCAL_MACHINE
Const HKUsers = &H80000003 'HKEY_USERS
Const HKCurrentConfig = &H80000005 'HKEY_CURRENT_CONFIG
'Setup objects to interact with here'
Set wshShell = WScript.CreateObject("Wscript.Shell")
strComputer = wshShell.ExpandEnvironmentStrings("%COMPUTERNAME%")
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
Set objNetwork = CreateObject("Wscript.Network")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Define variable to store the current user and then pull the current user
Dim currentUser
strCurrentUser = objNetwork.UserName
'find the data in the string we want to get the value from'
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\"
strValueName = "Desktop"
'pull the info and store it in strValue'
objRegistry.GetStringValue HKCurrentUser,strKeyPath,strValueName,strValue
'setup for output of data to the file'
Dim strSpacer
Dim strData
strSpace = "+-------------------------------------------------------------------------------------------------------------------------+"
strData = "| " & strComputer & " == " & strCurrentUser & " == " & strValue & " |"
Dim strFileName
strFileName = "\\server\share\" & strCurrentUser & ".txt"
Set objFile = objFSO.OpenTextFile(strFileName,8,true)
objFile.write vbCrLf & strSpace & vbCrLf
objFile.write strData & vbCrLf
objFile.write strSpace & vbCrLf
'Close file'
objFile.Close
After review I found the answer to my own question. I was reading the registry incorrectly for what I was doing.
strRegkey = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Desktop"
strDataValue = wshShell.RegRead(strRegKey)
this returns the value stored currently in the key.
I suspect that the environment variable %USERPROFILE% from the registry value gets expanded to the profile of the user running the WMI service (LOCAL SYSTEM). GetStringValue seems to behave the same as GetExpandedStringValue when reading REG_EXPAND_SZ values.

how to add a log to my vbscript

i have this script that reads a list of computers and check to see if the computers have the right software version install. the script echo to me the computers with the wrong version, but i want to make a log instead
Dim strComputer, objFSO, ObjShell, strDisplayName, objList, strObject
Dim objReg, arrSubKeys, strProduct, strVersion, strReqVersion
Const For_Writing = 2
Const ForReading = 1
const ForAppending = 3
Const HKLM = &H80000002
Const strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
strReqVersion = "8.2.1 MP2"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set objList = objFSO.OpenTextFile("c:\test\test.txt",ForReading)
Do While Not objList.AtEndOfStream
strComputer = objList.ReadLine
If HostOnline(strComputer) = True Then
Inventory(strComputer)
End If
Loop
Function Inventory(strComputer)
Set objTextFile = objFSO.OpenTextFile("c:\test\inventory.txt",2,true)
'creating a dictionary object
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
' Enumerate the subkeys of the Uninstall key
objReg.EnumKey HKLM, strKeyPath, arrSubKeys
For Each strProduct In arrSubKeys
' Get the product's display name
objReg.GetStringValue HKLM, strKeyPath & "\" & strProduct, "DisplayName", strDisplayName
' Process only products whose name contain 'symantec'
If InStr(1, strDisplayName, "Symantec", vbTextCompare) > 0 Then
' Get the product's display version
objReg.GetStringValue HKLM, strKeyPath & "\" & strProduct, "DisplayVersion", strVersion
If strReqVersion <> strVersion Then
WScript.Echo strObject
objDictionary.Add strComputer, strVersion
For Each strObject In objDictionary
WScript.Echo strObject
objTextFile.WriteLine(strObject)
Next
objTextFile.Close
End If
End If
Next
End Function
Function HostOnline(strComputername)
'---------- Test to see if host or url alive through ping -----------------
' Returns True if Host responds to ping
'
' strComputername is a hostname or IP
Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1
Dim objShell, objFSO, sTempFile, fFile
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
sTempFile = objFSO.GetSpecialFolder(2).ShortPath & "\" & objFSO.GetTempName
objShell.Run "cmd /c ping -n 2 -l 8 " & strComputername & ">" & sTempFile, 0 , True
Set fFile = objFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsASCII)
Select Case InStr(fFile.ReadAll, "TTL=")
Case 0
HostOnline = False
Case Else
HostOnline = True
End Select
ffile.close
objFSO.DeleteFile(sTempFile)
Set objFSO = Nothing
Set objShell = Nothing
End Function
can some one help me please thanks
There are several ways to do this. The simplest way, without any modification to your script, would be to call the script with cscript.exe (in a command prompt) and redirect the output to a file:
cscript your.vbs > output.log
However, if you want a log to be created even when users double-click your script you'll have to change your script so that it writes to a file instead of echoing the output. Open the log file at the beginning of the script:
Set myLog = objFSO.OpenTextFile("C:\my.log", For_Writing, True)
replace WScript.Echo ... with myLog.WriteLine ..., and close the file before you exit from the script:
myLog.Close
A somewhat more sophisticated approach would be to create a set of logging functions, which will allow you create log lines depending on certain conditions, e.g. LogInfo() for informational log messages and LogError() for errors.
Shameless plug: Some time ago I got fed up with writing the same boilerplate logging functions over and over again, so I wrote a logger class that encapsulates the usual logging facilities (interactive console, files, eventlog) and provides logging methods for 4 log levels (Error, Warning, Information, Debug). The class can be used for logging to a file like this:
Set myLog = New CLogger
myLog.LogToConsole = False
myLog.LogFile = "C:\my.log"
myLog.LogInfo "info message"
...
myLog.LogError "an error occurred"
The log file is automatically closed when the object is released.
Why not use the system's event log? I described how in this answer
It means most of the work is done for you and you don't need to worry about where to put your log file

Writing From HKEY_USERS

I am attempting to create an application that will allow me to input a username and switch that user's default printer by modifying the registry under HKEY_USERS\UserSID. I cannot seem write values to that section of the registry though. Perhaps it's a Windows limitation? Here's the code I have so far.
Dim strComputer = "."
Dim objWMIService As Object = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Dim theUsername As String = TextBox1.Text
Dim theDomain As String = TextBox2.Text
Dim objAccount As Object = objWMIService.Get("Win32_UserAccount.Name='" & theUsername & "',Domain='" & theDomain & "'")
Dim theport As RegistryKey
theport = Registry.CurrentUser.OpenSubKey("Software\\Microsoft\\Windows NT\\CurrentVersion\\Devices")
Dim val As Object = theport.GetValue(ListBox1.SelectedItem)
theport.Close()
Dim theSid As String = objAccount.sid
Dim theKey As RegistryKey = Registry.Users.OpenSubKey(theSid + "\\Software\\Microsoft\\Windows NT\\CurrentVersion\\Windows", True)
I don't think that there is some Windows limitation, because I wrote to HKEY_USERS\SIDs many times. But I used for this purpose the vbscript. Also I should warn you that you can only read&write to Users registry if they are logged. For not logged users - use the ActiveSetup.
There is my script on vbs which writes some registry to all logged users. Hope you could adapt it to VB.NET.
Option Explicit
Const HKEY_USERS = &H80000003
Dim objReg, objWMI, colSessions, objSession, colList, colUsers, objUser, Domain, UserName, objUserAccount, SID, WshShell
Set WshShell = CreateObject("WScript.Shell")
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colSessions = objWMI.ExecQuery("Select * from Win32_LogonSession Where LogonType = 2 Or LogonType = 10")
If colSessions.Count <> 0 Then
For Each objSession in colSessions
Set colUsers = objWMI.ExecQuery("Associators of " & "{Win32_LogonSession.LogonId=" & objSession.LogonId & "} " & "Where AssocClass=Win32_LoggedOnUser Role=Dependent" )
For Each objUser in colUsers
Domain = objUser.Domain : UserName = objUser.Name
Set objUserAccount = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2:Win32_UserAccount.Domain='" & Domain & "',Name='" & UserName & "'")
SID = objUserAccount.SID
objReg.CreateKey HKEY_USERS, SID & "\Control Panel\Desktop"
objReg.SetStringValue HKEY_USERS, SID & "\Control Panel\Desktop", "Example", "1"
objReg.SetDwordValue HKEY_USERS, SID & "\Control Panel\Desktop", "Example", "2"
Next
Next
End If

Resources