ldapclasses.pas

Delphi LDAP Authentication Component delphi ldap控件

procedure TLDAPSession.SetSSL(SSL: Boolean);
begin
  Disconnect;
  ldapSSL := SSL;
end;

procedure TLDAPSession.SetLdapAuthMethod(Method: TLdapAuthMethod);
begin
  Disconnect;
  ldapAuthMethod := Method;
end;

procedure TLDAPSession.SetTimeLimit(const Value: Integer);
begin
  if Value <> fTimeLimit then
  begin
    fTimeLimit := Value;
    if Connected then
      LdapCheck(ldap_set_option(pld, LDAP_OPT_TIMELIMIT,@Value), false);
  end;
end;

procedure TLDAPSession.SetSizeLimit(const Value: Integer);
begin
  if Value <> fSizeLimit then
  begin
    fSizeLimit := Value;
    if Connected then
      LdapCheck(ldap_set_option(pld, LDAP_OPT_SIZELIMIT,@Value), false);
  end;
end;

procedure TLDAPSession.SetDerefAliases(const Value: Integer);
begin
  if Value <> fDerefAliases then
  begin
    fDerefAliases := Value;
    if Connected then
      LdapCheck(ldap_set_option(pld, LDAP_OPT_DEREF,@Value), false);
  end;
end;

procedure TLDAPSession.SetChaseReferrals(const Value: boolean);
var
  v: Pointer;
begin
  if Value <> fChaseReferrals then
  begin
    fChaseReferrals := Value;
    if Connected then
    begin
      if Value then
        v := LDAP_OPT_ON
      else
        v := LDAP_OPT_OFF;
      LdapCheck(ldap_set_option(pld, LDAP_OPT_SIZELIMIT, @v), false);
    end;
  end;
end;

procedure TLDAPSession.SetReferralHops(const Value: Integer);
begin
  if Value <> fReferralHops then
  begin
    fReferralHops := Value;
    if Connected then
      LdapCheck(ldap_set_option(pld, LDAP_OPT_REFERRAL_HOP_LIMIT,@Value), false);
  end;
end;

function TLDAPSession.GetOperationalAttrs: string;
var
  i: Integer;
begin
  if Assigned(fOperationalAttrs) then
  begin
     Result := fOperationalAttrs[Low(fOperationalAttrs)];
     for i := Low(fOperationalAttrs) to High(fOperationalAttrs) do
       Result := Result + ',' +  fOperationalAttrs[i];
  end
  else
    Result := '';
end;

procedure TLDAPSession.SetOperationalAttrs(const Value: string);
var
  fStringList: TStringList;
  i: Integer;
begin
  for i := Low(fOperationalAttrs) to High(fOperationalAttrs) do
    StrDispose(fOperationalAttrs[i]);
  if Value <> '' then
  begin
    fStringList := TStringList.Create;
    with fStringList do
    try
      CommaText := Value;
      SetLength(fOperationalAttrs, Count + 1);
      fOperationalAttrs[Count] := nil;
      for i := 0 to Count - 1 do
        fOperationalAttrs[i] := StrNew(PChar(fStringList[i]));
    finally
      Free;
    end;
  end
  else
    fOperationalAttrs := nil;
end;

procedure TLDAPSession.SetConnect(DoConnect: Boolean);
begin
  if not Connected then
    Connect;
end;

function TLDAPSession.IsConnected: Boolean;
begin
  Result := Assigned(pld);
end;

constructor TLDAPSession.Create;
begin
  inherited Create;
  ldapAuthMethod := AUTH_SIMPLE;
  ldapPort := LDAP_PORT;
  ldapVersion := LDAP_VERSION3;
  ldapSSL := false;
  fTimeLimit := SESS_TIMEOUT;
  fSizeLimit := SESS_SIZE_LIMIT;
  fPagedSearch := true;
  fPageSize := SESS_PAGE_SIZE;
  fDerefAliases := LDAP_DEREF_NEVER;
  fChaseReferrals := true;
  fReferralHops := SESS_REFF_HOP_LIMIT;
// fOnConnect := TNotifyEvent.create;
// fOnDisconnect := TNotifyEvent.Create;
end;

destructor TLDAPSession.Destroy;
begin
  try
    Disconnect;
  except
    on E: exception do MessageDlg(E.Message, mtError, [mbOk], 0);
  end;
//  fOnConnect.Free;
// fOnDisconnect.Free;
  OperationalAttrs := ''; // dispose string array
  inherited;
end;

procedure TLDAPSession.Connect;
var
  res: Cardinal;
  v: Pointer;
  ident: SEC_WINNT_AUTH_IDENTITY;
