ldapclasses.pas

Delphi LDAP Authentication Component delphi ldap控件

begin
  Result := TLdapAttributeData.Create(Self);
  fValues.Add(Result);
end;

procedure TLdapAttribute.AddValue(const AValue: string);
var
  idx: Integer;
  Value: TLdapAttributeData;
begin
  idx := IndexOf(AValue);
  if idx = -1 then
  begin
    Value := TLdapAttributeData.Create(Self);
    fValues.Add(Value);
  end
  else
    Value := TLdapAttributeData(fValues[idx]);
  Value.AsString := AValue;
end;

procedure TLdapAttribute.AddValue(const AData: Pointer; const ADataSize: Cardinal);
var
  idx: Integer;
  Value: TLdapAttributeData;
begin
  idx := IndexOf(AData, ADataSize);
  if idx = -1 then
  begin
    Value := TLdapAttributeData.Create(Self);
    fValues.Add(Value);
  end
  else
    Value := TLdapAttributeData(fValues[idx]);
  Value.SetData(AData, ADataSize);
end;


function TLdapAttribute.GetString: string;
begin
  if fValues.Count > 0 then
    Result := TLdapAttributeData(fValues[0]).AsString
  else
    Result := '';
end;

procedure TLdapAttribute.SetString(AValue: string);
begin
  // Setting string value(s) to '' means deleting of the attribute
  if AValue = '' then
    Delete
  else
  if fValues.Count = 0 then
    AddValue(AValue)
  else
    TLdapAttributeData(fValues[0]).AsString := PChar(AValue);
end;

constructor TLdapAttribute.Create(const AName: string; OwnerList: TLdapAttributeList);
begin
  fName := AName;
  fOwnerList := OwnerList;
  fEntry := OwnerList.fEntry;
  fValues := TList.Create;
end;

destructor TLdapAttribute.Destroy;
var
  i: Integer;
begin
  for i := 0 to fValues.Count - 1 do
    TLDapAttributeData(fValues[i]).Free;
  fValues.Free;
end;

procedure TLdapAttribute.DeleteValue(const AValue: string);
var
  idx: Integer;
begin
  idx := IndexOf(AValue);
  if idx > -1 then
    TLdapAttributeData(fValues[idx]).Delete;
end;

procedure TLdapAttribute.Delete;
var
  i: Integer;
begin
  if asBrowse in State then
  begin
    fState := fState + [asDeleted];
    fEntry.fState := fEntry.fState + [esModified];
  end;
  for i := 0 to fValues.Count - 1 do
    TLdapAttributeData(fValues[i]).Delete;
end;

function TLdapAttribute.IndexOf(const AValue: string): Integer;
begin
  Result := fValues.Count - 1;
  while Result >= 0 do begin
    if AnsiCompareText(AValue, TLdapAttributeData(fValues[Result]).AsString) = 0 then
      break;
    dec(Result);
  end;
end;

function TLdapAttribute.IndexOf(const AData: Pointer; const ADataSize: Cardinal): Integer;
begin
  Result := fValues.Count - 1;
  while Result >= 0 do begin
    if TLdapAttributeData(fValues[Result]).CompareData(AData, ADataSize) then
      break;
    dec(Result);
  end;
end;

{ TLdapAttributeList }

function TLdapAttributeList.GetCount: Integer;
begin
  Result := fList.Count;
end;

function TLdapAttributeList.GetNode(Index: Integer): TLdapAttribute;
begin
  Result := TLdapAttribute(fList[Index]);
end;

constructor TLdapAttributeList.Create(Entry: TLdapEntry);
begin
  fEntry := Entry;
  fList := TList.Create;
end;

destructor TLdapAttributeList.Destroy;
var
  i: Integer;
begin
  for i := 0 to fList.Count - 1 do
    TLdapAttribute(fList[i]).Free;
  fList.Free;
  inherited Destroy;
end;

function TLdapAttributeList.Add(const AName: string): TLdapAttribute;
begin
  Result := TLdapAttribute.Create(AName, Self);
  fList.Add(Result);
