Autenticar sistema via Active Directory Windows

[joaosolution]

Srs.

Boa tarde

Tenho um cliente que gostaria que fosse possível validar o sistema pelo Active Directory do Windows.

Alguém já fez alguma coisa neste sentido?

Att

João Bosco

[Alexandre Bassanezi]

João, boa noite.

Para fazer algo assim você vai precisar usar LDAP.

Dá uma pesquisada na web, vai encontrar bastante coisa sobre isto. Na minha opinião você deveria procurar pelo programa "LDAPSEARCH" que deve atender o que você precisa.

Abs

Alexandre

[joaosolution]

Srs.

Gostaria de converter esta função em VbScript para xHarbour, a minha necessidade é validar o usuário pelo Active Directory

Function AuthenticateUser(ByVal strUser, ByVal strPW)
Const ADS_SECURE_AUTHENTICATION = 1
Const ADS_SERVER_BIND = 512

strPath = "LDAP://RootDSE"

Set LDAP = GetObject(strPath)
Set strAuth = LDAP.OpenDSObject(strPath, strUser, strPW, ADS_SECURE_AUTHENTICATION Or ADS_SERVER_BIND)
If Err.Number <> 0 Then
boolAuth = False
Else
boolAuth = True
End If
AuthenticateUser = boolAuth
End Function

Agradeço a ajuda

Att
João Bosco

[kapiaba]

Bom dia, alguém pode testar e ver o que está errado para o João?

#include 'fivewin.ch'
#include "ado.ch"
#include "xBrowse.ch"

#define MI_DOMINIO          'LDAP://ajtarragona.es'

#define ADS_SCOPE_BASE      0
#define ADS_SCOPE_ONELEVEL  1
#define ADS_SCOPE_SUBTREE   2

STATIC oCon

*--------------
FUNCTION Main()
*--------------
    LOCAL aData

    IF ConectaLDAP()

       MsgRun( "Carregant dades del LDAP...", 'Sistema', ;
              {|o| aData := SelectUsers() } )

    ENDIF

RETU NIL

*---------------------
FUNCTION ConectaLDAP()
*---------------------
   LOCAL lOk    := .F.
   LOCAL oError

   TRY

     oCon          := TOleAuto():new("ADODB.Connection")

     oCon:Provider := 'ADsDSOObject'

     oCon:Open( "Active Directory Provider" )

     lOk           := .T.


    CATCH oError

      xBrowse( oError )

   END

RETU lOk

*----------------------------
STATIC FUNCTION SelectUsers()
*----------------------------
   LOCAL oRs, oProp, oError, o
   LOCAL nLen    := 0
   LOCAL cString := ''
   LOCAL cWhere  := ''
   LOCAL aData   := {}
   LOCAL aHead   := {}


   TRY

     oRs             := TOleAuto():new("ADODB.Command")

     oRs:ActiveConnection := oCon


     cString         := "SELECT "              + ;
                        " displayName,"        + ;
                        " distinguishedName,"  + ;
                        " mail,"               + ;
                        " telephoneNumber,"    + ;
                        " mobile,"             + ;
                        " department,"         + ;
                        " sAMAccountname"      + ;
                        ""                     + ;
                        " FROM '" + MI_DOMINIO + "'"

      cWhere         :=  " WHERE objectCategory   = 'person' AND" + ;
                         "       objectClass      = 'user'   AND" + ;
                         "     ( telephoneNumber  = '*'      OR " + ;
                         "       mobile           = '*' )       " + ;
                         " ORDER BY telephoneNumber"

*                         " ORDER BY displayName"


     oRs:CommandText := cString + cWhere

     oProp           := oRs:Properties( 'SearchScope' )
     oProp:value     := ADS_SCOPE_SUBTREE

     oProp           := oRs:Properties( 'Page size' )
     oProp:value     := 2000

     o := oRs:Execute()

    CATCH oError

      xBrowse( oError )

   END

   nLen  := LoadData( o, @aData, @aHead )


   IF nLen > 0

      Table( aData, aHead, 'Total: ' + ltrim(str(nLen)) )

     ELSE

      Alert( 'No data !' )

   ENDIF


RETU aData


*------------------------------------
FUNCTION AdoError( oError, lMessage )
*------------------------------------
    LOCAL cError := .T.

    DEFAULT lMessage := .T.

    cError := "Descripción  "  + Chr( VK_TAB) + ": " + oError:Description              + CRLF + CRLF +  ;
              "Error Nativo  " + Chr( VK_TAB) + ": "  + Ltrim(Str(oError:NativeError)) + CRLF + ;
              "Número Error  " + Chr( VK_TAB) + ": "  + Ltrim(Str(oError:Number))      + CRLF + ;
              "Origen        " + Chr( VK_TAB) + ": "  + oError:Source                  + CRLF + ;
              "EszAdo SQL  "   + Chr( VK_TAB) + ": "  + oError:SQLState

    IF lMessage
       MsgStop( cError, 'Ado Connection' )
    ENDIF

RETU cError

