To All
I have searched this forum for an LDAP query to just return all userid's and full names from a Microsoft Domain without any luck .. Any examples would be most helpful.
Thanks
Rick Lipkin
#include 'fivewin.ch'
#include "ado.ch"
#include "xBrowse.ch"
#define MY_DOMAIN 'LDAP://wwrowland.com'
#define ADS_SCOPE_BASE 0
#define ADS_SCOPE_ONELEVEL 1
#define ADS_SCOPE_SUBTREE 2
STATIC oCon
*--------------
FUNCTION Main()
*--------------
LOCAL aData
IF ConectaLDAP()
MsgRun( "Collect LDAP Data...", 'System', ;
{|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," + ;
" useraccountcontrol" + ;
"" + ;
" FROM '" + MY_DOMAIN + "'"
/*
cWhere := " WHERE objectCategory = 'person' AND" + ;
" objectClass = 'user' " + ;
" ORDER BY displayName"
*/
cWhere := " WHERE objectCategory = 'person' AND" + ;
" objectClass = 'user' AND" + ;
" mail = '*' AND" + ;
" useraccountcontrol = 66048 " + ;
" ORDER BY telephoneNumber"
*/
/*
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 := "Description " + Chr( VK_TAB) + ": " + oError:Description + CRLF + CRLF + ;
"Error Native " + Chr( VK_TAB) + ": " + Ltrim(Str(oError:NativeError)) + CRLF + ;
"Error Number " + Chr( VK_TAB) + ": " + Ltrim(Str(oError:Number)) + CRLF + ;
"Origin " + Chr( VK_TAB) + ": " + oError:Source + CRLF + ;
"SQL State " + Chr( VK_TAB) + ": " + oError:SQLState
IF lMessage
MsgStop( cError, 'Ado Connection' )
ENDIF
RETU cError
*------------------------
FUNCTION ShowInfo( oCon )
*------------------------
LOCAL cInfo := ''
cInfo += 'ADO Version ' + 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 := 'Selection...'
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
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 60 guests