FW user login to authenticate from windows active directory

[hebert_j_vargas]

Hi Herbert,

here in line 29:

oRootDSE := CreateObject("LDAP://",cUserID,cPassword)

Error description: Error TOleAuto/-1 CO_E_CLASSSTRING: TOLEAUTO:NEW
Args:
[ 1] = C LDAP://
[ 2] = U
[ 3] = C FPGRANDE

Thanks in advance.

Regards

Thank's Baxajaun, the code must be:

oRootDSE := CreateObject("LDAP://")

I forgot to remove those parameter's, but all you get from GetObject or CreateObject is NIL .

[Baxajaun]

Thanks Herbert,

but with that change

Error description: Error TOleAuto/-1 CO_E_CLASSSTRING: TOLEAUTO:NEW
Args:
[ 1] = C LDAP://
[ 2] = U
[ 3] = U

in line

oRootDSE := CreateObject("LDAP://")

Thanks in advance !

Regards,

[Rick Lipkin]

To All

These are my modifications from the original LDAP code .. I use this routine to pull AD information for a selected User :

Code: Select all  Expand view  RUN

#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

 

[hebert_j_vargas]

Thank's Rick, I already tested your procedure, It worked fine, but what I need is to verify the user by valildating user and password from LDAP services, What I've found is has something to do with xharbour and ole issue, OLE can't find "LDAP".

Ragard's

[Baxajaun]

Hi Rick,

could you share these functions:

- _Namechk()
- LightGreyGrad()
- _BrowColor()

Thanks in advance !

Regards

[Rick Lipkin]

Sure .. here are the Functions ..

Rick lipkin

Code: Select all  Expand view  RUN

//--------------------
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 view  RUN

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

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

Return(nil)
 

Code: Select all  Expand view  RUN

//----------------------
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)
 

[Rick Lipkin]

Herbert

User-Password ( userPassword ) is an AD attribute, however if you include it in my above code .. it does not resolve and is probably encrypted ..

http://www.kouti.com/tables/userattributes.htm

Rick Lipkin

[Baxajaun]

Thanks a lot Rick !!!

Regards,

[Baxajaun]

Hi Herbert,

have you login Active Directory from FWH ?

Perhaps, Mr, Rao could help with this .

Thanks in advance.

Regards

[hebert_j_vargas]

Hi Herbert,

have you login Active Directory from FWH ?

Perhaps, Mr, Rao could help with this .

Thanks in advance.

Regards

Hi baxajaun, I try 2 aproach

Code: Select all  Expand view  RUN

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" )
 

Even you put a wrong password you can log to Activde Directory
and the one translated from visual basic

Code: Select all  Expand view  RUN

       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

This one, can't get ole service from LDAP. Maybe mr. Rao can give us a hand on this issue.

[hebert_j_vargas]

Hi Herbert,

have you login Active Directory from FWH ?

Perhaps, Mr, Rao could help with this .

Thanks in advance.

Regards

Hi baxajaun, I try 2 aproach

Code: Select all  Expand view  RUN

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" )
 

Even you put a wrong password you can log to Activde Directory
and the one translated from visual basic

Code: Select all  Expand view  RUN

       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

This one, can't get ole service from LDAP. Maybe mr. Rao can give us a hand on this issue.

Mr. Rao, could you pleae give us a hand on this?

[hebert_j_vargas]

UP

[Baxajaun]

Up !

[Rick Lipkin]

Just a dumb observation and this may not be the case .. but in order to use Active Directory the MACHINE your customer is using to authenticate your application ( external app I presume ) MUST be a member of the domain.

You just can not take any computer that is not part of the domain and expect the user on that machine to authenticate to Active Directory. .. UNLESS you are using a VPN back to the domain or RDP into a machine attached and inside the domain.

Rick Lipkin

[Horizon]

UP