*------------------------
FUNCTION ShowInfo( oCon )
*------------------------
    LOCAL cInfo      := ''

    cInfo += 'Version Ado       '  + Chr( VK_TAB ) + Chr( VK_TAB ) + ': '  + Alltrim( cValToChar(oCon:Version()            )) + CRLF
    cInfo += 'Provider          '  + Chr( VK_TAB ) + Chr( VK_TAB ) + ': '  + Alltrim( cValToChar(oCon:Provider()           )) + CRLF
    cInfo += 'Mode              '  + Chr( VK_TAB ) + Chr( VK_TAB ) + ': '  + Alltrim( cValToChar(oCon:Mode()               )) + CRLF
    cInfo += 'State             '  + Chr( VK_TAB ) + Chr( VK_TAB ) + ': '  + Alltrim( cValToChar(oCon:State()              )) + CRLF
    cInfo += 'CursorLocation    '  + Chr( VK_TAB ) + Chr( VK_TAB ) + ': '  + Alltrim( cValToChar(oCon:CursorLocation()     )) + CRLF
    cInfo += 'Connection TimeOut'  + Chr( VK_TAB ) + ': '  + Alltrim( cValToChar( oCon:ConnectionTimeOut() )) + CRLF
    cInfo += 'Command TimeOut   '  + Chr( VK_TAB ) + ': '  + Alltrim( cValToChar( oCon:CommandTimeOut()    )) + CRLF + CRLF
    cInfo += 'Connection String '  + CRLF
    cInfo += oCon:ConnectionString()

    MsgInfo( cInfo, 'Info Connection' )

RETU NIL

*---------------------------------------------------
FUNCTION Table( aValues, aHeaders, cTitle, lSelect )
*---------------------------------------------------
    LOCAL oDlg, oBrw, oFont
    LOCAL nI
    LOCAL nPos := 0

    DEFAULT aHeaders := {}
    DEFAULT cTitle   := 'Seleccione...'
    DEFAULT lSelect  := .T.

    IF ValType( aValues ) <> 'A'
       MsgAlert( aValues, 'Not table' )
       RETU 0
    ENDIF

    IF ValType( aHeaders ) == 'C'
       aHeaders := { aHeaders }
    ENDIF

    IF Len( avalues ) == 0
       MsgAlert( 'Table is empty !', 'LDAP Error' )
       RETU 0
    ENDIF

    DEFINE FONT oFont    NAME 'Courier New' SIZE NIL, -11

    DEFINE DIALOG oDlg TITLE cTitle FROM 0, 0 TO 20, 90
                  oDlg:lHelpIcon := .f.
                  oDlg:nStyle    := nOr( WS_THICKFRAME, WS_SYSMENU, WS_MINIMIZEBOX, WS_MAXIMIZEBOX )

       @ 0, 0 XBROWSE oBrw OF oDlg ARRAY aValues // AUTOSORT

            oBrw:SetArray( aValues )
            oBrw:SetColor( CLR_RED, CLR_WHITE )
            oBrw:SetFont( oFont )

            FOR nI := 1 TO Len( aHeaders )
                oBrw:aCols[nI]:cHeader := aHeaders[nI]
            NEXT

            IF Len( oBrw:aCols ) == 1

            ENDIF

            oBrw:blDblClick := {|| ( nPos := oBrw:nArrayAt, ;
                                     IF( lSelect, oDlg:End(),;
                                                  Table( aValues[nPos],,str(nPos), .F.);
                                       );
                                   )}
            oBrw:bKeyChar   := {|nKey| IF( nKey == VK_RETURN, Eval( oBrw:blDblClick ), )}

            oBrw:CreateFromCode()

            oDlg:oClient = oBrw

    ACTIVATE DIALOG oDlg CENTERED ;
             ON INIT ( SetupBar( oDlg )  ,;
                       XecValues( oDlg, oBrw, aValues )  ,;
                       oDlg:Resize() )

RETU nPos

*-------------------------------
STATIC FUNCTION SetupBar( oDlg )
*-------------------------------
    LOCAL oBar, oHand

    DEFINE CURSOR oHand HAND

    DEFINE BUTTONBAR oBar TOP _3D SIZE 23,23 OF oDlg
    DEFINE BUTTON  OF oBar       NOBORDER NAME '16Exit' ACTION oDlg:End()

    AEval( oBar:aControls,  {|x| x:oCursor := oHand } )

RETU NIL


*-----------------------------------------------
STATIC FUNCTION XecValues( oDlg, oBrw, aValues )
*-----------------------------------------------
    LOCAL nMax := 0


    IF Len( oBrw:aCols ) > 1
       RETU NIL
    ENDIF

    AEval( aValues, {|x| nMax := Max( nMax,;
           if( valtype(x) =='C', oDlg:GetWidth(Upper(x), oBrw:oFont), 0 ) ) } )

    nMax := IF( nMax > oBrw:nWidth, oBrw:nWidth, nMax )

    oBrw:aCols[1]:nWidth := nMax + 50

    oBrw:Refresh(.t.)

RETU NIL


*--------------------------------------------
STATIC FUNCTION LoadData( oRs, aData, aHead )
*--------------------------------------------
   LOCAL nLen    := 0
   LOCAL nFields := oRs:Fields:Count
   LOCAL nI
   LOCAL aReg

   aData := {}
   aHead := {}


   for nI := 0 TO nFields - 1
     Aadd( aHead, oRs:Fields(nI):name )
   next

   nLen := oRs:RecordCount()

   IF nLen > 0

      oRs:movefirst()

      WHILE !oRs:Eof()

          aReg := {}

          FOR nI := 1 TO Len(aHead)
              Aadd( aReg, oRs:Fields( aHead[nI] ):value )
          NEXT

          Aadd( aData, aReg )

          oRs:MoveNext()

      END

   ENDIF

RETU nLen

http://forums.fivetechsupport.com/viewtopic.php?f=3&t=26995&p=150642&hilit=Authenticated#p150642

Obg. abs

[joaosolution]

Kapiaba

Obrigado pelo retorno.

Já utilizei esta função mas não lista os dados.

Grato

João Bosco