I want help to create a registry path which will use a variable for logged in user SID. The path is like - HKEY_USERS\'%UserSID%'\Software\Microsoft\Office\16.0\Outlook
User SID should be picked for whoever user is currently logged in on the system.
I don't know how to create this variable?
I want to use this variable in my script array.
KEY_PATHS = Array("HKEY_USERS\S-1-5-21-4054882774-118064744-2143271696-500\Software\Microsoft\Office\16.0\Outlook", _
"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList\S-1-5-21-2660683129-3636505375-3381148637-65620")
DEBUG_PRINTING = False
MASTER_EXECUTION
Sub MASTER_EXECUTION()
' WMI Class Management
MAINTAIN_WMI_CLASS()
' Registry Key Storage
For Each KEY_PATH In KEY_PATHS
STORE_KEYS(KEY_PATH)
Next
If Err.Number <> 0 Then
EVENT_WRITER "ERROR","Storing Registry Keys Failed " & Err.Number & " | " & Err.Description
Else
EVENT_WRITER "INFO", "Storing Registry Keys Completed Successfully"
End If
End Sub
Function CONVERT_HIVE(HIVE)
' Check and return a system name based on a friendly name
If UCase(HIVE) = "HKEY_LOCAL_MACHINE" Then
CONVERT_HIVE = &H80000002
ElseIf UCase(HIVE) = "HKEY_USERS" Then
CONVERT_HIVE = &H80000002
ElseIf UCase(HIVE) = "HKEY_CURRENT_CONFIG" Then
CONVERT_HIVE = &H80000005
Else
EVENT_WRITER "ERROR","Converting Hive " & HIVE & " failed - " & Err.Number & " | " & Err.Description
WScript.Quit
End If
End Function
I got my answer in one of Microsoft thread:
Below VB code will fetch logged in user sid and and we can use that variable for our purpose:
vbs code in image
'And the variable path i was looking for will be like
KEY_PATHS = Array("HKEY_USERS\" & Sid & "\Software\Microsoft\Office\16.0\Outlook\PST")
Related
With the examples in here, I have created a vbscript which uses WMI registry object to enumerate the sub-keys on the registry key "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components". The vbscript runs fine and produces the result I need when I test it using WScript.
When I embedded the vbscript into in installer as a custom action, the EnumKey call returns error wbemErrNotFound(2). However, it could return successful result if I enumerate some other keys. Is it permission issue? I have tried running the installer in elevated privilege. How do I get it working with the installer?
For demonstrating the problem, below is a cut down version of the vbscript I am using:
Const HKEY_LOCAL_MACHINE = &H80000002
Const KEY_ENUMERATE_SUB_KEYS = &H00000008
Function CountSubKeys(nHiveRoot, sKeyPath)
Const sComputer = "." ' Use . for current machine
Dim nRet
Dim nSum
MsgBox "EnumKey: " & sKeyPath, vbOkOnly, "CountSubKeys"
' Set oReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & sComputer & "/root/default:StdRegProv" )
Set oReg = GetObject( "winmgmts:{impersonationLevel=impersonate}!//" & sComputer & "/root/cimv2:StdRegProv" )
Dim bGranted
nRet = oReg.CheckAccess(nHiveRoot, sKeyPath, KEY_ENUMERATE_SUB_KEYS, bGranted)
If (nRet = 0) Then
If bGranted = True Then
MsgBox "Access to key: " & sKeyPath & " is granted", vbOkOnly, "CountSubKeys"
Else
MsgBox "Access to key: " & sKeyPath & " is denied", vbOkOnly, "CountSubKeys"
End If
Else
MsgBox "Failed to check key access: " & sKeyPath & ", nRet: " & nRet, vbOkOnly, "CountSubKeys"
End If
nRet = oReg.EnumKey(nHiveRoot, sKeyPath, arrSubKeys)
If (nRet = 0) Then
If isArray(arrSubKeys) Then
nSum = UBound(arrSubKeys) + 1
MsgBox "Number of sub keys: " & nSum, vbOkOnly, "CountSubKeys"
Else
MsgBox "EnumKey return no sub key on path" & sKeyPath, vbOkOnly, "CountSubKeys"
nSum = 0
End If
Else
MsgBox "Failed to enum key: " & sKeyPath & ", Err: " & nRet, vbOkOnly, "CountSubKeys"
nSum = -1
End If
CountSubKeys = nSum
End Function
Sub TestEnumKey()
Const sInstalledComponentKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\"
nCount = CountSubKeys(HKEY_LOCAL_MACHINE, sInstalledComponentKey)
MsgBox "nCount: " & nCount, vbOkOnly, "TestEnumKey"
End Sub
TestEnumKey()
The custom action uses the Sub TestEnumKey() as the entry point of the vbscrpt.
The error is not caused by permission of the registry key. It is due to the accessing of 64-bits registry on a 32-bits scripting host.
When I tested the vbscript using WScript, it is by default using the 64-bits scripting host and accessing the 64-bits registry by default and successfully enumerate the subkeys.
My installer is an 32-bits msi and therefore its custom action invokes 32-bits scripting host, which accesses the 32-bits registry by default, and of course cannot find the 64-bit registry key.
my problem is:
when i run my user creation script at my server, it works fine, a user gets created and has a membership (according to a .txt file)
when i run that same script outside of my server, the user gets created but doesnt have memberships
when i run that same script as admin outside of my server, the user gets created but doesnt have memberships
so this is the relevant code that adds memberships:
Dim fso, f, Row, Field
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile ("\\some\folder\user.txt",1,0)
Do while not f.AtEndOfLine
Row = f.readLine
Field = split(Row,",")
Username = Field(0)
Group = Field(1)
Lastname = Field(2)
Password = Field(3)
ScriptP = Field(4)
Project = Field(5)
Call UserCreation(Username,Group,Lastname,Password,ScriptP)
Loop
f.Close
Wscript.Quit(0)
Sub UserCreation (Username,Group,Lastname,Password,ScriptP)
Dim ouo, b
Set ouo = GetObject("LDAP://OU=abcOU,DC=my,DC=domain")
Set b = ouo.Create("user", "CN=" & Group & " " & Lastname)
Dim WshShell, ret
Set WshShell = WScript.CreateObject("WScript.Shell")
b.Put "sAMAccountName", Username
b.Put "userPrincipalName", Username & "#my.domain"
b.Put "scriptPath", ScriptP
b.SetInfo
b.SetPassword Password
b.AccountDisabled = False
b.SetInfo
cmdbegin = "cmd /C dsmod group"
CN = "CN=TN_" & Project & ",OU=projectOU,DC=my,DC=domain"
oudc = "OU=abcOU,DC=my,DC=domain"
cmdmid = "-addmbr"
grpadd = cmdbegin & " " & AddQuotes(CN) & " " & cmdmid & " " & AddQuotes("CN=" & Group & " " & Lastname & "," & oudc) & " >>\\some\folder\log.txt"
WshShell.Run grpadd
that log.txt just adds a row like this at completion:
dsmod was successful:CN=TN_Test,OU=projectOU,DC=my,DC=domain
The root of the problem is likely that dsmod is not installed on the computer you're running this from, since the documentation says that it is only installed by default on domain controllers. That can be confirmed by just running dsmod from the command line.
But that also seems like the hard way to do it. You can replace everything from the cmdbegin line to the end with this:
Set group = GetObject("LDAP://CN=TN_" & Project & ",OU=projectOU,DC=my,DC=domain")
group.Add(b.aDSPath)
The group variable will be a IADsGroup object, so you can use its Add method to add the user.
I'm writing a VBScript that will simply check each user in AD if their password has been changed within a given number of days. When I was trying to get it working for a single user, I came up with the following working code:
Option Explicit
Dim objUser, strLDAPConnection, intPwdExpLimit
strLDAPConnection = "CN=Test User,OU=Test,OU=Employees,DC=domain,DC=com"
intPwdExpLimit = 90
Set objUser = GetObject("LDAP://" + strLDAPConnection)
WScript.Echo DaysSincePwdChange(objUser)
Function DaysSincePwdChange(objUserAccount)
DaysSincePwdChange = dateDiff("d", objUserAccount.PasswordLastChanged, Now)
End Function
So then I tried to get it to work by looping through all users in a Test OU with the following code:
Option Explicit
Const strOffice = "Test"
Dim objEmployeesOU, objUser, intPwdExpLimit
intPwdExpLimit = 90
Set objEmployeesOU = GetObject("LDAP://OU=" & strOffice & _
",OU=Employees,DC=domain,DC=com")
For Each objUser In objEmployeesOU
If objUser.class = "user" Then
If ((DaysSincePwdChange(objUser)) >= intPwdExpLimit) Then
MsgBox(objUser & ": Password Expired.")
Else
MsgBox(objUser & ": Password Current.")
End If
End If
Next
Function DaysSincePwdChange(objUserAccount)
DaysSincePwdChange = dateDiff("d", objUserAccount.PasswordLastChanged, Now)
End Function
The above code produces a 0x8000500D error and googling the error says that it can't find the property in the cache (referring to the PasswordLastSet property, see error description link here).
Any ideas why the first block of code works fine but the second has a problem accessing that property?
Error code 0x8000500d means E_ADS_PROPERTY_NOT_FOUND. The password of the user has never been changed, so the property is not set. You could handle the condition like this:
Function DaysSincePwdChange(objUserAccount)
On Error Resume Next
DaysSincePwdChange = dateDiff("d", objUserAccount.PasswordLastChanged, Now)
If Err Then
If Err.Number = &h8000500d Then
DaysSincePwdChange = -1
Else
WScript.Echo "Unexpected Error (0x" & Hex(Err.Number) & "): " & _
Err.Description
WScript.Quit 1
End If
End If
End Function
and modify the check like this:
passwordAge = DaysSincePwdChange(objUser)
If passwordAge >= intPwdExpLimit) Then
MsgBox(objUser & ": Password Expired.")
ElseIf passwordAge = -1 Then
MsgBox(objUser & ": Password never changed.")
Else
MsgBox(objUser & ": Password Current.")
End If
While I'm working on SID conversion, I found the workable script with the VirsualSVN installed on the test machine, but the script was not working on the server. I saved file as test.vbs put on the desktop and use the following command to execute the code and produce the output as the text file: cscript test.vbs > c:\output.txt
On the test machine, I installed VisualSVN version 2.5.8 and root repositories is on C:\Repositories
While on the server, installed VisualSVN version 1.6.3 and root repositories is on E:\Repositories
From the script below, I'm lack in coding and no idea where should I modify the script to make it work on the server? I'm seeking your expert help on this.
'
' Print permissions in the form: user_name,path,level
'
strComputer = "."
Set wmi = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\VisualSVN")
Set win = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
' Return text representation for the Access Level
Function AccessLevelToText(level)
If level = 0 Then
AccessLevelToText = "No Access"
ElseIf level = 1 Then
AccessLevelToText = "Read Only"
ElseIf level = 2 Then
AccessLevelToText = "Read/Write"
Else
AccessLevelToText = "Unknown"
End If
End Function
' Return repository path for the object
Function GetPath(obj)
cname = assoc.Path_.Class
If cname = "VisualSVN_Service" Then
GetPath = "Repositories Root"
ElseIf cname = "VisualSVN_Repository" Then
GetPath = assoc.Name
ElseIf cname = "VisualSVN_RepositoryEntry" Then
GetPath = assoc.RepositoryName & ": " & assoc.Path
Else
GetPath = "Unknown"
End If
End Function
' Convert SID to user name
Function SidToUserName(sid)
Set account = win.Get("Win32_SID.SID='" & sid & "'")
user = account.AccountName
domain = account.ReferencedDomainName
SidToUserName = domain & "\" & user
End Function
' Iterate over all security descriptions
Set objs = wmi.ExecQuery("SELECT * FROM VisualSVN_SecurityDescriptor")
For Each obj In objs
Set assoc = wmi.Get(obj.AssociatedObject)
For Each perm in obj.Permissions
sid = perm.Account.SID
level = AccessLevelToText(perm.AccessLevel)
Wscript.Echo SidToUserName(sid) & "," & GetPath(assoc) & "," & level
Next
Next
Code reference from http://www.svnforum.org/threads/38790-Access-Rights-Reporting-in-Subversion-or-Viusal-SVN
0x8004100e means that the namespace (/root/VisualSVN) doesn't exist. Perhaps the version installed on the server is too old and doesn't create this namespace in WMI.
Following #Ansgar's answer.
VisualSVN Server versions older than 2.0 can't be managed via WMI.
I am trying to connect command prompt through VB script and further its connecting with Oracle enviroment to execute some reports of Oracle discoverer.
But the problem is with this VB script only.
line 2: for establishing the connection.
line 7:fetching the current REQUEST_ID.
line 16:XXDIS_EXPORT_CMD_V is a view and cmd is a column.which select a value like this for corresponding REQUEST_ID.
/CONNECT DISCADMIN:"FAI Financials Intelligence"/discbi#deverp /OPENDB "1 Scheduling" /SHEET "Sheet_1" /EXPORT HTML o27673334.out /LOGFILE l27673334.log /BATCH
In the end i want to execute this cmd using VBScript.
Error coming :
"In line 32 tkgoShell was not
recognized"
This is My code:
' Process job
Set objADO =CreateObject("ADODB.Connection")
objADO.Open "Driver={Microsoft ODBC for Oracle}; CONNECTSTRING=deverp; UID=apps; PWD=apps11i;"
MsgBox "Connection Established to Server.", vbExclamation + vbOKOnly, "System"
Do While True
' Check if there is a job to process
Set moRS=objADO.execute("SELECT apps.xxdis_schedule_pkg.start_job REQUEST_ID FROM dual")
moRS.MoveFirst
msRequest = moRS("REQUEST_ID")
'MsgBox msRequest,msRequest
' If no jobs then exit
' If msRequest = "0" Then
Exit Do
' End If
loop
Set moRS=objADO.execute("SELECT cmd EXPORT_CMD FROM apps.xxdis_export_cmd_v " & _
"WHERE request_id = " & msRequest)
MsgBox msRequest,msRequest
moRS.MoveFirst
msExpCmd = moRS("EXPORT_CMD")
' write command into a temporary file
msCmdFile = "r" & msRequest & ".cmd"
dim moOutputStream,filesys,msCommand
Set filesys = CreateObject("Scripting.FileSystemObject")
Set moOutputStream = filesys.CreateTextFile(msCmdFile, True)
' Substitute $SAMBA$ and $TNS$ locally configured variables
moOutputStream.Write Replace(Replace(msCmd, "$SAMBA$", gsOutDir),_
"$TNS$", gsInstance) & vbCRLF
moOutputStream.Close
' Call Discoverer to process the command
msCommand = gsBinDir & gsDiscoExe & " /EUL " & gsEUL & " /CMDFILE " & msCmdFile
Call tkgoShell.Run (msCommand, 1, true)
If I understand your code correctly I can't see anywhere where you're actually creating the tkgoShell.
Try inserting the following 2 rows before your last line:
Dim tkgoShell
Set tkgoShell = WScript.CreateObject ("WScript.Shell")
See here for more information about Shell.Run.