ldapsend.pas

snmp设计增加相应SNMP的OID,是实时处理的.

          if s <> '' then
            if s[1] = ')' then
              {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(s, 1, 1);
          Result := Result + TranslateFilter(t);
        until s = '';
        Result := ASNOBject(Result, $A1);
      end;
    else
      begin
        l := Trim(SeparateLeft(s, '='));
        r := Trim(SeparateRight(s, '='));
        if l <> '' then
        begin
          c := l[Length(l)];
          case c of
            ':':
              // Extensible match
              begin
                {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
                dn := False;
                attr := '';
                rule := '';
                if Pos(':dn', l) > 0 then
                begin
                  dn := True;
                  l := ReplaceString(l, ':dn', '');
                end;
                attr := Trim(SeparateLeft(l, ':'));
                rule := Trim(SeparateRight(l, ':'));
                if rule = l then
                  rule := '';
                if rule <> '' then
                  Result := ASNObject(rule, $81);
                if attr <> '' then
                  Result := Result + ASNObject(attr, $82);
                Result := Result + ASNObject(DecodeTriplet(r, '\'), $83);
                if dn then
                  Result := Result + ASNObject(AsnEncInt($ff), $84)
                else
                  Result := Result + ASNObject(AsnEncInt(0), $84);
                Result := ASNOBject(Result, $a9);
              end;
            '~':
              // Approx match
              begin
                {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
                Result := ASNOBject(l, ASN1_OCTSTR)
                  + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
                Result := ASNOBject(Result, $a8);
              end;
            '>':
              // Greater or equal match
              begin
                {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
                Result := ASNOBject(l, ASN1_OCTSTR)
                  + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
                Result := ASNOBject(Result, $a5);
              end;
            '<':
              // Less or equal match
              begin
                {$IFDEF CIL}Borland.Delphi.{$ENDIF}System.Delete(l, Length(l), 1);
                Result := ASNOBject(l, ASN1_OCTSTR)
                  + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
                Result := ASNOBject(Result, $a6);
              end;
          else
            // present
            if r = '*' then
              Result := ASNOBject(l, $87)
            else
              if Pos('*', r) > 0 then
              // substrings
              begin
                s := Fetch(r, '*');
                if s <> '' then
                  Result := ASNOBject(DecodeTriplet(s, '\'), $80);
                while r <> '' do
                begin
                  if Pos('*', r) <= 0 then
                    break;
                  s := Fetch(r, '*');
                  Result := Result + ASNOBject(DecodeTriplet(s, '\'), $81);
                end;
                if r <> '' then
                  Result := Result + ASNOBject(DecodeTriplet(r, '\'), $82);
                Result := ASNOBject(l, ASN1_OCTSTR)
                  + ASNOBject(Result, ASN1_SEQ);
                Result := ASNOBject(Result, $a4);
              end
              else
              begin
                // Equality match
                Result := ASNOBject(l, ASN1_OCTSTR)
                  + ASNOBject(DecodeTriplet(r, '\'), ASN1_OCTSTR);
                Result := ASNOBject(Result, $a3);
              end;
          end;
        end;
      end;
  end;
end;

function TLDAPSend.Login: Boolean;
begin
  Result := False;
  if not Connect then
    Exit;
  Result := True;
  if FAutoTLS then
    Result := StartTLS;
end;

function TLDAPSend.Bind: Boolean;
var
  s: string;
begin
  s := ASNObject(ASNEncInt(FVersion), ASN1_INT)
    + ASNObject(FUsername, ASN1_OCTSTR)
    + ASNObject(FPassword, $80);
  s := ASNObject(s, LDAP_ASN1_BIND_REQUEST);
  Fsock.SendString(BuildPacket(s));
  s := ReceiveResponse;
  DecodeResponse(s);
  Result := FResultCode = 0;
end;

function TLDAPSend.BindSasl: Boolean;
var
  s, t: string;
  x, xt: integer;
  digreq: string;
begin
  Result := False;
  if FPassword = '' then
    Result := Bind
  else
  begin
    digreq := ASNObject(ASNEncInt(FVersion), ASN1_INT)
      + ASNObject('', ASN1_NULL)
      + ASNObject(ASNObject('DIGEST-MD5', ASN1_OCTSTR), $A3);
    digreq := ASNObject(digreq, LDAP_ASN1_BIND_REQUEST);
    Fsock.SendString(BuildPacket(digreq));
    s := ReceiveResponse;
    t := DecodeResponse(s);
    if FResultCode = 14 then
    begin
      s := t;
      x := 1;
      t := ASNItem(x, s, xt);
      s := ASNObject(ASNEncInt(FVersion), ASN1_INT)
        + ASNObject('', ASN1_NULL)
        + ASNObject(ASNObject('DIGEST-MD5', ASN1_OCTSTR), $A3)
        + ASNObject(LdapSasl(t), ASN1_OCTSTR);
      s := ASNObject(s, LDAP_ASN1_BIND_REQUEST);
      Fsock.SendString(BuildPacket(s));
      s := ReceiveResponse;
      DecodeResponse(s);
      if FResultCode = 14 then
      begin
        Fsock.SendString(BuildPacket(digreq));
        s := ReceiveResponse;
        DecodeResponse(s);
      end;
      Result := FResultCode = 0;
    end;
  end;
end;

function TLDAPSend.Logout: Boolean;
begin
  Fsock.SendString(BuildPacket(ASNObject('', LDAP_ASN1_UNBIND_REQUEST)));
  FSock.CloseSocket;
  Result := True;
end;

function TLDAPSend.Modify(obj: string; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean;
var
  s: string;
  n: integer;
begin
  s := '';
  for n := 0 to Value.Count -1 do
    s := s + ASNObject(Value[n], ASN1_OCTSTR);
  s := ASNObject(Value.AttributeName, ASN1_OCTSTR) + ASNObject(s, ASN1_SETOF);
  s := ASNObject(ASNEncInt(Ord(Op)), ASN1_ENUM) + ASNObject(s, ASN1_SEQ);
  s := ASNObject(s, ASN1_SEQ);
  s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ);
  s := ASNObject(s, LDAP_ASN1_MODIFY_REQUEST);
  Fsock.SendString(BuildPacket(s));
  s := ReceiveResponse;
  DecodeResponse(s);
  Result := FResultCode = 0;
end;

function TLDAPSend.Add(obj: string; const Value: TLDAPAttributeList): Boolean;
var
  s, t: string;
  n, m: integer;
begin
  s := '';
  for n := 0 to Value.Count - 1 do
  begin
    t := '';
    for m := 0 to Value[n].Count - 1 do
      t := t + ASNObject(Value[n][m], ASN1_OCTSTR);
    t := ASNObject(Value[n].AttributeName, ASN1_OCTSTR)
      + ASNObject(t, ASN1_SETOF);
    s := s + ASNObject(t, ASN1_SEQ);
  end;
  s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ);
  s := ASNObject(s, LDAP_ASN1_ADD_REQUEST);
  Fsock.SendString(BuildPacket(s));
  s := ReceiveResponse;
  DecodeResponse(s);
  Result := FResultCode = 0;
end;

function TLDAPSend.Delete(obj: string): Boolean;
var
  s: string;
begin
  s := ASNObject(obj, LDAP_ASN1_DEL_REQUEST);
  Fsock.SendString(BuildPacket(s));
  s := ReceiveResponse;
  DecodeResponse(s);
  Result := FResultCode = 0;
end;

function TLDAPSend.ModifyDN(obj, newRDN, newSuperior: string; DeleteOldRDN: Boolean): Boolean;
var
  s: string;
begin
  s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(newRDN, ASN1_OCTSTR);
  if DeleteOldRDN then
    s := s + ASNObject(ASNEncInt($ff), ASN1_BOOL)
  else
    s := s + ASNObject(ASNEncInt(0), ASN1_BOOL);
  if newSuperior <> '' then
    s := s + ASNObject(newSuperior, $80);
  s := ASNObject(s, LDAP_ASN1_MODIFYDN_REQUEST);
  Fsock.SendString(BuildPacket(s));
  s := ReceiveResponse;
  DecodeResponse(s);
  Result := FResultCode = 0;
end;

function TLDAPSend.Compare(obj, AttributeValue: string): Boolean;
var
  s: string;
begin
  s := ASNObject(Trim(SeparateLeft(AttributeValue, '=')), ASN1_OCTSTR)
    + ASNObject(Trim(SeparateRight(AttributeValue, '=')), ASN1_OCTSTR);
  s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(s, ASN1_SEQ);
  s := ASNObject(s, LDAP_ASN1_COMPARE_REQUEST);
  Fsock.SendString(BuildPacket(s));
  s := ReceiveResponse;
  DecodeResponse(s);
  Result := FResultCode = 0;
end;

function TLDAPSend.Search(obj: string; TypesOnly: Boolean; Filter: string;
  const Attributes: TStrings): Boolean;
var
  s, t, u: string;
  n, i, x: integer;
  r: TLDAPResult;
  a: TLDAPAttribute;
begin
  FSearchResult.Clear;
  FReferals.Clear;
  s := ASNObject(obj, ASN1_OCTSTR);
  s := s + ASNObject(ASNEncInt(Ord(FSearchScope)), ASN1_ENUM);
  s := s + ASNObject(ASNEncInt(Ord(FSearchAliases)), ASN1_ENUM);
  s := s + ASNObject(ASNEncInt(FSearchSizeLimit), ASN1_INT);
  s := s + ASNObject(ASNEncInt(FSearchTimeLimit), ASN1_INT);
  if TypesOnly then
    s := s + ASNObject(ASNEncInt($ff), ASN1_BOOL)
  else
    s := s + ASNObject(ASNEncInt(0), ASN1_BOOL);
  if Filter = '' then
    Filter := '(objectclass=*)';
  t := TranslateFilter(Filter);
  if t = '' then
    s := s + ASNObject('', ASN1_NULL)
  else
    s := s + t;
  t := '';
  for n := 0 to Attributes.Count - 1 do
    t := t + ASNObject(Attributes[n], ASN1_OCTSTR);
  s := s + ASNObject(t, ASN1_SEQ);
  s := ASNObject(s, LDAP_ASN1_SEARCH_REQUEST);
  Fsock.SendString(BuildPacket(s));
  repeat
    s := ReceiveResponse;
    t := DecodeResponse(s);
    if FResponseCode = LDAP_ASN1_SEARCH_ENTRY then
    begin
      //dekoduj zaznam
      r := FSearchResult.Add;
      n := 1;
      r.ObjectName := ASNItem(n, t, x);
      ASNItem(n, t, x);
      if x = ASN1_SEQ then
      begin
        while n < Length(t) do
        begin
          s := ASNItem(n, t, x);
          if x = ASN1_SEQ then
          begin
            i := n + Length(s);
            a := r.Attributes.Add;
            u := ASNItem(n, t, x);
            a.AttributeName := u;
            ASNItem(n, t, x);
            if x = ASN1_SETOF then
              while n < i do
              begin
                u := ASNItem(n, t, x);
                a.Add(UnquoteStr(u, '"'));
              end;
          end;
        end;
      end;
    end;
    if FResponseCode = LDAP_ASN1_SEARCH_REFERENCE then
    begin
      n := 1;
      while n < Length(t) do
        FReferals.Add(ASNItem(n, t, x));
    end;
  until FResponseCode = LDAP_ASN1_SEARCH_DONE;
  Result := FResultCode = 0;
end;

function TLDAPSend.Extended(const Name, Value: string): Boolean;
var
  s, t: string;
  x, xt: integer;
begin
  s := ASNObject(Name, $80);
  if Value <> '' then
    s := s + ASNObject(Value, $81);
  s := ASNObject(s, LDAP_ASN1_EXT_REQUEST);
  Fsock.SendString(BuildPacket(s));
  s := ReceiveResponse;
  t := DecodeResponse(s);
  Result := FResultCode = 0;
  if Result then
  begin
    x := 1;
    FExtName := ASNItem(x, t, xt);
    FExtValue := ASNItem(x, t, xt);
  end;
end;


function TLDAPSend.StartTLS: Boolean;
begin
  Result := Extended('1.3.6.1.4.1.1466.20037', '');
  if Result then
  begin
{$IFDEF STREAMSEC}
    if Assigned(FTLSServer) then
    begin
      Fsock.TLSServer := FTLSServer;
      Fsock.Connect('','');
      Result := FSock.LastError = 0;
    end
    else
      Result := false;
{$ELSE}
    Fsock.SSLDoConnect;
    Result := FSock.LastError = 0;
{$ENDIF}
  end;
end;

{==============================================================================}
function LDAPResultDump(const Value: TLDAPResultList): string;
var
  n, m, o: integer;
  r: TLDAPResult;
  a: TLDAPAttribute;
begin
  Result := 'Results: ' + IntToStr(Value.Count) + CRLF +CRLF;
  for n := 0 to Value.Count - 1 do
  begin
    Result := Result + 'Result: ' + IntToStr(n) + CRLF;
    r := Value[n];
    Result := Result + '  Object: ' + r.ObjectName + CRLF;
    for m := 0 to r.Attributes.Count - 1 do
    begin
      a := r.Attributes[m];
      Result := Result + '  Attribute: ' + a.AttributeName + CRLF;
      for o := 0 to a.Count - 1 do
        Result := Result + '    ' + a[o] + CRLF;
    end;
  end;
end;

end.