begin
  if (ldapUser<>'') and (ldapPassword='') then
    if not InputDlg(cEnterPasswd, Format(stPassFor, [ldapUser]), ldapPassword, '*', true) then Abort;
  if ldapSSL then
    ldappld := ldap_sslinit(PChar(ldapServer), ldapPort,1)
  else
    ldappld := ldap_init(PChar(ldapServer), ldapPort);
  if Assigned(pld) then
  try
    LdapCheck(ldap_set_option(pld,LDAP_OPT_PROTOCOL_VERSION,@ldapVersion));
    if ldapSSL then
    begin
      res := ldap_set_option(pld, LDAP_OPT_SERVER_CERTIFICATE, @VerifyCert);
      if (res <> LDAP_SUCCESS) and (res <> LDAP_LOCAL_ERROR) then
        LdapCheck(res);
      CertServerName := PChar(ldapServer);
    end;
    CertUserAbort := false;
    case ldapAuthMethod of
      AUTH_SIMPLE:   res := ldap_simple_bind_s(ldappld, PChar(ldapUser), PChar(ldapPassword));
      AUTH_GSS,
      AUTH_GSS_SASL: if (ldapUser <> '') or (ldapPassword <> '') then
                     begin
                       ident.User := PChar(ldapUser);
                       ident.UserLength := Length(ldapUser);
                       ident.Domain := '';
                       ident.DomainLength := 0;
                       ident.Password := PChar(ldapPassword);
                       ident.PasswordLength := Length(Password);
                       ident.Flags := SEC_WINNT_AUTH_IDENTITY_ANSI;
                       if ldapAuthMethod = AUTH_GSS_SASL then
                         LdapCheck(ldap_set_option(pld,LDAP_OPT_ENCRYPT, LDAP_OPT_ON));
                       res := ldap_bind_s(ldappld, nil, @ident, LDAP_AUTH_NEGOTIATE);
                     end
                     else
                       res := ldap_bind_s(ldappld, nil, nil, LDAP_AUTH_NEGOTIATE);
    else
      raise Exception.Create('Invalid authentication method!');
    end;

    //res := ldap_simple_bind_s(ldappld, PChar(ldapUser), PChar(ldapPassword));
    if CertUserAbort then
      Abort;
    LdapCheck(res);
    if ldapVersion < 3 then
      fPagedSearch := false;
    // set options
    if fTimeLimit <> SESS_TIMEOUT then
      LdapCheck(ldap_set_option(pld,LDAP_OPT_TIMELIMIT,@fTimeLimit), false);
    if fSizeLimit <> SESS_SIZE_LIMIT then
      LdapCheck(ldap_set_option(pld,LDAP_OPT_SIZELIMIT,@fSizeLimit), false);
    if fDerefAliases <> LDAP_DEREF_NEVER then
      LdapCheck(ldap_set_option(pld, LDAP_OPT_DEREF,@fDerefAliases), false);
    if not fChaseReferrals then
    begin
      v := LDAP_OPT_OFF;
      LdapCheck(ldap_set_option(pld, LDAP_OPT_SIZELIMIT, @v), false);
    end;
    if fReferralHops <> SESS_REFF_HOP_LIMIT then
      LdapCheck(ldap_set_option(pld, LDAP_OPT_REFERRAL_HOP_LIMIT,@fReferralHops), false);
  except
    // close connection
    LdapCheck(ldap_unbind_s(pld), false);
    ldappld := nil;
    raise;
  end;
//  fOnConnect
//  Execute(self);
end;

procedure TLDAPSession.Disconnect;
begin
  if Connected then
  begin
//    fOnDisconnect.Execute(self);
    LdapCheck(ldap_unbind_s(pld), false);
    ldappld := nil;
  end;
end;

{ TLDapAttributeData }

function TLDapAttributeData.GetType: TDataType;
var
  l: Integer;
begin
  if (fType = dtUnknown) and (DataSize > 0) then
  begin
    l := MultiByteToWideChar( CP_UTF8, 8{MB_ERR_INVALID_CHARS}, PChar(Data), DataSize, nil, 0);
    if l <> 0 then
      fType := dtText
    else
      fType := dtBinary;
  end;
  Result := fType;
end;

function TLDapAttributeData.GetString: string;
begin
  if Assigned(Self) and (ModOp <> LdapOpNoop) and (ModOp <> LdapOpDelete) then
  begin
    if fUtf8 then
      Result := UTF8ToStringLen(PChar(Data), DataSize)
    else
      System.SetString(Result, PChar(Data), DataSize);
  end
  else
    Result := '';
end;

procedure TLDapAttributeData.SetString(AValue: string);
var
  s: string;
begin
  if fUtf8 then
    s := StringToUtf8Len(PChar(AValue), Length(AValue))
  else
    s := AVAlue;
  SetData(PChar(s), Length(s));
end;

procedure TLDapAttributeData.LoadFromStream(Stream: TStream);
var
  p: Pointer;
