CVS download of AD user info

[drobertson]

Add the following action to user asset pages:

{actionpath}CSV_download.vbs "{username}"

And then this is the content of CSV_download.vbs

uName = WScript.Arguments(0)

Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRootLDAP = GetObject("LDAP://RootDSE")

'Define Constant and declare variables
Const ADS_UF_ACCOUNTDISABLE = &H02
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_LOCKOUT = &H10
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const SEC_IN_DAY = 86400
acctdisable = "Enabled"
acctlocked = "Not Locked"

'Setup ADODB connection
clicked = 1
Set con = CreateObject("ADODB.Connection")
If clicked = 1 Then
objShell.SendKeys "{ENTER}"
clicked = 0
End If

Set com = CreateObject("ADODB.Command")
dcName = objRootLDAP.Get("DefaultNamingContext")
DomainN = Replace(Replace(dcName,",DC=","."),"DC=","")
    
    con.Provider = "ADsDSOObject"
    con.Open "Active Directory Provider"
    Set com.ActiveConnection = con
    com.Properties("Searchscope") = 2
    com.CommandText = "select sAMAccountName,distinguishedName,givenName,sn,UserAccountControl,CN,l,mail,Department,telephoneNumber,Title,manager,adspath,employeeid,memberof,primaryGroupId from 'LDAP://" & dcName & "' WHERE samAccountName  = '" & uName & "' and objectclass = 'USER'"
	Set rs = com.Execute

	com.CommandText = "<LDAP://" & dcName & ">" & ";(&(objectClass=user)(mail=*)(samaccountname=" & uName & "))" & ";distinguishedName,displayName,mail,proxyAddresses;subtree"
    Set objRecordSet = com.Execute

'get proxy emails
      While Not objRecordSet.EOF 'Iterate through the search results
            strUserDN = objRecordSet.Fields("distinguishedName")     'Get User's distinguished name from Recordset into a string
            set objUser= GetObject("LDAP://"& strUserDN & "")         'Use string to bind to user object
            
                       strResult = strResult & objUser.mail & "; "
                       arrProxyAddresses = objRecordSet.Fields("proxyAddresses")
                       If IsArray(objRecordSet.Fields("proxyAddresses")) Then
                          For Each ProxyAddress in arrProxyAddresses
                          	proxy_parts = Split(ProxyAddress,":")
                          	If InStr(objUser.mail, proxy_parts(1)) Then
                          	' skip since mail email is also a proxy
                          	Else
                          	If InStr(proxy_parts(1), "@") Then
                             'Sub: Check X400
                             If InStr(ProxyAddress, "x400") Then 
                             'Sub: Check X500
                        	 ElseIf InStr(ProxyAddress, "x500") Then
                     		 Else
                             strResult = strResult & proxy_parts(1) & "; "
                             AddressCount = AddressCount + 1
                             End If   'Ends loop for X400 address
                             Else
                             ' not an email address
                             End If 'Ends loop for InStr(proxy_parts(1), "@") 
                            End If 'Ends loop for InStr(objUser.mail, proxy_parts(1))
                          Next
                              Else
                                  strResult = strResult &  "#Object does not have proxy addresses"
                          End If
                              strResult = strResult
            
     objRecordSet.MoveNext 
Wend  'End while loop second query for users

If Len(strResult) > 0 Then
' remove whitespace
strResult = Trim(strResult)
' remove last character 
strResult = Left(strResult, Len(strResult) - 1)
End If
proxyemail = strResult

' get sid
On Error Resume Next
Set WMIUser = GetObject("winmgmts:{impersonationlevel=impersonate}!" & "/root/cimv2:Win32_UserAccount.Domain='" & Split(DomainN,".")(0) & "'" & ",Name='" & rs("sAMAccountName") & "'")
  If Err.Number = 0 Then
    sid_result = WMIUser.SID
  Else
    sid_result = ""
  End If
  On Error GoTo 0
  