end;

function TLdapAttributeList.IndexOf(const Name: string): Integer;
begin
  Result := fList.Count - 1;
  while Result >= 0 do
  begin
    if AnsiCompareText(Name, Items[Result].Name) = 0 then
      break;
    dec(Result);
  end;
end;

function TLdapAttributeList.AttributeOf(const Name: string): TLdapAttribute;
var
  idx: Integer;
begin
  Result := nil;
  for idx := 0 to fList.Count - 1 do
    if AnsiCompareText(Name, Items[idx].Name) = 0 then
    begin
      Result := Items[idx];
      break;
    end;
end;

procedure TLdapAttributeList.Clear;
var
  i: Integer;
begin
  for i := 0 to fList.Count - 1 do
    TLdapAttribute(fList[i]).Free;
  fList.Clear;
end;

{ TLdapEntry }

procedure TLDAPEntry.SetDn(const adn: string);
var
  attrib, value: string;
  i, j: Integer;
begin
  if esBrowse in State then
  begin
    if GetRdnFromDn(adn) <> GetRdnFromDn(fdn) then
    begin
      SplitRDN(adn, attrib, value);
      with AttributesByName[attrib] do
        if AsString <> '' then
          AsString := value;
    end;
    // Reset all flags
    i := Attributes.Count - 1;
    while i >= 0 do with Attributes[i] do
    begin
      fState := [asNew, asModified];
      j := ValueCount - 1;
      while j >= 0 do with Values[j] do
      begin
        if ModOp = LdapOpDelete then
        begin
          Free;
          fValues.Delete(j);
        end
        else
        if ModOp <> LdapOpNoop then
          fModOp := LdapOpAdd;
        dec(j);
      end;
      dec(i);
    end;
    fState := [esNew];
    { added *TEST* }
    if Attributes.Count > 0 then
      fState := fState + [esModified];
  end;
  fdn := adn;
end;

constructor TLDAPEntry.Create(const ASession: TLDAPSession; const adn: string);
begin
  inherited Create;
  fdn := adn;
  fSession := ASession;
  fState := [esNew];
  fAttributes := TLdapAttributeList.Create(Self);
  fOperationalAttributes := TLdapAttributeList.Create(Self);
end;

destructor TLDAPEntry.Destroy;
begin
  fAttributes.Free;
  fOperationalAttributes.Free;
  inherited;
end;

procedure TLDAPEntry.Read;
begin
  fAttributes.Clear;
  fState := [esReading];
  try
    fSession.ReadEntry(Self);
    fState := fState + [esBrowse];
  finally
    fState := fState - [esReading];
  end;
end;

procedure TLDAPEntry.Write;
var
  i, j: Integer;
begin
  if esModified in fState then
  begin
    Session.WriteEntry(Self);
    { added 05.07.2007 - reset all flags to read state}
    fState := fState - [esModified];
    for i := 0 to Attributes.Count - 1 do with Attributes[i] do
    begin
      fState := fState - [asModified];
      for j := 0 to ValueCount - 1 do
        Values[j].fModOp := LdapOpRead;
    end;
  end;
end;

procedure TLDAPEntry.Delete;
begin
  Session.DeleteEntry(dn);
  fState := fState + [esDeleted];
end;

function TLDAPEntry.GetNamedAttribute(const AName: string): TLdapAttribute;
var
  i: Integer;
begin
  i := fAttributes.IndexOf(AName);
  if i < 0 then
    Result := fAttributes.Add(AName)
  else
    Result := fAttributes[i];
end;

{ TLdapEntryList }

function TLdapEntryList.GetCount: Integer;
begin
  Result := fList.Count;
end;

function TLdapEntryList.GetNode(Index: Integer): TLdapEntry;
begin
  Result := TLdapEntry(fList[Index]);
end;

constructor TLdapEntryList.Create;
begin
  fList := TList.Create;
end;