begin
  with Stream do
  begin
    GetMem(P, Size);
    try
      ReadBuffer(P^, Size);
      SetData(P, Size);
    finally
      FreeMem(P);
    end;
  end;
end;

procedure TLDapAttributeData.SaveToStream(Stream: TStream);
begin
  if Assigned(Self) and (ModOp <> LdapOpNoop) and (ModOp <> LdapOpDelete) then
    Stream.WriteBuffer(Berval.bv_Val^, fBerval.Bv_Len);
end;

function TLDapAttributeData.BervalAddr: PLdapBerval;
begin
  Result := Addr(fBerval);
end;

constructor TLDapAttributeData.Create(Attribute: TLdapAttribute);
begin
  fAttribute := Attribute;
  fEntry := Attribute.fEntry;
  fType := dtUnknown;
  if not (Assigned(fEntry) and Assigned(fEntry.Session) and (fEntry.Session.Version < LDAP_VERSION3)) then
    fUtf8 := true;
  inherited Create;
end;

{ Same as Result := (DataSize <> ADataSize) or not (Assigned(fBerval.Bv_Val) and CompareMem(AData, Data, ADataSize)); }
function TLDapAttributeData.CompareData(P: Pointer; Length: Integer): Boolean; assembler;
asm
        PUSH    ESI
        PUSH    EDI
        MOV     ESI,P
        MOV     EDX,EAX
        XOR     EAX,EAX
        MOV     EDI,[edx + fBerval.Bv_Val]
        CMP     ECX,[edx + fBerval.Bv_Len]
        JNE     @@2
        CMP     ESI,EDI
        JE      @@1
        REPE    CMPSB
        JNE     @@2
@@1:    INC     EAX
@@2:    POP     EDI
        POP     ESI
end;

procedure TLDapAttributeData.SetData(AData: Pointer; ADataSize: Cardinal);
var
  i: Integer;
begin
  if ADataSize = 0 then
    Delete
  else
  begin
    fAttribute.fState := fAttribute.fState - [asDeleted];
    if not CompareData(AData, ADataSize) then
    begin
      fType := dtUnknown;
      fBerval.Bv_Len := ADataSize;
      SetLength(fBerval.Bv_Val, ADataSize);
      Move(AData^, Pointer(fBerval.Bv_Val)^, ADataSize);
      if esReading in fEntry.State then
        fModOp := LdapOpRead
      else
      begin
        if ModOp = LdapOpNoop then
          fModOp := LDAP_MOD_ADD
        else
        if ModOp <> LDAP_MOD_ADD then
        begin
          for i := 0 to fAttribute.ValueCount - 1 do
            fAttribute.Values[i].fModOp := LDAP_MOD_REPLACE;
        end;
        fEntry.fState := fEntry.fState + [esModified];
        fAttribute.fState := fAttribute.fState + [asModified];
      end;
    end
    else begin
      if ModOp = LdapOpNoop then
        fModOp := LDAP_MOD_ADD
      else
      if ModOp = LDAP_MOD_DELETE then
        fModOp := LdapOpRead;
    end;
  end;
  if Assigned(fEntry.OnChange) then fEntry.OnChange(Self);
end;

procedure TLDapAttributeData.Delete;
var
  i: Integer;
begin
  if (fModOp = LdapOpNoop) then Exit;
  if fModOp = LDAP_MOD_ADD then
    fModOp := LdapOpNoop
  else
  begin
    if (fModOp = LdapOpReplace) and (fAttribute.fValues.Count > 1) then
    begin
      fModOp := LdapOpRead;
      with fAttribute do
      begin
        i := fValues.Count - 1;
        while i >= 0 do with Values[i] do
        begin
          if ModOp = LdapOpReplace then
            Exit;
          dec(i);
        end;
      end;
    end;

    fModOp := LDAP_MOD_DELETE;
    fAttribute.fState := fAttribute.fState + [asModified];
    fEntry.fState := fEntry.fState + [esModified];
    { Added to handle attributes with no equality matching rule.
    { Check if all single values are deleted, if so delete attribute as whole. }
    with fAttribute do
    begin
      i := fValues.Count - 1;
      while i >= 0 do with Values[i] do
      begin
        if (ModOp <> LdapOpDelete) and (ModOp <> LdapOpNoop) then
          break;
        dec(i);
      end;
      if i = -1 then
        fAttribute.fState := fAttribute.fState + [asDeleted];
    end;
    { end change }
  end;
  if Assigned(fEntry.OnChange) then fEntry.OnChange(Self);
end;

{ TLdapAttribute }

function TLdapAttribute.GetCount: Integer;
begin
  Result := fValues.Count;
end;

function TLdapAttribute.GetValue(Index: Integer): TLdapAttributeData;
begin
  if fValues.Count > 0 then
    Result := fValues[Index]
  else
    Result := nil;
end;

function TLdapAttribute.AddValue: TLdapAttributeData;