Looking how to create a vbscript to pull the maximum number of days a PSO policy has set. It comes back as a value of ... and I do not know how to get the real value that was set.
This is what I have so far:
Option Explicit
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Dim strFilePath, objFSO, objFile, adoConnection, adoCommand, objCDOConf
Dim objRootDSE, strDNSDomain, strFilter, strQuery, adoRecordset, objMaxPwdAge
Dim strDN, objShell, lngBiasKey, lngBias, blnPwdExpire, strDept, strAdd
Dim objDate, dtmPwdLastSet, lngFlag, k, address, objAdd, objMessage
' Check for required arguments.
If (Wscript.Arguments.Count < 1) Then
Wscript.Echo "Arguments <FileName> required. For example:" & vbCrLf _
& "cscript PwdLastChanged.vbs c:\MyFolder\UserList.txt"
Wscript.Quit(0)
End If
strFilePath = Wscript.Arguments(0)
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Open the file for write access.
On Error Resume Next
Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "File " & strFilePath & " cannot be opened"
Wscript.Quit(1)
End If
On Error GoTo 0
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
' Use ADO to search the domain for all users.
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOOBject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Determine the DNS domain from the RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
' Filter to retrieve all user objects.
strFilter = "(&(objectClass=msDS-PasswordSettings))"
' Filter to retrieve all computer objects.
strQuery = "<LDAP://CN=PSO-Information Systems,CN=Password Settings Container,CN=System,DC=yrmc,DC=org>;" _
& ";cn,msDS-LockoutDuration,msDS-MaximumPasswordAge,msDS-
PasswordSettingsPrecedence;subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
objFile.WriteLine adoRecordset.Fields("cn").Value
adoRecordset.MoveNext
Loop
adoRecordset.Close
I can get a value for cn and even msDS-PasswordSettingsPrecedence but not for msDS-MaximumPasswordAge. Any help would be appreciated.
This is at best a partial answer but I did some searching and I believe you will need one or more of the following:
DSGet/DSQuery
LDIFDE to manage PSO's.
Quest's "Free PowerShell Commands for Active Directory"
Using Quest's free tools, you might find this link handy
Put square brackets around our Active Directory attribute name:
See the blog post "How can I retrieve the value of an active directory attribute that has a hyphen in its name" for more.
you have to find UsersPSO location in your AD like that
domainLookupString = ""CN=UsersPSO,CN=Password Settings Container,CN=System,DC=COMPAY,DC=ORG";
then run the ldap query
ldapFilterString = "(&(objectClass=msDS-PasswordSettings))";
at the end, get the ldap attribute with the Maximum Password Age of the current PSO policy
"msDS-MaximumPasswordAge"
Related
The following script check local computers for inactive (90 days or more) accounts and disables them. The script works fine, but it lists all the disabled accounts every time is executed. I only need it to list the accounts that have been disabled the day is was executed.
Option Explicit
Dim objNetwork, strComputer, objComputer, objUser, dtmLast, objGroup, ObjGroupDict
Dim FSO, OutPutFile
Set FSO = CreateObject("Scripting.FileSystemObject")
'1 = reading, 2 = writing, and 8 = appending. The third parameter is a
'boolean true means a new file can be created if it doesn't exist. False
'means a new file cannot be created.
Set OutPutFile = FSO.OpenTextFile("C:\Test\Result.log", 8, True)
'Bind to the local computer.
Set objNetwork = CreateObject("WScript.Network")
strComputer = objNetwork.ComputerName
Set objComputer = GetObject("WinNT://" & strComputer & ",computer")
'Enumerate all users.
objComputer.Filter = Array("user")
For Each objUser In objComputer
Set ObjGroupDict = CreateMemberOfObject(objUser)
If ((Left(objUser.Name,3) <> "au_") And (CBool(ObjGroupDict.Exists("Administrators") = False))) Then
'Trap error if user never logged in.
On Error Resume Next
dtmLast = objUser.lastLogin
If (Err.Number <> 0) Then
dtmLast = #1/1/1970#
End If
On Error GoTo 0
'Check if last logon was more than 90 days in the past.
If (DateDiff("d", dtmLast, Now()) > 90) Then
'Disable the user.
objUser.AccountDisabled = True
objUser.SetInfo
OutPutFile.WriteLine(Now & " " & strComputer & " " & Wscript.ScriptName & " " & objUser.Name & " " & "Disabled")
'MsgBox objUser.Name
Set FSO = Nothing
End If
End If
Next
Function CreateMemberOfObject(objUser)
'Given a domain name and username, returns a Dictionary
'object of groups to which the user is a member of.
'Inputs: objUser - User Object
Set CreateMemberOfObject = CreateObject("Scripting.Dictionary")
CreateMemberOfObject.CompareMode = vbTextCompare
Dim objGroup
For Each objGroup In objUser.Groups
CreateMemberOfObject.Add objGroup.Name, "-"
Next
End Function
You're disabling all accounts whose last login was more than 90 days ago, even if the account already is disabled. Add a condition that matches only accounts that are not disabled, and the code will do what you want:
If DateDiff("d", dtmLast, Now) > 90 And Not objUser.AccountDisabled Then
...
End If
I am using the below VBscript to change group type of couple of groups to Security. I am getting an error "The server is unwilling to process the request" when executing objGroup.setinfo.
Appreciate if someone can help to resolve this.
Dim strOU, strGroup, objOU, objGroup
Dim strFile, objFile, objFSO
Const ADS_GROUP_TYPE_SECURITY_ENABLED = &H80000000
Const ForReading = 1
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
Const ADS_GROUP_TYPE_UNIVERSAL = &H8
strFile = "c:\Temp\GroupNames.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFile, ForReading)
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
strNetBIOSDomain = Left(strNetBIOSDomain, _
Len(strNetBIOSDomain) - 1)
Do Until objFile.AtEndOfStream
strNTName = Trim(objFile.ReadLine)
If (strNTName <> "") Then
On Error Resume Next
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain & "\" & strNTName
End If
' Use Get method to retrieve Distinguished Name.
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
wscript.echo strUSerDN
' Bind to user object in AD.
Set objGroup = GetObject("LDAP://servername
" & strUserDN)
objGroup.Put "groupType", ADS_GROUP_TYPE_SECURITY_ENABLED
objGroup.SetInfo
Loop
objFile.Close
You need to specify the group scope as well. Instead of just "ADS_GROUP_TYPE_SECURITY_ENABLED", you need "ADS_GROUP_TYPE_[type]_GROUP Or ADS_GROUP_TYPE_SECURITY_ENABLED", where [type] is GLOBAL, LOCAL, or UNIVERSAL.
I have my script to search by displayname and return the userid, which works fine.
but when I encounter a displayname that has 2 entries in AD i.e.
pavle stojanovic - he is from company 1
pavle stojanovic - he is from company 2
the userid doesnt get displayed because the script doesnt know what to do ?
how do i over come this ? if I get a return of 2 or more I'd like to say in the output hey i found the same name twice etc.. here are the userids and companies for both.
If you want to see the script its below...
strFile = objFSO.GetParentFolderName(Wscript.ScriptFullName) & "\users.xls"
Set objWorkbook = objExcel.Workbooks.Open(strFile)
objWorkbook.Activate
objExcel.Visible = False
intRow = 2 ' starts reading file at line 2
' this part runs a loop through the excel file reading each userid and getting data requested.
' ---------------------------------------------------------------------------------------------
Do Until objExcel.Cells(intRow,1).Value = ""
ExcelRow = objExcel.Cells(intRow, 1)
Call GetOU ' calling sub to search
intRow = intRow + 1
Loop
' This section just formats the excel file to widen the columns
' --------------------------------------------------------------
Set objRange = objExcel.Range("A1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
Set objRange = objExcel.Range("B1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
Set objRange = objExcel.Range("C1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
Set objRange = objExcel.Range("D1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
objExcel.ActiveWorkbook.Save
objExcel.Quit
' Sub to get Details for user
' ----------------------------
Sub GetOU
On Error Resume Next
Set objRootDSE = GetObject("LDAP://RootDSE")
strDomain = objRootDSE.Get("DefaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Size Limit") = 100000
objCommand.Properties("Searchscope") = 2
objCommand.CommandText = "SELECT distinguishedName FROM 'LDAP://" & _
strDomain & _
"' WHERE objectCategory='User' AND DisplayName = '" & _
ExcelRow & "'"
Set objRecordSet = objCommand.Execute
If Not objRecordSet.EOF Then
strDN = objRecordSet.Fields("distinguishedName").Value
' ###########################################################
' ###########################################################
' This is where the script does 'its thing' ...
' gets what you want.
' ------------------------------------------------
Set MyUser = GetObject ("LDAP://" & strDN)
objExcel.Cells(intRow, 3).Value = UCASE(MyUser.SamAccountName)
' ###########################################################
' ###########################################################
Else
Wscript.Echo "User Not Found: " & ExcelRow
End If
Err.Clear
End Sub
If multiple accounts are found, the Record Set will have multiple records and you'll need to loop through it. Your code currently only gets the first item in the Record Set.
Change If Not objRecordSet.EOF Then to Do While Not objRecordSet.EOF
Then
strDN = objRecordSet.Fields("distinguishedName").Value
' ###########################################################
' ###########################################################
Set MyUser = GetObject ("LDAP://" & strDN)
When inserting the users into the spreadsheet, you'll want to control the placement of the cell dynamically so the same cell isn't written over at each loop.
objExcel.Cells(intRow, 3).Value = UCASE(MyUser.SamAccountName)
At the end of processing this user, you'll use this to move to the next object (user) in the Record Set
objRecordSet.MoveNext
Then instead of End If, you'll use Loop
EDIT:
Also, instead of connecting to the object using Set MyUser = GetObject(etc), could you just use "SELECT sAMAccountName FROM... in your query then strsAMAccountName = objRecordSet.Fields("sAMAccountName") to save some memory/time?
Edit2:
I am doing this in my script.
If objRecordSet.RecordCount = 0 Then
'Things to do if not found
Exit Sub 'Then exit before entering loop
End If
Also, if the user isn't found then objRecordSet.EOF will equal True.
I'm trying to write a vb script that prompts a user for a schema attribute which I'll call bID and checks that the person with that bID is in active directory. I really have no idea how to get started, there are plenty of examples on how to query active directory users but I havent found a good one regarding checking against specific attributes. Any help/suggestions are greatly appreciated!
UPDATE:
ok heres my code so far, doesnt error out and returns 0, but I dont get a wscript.echo of the distinguished name for some reason. I included a few debugging wscript.echo's and it seems to never get into the while loop. Any ideas?
Option Explicit
GetUsers "CN=users,DC=example,DC=example,DC=example,DC=com","123456"
Function GetUsers(domainNc, ID)
Dim cnxn
Set cnxn = WScript.CreateObject("ADODB.Connection")
cnxn.Provider = "ADsDSOObject"
cnxn.Open "Active Directory Provider"
Dim cmd
Set cmd = WScript.CreateObject("ADODB.Command")
cmd.ActiveConnection = cnxn
cmd.CommandText = "<LDAP://" & domainNc & ">;(&(objectCategory=user)(objectClass=user) (employeeNumber=" & ID & "));distinguishedName;subtree"
WScript.Echo cmd.CommandText
cmd.Properties("Page Size") = 100
cmd.Properties("Timeout") = 30
cmd.Properties("Cache Results") = False
WScript.Echo "setting cmd.properties"
Dim rs
Set rs = cmd.Execute
WScript.Echo "rs object set"
While Not rs.eof
On Error Resume Next
WScript.Echo "while loop start"
Wscript.Echo rs.fields("distinguishedName".Value)
rs.MoveNext
If (Err.Number <> 0) Then
WScript.Echo vbCrLf& "Error # "& CStr(Err.Number)& " "& Err.Description
Else
On Error GoTo 0
End If
Wend
WScript.Echo "while loop end"
rs.close
WScript.Echo "rs object closed"
cnxn.Close
Set rs = Nothing
Set cmd = Nothing
Set cnxn = Nothing
End Function
Here's some vbscript that will find all users with bID=FooVal and write their DN out
Function GetUsers(domainNc, bIdVal)
Dim cnxn
Set cnxn = WScript.CreateObject("ADODB.Connection")
cnxn.Provider = "ADsDSOObject"
cnxn.Open "Active Directory Provider"
Dim cmd
Set cmd = WScript.CreateObject("ADODB.Command")
cmd.ActiveConnection = cnxn
cmd.CommandText = "<LDAP://" & domainNc & ">;(&(objectCass=user)(objectCategory=person)(bid=" & bidVal & "));distinguishedName;subtree"
cmd.Properties("Page Size") = 100
cmd.Properties("Timeout") = 30
cmd.Properties("Cache Results") = False
Dim rs
Set rs = cmd.Execute
While Not rs.eof
Wscript.Echo rs.fields("distinguishedName").Value
rs.MoveNext
Wend
rs.close
cnxn.Close
Set rs = Nothing
Set cmd = Nothing
Set cnxn = Nothing
End Function
I have this VBScript which runs however, while it is processing, it will randomly stop and require a user to hit the spacebar for it to display the rest of its ongoing output.
How do I figure out why this is happening?
Here is a copy of the script:
'On Error Resume Next
Dim arrFolders()
intSize = 0
Function StampNow()
Dim Hr, Mn, Yr, Mon, Dy, Date1
Date1=Now()
Hr=DatePart("h",Date1)
Mn=DatePart("n",Date1)
Yr = DatePart("yyyy",Date1)
Mon = DatePart("m",Date1)
Dy = DatePart("d",Date1)
StampNow = Yr & "-" & Mon & "-" & Dy
end function
'Output log info.
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objFile,objFolder,objTextFile,objFSO
strDirectory = "c:\log"
strFile = "\dpadmin_copy2run-"& StampNow & ".bat"
'strText = "dpadmin_copy2"
strText = strToAdd
' Create the File System Object.
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists.
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript.
objTextFile.WriteLine(strText)
objTextFile.Close
End Function
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
strFolderName = "D:\1\production\Openjobs"
Set colSubfolders = objWMIService.ExecQuery _
("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
& "Where AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
dim diffindates
'Init vars for regex.
Dim retVal, retVal2
Dim Lastprop
Dim objRegExpr 'regex variable
Set objRegExpr = New regexp
Set objRegExprX31 = New regexp
objRegExpr.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9][A-Z][A-Z][A-Z]"
objRegExprX31.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9]X31"
objRegExpr.Global = True
objRegExprX31.Global = True
objRegExpr.IgnoreCase = True
objRegExprX31.IgnoreCase = True
'Variables for getting last accessed property.
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
'Current time vars.
Dim currenttime
currenttime = Now()
ParentFolder = "D:\1\Production\Openjobs\ClosedJobs"
For Each objFolder in colSubfolders
intSize = intSize + 1
retVal = objRegExpr.Test(objFolder.Name)
retVal2 = objRegExprX31.Test(objFolder.Name)
if (retVal OR retVal2 ) then
'set filename to array
strFolderName = objFolder.Name
'Get last modified date.
Set f = fs.GetFolder(objFolder.Name)
Lastprop = f.DateLastModified
'MsgBox(Lastprop)
if ( DateDiff("m", f.DateLastModified, Now()) > 4) then
diffindates = DateDiff("m", f.DateLastModified, Now())
Set objShell = CreateObject("Shell.Application")
Set objCopyFolder = objShell.NameSpace(ParentFolder)
OutputToLog("rem " & f.DateLastModified & ":" & objFolder.Name )
outputtolog("move /Y """ & objFolder.Name & """ " & ParentFolder)
wscript.echo(diffindates & ":" & objFolder.Name & vbCr)
end if
end if
Next
Update
It stops at the line:
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
with the error Microsoft VBScript runtime error: Permission denied
I'm a little confusd by this. The logfile was only 356kb
I was able to run your script several times without it pausing for input. Run your script with the //X flag to start it in the debugger:
>cscript //nologo //X dpadmin_copy2.vbs"
You should be able to then step through the code.
You can also start putting in wscript.echo trace statements everywhere and see if you can narrow down what it's waiting on.
One thing that's gotten me in the past; If your command console is in QuickEdit mode and you accidentally click anywhere in the console window, the console will hang while it waits for you to press a key.
Well the first step is to remove any global On Error Resume Next statements. Better feedback would come if we could see the script.
You usually get an Permission denied when trying to write to a text file when the text file already has an open handle from some other process or because you have previously opened a handle earlier in you code which you have not closed. I haven't tried this but I don't know why this wouldn't work, you can look at using Handle from Sysinternals (Microsoft) to tell you what process has the open handle for the file. Please see here for a further reference of how to use Handle: http://www.orcsweb.com/blog/post/Closing-open-file-handles.aspx You could also write a second script which runs in a loop to monitor the main script. The second script can verify the first script by doing a WMI Process query which returns only processes that match a defined command line. The second script could then restart the main it stops, alert you, log a file, launch a handle search, etc.