Delphi'yi Active Directory ile nasıl entegre edebilirim?

Question

Microsoft'un Active Directory'deki bir kullanıcıyı Delphi 7'yi kullanarak doğrulamamız gerekiyor, bunu yapmanın en iyi yolu nedir? kullanıcı adı alanını içerebilir ağ kullanıcı adı ve şifre girer, ve geçerli bir aktif kullanıcı ise biz aktif dizin kontrol edin:

Biz iki senaryo olabilir. Ya da şimdiki oturum açmış olan kullanıcıyı Windows'dan alıp, hala geçerli olup olmadığını kontrol edin.

ilk senaryo

kullanıcı doğrulaması gerektiriyorsa, sadece ikincisine basit AD arama yaparken ve bulun.

kimse bileşenleri veya yukarıda açıklanan senaryolardan birini veya her ikisini birden yapın kod biliyor mu

?

Answer 1

tarihinde Delphi ile ADSI kullanarak için, o

Active Directory Service Interfaces

Using ADSI in Delphi

bahsediyor bazı makaleler bulabilirsiniz ve pencereleri hizmetlerin birçoğunu yönetmek için sunduğu bileşenler hangi ayrıca online-admin bakabilirsiniz AD

Answer 2

dahil hep büyük bir başarı ile, AD ile çalışmak için 'ADSISearch.pas' birimi kullandım.

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; 

Ve daha fazla gecikmeden, burada (benim tarafımdan yazılmamış) birimidir:: Ayrıca, burada onların AD nesneden bir kullanıcının homedrive bilgi almak için (yani bu üniteyi kullanır) kullanılan bazı koddur

(* ---------------------------------------------------------------------------- 
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, 

Answer 3

Burada yazdığımız ünitesi ve yaramaz. Basit ve işi bitirir.

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. 

Answer 4

benim ADSISearch bileşeni :-) Burada sözü görmek gurur duydum, ama sadece kullanıcı kimlik bilgilerini doğrulamak amacıyla, siz "LogonUser" Win32 API kullanarak muhtemelen kapalı bile daha iyidir. Oldukça eminim ki (artık herhangi bir Delphi çalışması yapmamak), muhtemelen bir yerde - yani JVCL kütüphanesinde ya da başka bir yerde - bunun etrafında yüzmenin bir uygulaması var.