SHARE
TWEET

Untitled

a guest Jun 8th, 2017 89 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. '#==============================================================================
  2. '#==============================================================================
  3. '#  SCRIPT.........:    CheckPasswords.vbs
  4. '#  AUTHOR.........:    Stuart Barrett
  5. '#  VERSION........:    1.0
  6. '#  CREATED........:    18/05/11
  7. '#  LICENSE........:    Freeware
  8. '#  REQUIREMENTS...:  
  9. '#
  10. '#  DESCRIPTION....:    Check all AD accounts on a set password.
  11. '#
  12. '#  NOTES..........:    This utility will test the password of each user within
  13. '#                      your organisation, to do this it will use a live login
  14. '#                      attempt, therefore there is a possibility that it could
  15. '#                      lock out some accounts by mistake.
  16. '#
  17. '#  CUSTOMIZE......:  
  18. '#==============================================================================
  19. '#  REVISED BY.....:  
  20. '#  EMAIL..........:  
  21. '#  REVISION DATE..:  
  22. '#  REVISION NOTES.:
  23. '#
  24. '#==============================================================================
  25. '#==============================================================================
  26.  
  27. On Error Resume Next
  28.  
  29. Const ADS_SECURE_AUTHENTICATION = &h0001
  30. Const ADS_CHASE_REFERRALS_ALWAYS = &h60
  31.  
  32. Set objShell = CreateObject("WScript.Shell")
  33. Set objFSO = CreateObject("Scripting.FileSystemObject")
  34.  
  35. 'strTemp = objShell.ExpandEnvironmentStrings("%TEMP%")
  36. strTemp = "c:\temp"
  37.  
  38. strPass = "12345678"
  39. advanced=1
  40.  
  41. If strPass = "" Then WScript.Quit
  42.  
  43. Set objNetwork = CreateObject("WScript.Network")
  44. strDomain = objNetwork.UserDomain
  45.  
  46. Set objRootDSE = GetObject("LDAP://RootDSE")
  47. strDNSDomain = objRootDSE.Get("defaultNamingContext")
  48.  
  49. Set objConnection = CreateObject("ADODB.Connection")
  50. objConnection.Open "Provider=ADsDSOObject;"
  51.  
  52. Set objCommand = CreateObject("ADODB.Command")
  53. objCommand.ActiveConnection = objConnection
  54.  
  55. Set objCommand.ActiveConnection = objConnection
  56. strBase = "<LDAP://" & strDNSDomain & ">"
  57.  
  58. strFilter = "(&(objectclass=user)(objectcategory=person))"
  59. strAttributes = "distinguishedName,sAMAccountName,displayName"
  60. strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
  61.  
  62. objCommand.CommandText = strQuery
  63. objCommand.Properties("Page Size") = 1000
  64. objCommand.Properties("Timeout") = 30
  65. objCommand.Properties("Cache Results") = False
  66.  
  67. Set objRecordset = objCommand.Execute
  68.  
  69. If (objRecordset.EOF = True) Then
  70.     MsgBox "Error", vbExclamation, "Password Checker"
  71.     WSxript.Quit
  72. End If
  73.  
  74. strPath = "LDAP://" & strDomain & "/" & strDNSDomain
  75. Set objDSO = GetObject("LDAP:")
  76.  
  77. Set objFile = objFSO.CreateTextFile(strTemp & "\PasswordCheck.csv", True)
  78.  
  79. If Err.Number <> 0 Then
  80.     MsgBox "There was an error accessing the " & strTemp & "\PasswordCheck.csv file." & _
  81.         vbCrLf & vbCrLf & "Please make sure you do not already have it open and then try again.", _
  82.         vbExclamation, "Password Check"
  83.     WScript.Quit
  84. End If
  85.  
  86. objFile.WriteLine strType & "Password Check"
  87. objFile.WriteLine ""
  88.  
  89. WScript.Echo strPass
  90. WScript.Echo "Username,Display Name,Password,ACCOUNTDISABLE"
  91.  
  92. Do Until objRecordSet.EOF
  93.     strUser = objRecordSet.Fields("sAMAccountName").Value
  94.     strName = objRecordSet.Fields("displayName").Value 
  95.    
  96.     strName = Replace(strName, ",", "")
  97.    
  98.     Set objUser = objDSO.OpenDSObject (strPath, strUser, strPass, ADS_SECURE_AUTHENTICATION OR ADS_CHASE_REFERRALS_ALWAYS)
  99.    
  100.     If Err.Number <> 0 Then
  101.         strUser = Replace(strUser, ",", "")
  102.         strCSV = strCSV & strUser & "," & strName & ",N/A" & vbCrLf
  103.         Else
  104.             if advanced=1 then
  105.                 WScript.Echo "======================"
  106.                 Set objUser = GetObject("LDAP://"& objRecordSet.Fields("distinguishedname").value)
  107.                 WScript.Echo "There are " & objRecordSet.PropertyCount & " properties"
  108.                
  109.                 strStatus = objUser.objectClass     'do not remove for properties
  110.                 intUAC = objUser.Get("userAccountControl")
  111.                 If intUAC AND 2 then
  112.                     strStatus = "Disabled"
  113.                 else
  114.                     strStatus = "Enabled"
  115.                 End If
  116.                 'WScript.Echo "There are " & objUser.PropertyCount & " properties"
  117.                 '--------------------
  118.                 sAttribList=""
  119.                 'Iterate through available user attributes
  120.                 For count = 0 to (objUser.PropertyCount-1)
  121.                     sAttribName = objUser.Item(CInt(count)).Name
  122.                     sAttribVal = objUser.Get(sAttribName)
  123.  
  124.                     If IsArray(sAttribVal) Then
  125.                         For Each sMultiVal in objUser.GetEx(sAttribName)
  126.                             sAttribList = sAttribList & sAttribName & Space(16-Len(sAttribName)) & ":: " & sMultiVal & vbCRLF
  127.                         Next
  128.                     Else
  129.                         sAttribList = sAttribList & sAttribName & Space(16-Len(sAttribName)) & ":  " & sAttribVal & vbCRLF
  130.                     End If
  131.                 Next
  132.  
  133.                 'WScript.Echo sAttribList
  134.             end if  'advanced
  135.             '---------------
  136.             i = i + 1
  137.             strUser = Replace(strUser, ",", "")
  138.             strCSV = strCSV & strUser & "," & strName & "," & strPass & vbCrLf
  139.             if strStatus = "Enabled" or 1 then
  140.                 WScript.Echo strUser & "," & strName & "," & strPass & "," & strStatus
  141.             End if
  142.     End If
  143.     Err.Clear
  144.  
  145.     objRecordSet.MoveNext
  146. Loop
  147.  
  148. objFile.WriteLine "Total Users Using '" & strPass & "': " & i
  149. objFile.WriteLine ""
  150. objFile.WriteLine "Username,Display Name,Password"
  151. objFile.WriteLine strCSV
  152.  
  153. objFile.Close
  154. Set objFile = Nothing
  155.  
  156. 'MsgBox "Password checking complete, the resulting file has been saved to " & strTemp & _
  157. '   "\PasswordCheck.csv", vbInformation, "Password Check"
  158.  
  159. 'objShell.Run strTemp & "\PasswordCheck.csv"
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top