ldapauth.pas.~29~

Delphi LDAP Authentication Component delphi ldap控件

unit LDAPAuth;

interface


uses Classes, LDAPClasses, SysUtils, STRUTils;

type
  FMdirectoryTypeOptions = (dtMicrosoft, dtEdirectory, dtOpenLDAP);


  TLDAPAuth = class(TComponent)
  private
    ldapServer: string;
    ldapPort: integer;
    ldapuseSSL: boolean;
    ldapVersion: integer;
    ldapBindUsername: string;
    ldapBindPassword: string;
    ldapBaseDN: string;
    fmDirectoryType: FMDirectoryTypeOptions;
    fmAnonymousBind: boolean;
    fmUserSearchAttribute: string;


    function AboutStr: string;
    function defaultLDAPPOrt: integer;
    procedure setLDAPUSESSL(Value: Boolean);
    function defaultLDAPVersion: integer;
    procedure SetDirectoryType(Value: FMDirectoryTypeOptions);

    function MakeMicrosoftLogonDN: string;

  public
    LDAPEntryList: TLDapEntryList;
    LDAPSession: TLdapSession;

    function AuthUser(username: string; password: string; var ErrMsg: string): boolean;
    function ReadAttribute(attribname:string):string;


  published

    property About: string read aboutStr;
    property Server: string read ldapServer write ldapServer;
    property Port: integer read defaultLDAPPort write ldapPort;
    property SSL: boolean read ldapUseSSL write setLDAPUSESSL;
    property Version: integer read ldapVersion write ldapVersion;
    property baseDN: string read ldapBaseDN write ldapBaseDN;
    property BindUsername: string read ldapBindUsername write ldapBindUsername;
    property BindPassword: string read ldapBindPassword write ldapBindPassword;
    property AnonymousBind: boolean read fmAnonymousBind write fmAnonymousBind;
    property DirectoryType: FMDirectoryTypeOptions read fmDirectoryType write SetDirectoryType;
    property SearchAttribute: string read FMUserSearchAttribute write FMUserSearchAttribute;






  end;



procedure Register;


implementation

procedure Register;
begin
  RegisterComponents('FreeMEG', [TLDAPAuth]);
end;


// Design Rubbish

procedure TLdapauth.SetDirectoryType(Value: FMdirectoryTypeOptions);
begin
  fmDirectoryType := value;

  if Value = dtMicrosoft then searchAttribute := 'CN';
  if Value = dteDirectory then searchAttribute := 'CN';
  if Value = dtOpenLDAP then searchAttribute := 'UID';



end;

procedure TLDAPAUth.setLDAPUSESSL(Value: Boolean);
begin
  if value then
  begin
    LDAPUSESSL := TRUE;

    DefaultLDAPPort;
  end
  else
  begin
    LDAPUSESSL := FALSE;
    DefaultLDAPPOrt;

  end;

end;

function TLDAPAUTH.DefaultLDAPVersion: integer;
begin
  if LDAPVersion > 10 then
  begin
    LDAPVersion := 3;
    Result := LDAPVersion;
  end;

end;

function TLDAPAUTH.DefaultLDAPPort: integer;
begin
  if LDAPPort > 65535 then
    if LDAPUSESSL then LDAPPORT := 636 else LDAPPort := 389;

  if ((LDAPPort = 389) and (LDAPUSESSL)) then LDAPPORT := 636;



  Result := LDAPPOrt;
end;

function TLDAPAUTH.AboutStr: string;
begin
  AboutStr := 'FreeMEG LDAP Library - Version 1.0';
end;

// The actual Code;

function TLDAPAUTH.MakeMicrosoftLogonDN: string;
var dummy: string;
begin
  dummy := '';
  dummy := AnsiReplaceText(LDAPBaseDN, ',', '.');
  dummy := AnsiReplaceText(dummy, 'DC=', '');
  result := dummy;


end;

function Tldapauth.ReadAttribute(attribname:string):string;
begin
    if LDAPEntryList.Count > 0 then
    begin
        LDAPEntryList.Items[0].AttributesByName[attribname].AsString;

    end;
end;

function Tldapauth.AuthUser(username: string; password: string; var ErrMsg: string): boolean;
var i: integer;
  SearchFilter: array[0..0] of string;
  SearchCallBack: TSearchCallBack;
begin
  // Assume Result is going to be fine unless something else happends
  Result := true;

    // First Free Previous Search/Login Attempts and start a new one
  try
    LDAPSession.Free;
    LDAPEntryList.Free;
    LDAPSession := TLDAPSession.Create;
    LDAPEntryList := TLDapEntryList.Create;

    //Now setup the connection
    with LDAPSession do
    begin
      Server := LDAPServer;
      Base := LDAPBaseDN;
      Version := LDAPVersion;
      if not fmAnonymousBind then
      begin
        user := LDAPBindUsername;
        password := LDAPBindPassword;
      end;

    //And add some extra optimizations
      pagedsearch := TRUE; //makes it a little faster
      pagesize := 100;
      dereferenceAliases := 1; //We are searching for the first real user that matches
    end;


    LDAPSession.Connect;

    if LDAPSession.Connected then
    begin
        //Okay now we search for our user, the first result returned we logon with.
      SearchFilter[0] := fmUserSearchAttribute;

      LDAPSession.Search(fmUserSearchAttribute + '=' + username, LDAPBaseDN, 2, SearchFilter, TRUE, LDAPEntryList, SearchCallBack);

      if LDAPEntryList.Count > 0 then
      begin
        ldapEntryList.Items[0].Read;

           //Now we disconnect the session and add the username instead of the bindusername to test password
        LDAPSession.Disconnect;
        if fmDirectoryType = dtMicrosoft then
          LDAPSession.User := ldapEntryList.items[0].AttributesByName['cn'].AsString + '@' + MakeMicrosoftLogonDN
        else
          LDAPSession.User := ldapEntryList.items[0].dn;

        LDAPSession.Password := password;
        try
        LDAPSession.Connect;

        IF LDAPSession.Connected then
        begin
           LDAPEntryList.Items[0].Read;
        end
        else
        begin
          Result := False;
          ErrMsg := 'Invalid Login Credentials';
        end;
        except
           on e:exception do
           begin
           errMSG := 'User Invalid Login Credentials';
           Result := false;
           end;
        end;

      end
      else
      begin
        Result := False;
        ErrMsg := 'User Not Found';
      end;

    end
    else
    begin
      Result := False;
      ErrMsg := 'Failed to Connect to LDAP Server';
    end;


  //Catch any exception here that we didn't plan on seeing, send the error back to the calling
  //procedure

  except
    on E: exception do
    begin
      ErrMsg := e.Message;
      Result := False;

    end;
  end;
end;


end.