destructor TLdapEntryList.Destroy;
var
  i: Integer;
begin
  for i := 0 to fList.Count - 1 do
    TLdapEntry(fList[i]).Free;
  fList.Free;
  inherited Destroy;
end;

procedure TLdapEntryList.Add(Entry: TLdapEntry);
begin
  fList.Add(Entry);
end;

procedure TLdapEntryList.Clear;
var
  i: Integer;
begin
  for i := 0 to fList.Count - 1 do
    TLdapEntry(fList[i]).Free;
  fList.Clear;
end;

procedure TLdapEntryList.Sort(const Attributes: array of string; const Asc: boolean);
var
  AttrTypes: array of TLdapAttributeSortType;
  i: integer;

  function  DoCompare(Entry1, Entry2: TLdapEntry): Integer;
  var
    i: integer;
  begin
    result := 0;
    for i:=0 to length(AttrTypes)-1 do begin
      case AttrTypes[i] of
        AT_DN:   result:=AnsiCompareStr(Entry1.DN, Entry2.DN);
        AT_RDN:  result:=AnsiCompareStr(GetRdnFromDn(Entry1.DN), GetRdnFromDn(Entry2.DN));
        AT_PATH: result:=AnsiCompareStr(CanonicalName(GetDirFromDn(Entry1.DN)),
                                        CanonicalName(GetDirFromDn(Entry2.DN)));
        else     result:=AnsiCompareStr(Entry1.AttributesByName[Attributes[i]].AsString,
                                         Entry2.AttributesByName[Attributes[i]].AsString)
      end;
      if result<>0 then break;
    end;

    if result=0 then result:=integer(Entry1)-integer(Entry2); // Delete QuickSort instability.
    if not Asc then result:=-result;
  end;

  procedure DoSort(L, R: Integer);
  var
    I, J: Integer;
    E: TLdapEntry;
    T: Pointer;
  begin
    repeat
      I := L;
      J := R;
      E := TLdapEntry(fList[(L + R) shr 1]);
      repeat
        while DoCompare(TLdapEntry(fList[I]), E) < 0 do Inc(I);
        while DoCompare(TLdapEntry(fList[J]), E) > 0 do Dec(J);
        if I <= J then
        begin
          T := fList[I];
          fList[I] := fList[J];
          fList[J] := T;
          Inc(I);
          Dec(J);
        end;
      until I > J;
      if L < J then
        DoSort(L, J);
      L := I;
    until I >= R;
  end;

begin
  if (length(Attributes)=0) or (fList.Count = 0) then exit;
  setlength(AttrTypes, length(Attributes));
  for i:=0 to length(Attributes)-1 do AttrTypes[i]:=GetAttributeSortType(Attributes[i]);

  DoSort(0, fList.Count-1);
end;

procedure TLdapEntryList.Sort(const Compare: TCompareLdapEntry; const Asc: boolean; const Data: pointer=nil);

  function  DoCompare(Entry1, Entry2: TLdapEntry): Integer;
  begin
    Compare(Entry1, Entry2, Data, result);
    if result=0 then result:=integer(Entry1)-integer(Entry2); // Delete QuickSort instability.
    if not Asc then result:=-result;
  end;

  procedure DoSort(L, R: Integer);
  var
    I, J: Integer;
    E: TLdapEntry;
    T: Pointer;
  begin
    repeat
      I := L;
      J := R;
      E := TLdapEntry(fList[(L + R) shr 1]);
      repeat
        while DoCompare(TLdapEntry(fList[I]), E) < 0 do Inc(I);
        while DoCompare(TLdapEntry(fList[J]), E) > 0 do Dec(J);
        if I <= J then
        begin
          T := fList[I];
          fList[I] := fList[J];
          fList[J] := T;
          Inc(I);
          Dec(J);
        end;
      until I > J;
      if L < J then
        DoSort(L, J);
      L := I;
    until I >= R;
  end;

begin
  if fList.Count = 0 then exit;
  DoSort(0, fList.Count-1);
end;

end.