These are my modifications from the original LDAP code .. I use this routine to pull AD information for a selected User :
Code: Select all
#Include "FiveWIn.Ch"
#Include "xBrowse.Ch"
#include "ado.ch"
#define ADS_SCOPE_BASE 0
#define ADS_SCOPE_ONELEVEL 1
#define ADS_SCOPE_SUBTREE 2
//----------------------
Func _UserGet( cMode,cAdFind,oAdFind,cUserId,oUserId,cFullName,oFullName,cLname,oLname,cFname,oFname,cPhone,oPhone,cFrom,cDomain,;
oButt1,oButt2,oButt3,oButt4,oButt5,oButt6)
Local oDLG,oLBX,lOk3
Local oRsAd,oCn,cConnect,cSql,oErr
Local oProp,oRs
Local aData,aHead,nI,aReg
Local oBtn1,oBtn2
Local Saying,cValue
If cMode = "V"
Return(.t.)
Endif
If cMode = "R" .and. cUserId = "All"
If cFrom = "BUTTON"
Else
Return(.t.)
Endif
Endif
If empty( cFrom )
cFrom := "FIELD"
Endif
If Empty( cDomain )
Saying := "Sorry .. the Domain Name has not been defined"
Msginfo( Saying )
Return(.f.)
Endif
If cFrom = "FIELD"
cAdFind := alltrim( oAdFInd:GetText() )
Endif
If empty(cAdFind) .or. cAdFind = " "
cAdFInd:= "Bogus"
Endif
// make sure there are no illegal charactors
If _NameCHk( cAdFind,.t.)
Else
cAdFInd := Space(35)
oAdFind:ReFresh()
oAdFInd:SetFocus()
Return(.f.)
Endif
cDomain := "LDAP://"+alltrim(cDomain)
cConnect := "Active Directory Provider"
oCn := CREATEOBJECT( "ADODB.Connection" )
oCn:Provider := 'ADsDSOObject'
TRY
oCn:Open( cConnect )
CATCH oErr
Saying := "Could not open a Global Connection to Domain "+cDomain
MsgInfo( Saying )
RETURN(.F.)
END TRY
*msginfo( "Connection Established" )
oRs := TOleAuto():new("ADODB.Command")
oRs:ActiveConnection := oCn
cSQL := "SELECT "
cSql += " telephoneNumber,"
cSql += " displayName," // fullname
cSql += " sAMAccountname," // userid
cSql += " sn," // last name sn
cSql += " givenname" // first name
cSql += ""
cSql += " FROM '"+cDomain+"'"
cSql += " WHERE objectCategory = 'person' AND"
cSql += " objectClass = 'user' "
DO Case
Case cAdFind = "Bogus"
// do nothing .. full table scan
OtherWise
cSql += " and displayname = '*"+alltrim(cAdFind)+"*' "
End DO
cSql += " ORDER BY displayName"
oRs:CommandText := cSql //cString + cWhere
oProp := oRs:Properties( 'SearchScope' )
oProp:value := ADS_SCOPE_SUBTREE
oProp := oRs:Properties( 'Page size' )
oProp:value := 2000
Try
oRsAd := oRs:Execute()
Catch oErr
Msginfo( "LDAP Query Execution Error")
oCN:CLose()
Return(.f.)
End Try
aData := {}
aHead := {}
// generate xBrowse headings
nFields := oRsAd:Fields:Count()
For nI := 0 TO nFields - 1
Aadd( aHead, oRsAd:Fields(nI):name )
Next
nLen := oRsAd:RecordCount()
IF nLen > 0
oRsAd:MoveFirst()
Do WHILE .not. oRsAd:Eof()
aReg := {}
For nI := 1 TO Len(aHead)
Aadd( aReg, oRsAd:Fields( aHead[nI] ):value )
NEXT
If empty( aReg[1]) .or. aReg[1] = " "
Else
Aadd( aData, aReg )
ENdif
oRsAd:MoveNext()
Enddo
Else
Msginfo( "No LDAP Data found" )
oRsAd:CLose()
oCN:CLose()
Return(.f.)
Endif
LightGreyGrad()
If cMode = "R"
Else
oButt1:Disable()
oButt2:Disable()
oButt3:Disable()
oButt4:Disable()
oButt5:Disable()
oButt6:Disable()
Endif
lOk3 := .f.
DEFINE DIALOG oDlg RESOURCE "USERSLCT" ;
TITLE "User LDAP Look Up Table" ;
REDEFINE xBROWSE oLBX ;
ARRAY aData ;
HEADERS "FirstName", ;
"LastName", ;
"UserId", ;
"FullName", ;
"Phone" ;
COLSIZES 97,97,97,150 ;
ID 111 of oDlg ;
AUTOSORT AUTOCOLS LINES CELL
oLbx:lHScroll := .f. // turn off horiz scroll bar
oLbx:lRecordSelector := .f.
oLbx:nMarqueeStyle := MARQSTYLE_HIGHLROW
oLbx:bLDblClick := { |nRow,nCol | (lOk3 := .t.,oDlg:End()) }
_BrowColor(oLbx)
REDEFINE BTNBMP oBtn1 ID 113 of oDlg ;
RESOURCE "OK", "DOK", "DOK" ;
PROMPT "&Ok" LEFT 2007;
ACTION (lok3 := .t., oDlg:End() )
REDEFINE BTNBMP oBtn2 ID 112 OF oDlg ;
RESOURCE "CANCEL", "DCANCEL", "DCANCEL" ;
PROMPT "&Cancel" LEFT 2007;
ACTION ( lOk3 := .f.,oDlg:End())
ACTIVATE DIALOG oDlg;
ON INIT ( oDlg:Move(100,400)) ; //, oLbx:SetFocus() );
VALID(!GETKEYSTATE( 27 ))
If lOk3 = .t.
cFname := If(empty(oLbx:aCols[ 1 ]:Value),space(15),;
substr(oLbx:aCols[ 1 ]:Value+space(15),1,15))
cLname := If(empty(oLbx:aCols[ 2 ]:Value),space(15),;
substr(oLbx:aCols[ 2 ]:Value+space(15),1,15))
cUserId := If(empty(oLbx:aCols[ 3 ]:Value),space(25),;
substr(oLbx:aCols[ 3 ]:Value+space(25),1,25))
cFullName := If(empty(oLbx:aCols[ 4 ]:Value),space(35),;
substr(oLbx:aCols[ 4 ]:Value+space(35),1,35))
cPhone := If(empty(oLbx:aCols[ 5 ]:Value),space(15),;
substr(oLbx:aCols[ 5 ]:Value+space(15),1,15))
cAdFind := space(35)
If .not. empty(oUserId)
oUserId:ReFresh()
Endif
If .not. empty(oFullName)
oFullName:ReFresh()
Endif
If .not. empty(oLname)
oLname:ReFresh()
Endif
If .not. empty(oFname)
oFname:ReFresh()
Endif
If .not. empty( oPhone )
oPhone:ReFresh()
Endif
oAdFind:ReFresh()
ELse
cAdFind := space(35)
oAdFind:ReFresh()
Endif
If cMode = "R"
Else
oButt1:Enable()
oButt2:Enable()
oButt3:Enable()
oButt4:Enable()
oButt5:Enable()
oButt6:Enable()
ENdif
LightGreenGrad()
oRsAd:CLose()
oCN:CLose()
RETURN( Lok3 )
// end UserSlct.prg