xLOGIN := substr(upper(WNetGetuser()+space(25)),1,25) // fivewin
#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
nageswaragunupudi wrote:I personally design all our network software to authenticate users by their windows user name (wnetgetuser()) rather than maintaining separate login for the application.
Carles wrote:Hi,
U can try this code to acces LDAP.
Dear Rao,
what if the FW user login is different from logged windows user.. How do you validate FW from domain user?
Kind regards.
fraxzi wrote:Dear All,
It's been a while.. busy with FWH projects..
Anyone here who can authenticate/validate a logon from FW apps to Windows Active Directory?
Kind regards,
Frances
Private Sub CommandButton1_Click()
If Authenticated(TextBox1.Value, TextBox2.Value) Then
MsgBox "Usuario Validado"
Else
MsgBox "Usuario / Contraseña Invalidos"
End If
End Sub
Private Sub CommandButton2_Click()
Application.Quit
End Sub
Function Authenticated(strUserID As String, strPassword As String, Optional strDNSDomain As String = "") As Boolean
If strDNSDomain = "" Then
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
End If
'Authenticate
Set dso = GetObject("LDAP:")
On Error Resume Next
Err.Clear
Set ou = dso.OpenDSObject("LDAP://" & strDNSDomain, strUserID, strPassword, 1)
Authenticated = (Err.Number = 0)
End Function
#include 'fivewin.ch'
#include "ado.ch"
#include "xBrowse.ch"
PROC Main()
LOCAL cUser := SPACE(20)
LOCAL cPssw := SPACE(20)
If MsgGet( "Autenticación de usuarios", "Nombre de Usuario:", @cUser)
If MsgGet( "Autenticación de usuarios", "Contraseña:", @cPssw)
If Authenticated( alltrim(cUser), alltrim(cPssw) )
MsgInfo("Usuario Correcto")
Else
MsgStop("Usuario Incorrecto")
Endif
Endif
Endif
RETURN
Function Authenticated(cUserID, cPassword, cDNSDomain)
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
RETURN (!lError)
Private Sub Workbook_Open()
UserForm1.Show
End Sub
fraxzi wrote:Thanks Hebert.
Thank you for this update. If I have time I will try this.. somehow I abandoned the idea
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 81 guests