CA eTrust SSO user list

تطلب المشروع الذي أعمل به حاليا استخراج بيانات المستخدمين من قاعدة بيانات  CA eTrust SSO. لذلك قمت بكتابة الكود التالي الذي يقوم بعمل الاتصال عن طريق LDAP باستخدام ADO.

 option explicit  
 Call Main()  
 Private Sub Main()  
 Dim strPath  
 strPath = GetCurrentPath() & “eTrust_Report.csv”  
 Call WriteeTrustContentToLog(strPath)  
 Msgbox “Operation completed successfully !” & _  
 vbCrLf & _  
 strPath, _  
 vbOKOnly + vbInformation  
 End Sub  
 Private Sub WriteeTrustContentToLog(p_strPath)  
 Dim cn, sUser, sPassword, sServer, sDN, sRoot, cnarray, grparray, autharray, strContent, ts, fso, rs, cmd, o, args  
 Set fso = CreateObject(“Scripting.FileSystemObject”)  
 Set ts = fso.CreateTextFile(p_strPath, True, True)  
 args = Wscript.arguments.count  
 if args = 3 then  
 sServer = Wscript.arguments.item(0)  
 sUser = Wscript.arguments.item(1)  
 sPassword = Wscript.arguments.item(2)  
 else  
 wscript.echo “Syntax: etrust_Report SSO_Server UserID Password”  
 end if  
 sDN = “cn=” & sUser & “,o=PS”  
 sRoot = “LDAP://”& sServer &”:13389/o=PS”  
 Dim oDS: Set oDS = GetObject(“LDAP:”)  
 Dim oAuth: Set oAuth = oDS.OpenDSObject(sRoot, sDN, sPassword, &H0200)  
 Dim oConn: Set oConn = CreateObject(“ADODB.Connection”)  
 oConn.Provider = “ADSDSOObject”  
 oConn.Open “ADSDSOObject”, sDN, sPassword  
 Set rs = oConn.Execute(“<” & sRoot & “>;(objectClass=eTssouser);cn,eTssoAuthnMethod,eTssoMemberOf;subtree”)  
 If rs.RecordCount <> 0 Then  
 rs.MoveFirst  
 Do Until rs.EOF  
 cnarray = rs(0)  
 strContent = cnarray(0)  
 if not isEmpty(rs(1)) and not isnull(rs(1)) then  
 autharray = rs(1)  
 strContent = strContent & vbTab & autharray(0)  
 else  
 strContent = strContent & vbTab  
 end if  
 strContent = strContent & vbTab  
 if not isEmpty(rs(2)) and not isnull(rs(2)) then  
 for o = 0 to ubound(rs(2))  
 grparray = rs(2)  
 if o = 0 then  
 strContent = strContent & grparray(o)  
 else  
 strContent = strContent & “;” & grparray(o)  
 end if  
 next  
 end if  
 call ts.writeline(strContent)  
 rs.MoveNext  
 Loop  
 else  
 msgbox “empty”  
 end if  
 Call rs.Close()  
 Set rs = Nothing  
 Set cmd = Nothing  
 set grparray = Nothing  
 set autharray = Nothing  
 Set cn = Nothing  
 Call ts.Close()  
 Set ts = Nothing  
 Set fso = Nothing  
 End Sub  
 private Function GetCurrentPath()  
 Dim strCurrentPath  
 With WScript  
 strCurrentPath = Replace(.ScriptFullName, _  
 .ScriptName, _  
 vbNullString, _  
 vbTextCompare)  
 End With  
 If Right(strCurrentPath, 1) <> “\” Then  
 strCurrentPath = strCurrentPath & “\”  
 End If  
 GetCurrentPath = strCurrentPath  
 End Function