' get lastlogon
Set objUser=GetObject(rs("adspath"))
Set objLogon=objUser.Get("lastlogon")
intLogonTime = objLogon.HighPart * (2^32) + objLogon.LowPart
LastLogon = Integer8Date(intLogonTime, lngBias)

  		u_proxyemails = proxyemail
  		u_sid = sid_result
        u_adspath = rs("adspath")
        u_primaryGroupId = rs("primaryGroupId")
        u_memberof = GetMemberOf(uName)
		u_sAMAccountName = rs("sAMAccountName")
		u_distinguishedName = rs("distinguishedName")
		u_givenName = rs("givenName")
		u_sn = rs("sn")
		u_UserAccountControl = rs("UserAccountControl")
		u_CN = rs("CN")
		u_l = rs("l")
		u_mail = rs("mail")
		u_Department = rs("Department")
		u_telephoneNumber = rs("telephoneNumber")
		u_Title = rs("Title")
		u_manager = rs("manager")
		u_employeeid = rs("employeeid")
		u_sidhistory = GetUserSidHistory(uName)
		u_lastLogon = LastLogon

	intFlag = u_UserAccountControl
	lngFlag = u_UserAccountControl
	
	Set objUser = GetObject("LDAP://" & u_distinguishedName & "")
	intUAC = u_UserAccountControl
	    dtmValue = objUser.PasswordLastChanged
		intTimeInterval = int(Now - dtmValue)
			
		Set objDomainNT = GetObject("WinNT://" & DomainN)
		ntMaxPwdAge = objDomainNT.Get("MaxPasswordAge")
		intMaxPwdAge = (ntMaxPwdAge/SEC_IN_DAY)

	If intFlag And ADS_UF_DONT_EXPIRE_PASSWD Then
		PWEXP = "Never"
	Else
		PWEXP = (dtmValue + intMaxPwdAge)
	End If
		u_pwexpires = PWEXP
		
Call MakeCSV()



'*****************************************************************************************
'	FUNCTIONS
'*****************************************************************************************
Function GetMemberOf(strUserName)
dim temp,d,returnstr,objNetwork

Set d = CreateObject("Scripting.Dictionary")
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_1779 = 1
Const ADS_NAME_INITTYPE_SERVER = 2
Const ADS_NAME_INITTYPE_DOMAIN = 1

strUserDomain_tmp = DomainN
strUserDomain = Split(strUserDomain_tmp,".")(0)

Set objUser = GetObject("WinNT://" & strUserDomain & "/" & strUserName & ",user")
strGroupList = ""

For Each objGroup In objUser.Groups
strGroupName=objGroup.Name
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_DOMAIN, strUserDomain
	strNTName = strUserDomain & "\" & strGroupName
       objTrans.Set ADS_NAME_TYPE_NT4, strNTName
        strGroupDN = objTrans.Get(ADS_NAME_TYPE_1779)
  ' Escape any forward slash characters, "/", with the backslash
  ' escape character. All other characters that should be escaped are.
       strGroupDN = Replace(strGroupDN, "/", "\/")

Set objGroup = GetObject("LDAP://" & strGroupDN)

        ' format OU path for display
        oupath = Mid(strGroupDN,Len(Trim(objGroup.CN))+5)
        oupath = Replace(oupath,"CN=","")
        oupath = Replace(oupath,"OU=","")
        oupath = Replace(oupath, ",DC=", "/",1,1)
        oupath = Replace(oupath, ",DC=", ".")

	returnstr = returnstr & objGroup.CN & " (" & oupath & "); "
    returnstr = returnstr & GetNested (objGroup)
Next


	GetMemberOf = returnstr
End Function

'*****************************************************************************************
Function GetNested(objGroup)
    On Error Resume Next
    colMembers = objGroup.GetEx("memberOf")
    For Each strMember in colMembers

        strPath = "LDAP://" & strMember
        Set objNestedGroup = GetObject(strPath)
        strGroupList =  objNestedGroup.CN
      if  strGroupList <> "" and temp <> strGroupList then
        temp=strGroupList
	   strGroupList=trim(strGroupList)
        d.add strGroupList
        
        ' format OU path for display
        oupath = Mid(strMember,Len(Trim(strGroupList))+5)
        oupath = Replace(oupath,"CN=","")
        oupath = Replace(oupath,"OU=","")
        oupath = Replace(oupath, ",DC=", "/",1,1)
        oupath = Replace(oupath, ",DC=", ".")
        
	returnstr = returnstr & strGroupList 	& " (" & oupath & "); "
     End If
         
        GetNested(objNestedGroup)
    Next
    GetNested = returnstr
End Function

'*****************************************************************************************

