FiveTech Software tech support forums

Code: Select all | Expand

#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

 

Code: Select all | Expand

//--------------------
Func _NameChk( cNAME, lEMPTY )

LOCAL SAYING

IF empty(lEMPTY)
   lEMPTY := .F.
ENDIF

IF lEMPTY = .F.
   IF empty(alltrim(cNAME )) .or. cNAME = "  "
      SAYING := "Sorry .. This field can not be BLANK"
      MsgInfo( SAYING )
      RETURN(.F.)
   ENDIF
ENDIF

IF AT( "'", cNAME ) > 0 .or.;
   AT( '"', cNAME ) > 0 .or.;
   AT( '(', cNAME ) > 0 .or.;
   AT( ':', cNAME ) > 0 .or.;
   AT( ')', cNAME ) > 0
   SAYING := "Sorry .. Apostrophes, Quotes, Colons, and Parentheses are ILLEGAL characters"
   MsgInfo( SAYING )
   RETURN(.F.)
ENDIF

RETURN(.T.)
 

Code: Select all | Expand

//------------------
Func LightGreyGrad()

SetDlgGradient( { { .50, nRGB( 216, 216, 216 ), nRGB( 255, 255, 255 ) } } )

Return(nil)
 

Code: Select all | Expand

//----------------------
Func _BrowColor( oLbx )
                               // foreground      // background
local aGradBarSelFocus := {{1, RGB(0,128,255) , RGB(0,128,255) }}          // in focus
local aGradBarSel         := {{1, RGB(255,255,255), RGB(192,192,192)  }}   // not in focus   192

WITH OBJECT oLbx
      :bClrSel       := {|| { CLR_BLACK, aGradBarSel } }  // not in focus
      :bClrSelFocus := { || { CLR_WHITE, aGradBarSelFocus } }     // in focus
END

Return(nil)
 

Code: Select all | Expand

oCon := TOleAuto():new("ADODB.Connection")
           oCon:Provider := 'ADsDSOObject'
           oPro := oCon:Properties('User ID')
           oPro:Value := cUserId
           oPro := oCon:Properties('Password')
           oPro:Value := cPassword
           oPro := oCon:Properties('Encrypt Password')
           oPro:Value := .t.
           //oCon:Properties("Encrypt Password") := .t.
           oCon:Open( "Active Directory Provider" )
 

Code: Select all | Expand

        local oRootDSE, oDSO, oU, lError
     
         default cDNSDomain := "DC=pdvsa,DC=com"
         TRY
            oRootDSE := GetActiveObject("LDAP://RootDSE")
         CATCH
            oRootDSE := CreateObject("LDAP:",cUserID,cPassword)
         END

         If empty( cDNSDomain )
            cDNSDomain := oRootDSE:Get( "defaultNamingContext" )
         EndIf
       
        TRY
           oDSO := GetActiveObject( "LDAP:" )
           oU := oDSO:OpenDSObject( "LDAP://" +  cDNSDomain, cUserID, cPassword, 1 ) //ADS Fast Bind
           lError := .f.
        CATCH
           lError := .t.
        END