How do integrate Delphi with Active Directory?
We need to validate an user on Microsoft\'s Active Directory using Delphi 7, what is the best way to do that?
We can have two scenarios: the user inputs its network
-
Google for using ADSI with Delphi, you can find some articles talking about that
Active Directory Service Interfaces
Using ADSI in Delphi
and you can also look at online-admin which they offer components to manage many of windows services including AD
讨论(0) -
Here's a unit we wrote and use. Simple and gets the job done.
unit ADSI; interface uses SysUtils, Classes, ActiveX, Windows, ComCtrls, ExtCtrls, ActiveDs_TLB, adshlp, oleserver, Variants; type TPassword = record Expired: boolean; NeverExpires: boolean; CannotChange: boolean; end; type TADSIUserInfo = record UID: string; UserName: string; Description: string; Password: TPassword; Disabled: boolean; LockedOut: boolean; Groups: string; //CSV end; type TADSI = class(TComponent) private FUserName: string; FPassword: string; FCurrentUser: string; FCurrentDomain: string; function GetCurrentUserName: string; function GetCurrentDomain: string; protected { Protected declarations } public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property CurrentUserName: string read FCurrentUser; property CurrentDomain: string read FCurrentDomain; function GetUser(Domain, UserName: string; var ADSIUser: TADSIUserInfo): boolean; function Authenticate(Domain, UserName, Group: string): boolean; published property LoginUserName: string read FUserName write FUserName; property LoginPassword: string read FPassword write FPassword; end; procedure Register; implementation function ContainsValComma(s1,s: string): boolean; var sub,str: string; begin Result:=false; if (s='') or (s1='') then exit; if SameText(s1,s) then begin Result:=true; exit; end; sub:=','+lowercase(trim(s1))+','; str:=','+lowercase(trim(s))+','; Result:=(pos(sub, str)>0); end; procedure Register; begin RegisterComponents('ADSI', [TADSI]); end; constructor TADSI.Create(AOwner: TComponent); begin inherited Create(AOwner); FCurrentUser:=GetCurrentUserName; FCurrentDomain:=GetCurrentDomain; FUserName:=''; FPassword:=''; end; destructor TADSI.Destroy; begin inherited Destroy; end; function TADSI.GetCurrentUserName : string; const cnMaxUserNameLen = 254; var sUserName : string; dwUserNameLen : DWord; begin dwUserNameLen := cnMaxUserNameLen-1; SetLength(sUserName, cnMaxUserNameLen ); GetUserName(PChar(sUserName), dwUserNameLen ); SetLength(sUserName, dwUserNameLen); Result := sUserName; end; function TADSI.GetCurrentDomain: string; const DNLEN = 255; var sid : PSID; sidSize : DWORD; sidNameUse : DWORD; domainNameSize : DWORD; domainName : array[0..DNLEN] of char; begin sidSize := 65536; GetMem(sid, sidSize); domainNameSize := DNLEN + 1; sidNameUse := SidTypeUser; try if LookupAccountName(nil, PChar(FCurrentUser), sid, sidSize, domainName, domainNameSize, sidNameUse) then Result:=StrPas(domainName); finally FreeMem(sid); end; end; function TADSI.Authenticate(Domain, UserName, Group: string): boolean; var aUser: TADSIUserInfo; begin Result:=false; if GetUser(Domain,UserName,aUser) then begin if not aUser.Disabled and not aUser.LockedOut then begin if Group='' then Result:=true else Result:=ContainsValComma(Group, aUser.Groups); end; end; end; function TADSI.GetUser(Domain, UserName: string; var ADSIUser: TADSIUserInfo): boolean; var usr : IAdsUser; flags : integer; Enum : IEnumVariant; grps : IAdsMembers; grp : IAdsGroup; varGroup : OleVariant; Temp : LongWord; dom1, uid1: string; //ui: TADSIUserInfo; begin ADSIUser.UID:=''; ADSIUser.UserName:=''; ADSIUser.Description:=''; ADSIUser.Disabled:=true; ADSIUser.LockedOut:=true; ADSIUser.Groups:=''; Result:=false; if UserName='' then uid1:=FCurrentUser else uid1:=UserName; if Domain='' then dom1:=FCurrentDomain else dom1:=Domain; if uid1='' then exit; if dom1='' then exit; try if trim(FUserName)<>'' then ADsOpenObject('WinNT://' + dom1 + '/' + uid1, FUserName, FPassword, 1, IADsUser, usr) else ADsGetObject('WinNT://' + dom1 + '/' + uid1, IADsUser, usr); if usr=nil then exit; ADSIUser.UID:= UserName; ADSIUser.UserName := usr.FullName; ADSIUser.Description := usr.Description; flags := usr.Get('userFlags'); ADSIUser.Password.Expired := usr.Get('PasswordExpired'); ADSIUser.Password.CannotChange := (flags AND ADS_UF_PASSWD_CANT_CHANGE)<>0; ADSIUser.Password.NeverExpires := (flags and ADS_UF_DONT_EXPIRE_PASSWD)<>0; ADSIUser.Disabled := usr.AccountDisabled; ADSIUser.LockedOut := usr.IsAccountLocked; ADSIUser.Groups:=''; grps := usr.Groups; Enum := grps._NewEnum as IEnumVariant; if Enum <> nil then begin while (Enum.Next(1,varGroup, Temp) = S_OK) do begin grp := IDispatch(varGroup) as IAdsGroup; //sGroupType := GetGroupType(grp); if ADSIUser.Groups<>'' then ADSIUser.Groups:=ADSIUser.Groups+','; ADSIUser.Groups:=ADSIUser.Groups+grp.Name; VariantClear(varGroup); end; end; usr:=nil; Result:=true; except on e: exception do begin Result:=false; exit; end; end; end; end.讨论(0) -
I'm flattered to see my ADSISearch component mentioned here :-), but in order to simply validate user credentials, you're probably even better off using the "LogonUser" Win32 API. I'm pretty sure (not doing any Delphi work anymore myself) that there's an implementation of that floating around somewhere - probably in the JVCL library or somewhere else.
讨论(0) -
I've always used the 'ADSISearch.pas' unit for working with AD, with great success. Also, here is some code I used (that uses this unit) to retrieve a user's HOMEDRIVE info from their AD object:
try ADSISearch1.Filter := WideString('samaccountname=' + GetUserFromWindows()); try ADSISearch1.Search; slTemp := ADSISearch1.GetFirstRow(); except //uh-oh, this is a problem, get out of here // --- must not have been able to talk to AD // --- could be the user recently changed pwd and is logged in with // their cached credentials // just suppress this exception bHomeDriveMappingFailed := True; Result := bSuccess; Exit; end; while (slTemp <> nil) do begin for ix := 0 to slTemp.Count - 1 do begin curLine := AnsiUpperCase(slTemp[ix]); if AnsiStartsStr('HOMEDIRECTORY', curLine) then begin sADHomeDriveUncPath := AnsiReplaceStr(curLine, 'HOMEDIRECTORY=', ''); //sADHomeDriveUncPath := slTemp[ix]; end else if AnsiStartsStr('HOMEDRIVE', curLine) then begin sADHomeDriveLetter := AnsiReplaceStr(curLine, 'HOMEDRIVE=', ''); //sADHomeDriveLetter := slTemp[ix]; end; end; FreeAndNil(slTemp); slTemp := ADSISearch1.GetNextRow(); end; except //suppress this exception bHomeDriveMappingFailed := True; Exit; end;And without further delay, here is the unit (not written by me):
(* ---------------------------------------------------------------------------- Module: ADSI Searching in Delphi Author: Marc Scheuner Date: July 17, 2000 Changes: Description: constructor Create(aOwner : TComponent); override; Creates a new instance of component destructor Destroy; override; Frees instance of component function CheckIfExists() : Boolean; Checks to see if the object described in the properties exists or not TRUE: Object exists, FALSE: object does not exist procedure Search; Launches the ADSI search - use GetFirstRow and GetNextRow to retrieve information function GetFirstRow() : TWideStringList; function GetNextRow() : TWideStringList; Returns the first row / next row of the result set, as a WideStringList. The values are stored in the string list as a <name>=<value> pair, so you can access the values via the FWideStringList.Values['name'] construct. Multivalued attributes are returned as one per line, in an array index manner: objectClass[0]=top objectClass[1]=Person objectClass[2]=organizationalPerson objectClass[3]=user and so forth. The index is zero-based. If there are no (more) rows, the return value will be NIL. It's up to the receiver to free the string list when no longer needed. property Attributes : WideString Defines the attributes you want to retrieve from the object. If you leave this empty, all available attributes will be returned. You can specify multiple attributes separated by comma: cn,distinguishedName,name,ADsPath will therefore retrieve these four attributes for all the objects returned in the search (if the attributes exist). property BaseIADs : IADs If you already have an interface to an IADs object, you can reuse it here by setting it to the BaseIADs property - in this case, ADSISearch can skip the step of binding to the ADSI object and will be executing faster. property BasePath : WideString LDAP base path for the search - the further down in the LDAP tree you start searching, the smaller the namespace to search and the quicker the search will return what you're looking for. LDAP://cn=Users,dc=stmaarten,dc=qc,dc=rnd is the well-known LDAP path for the Users container in the stmaarten.qc.rnd domain. property ChaseReferrals : Boolean If set to TRUE, the search might need to connect to other domain controllers and naming contexts, which is very time consuming. Set this property to FALSE to limit it to the current naming context, thus speeding up searches significantly. property DirSrchIntf : IDirectorySearch Provides access to the basic Directory Search interface, in case you need to do some low-level tweaking property Filter : WideString LDAP filter expression to search for. It will be ANDed together with a (objectClass=<ObjectClass>) filter to form the full search filter. It can be anything that is a valid LDAP search filter - see the appropriate books or online help files for details. It can be (among many other things): cn=Marc* badPwdCount>=0 countryCode=49 givenName=Steve and multiple conditions can be ANDed or ORed together using the LDAP syntax. property MaxRows : Integer Maximum rows of the result set you want to retrieve. Default is 0 which means all rows. property PageSize : Integer Maximum number of elements to be returned in a paged search. If you set this to 0, the search will *not* be "paged", e.g. IDirectorySearch will return all elements found in one big gulp, but there's a limit at 1'000 elements. With paged searching, you can search and find any number of AD objects. Default is set to 100 elements. No special need on the side of the developer / user to use paged searches - just set the PageSize to something non-zero. property ObjectClass: WideString ObjectClass of the ADSI object you are searching for. This allows you to specify e.g. just users, only computers etc. Be aware that ObjectClass is a multivalued attribute in LDAP, and sometimes has unexpected hierarchies (e.g."computer" descends from "user" and will therefore show up if you search for object class "user"). This property will be included in the LDAP search filter passed to the search engine. If you don't want to limit the objects returned, just leave it at the default value of * property SearchScope Limits the scope of the search. scBase: search only the base object (as specified by the LDAP path) - not very useful..... scOneLevel: search only object immediately contained by the specified base object (does not include baes object) - limits the depth of the search scSubtree: no limit on how "deep" the search goes, below the specified base object - this is the default. ---------------------------------------------------------------------------- *) unit ADSISearch; interface uses ActiveX, ActiveDs_TLB, Classes, SysUtils {$IFDEF UNICODE} ,Unicode {$ENDIF} ; type EADSISearchException = class(Exception); TSearchScope = (scBase, scOneLevel, scSubtree); TADSISearch = class(TComponent) private FBaseIADs : IADs; FDirSrchIntf : IDirectorySearch; FSearchHandle : ADS_SEARCH_HANDLE; FAttributes, FFilter, FBasePath, FObjectClass : Widestring; FResult : HRESULT; FChaseReferrals, FSearchExecuted : Boolean; FMaxRows, FPageSize : Integer; FSearchScope : TSearchScope; FUsername: Widestring; FPassword: Widestring; {$IFDEF UNICODE} procedure EnumerateColumns(aStrList : TWideStringList); {$ELSE} procedure EnumerateColumns(aStrList : TStringList); {$ENDIF} function GetStringValue(oSrchColumn : ads_search_column; Index : Integer) : WideString; procedure SetBaseIADs(const Value: IADs); procedure SetBasePath(const Value: WideString); procedure SetFilter(const Value: WideString); procedure SetObjectClass(const Value: Widestring); procedure SetMaxRows(const Value: Integer); procedure SetPageSize(const Value: Integer); procedure SetAttributes(const Value: WideString); procedure SetChaseReferrals(const Value: Boolean); procedure SetUsername(const Value: WideString); procedure SetPassword(const Value: WideString); public constructor Create(aOwner : TComponent); override; destructor Destroy; override; function CheckIfExists() : Boolean; procedure Search; {$IFDEF UNICODE} function GetFirstRow() : TWideStringList; function GetNextRow() : TWideStringList; {$ELSE} function GetFirstRow() : TStringList; function GetNextRow() : TStringList; {$ENDIF} published // list of attributes to return - empty string equals all attributes property Attributes : WideString read FAttributes write SetAttributes; // search base - both as an IADs interface, as well as a LDAP path property BaseIADs : IADs read FBaseIADs write SetBaseIADs stored False; property BasePath : WideString read FBasePath write SetBasePath; // chase possible referrals to other domain controllers? property ChaseReferrals : Boolean read FChaseReferrals write SetChaseReferrals default False; // "raw" search interface - for any low-level tweaking necessary property DirSrchIntf : IDirectorySearch read FDirSrchIntf; // LDAP filter to limit the search property Filter : WideString read FFilter write SetFilter; // maximum number of rows to return - 0 = all rows (no limit) property MaxRows : Integer read FMaxRows write SetMaxRows default 0; property ObjectClass : Widestring read FObjectClass write SetObjectClass; property PageSize : Integer read FPageSize write SetPageSize default 100; property SearchScope : TSearchScope read FSearchScope write FSearchScope default scSubtree; property Username : Widestring read FUsername write SetUsername; property Password : Widestring read FPassword write SetPassword; end; const // ADSI success codes S_ADS_ERRORSOCCURRED = $00005011; S_ADS_NOMORE_ROWS = $00005012; S_ADS_NOMORE_COLUMNS = $00005013; // ADSI error codes E_ADS_BAD_PATHNAME = $80005000; E_ADS_INVALID_DOMAIN_OBJECT = $80005001; E_ADS_INVALID_USER_OBJECT = $80005002; E_ADS_INVALID_COMPUTER_OBJECT = $80005003; E_ADS_UNKNOWN_OBJECT = $80005004; E_ADS_PROPERTY_NOT_SET = $80005005; E_ADS_PROPERTY_NOT_SUPPORTED = $80005006; E_ADS_PROPERTY_INVALID = $80005007; E_ADS_BAD_PARAMETER = $80005008; E_ADS_OBJECT_UNBOUND = $80005009; E_ADS_PROPERTY_NOT_MODIFIED = $8000500A; E_ADS_PROPERTY_MODIFIED = $8000500B; E_ADS_CANT_CONVERT_DATATYPE = $8000500C; E_ADS_PROPERTY_NOT_FOUND = $8000500D; E_ADS_OBJECT_EXISTS = $8000500E; E_ADS_SCHEMA_VIOLATION = $8000500F; E_ADS_COLUMN_NOT_SET = $80005010; E_ADS_INVALID_FILTER = $80005014; procedure Register; (*============================================================================*) (* IMPLEMENTATION *) (*============================================================================*) implementation uses Windows; var ActiveDSHandle : THandle; gADsGetObject: function(pwcPathName: PWideChar; const xRIID: TGUID; out pVoid): HResult; stdcall; gFreeADsMem : function(aPtr : Pointer) : BOOL; stdcall; // Active Directory API helper functions - implemented in ActiveDs.DLL and // dynamically loaded at time of initialization of this module function ADsGetObject(pwcPathName: PWideChar; const xRIID: TGUID; var pVoid): HResult; begin Result := gADsGetObject(pwcPathName, xRIID, pVoid); end; function FreeADsMem(aPtr : Pointer) : BOOL; begin Result := gFreeADsMem(aPtr); end; // resource strings for all messages - makes localization so much easier! resourcestring rc_CannotLoadActiveDS = 'Cannot load ActiveDS.DLL'; rc_CannotGetProcAddress = 'Cannot GetProcAddress of '; rc_CouldNotBind = 'Could not bind to object %s (%x)'; rc_CouldNotFreeSH = 'Could not free search handle (%x)'; rc_CouldNotGetIDS = 'Could not obtain IDirectorySearch interface for %s (%x)'; rc_GetFirstFailed = 'GetFirstRow failed (%x)'; rc_GetNextFailed = 'GetNextRow failed (%x)'; rc_SearchFailed = 'Search in ADSI failed (result code %x)'; rc_SearchNotExec = 'Search has not been executed yet'; rc_SetSrchPrefFailed = 'Setting the max row limit failed (%x)'; rc_UnknownDataType = '(unknown data type %d)'; // --------------------------------------------------------------------------- // Constructor and destructor // --------------------------------------------------------------------------- constructor TADSISearch.Create(aOwner : TComponent); begin inherited Create(aOwner); FBaseIADs := nil; FDirSrchIntf := nil; FAttributes := ''; FBasePath := ''; FFilter := ''; FObjectClass := '*'; FMaxRows := 0; FPageSize := 100; FChaseReferrals := False; FSearchScope := scSubtree; FSearchExecuted := False; end; destructor TADSISearch.Destroy; begin if (FSearchHandle <> 0) then FResult := FDirSrchIntf.CloseSearchHandle(FSearchHandle); FBaseIADs := nil; FDirSrchIntf := nil; inherited; end; // --------------------------------------------------------------------------- // Set and Get methods // --------------------------------------------------------------------------- procedure TADSISearch.SetPassword(const Value: WideString); begin if (FPassword <> Value) then begin FPassword := Value; end; end; procedure TADSISearch.SetUsername(const Value: WideString); begin if (FUsername <> Value) then begin FUsername := Value; end; end; procedure TADSISearch.SetAttributes(const Value: WideString); begin if (FAttributes <> Value) then begin FAttributes := Value; end; end; // the methods to set the search base always need to update the other property // as well, in order to make sure the base IADs interface and the BasePath // property stay in sync // setting the search base will require a new search // therefore set internal flag FSearchExecuted to false procedure TADSISearch.SetBaseIADs(const Value: IADs); begin if (FBaseIADs <> Value) then begin FBaseIADs := Value; FBasePath := FBaseIADs.ADsPath; FSearchExecuted := False; end; end; procedure TADSISearch.SetBasePath(const Value: WideString); begin if (FBasePath <> Value) then begin FBasePath := Value; FBaseIADs := nil; FSearchExecuted := False; end; end; procedure TADSISearch.SetChaseReferrals(const Value: Boolean); begin if (FChaseReferrals <> Value) then begin FChaseReferrals := Value; end; end; // setting the filter will require a new search // therefore set internal flag FSearchExecuted to false procedure TADSISearch.SetFilter(const Value: WideString); begin if (FFilter <> Value) then begin FFilter := Value; FSearchExecuted := False; end; end; procedure TADSISearch.SetMaxRows(const Value: Integer); begin if (Value >= 0) and (Value <> FMaxRows) then begin FMaxRows := Value; end; end; procedure TADSISearch.SetPageSize(const Value: Integer); begin if (Value >= 0) and (Value <> FPageSize) then begin FPageSize := Value; end; end; // setting the object category will require a new search // therefore set internal flag FSearchExecuted to false procedure TADSISearch.SetObjectClass(const Value: Widestring); begin if (FObjectClass <> Value) then begin if (Value = '') then FObjectClass := '*' else FObjectClass := Value; FSearchExecuted := False; end; end; // --------------------------------------------------------------------------- // Private helper methods // --------------------------------------------------------------------------- // EnumerateColumns iterates through all the columns in the current row of // the search results and builds the string list of results {$IFDEF UNICODE} procedure TADSISearch.EnumerateColumns(aStrList: TWideStringList); {$ELSE} procedure TADSISearch.EnumerateColumns(aStrList: TStringList); {$ENDIF} var ix : Integer; bMultiple : Boolean; pwColName : PWideChar; oSrchColumn : ads_search_column; wsColName, wsValue : WideString; begin // determine name of next column to fetch FResult := FDirSrchIntf.GetNextColumnName(FSearchHandle, pwColName); // as long as no error occured and we still do have columns.... while Succeeded(FResult) and (FResult <> S_ADS_NOMORE_COLUMNS) do begin // get the column from the result set FResult := FDirSrchIntf.GetColumn(FSearchHandle, pwColName, oSrchColumn); if Succeeded(FResult) then begin // check if it's a multi-valued attribute bMultiple := (oSrchColumn.dwNumValues > 1); if bMultiple then begin // if it's a multi-valued attribute, iterate through the values for ix := 0 to oSrchColumn.dwNumValues-1 do begin wsColName := Format('%s[%d]', [oSrchColumn.pszAttrName, ix]); wsValue := GetStringValue(oSrchColumn, ix); aStrList.Add(wsColName + '=' + wsValue); end; end else begin // single valued attributes are quite straightforward wsColName := oSrchColumn.pszAttrName; wsValue := GetStringValue(oSrchColumn, 0); aStrList.Add(wsColName + '=' + wsValue); end; end; // free the memory associated with the search column, and the column name FDirSrchIntf.FreeColumn(oSrchColumn); FreeADsMem(pwColName); // get next column name FResult := FDirSrchIntf.GetNextColumnName(FSearchHandle, pwColName); end; end; // Get string value will turn the supported types of data into a string representation // for inclusion in the resulting string list // For a complete list of possible values, see the ADSTYPE_xxx constants in the // ActiveDs_TLB.pas file function TADSISearch.GetStringValue(oSrchColumn: ads_search_column; Index: Integer): WideString; var wrkPointer : PADSValue; oSysTime : _SYSTEMTIME; dtDate, dtTime : TDateTime; begin Result := ''; // advance the value pointer to the correct one of the potentially multiple // values in the "array of values" for this attribute wrkPointer := oSrchColumn.pADsValues; Inc(wrkPointer, Index); // depending on the type of the value, turning it into a string is more // or less straightforward case oSrchColumn.dwADsType of ADSTYPE_CASE_EXACT_STRING : Result := wrkPointer^.__MIDL_0010.CaseExactString; ADSTYPE_CASE_IGNORE_STRING : Result := wrkPointer^.__MIDL_0010.CaseIgnoreString; ADSTYPE_DN_STRING : Result := wrkPointer^.__MIDL_0010.DNString; ADSTYPE_OBJECT_CLASS : Result := wrkPointer^.__MIDL_0010.ClassName; ADSTYPE_PRINTABLE_STRING : Result := wrkPointer^.__MIDL_0010.PrintableString; ADSTYPE_NUMERIC_STRING : Result := wrkPointer^.__MIDL_0010.NumericString; ADSTYPE_BOOLEAN : Result := IntToStr(wrkPointer^.__MIDL_0010.Boolean); ADSTYPE_INTEGER : Result := IntToStr(wrkPointer^.__MIDL_0010.Integer); ADSTYPE_LARGE_INTEGER : Result := IntToStr(wrkPointer^.__MIDL_0010.LargeInteger); ADSTYPE_UTC_TIME: begin // ADS_UTC_TIME maps to a _SYSTEMTIME structure Move(wrkPointer^.__MIDL_0010.UTCTime, oSysTime, SizeOf(oSysTime)); // create two TDateTime values for the date and the time dtDate := EncodeDate(oSysTime.wYear, oSysTime.wMonth, oSysTime.wDay); dtTime := EncodeTime(oSysTime.wHour, oSysTime.wMinute, oSysTime.wSecond, oSysTime.wMilliseconds); // add the two TDateTime's (really only a Float), and turn into a string Result := DateTimeToStr(dtDate+dtTime); end; else Result := Format(rc_UnknownDataType, [oSrchColumn.dwADsType]); end; end; // --------------------------------------------------------------------------- // Public methods // --------------------------------------------------------------------------- // Check if any object matching the criteria as defined in the properties exists function TADSISearch.CheckIfExists(): Boolean; var {$IFDEF UNICODE} slTemp : TWideStringList; {$ELSE} slTemp : TStringList; {$ENDIF} iOldMaxRows : Integer; wsOldAttributes : WideString; begin Result := False; // save the settings of the MaxRows and Attributes properties iOldMaxRows := FMaxRows; wsOldAttributes := FAttributes; try // set the attributes to return just one row (that's good enough for // making sure it exists), and the Attribute of instanceType which is // one attribute that must exist for any of the ADSI objects FMaxRows := 1; FAttributes := 'instanceType'; try Search; // did we get any results?? If so, at least one object exists! slTemp := GetFirstRow(); Result := (slTemp <> nil); slTemp.Free; except on EADSISearchException do ; end; finally // restore the attributes to what they were before FMaxRows := iOldMaxRows; FAttributes := wsOldAttributes; end; end; {$IFDEF UNICODE} function TADSISearch.GetFirstRow(): TWideStringList; var slTemp : TWideStringList; {$ELSE} function TADSISearch.GetFirstRow(): TStringList; var slTemp : TStringList; {$ENDIF} begin slTemp := nil; try if FSearchExecuted then begin // get the first row of the result set FResult := FDirSrchIntf.GetFirstRow(FSearchHandle); // did we succeed? ATTENTION: if we don't have any more rows, // we still get a "success" value back from ADSI!! if Succeeded(FResult) then begin // any more rows in the result set? if (FResult <> S_ADS_NOMORE_ROWS) then begin // create a string list {$IFDEF UNICODE} slTemp := TWideStringList.Create; {$ELSE} slTemp := TStringList.Create; {$ENDIF} // enumerate all columns into that resulting string list EnumerateColumns(slTemp); end; end else begin raise EADSISearchException.CreateFmt(rc_GetFirstFailed, [FResult]); end; end else begin raise EADSISearchException.Create(rc_SearchNotExec); end; finally Result := slTemp; end; end; {$IFDEF UNICODE} function TADSISearch.GetNextRow(): TWideStringList; var slTemp : TWideStringList; {$ELSE} function TADSISearch.GetNextRow(): TStringList; var slTemp : TStringList; {$ENDIF} begin slTemp := nil; try if FSearchExecuted then begin // get the next row of the result set FResult := FDirSrchIntf.GetNextRow(FSearchHandle); // did we succeed? ATTENTION: if we don't have any more rows, // we still get a "success" value back from ADSI!! if Succeeded(FResult) then begin // any more rows in the result set? if (FResult <> S_ADS_NOMORE_ROWS) then begin // create result string list {$IFDEF UNICODE} slTemp := TWideStringList.Create; {$ELSE} slTemp := TStringList.Create; {$ENDIF} // enumerate all columns in result set EnumerateColumns(slTemp); end; end else begin raise EADSISearchException.CreateFmt(rc_GetNextFailed, [FResult]); end; end else begin raise EADSISearchException.Create(rc_SearchNotExec); end; finally Result := slTemp; end; end; // this is the core piece of the component - the actual search method procedure TADSISearch.Search; var ix : Integer; wsFilter : WideString; {$IFDEF UNICODE} slTemp : TWideStringList; {$ELSE} slTemp : TStringList; {$ENDIF} AttrCount : Cardinal; AttrArray : array of WideString; SrchPrefInfo : array of ads_searchpref_info; DSO :IADsOpenDSObject; Dispatch:IDispatch; begin // check to see if we have assigned an IADs, if not, bind to it if (FBaseIADs = nil) then begin ADsGetObject('LDAP:', IID_IADsOpenDSObject, DSO); Dispatch := DSO.OpenDSObject(FBasePath, FUsername, FPassword, ADS_SECURE_AUTHENTICATION); FResult := Dispatch.QueryInterface(IID_IADs, FBaseIADs); //FResult := ADsGetObject(@FBasePath[1], IID_IADs, FBaseIADs); if not Succeeded(FResult) then begin raise EADSISearchException.CreateFmt(rc_CouldNotBind, [FBasePath, FResult]); end; end; // get the IDirectorySearch interface from the base object FDirSrchIntf := (FBaseIADs as IDirectorySearch); if (FDirSrchIntf = nil) then begin raise EADSISearchException.CreateFmt(rc_CouldNotGetIDS, [FBasePath, FResult]); end; // if we still have a valid search handle => close it if (FSearchHandle <> 0) then begin FResult := FDirSrchIntf.CloseSearchHandle(FSearchHandle); if not Succeeded(FResult) then begin raise EADSISearchException.CreateFmt(rc_CouldNotFreeSH, [FResult]); end; end; // we are currently setting 3 search preferences // for a complete list of possible search preferences, please check // the ADS_SEARCHPREF_xxx values in ActiveDs_TLB.pas SetLength(SrchPrefInfo, 4); // Set maximum number of rows to be what is defined in the MaxRows property SrchPrefInfo[0].dwSearchPref := ADS_SEARCHPREF_SIZE_LIMIT; SrchPrefInfo[0].vValue.dwType := ADSTYPE_INTEGER; SrchPrefInfo[0].vValue.__MIDL_0010.Integer := FMaxRows; // set the "chase referrals" search preference SrchPrefInfo[1].dwSearchPref := ADS_SEARCHPREF_CHASE_REFERRALS; SrchPrefInfo[1].vValue.dwType := ADSTYPE_BOOLEAN; SrchPrefInfo[1].vValue.__MIDL_0010.Boolean := Ord(FChaseReferrals); // set the "search scope" search preference SrchPrefInfo[2].dwSearchPref := ADS_SEARCHPREF_SEARCH_SCOPE; SrchPrefInfo[2].vValue.dwType := ADSTYPE_INTEGER; SrchPrefInfo[2].vValue.__MIDL_0010.Integer := Ord(FSearchScope); // set the "page size " search preference SrchPrefInfo[3].dwSearchPref := ADS_SEARCHPREF_PAGESIZE; SrchPrefInfo[3].vValue.dwType := ADSTYPE_INTEGER; SrchPrefInfo[3].vValue.__MIDL_0010.Integer := FPageSize; // set the search preferences of our directory search interface FResult := FDirSrchIntf.SetSearchPreference(Pointer(SrchPrefInfo), Length(SrchPrefInfo)); if not Succeeded(FResult) then begin raise EADSISearchException.CreateFmt(rc_SetSrchPrefFailed,讨论(0)
加载中...
- 热议问题