Function GetUserSidHistory(UsrName)
Dim tDomain,cmd,shell,executor,ps1result,regSidHist
tDomain = DomainN

	strResult = ""
	cmd = "powershell.exe -nologo -windowstyle hidden -command ""Get-AdUser -Server "& tDomain &" -Identity "& UsrName &" -Properties sidhistory"""
	Set shell = CreateObject("WScript.Shell")
	Set executor = shell.Exec(cmd)
	executor.StdIn.Close
	ps1result = executor.StdOut.ReadAll
	strResult = Trim(ps1result)
	' format result
	strResult = Split(strResult, "SIDHistory        :")(1)
	strResult = Split(strResult, "Surname           :")(0)
    Set shell = Nothing

	GetUserSidHistory = strResult	
End Function

'*****************************************************************************************
Function MakeCSV()
Const ForWriting = 2
dt=now
dt_format = ((year(dt)*100 + month(dt))*100 + day(dt))

' get user
sUserIDValue = uName
' format domain
strSubDomain = Split(DomainN,".")(0)
		
' get csv value data
sidhist = Trim(Replace(Replace(u_sidhistory,"}",";"),"{",""))
uMembersof = u_memberof
userSMTP = u_proxyemails
userSID = u_sid
userDept = u_Department
userTitle = u_Title
userEmail = u_mail
userFname = u_givenName
userLname = u_sn
userPWexpire = u_pwexpires


userLastLogon = u_lastLogon

' get desktop path of user
strDirectory = objShell.SpecialFolders("Desktop")
' Create new CSV file 
csvFilePath = strDirectory & "\" & dt_format & "-" & sUserIDValue & "-" & strSubDomain & ".csv"

If (objFSO.FileExists(csvFilePath)) Then
MsgBox "This file already exists: " & vbCrLf & csvFilePath,0,"Error"
Exit Function
Else
objFSO.CreateTextFile(csvFilePath)
Set objCSVFile = objFSO.OpenTextFile(csvFilePath,ForWriting,True)
End If


' Write comma delimited list of columns in new CSV file.
csvColumns = "Name,Department,Display Name,Email Address,All SMTP Addresses,Group Membership (All),Job Title,Last Logon Date,Password Expiration Date,SID,SID history,Username"
objCSVFile.Write csvColumns
objCSVFile.WriteLine

' Write values as comma-separated in new CSV file.
 'For i = 0 to 1 
 	'Name
    objCSVFile.Write chr(34) & userFname & " " & userLname & chr(34) & ","
    'Department
    objCSVFile.Write chr(34) & userDept & chr(34) & ","
    'Display Name
    objCSVFile.Write chr(34) & userLname & ", " & userFname & chr(34) & ","
    'Email Address
    objCSVFile.Write chr(34) & userEmail & chr(34) & ","
    'All SMTP Email Address
    objCSVFile.Write chr(34) & userSMTP & chr(34) & ","
    'Group membership
    objCSVFile.Write chr(34) & uMembersof & chr(34) & ","
    'Job title
    objCSVFile.Write chr(34) & userTitle & chr(34) & ","
    'Last logon date
    objCSVFile.Write chr(34) & userLastLogon & chr(34) & ","
    'logon DC
    'objCSVFile.Write chr(34) & strSubDomain & chr(34) & ","
    'Password exp date
    objCSVFile.Write chr(34) & userPWexpire & chr(34) & ","
    'SID
    objCSVFile.Write chr(34) & userSID & chr(34) & ","
    'SID History
    objCSVFile.Write chr(34) & sidhist & chr(34) & ","
    'Username
    objCSVFile.Write chr(34) & u_sAMAccountName & chr(34) & ""
    
    objCSVFile.Writeline
 'Next

If (objFSO.FileExists(csvFilePath)) Then
MsgBox "CSV Export completed. File saved to: " & vbCrLf & csvFilePath,0,"Success"
End If

End function

'*****************************************************************************************

Function Integer8Date(ByVal lngValue, ByVal lngBias)
    ' Function to convert Integer8 (64-bit) value to a date, adjusted for
    ' local time zone bias.
    Dim lngDate
    lngDate = #1/1/1601# + (lngValue/600000000 - lngBias)/1440
    ' Trap error if lngDate is ridiculously huge.
    On Error Resume Next
    Integer8Date = CDate(lngDate)
    If (Err.Number <> 0) Then
        On Error GoTo 0
        Integer8Date = #1/1/1601#
    End If
    On Error GoTo 0
    
End Function


'*****************************************************************************************