pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

D2009 compatibility fix

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@99 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby 2009-09-29 10:42:05 +00:00
parent 71b081e456
commit b6ad738531
1 changed files with 69 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

137
ldapsend.pas
View File

@ -1,9 +1,9 @@
{==============================================================================| {==============================================================================|
| Project : Ararat Synapse | 001.005.000 | | Project : Ararat Synapse | 001.006.000 |
|==============================================================================| |==============================================================================|
| Content: LDAP client | | Content: LDAP client |
|==============================================================================| |==============================================================================|
| Copyright (c)1999-2008, Lukas Gebauer | | Copyright (c)1999-2009, Lukas Gebauer |
| All rights reserved. | | All rights reserved. |
| | | |
| Redistribution and use in source and binary forms, with or without | | Redistribution and use in source and binary forms, with or without |
@ -33,7 +33,7 @@
| DAMAGE. | | DAMAGE. |
|==============================================================================| |==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2003-2005. | | Portions created by Lukas Gebauer are Copyright (c)2003-2009. |
| All Rights Reserved. | | All Rights Reserved. |
|==============================================================================| |==============================================================================|
| Contributor(s): | | Contributor(s): |
@ -92,15 +92,15 @@ type
descendant of TStringList class enhanced by some new properties.} descendant of TStringList class enhanced by some new properties.}
TLDAPAttribute = class(TStringList) TLDAPAttribute = class(TStringList)
private private
FAttributeName: string; FAttributeName: AnsiString;
FIsBinary: Boolean; FIsBinary: Boolean;
protected protected
function Get(Index: integer): string; override; function Get(Index: integer): string; override;
procedure Put(Index: integer; const Value: string); override; procedure Put(Index: integer; const Value: string); override;
procedure SetAttributeName(Value: string); procedure SetAttributeName(Value: AnsiString);
published published
{:Name of LDAP attribute.} {:Name of LDAP attribute.}
property AttributeName: string read FAttributeName Write SetAttributeName; property AttributeName: AnsiString read FAttributeName Write SetAttributeName;
{:Return @true when attribute contains binary data.} {:Return @true when attribute contains binary data.}
property IsBinary: Boolean read FIsBinary; property IsBinary: Boolean read FIsBinary;
end; end;
@ -123,7 +123,7 @@ type
{:Delete one TLDAPAttribute object from list.} {:Delete one TLDAPAttribute object from list.}
procedure Del(Index: integer); procedure Del(Index: integer);
{:Find and return attribute with requested name. Returns nil if not found.} {:Find and return attribute with requested name. Returns nil if not found.}
function Find(AttributeName: string): TLDAPAttribute; function Find(AttributeName: AnsiString): TLDAPAttribute;
{:List of TLDAPAttribute objects.} {:List of TLDAPAttribute objects.}
property Items[Index: Integer]: TLDAPAttribute read GetAttribute; default; property Items[Index: Integer]: TLDAPAttribute read GetAttribute; default;
end; end;
@ -133,14 +133,14 @@ type
values)} values)}
TLDAPResult = class(TObject) TLDAPResult = class(TObject)
private private
FObjectName: string; FObjectName: AnsiString;
FAttributes: TLDAPAttributeList; FAttributes: TLDAPAttributeList;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
published published
{:Name of this LDAP object.} {:Name of this LDAP object.}
property ObjectName: string read FObjectName write FObjectName; property ObjectName: AnsiString read FObjectName write FObjectName;
{:Here is list of object attributes.} {:Here is list of object attributes.}
property Attributes: TLDAPAttributeList read FAttributes; property Attributes: TLDAPAttributeList read FAttributes;
end; end;
@ -198,13 +198,13 @@ type
private private
FSock: TTCPBlockSocket; FSock: TTCPBlockSocket;
FResultCode: Integer; FResultCode: Integer;
FResultString: string; FResultString: AnsiString;
FFullResult: string; FFullResult: AnsiString;
FAutoTLS: Boolean; FAutoTLS: Boolean;
FFullSSL: Boolean; FFullSSL: Boolean;
FSeq: integer; FSeq: integer;
FResponseCode: integer; FResponseCode: integer;
FResponseDN: string; FResponseDN: AnsiString;
FReferals: TStringList; FReferals: TStringList;
FVersion: integer; FVersion: integer;
FSearchScope: TLDAPSearchScope; FSearchScope: TLDAPSearchScope;
@ -212,15 +212,15 @@ type
FSearchSizeLimit: integer; FSearchSizeLimit: integer;
FSearchTimeLimit: integer; FSearchTimeLimit: integer;
FSearchResult: TLDAPResultList; FSearchResult: TLDAPResultList;
FExtName: string; FExtName: AnsiString;
FExtValue: string; FExtValue: AnsiString;
function Connect: Boolean; function Connect: Boolean;
function BuildPacket(const Value: string): string; function BuildPacket(const Value: AnsiString): AnsiString;
function ReceiveResponse: string; function ReceiveResponse: AnsiString;
function DecodeResponse(const Value: string): string; function DecodeResponse(const Value: AnsiString): AnsiString;
function LdapSasl(Value: string): string; function LdapSasl(Value: AnsiString): AnsiString;
function TranslateFilter(Value: string): string; function TranslateFilter(Value: AnsiString): AnsiString;
function GetErrorString(Value: integer): string; function GetErrorString(Value: integer): AnsiString;
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
@ -249,26 +249,26 @@ type
function Logout: Boolean; function Logout: Boolean;
{:Modify content of LDAP attribute on this object.} {:Modify content of LDAP attribute on this object.}
function Modify(obj: string; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean; function Modify(obj: AnsiString; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean;
{:Add list of attributes to specified object.} {:Add list of attributes to specified object.}
function Add(obj: string; const Value: TLDAPAttributeList): Boolean; function Add(obj: AnsiString; const Value: TLDAPAttributeList): Boolean;
{:Delete this LDAP object from server.} {:Delete this LDAP object from server.}
function Delete(obj: string): Boolean; function Delete(obj: AnsiString): Boolean;
{:Modify object name of this LDAP object.} {:Modify object name of this LDAP object.}
function ModifyDN(obj, newRDN, newSuperior: string; DeleteoldRDN: Boolean): Boolean; function ModifyDN(obj, newRDN, newSuperior: AnsiString; DeleteoldRDN: Boolean): Boolean;
{:Try to compare Attribute value with this LDAP object.} {:Try to compare Attribute value with this LDAP object.}
function Compare(obj, AttributeValue: string): Boolean; function Compare(obj, AttributeValue: AnsiString): Boolean;
{:Search LDAP base for LDAP objects by Filter.} {:Search LDAP base for LDAP objects by Filter.}
function Search(obj: string; TypesOnly: Boolean; Filter: string; function Search(obj: AnsiString; TypesOnly: Boolean; Filter: AnsiString;
const Attributes: TStrings): Boolean; const Attributes: TStrings): Boolean;
{:Call any LDAPv3 extended command.} {:Call any LDAPv3 extended command.}
function Extended(const Name, Value: string): Boolean; function Extended(const Name, Value: AnsiString): Boolean;
{:Try to start SSL/TLS connection to LDAP server.} {:Try to start SSL/TLS connection to LDAP server.}
function StartTLS: Boolean; function StartTLS: Boolean;
@ -280,11 +280,11 @@ type
property ResultCode: Integer read FResultCode; property ResultCode: Integer read FResultCode;
{:Human readable description of result code of last LDAP operation.} {:Human readable description of result code of last LDAP operation.}
property ResultString: string read FResultString; property ResultString: AnsiString read FResultString;
{:Binary string with full last response of LDAP server. This string is {:Binary string with full last response of LDAP server. This string is
encoded by ASN.1 BER encoding! You need this only for debugging.} encoded by ASN.1 BER encoding! You need this only for debugging.}
property FullResult: string read FFullResult; property FullResult: AnsiString read FFullResult;
{:If @true, then try to start TSL mode in Login procedure.} {:If @true, then try to start TSL mode in Login procedure.}
property AutoTLS: Boolean read FAutoTLS Write FAutoTLS; property AutoTLS: Boolean read FAutoTLS Write FAutoTLS;
@ -317,18 +317,18 @@ type
{:When you call @link(Extended) operation, then here is result Name returned {:When you call @link(Extended) operation, then here is result Name returned
by server.} by server.}
property ExtName: string read FExtName; property ExtName: AnsiString read FExtName;
{:When you call @link(Extended) operation, then here is result Value returned {:When you call @link(Extended) operation, then here is result Value returned
by server.} by server.}
property ExtValue: string read FExtValue; property ExtValue: AnsiString read FExtValue;
{:TCP socket used by all LDAP operations.} {:TCP socket used by all LDAP operations.}
property Sock: TTCPBlockSocket read FSock; property Sock: TTCPBlockSocket read FSock;
end; end;
{:Dump result of LDAP SEARCH into human readable form. Good for debugging.} {:Dump result of LDAP SEARCH into human readable form. Good for debugging.}
function LDAPResultDump(const Value: TLDAPResultList): string; function LDAPResultDump(const Value: TLDAPResultList): AnsiString;
implementation implementation
@ -342,7 +342,7 @@ end;
procedure TLDAPAttribute.Put(Index: integer; const Value: string); procedure TLDAPAttribute.Put(Index: integer; const Value: string);
var var
s: string; s: AnsiString;
begin begin
s := Value; s := Value;
if FIsbinary then if FIsbinary then
@ -352,7 +352,7 @@ begin
inherited Put(Index, s); inherited Put(Index, s);
end; end;
procedure TLDAPAttribute.SetAttributeName(Value: string); procedure TLDAPAttribute.SetAttributeName(Value: AnsiString);
begin begin
FAttributeName := Value; FAttributeName := Value;
FIsBinary := Pos(';binary', Lowercase(value)) > 0; FIsBinary := Pos(';binary', Lowercase(value)) > 0;
@ -414,7 +414,7 @@ begin
FAttributeList.Delete(Index); FAttributeList.Delete(Index);
end; end;
function TLDAPAttributeList.Find(AttributeName: string): TLDAPAttribute; function TLDAPAttributeList.Find(AttributeName: AnsiString): TLDAPAttribute;
var var
n: integer; n: integer;
x: TLDAPAttribute; x: TLDAPAttribute;
@ -520,7 +520,7 @@ begin
inherited Destroy; inherited Destroy;
end; end;
function TLDAPSend.GetErrorString(Value: integer): string; function TLDAPSend.GetErrorString(Value: integer): AnsiString;
begin begin
case Value of case Value of
0: 0:
@ -623,13 +623,13 @@ begin
Result := FSock.LastError = 0; Result := FSock.LastError = 0;
end; end;
function TLDAPSend.BuildPacket(const Value: string): string; function TLDAPSend.BuildPacket(const Value: AnsiString): AnsiString;
begin begin
Inc(FSeq); Inc(FSeq);
Result := ASNObject(ASNObject(ASNEncInt(FSeq), ASN1_INT) + Value, ASN1_SEQ); Result := ASNObject(ASNObject(ASNEncInt(FSeq), ASN1_INT) + Value, ASN1_SEQ);
end; end;
function TLDAPSend.ReceiveResponse: string; function TLDAPSend.ReceiveResponse: AnsiString;
var var
x: Byte; x: Byte;
i,j: integer; i,j: integer;
@ -639,9 +639,9 @@ begin
x := FSock.RecvByte(FTimeout); x := FSock.RecvByte(FTimeout);
if x <> ASN1_SEQ then if x <> ASN1_SEQ then
Exit; Exit;
Result := Char(x); Result := AnsiChar(x);
x := FSock.RecvByte(FTimeout); x := FSock.RecvByte(FTimeout);
Result := Result + Char(x); Result := Result + AnsiChar(x);
if x < $80 then if x < $80 then
i := 0 i := 0
else else
@ -667,11 +667,11 @@ begin
FFullResult := Result; FFullResult := Result;
end; end;
function TLDAPSend.DecodeResponse(const Value: string): string; function TLDAPSend.DecodeResponse(const Value: AnsiString): AnsiString;
var var
i, x: integer; i, x: integer;
Svt: Integer; Svt: Integer;
s, t: string; s, t: AnsiString;
begin begin
Result := ''; Result := '';
FResultCode := -1; FResultCode := -1;
@ -713,11 +713,11 @@ begin
Result := Copy(Value, i, Length(Value) - i + 1); Result := Copy(Value, i, Length(Value) - i + 1);
end; end;
function TLDAPSend.LdapSasl(Value: string): string; function TLDAPSend.LdapSasl(Value: AnsiString): AnsiString;
var var
nonce, cnonce, nc, realm, qop, uri, response: string; nonce, cnonce, nc, realm, qop, uri, response: AnsiString;
s: string; s: AnsiString;
a1, a2: string; a1, a2: AnsiString;
l: TStringList; l: TStringList;
n: integer; n: integer;
begin begin
@ -751,12 +751,13 @@ begin
end; end;
end; end;
function TLDAPSend.TranslateFilter(Value: string): string; function TLDAPSend.TranslateFilter(Value: AnsiString): AnsiString;
var var
x: integer; x: integer;
s, t, l, r: string; s, t, l: AnsiString;
c: char; r: string;
attr, rule: string; c: Ansichar;
attr, rule: AnsiString;
dn: Boolean; dn: Boolean;
begin begin
Result := ''; Result := '';
@ -910,7 +911,7 @@ end;
function TLDAPSend.Bind: Boolean; function TLDAPSend.Bind: Boolean;
var var
s: string; s: AnsiString;
begin begin
s := ASNObject(ASNEncInt(FVersion), ASN1_INT) s := ASNObject(ASNEncInt(FVersion), ASN1_INT)
+ ASNObject(FUsername, ASN1_OCTSTR) + ASNObject(FUsername, ASN1_OCTSTR)
@ -924,9 +925,9 @@ end;
function TLDAPSend.BindSasl: Boolean; function TLDAPSend.BindSasl: Boolean;
var var
s, t: string; s, t: AnsiString;
x, xt: integer; x, xt: integer;
digreq: string; digreq: AnsiString;
begin begin
Result := False; Result := False;
if FPassword = '' then if FPassword = '' then
@ -971,9 +972,9 @@ begin
Result := True; Result := True;
end; end;
function TLDAPSend.Modify(obj: string; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean; function TLDAPSend.Modify(obj: AnsiString; Op: TLDAPModifyOp; const Value: TLDAPAttribute): Boolean;
var var
s: string; s: AnsiString;
n: integer; n: integer;
begin begin
s := ''; s := '';
@ -990,9 +991,9 @@ begin
Result := FResultCode = 0; Result := FResultCode = 0;
end; end;
function TLDAPSend.Add(obj: string; const Value: TLDAPAttributeList): Boolean; function TLDAPSend.Add(obj: AnsiString; const Value: TLDAPAttributeList): Boolean;
var var
s, t: string; s, t: AnsiString;
n, m: integer; n, m: integer;
begin begin
s := ''; s := '';
@ -1013,9 +1014,9 @@ begin
Result := FResultCode = 0; Result := FResultCode = 0;
end; end;
function TLDAPSend.Delete(obj: string): Boolean; function TLDAPSend.Delete(obj: AnsiString): Boolean;
var var
s: string; s: AnsiString;
begin begin
s := ASNObject(obj, LDAP_ASN1_DEL_REQUEST); s := ASNObject(obj, LDAP_ASN1_DEL_REQUEST);
Fsock.SendString(BuildPacket(s)); Fsock.SendString(BuildPacket(s));
@ -1024,9 +1025,9 @@ begin
Result := FResultCode = 0; Result := FResultCode = 0;
end; end;
function TLDAPSend.ModifyDN(obj, newRDN, newSuperior: string; DeleteOldRDN: Boolean): Boolean; function TLDAPSend.ModifyDN(obj, newRDN, newSuperior: AnsiString; DeleteOldRDN: Boolean): Boolean;
var var
s: string; s: AnsiString;
begin begin
s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(newRDN, ASN1_OCTSTR); s := ASNObject(obj, ASN1_OCTSTR) + ASNObject(newRDN, ASN1_OCTSTR);
if DeleteOldRDN then if DeleteOldRDN then
@ -1042,9 +1043,9 @@ begin
Result := FResultCode = 0; Result := FResultCode = 0;
end; end;
function TLDAPSend.Compare(obj, AttributeValue: string): Boolean; function TLDAPSend.Compare(obj, AttributeValue: AnsiString): Boolean;
var var
s: string; s: AnsiString;
begin begin
s := ASNObject(Trim(SeparateLeft(AttributeValue, '=')), ASN1_OCTSTR) s := ASNObject(Trim(SeparateLeft(AttributeValue, '=')), ASN1_OCTSTR)
+ ASNObject(Trim(SeparateRight(AttributeValue, '=')), ASN1_OCTSTR); + ASNObject(Trim(SeparateRight(AttributeValue, '=')), ASN1_OCTSTR);
@ -1056,10 +1057,10 @@ begin
Result := FResultCode = 0; Result := FResultCode = 0;
end; end;
function TLDAPSend.Search(obj: string; TypesOnly: Boolean; Filter: string; function TLDAPSend.Search(obj: AnsiString; TypesOnly: Boolean; Filter: AnsiString;
const Attributes: TStrings): Boolean; const Attributes: TStrings): Boolean;
var var
s, t, u: string; s, t, u: AnsiString;
n, i, x: integer; n, i, x: integer;
r: TLDAPResult; r: TLDAPResult;
a: TLDAPAttribute; a: TLDAPAttribute;
@ -1130,9 +1131,9 @@ begin
Result := FResultCode = 0; Result := FResultCode = 0;
end; end;
function TLDAPSend.Extended(const Name, Value: string): Boolean; function TLDAPSend.Extended(const Name, Value: AnsiString): Boolean;
var var
s, t: string; s, t: AnsiString;
x, xt: integer; x, xt: integer;
begin begin
s := ASNObject(Name, $80); s := ASNObject(Name, $80);
@ -1163,7 +1164,7 @@ begin
end; end;
{==============================================================================} {==============================================================================}
function LDAPResultDump(const Value: TLDAPResultList): string; function LDAPResultDump(const Value: TLDAPResultList): AnsiString;
var var
n, m, o: integer; n, m, o: integer;
r: TLDAPResult; r: TLDAPResult;