ldapauth.pas

Delphi LDAP Authentication Component delphi ldap控件

  {      LDAPAUTH - LDAPAUTH.pas
  *      Copyright (C) 2008 FreeMEG Software
  *      Website: http://www.freemeg.com
  *
  *      Author: Solomon Box
  *
  *
  * This file is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
  * the Free Software Foundation; either version 2 of the License, or
  * (at your option) any later version.
  *
  * This file is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU General Public License for more details.
  *
  * You should have received a copy of the GNU General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
  }
unit LDAPAuth;

interface


uses Classes, LDAPClasses, SysUtils, STRUTils;

type
  FMdirectoryTypeOptions = (dtMicrosoft, dtEdirectory, dtOpenLDAP);


  TLDAPAuth = class(TComponent)
  private

  protected

           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;

         constructor Create(Owner:TComponent); override;
    destructor Destroy;override;
  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

constructor TLdapAuth.Create(Owner: TComponent);
begin
  inherited;
  self.LdapVersion := 3;
end;

destructor TLdapAuth.Destroy;
begin
  LdapSession.Free;
  LDapEntryList.Free;
  inherited;
end;

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.1';
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
       result :=  LDAPEntryList.Items[0].AttributesByName[attribname].AsString;

    end;
end;

function Tldapauth.AuthUser(username: string; password: string; var ErrMsg: string): boolean;
var
  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[fmUserSearchAttribute].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.