interface
uses
Linldap,sysutils,classes;
type
ELDAP =
class(
Exception);
PCharArray =
array of pchar;
PLDAPModArray =
array of PLDAPMod;
PPCharArray = ^PCharArray;
PPLDAPModArray = ^PLDAPModArray;
ldapAttribute =
class(Tobject)
private
fName:
string;
fValues:TStringlist;
function GetValue(I:integer):
string;
procedure Add(S:
String);
procedure Delete(S:
string);
function getExists(V:
string): boolean;
public
constructor Create(
Name:
string);
destructor Destroy;
override;
property Name:
string read fName;
property Exists[V:
string]:boolean
read getExists;
property ValueList:TStringlist
read fValues;
property Value[I:integer]:
string read GetValue;
default;
end;
ldapentryList =
class;
ldapEntry =
class(TObject)
private
fdn:
string;
P:
array of PLDAPMod;
fParent:ldapEntry;
fAttributes: TStringlist;
fChildren: ldapEntrylist;
function GetAttribute(
Name:
string): ldapAttribute;
function GetAttributeValue(
Name:
string; Idx:Integer):
string;
function GetNiceName:
string;
procedure MakeLDAPArray;
procedure MakeModLDAPArray(le: ldapEntry);
procedure ApplyChangesInMemory;
procedure DisposeLDAPArray;
function GetExists(
Name, Value:
string): boolean;
function GetLDIF:
string;
procedure SetLDIF(S:
string);
function Equal(
Name:
string;le:ldapEntry;
var SL:Tstringlist):boolean;
function AddsOnly(
Name:
string; le: ldapEntry;
var SL:Tstringlist): boolean;
function DeletesOnly(
Name:
string; le: ldapEntry;
var SL: Tstringlist): boolean;
procedure ClearAll;
public
property DN:
string read fDN
write fDN;
property AttributeValue[
Name:
string;Idx:integer]:
string read GetAttributeValue;
default;
property Attribute[
Name:
string]:ldapAttribute
read GetAttribute;
property Children:ldapEntryList
read fChildren;
property Parent:ldapEntry
read fParent;
property Exists[
Name,Value:
string]:boolean
read GetExists;
property NameList:TStringList
read fAttributes;
property NiceName:
string read GetNiceName;
property AsLDIF:
string read GetLDIF
write SetLDIF;
constructor Create;
overload;
constructor Create(le:ldapEntry);
overload;
procedure Assign(le: ldapEntry);
destructor Destroy;
function FreeChild(ee: ldapEntry): boolean;
procedure Add(
Name,Value:
string);
overload;
procedure Add(
Name:
string; Value:
array of string);
overload;
procedure Modify(
Name:
string;Value:
array of string);
overload;
procedure Modify(
Name,Value:
string);
overload;
procedure Delete(
Name:
string);
overload;
procedure Delete(
Name,Value:
string);
overload;
end;
ldapEntryList =
class(TStringList)
function GetEntry(Idx:integer):ldapEntry;
function GetDN(Idx:integer):
string;
function GetEntryValue(Idx:integer;Attribute:
string;AttributeIndex:integer):
string;
public
property DN[Idx:integer]:
string read GetDN;
property Entry[Idx:integer]:ldapEntry
read GetEntry;
default;
property EntryValue[Idx:integer;Attribute:
string;AttributeIndex:integer]:
string read GetEntryValue;
function NewEntry(
const DN:
string):ldapEntry;
procedure ClearAll;
destructor Destroy;
end;
ldapConnection =
class(tObject)
private
fConn:PLDAP;
fHost,fDN,fPWD:
string;
fPort:integer;
fBaseDN:
string;
procedure LDAPError(
const s:
string);
procedure LDAPCheck(err: ULONG);
public
property Host:
string read fHost
write fHost;
property Port:integer
read fPort
write fPort;
property BindDN:
string read fDN
write fDN;
property BaseDN:
string read fBaseDN
write fBaseDN;
property BindPwd:
string read fPWD
write fPWD;
function UidToDN(
const Uid:
string;
const Base:
string):
string;
procedure Open;
overload;
procedure Open(
const Hostname:
string;
const BindAs:string='
';
const BindPassword:string='
';
const PortNumber:integer=389);
overload;
procedure ReBind(
const BindAs, BindPassword:
string);
procedure Search(
var Results:ldapEntryList;
const Base:
string;
const Search:string='
(objectclass=*)';
const Scope:string='
sub');
overload;
procedure Search(
var Results:ldapEntryList;
const DNs:ldapAttribute);
overload;
procedure Add(
const Entry:ldapEntry);
procedure Fill(
var Entry:ldapEntry);
procedure Modify(
const Entry,NewEntry: ldapEntry);
procedure Delete(
const DN:
string);
overload;
procedure Delete(
const Entry: ldapEntry);
overload;
procedure Close;
end;
function AttributeName(S:
string):
string;
function AttributeValue(S:
string):
string;
function FindDn(
const server,base,Uid:
string):
string;
function ValidDn(
const server,dn,uid,pwd:
string):boolean;
function RDN(dn:
string):
string;
function FullDN(rdn,basedn:
string):
string;
function Check(
const Server:
string;
const PortNumber:integer;
const Uid,Password,BaseDN:
string):boolean;
implementation
uses LDAP_Test_Main;
function AttributeName(S:
string):
string;
begin
if pos('
:',S)>0
then
Result:=copy(S,1,pos('
:',S)-1)
else
Result:='
';
end;
function AttributeValue(S:
string):
string;
begin
if pos('
:',S)>0
then
Result:=copy(S,pos('
:',S)+1,999)
else
Result:='
';
end;
function RDN(dn:
string):
string;
var
I:integer;
begin
I:=pos('
,',dn);
if I>1
then
begin
result:=trim(copy(dn,1,I-1))
end
else
result:=dn;
end;
function FullDN(rdn,basedn:
string):
string;
begin
if pos('
,',rdn)=0
then
result:=rdn+'
,'+basedn
else
result:=rdn;
end;
{ ldapAttribute }
constructor ldapAttribute.Create(
Name:
string);
begin
inherited Create;
fName:=Name;
fValues:=TStringlist.Create;
fValues.Duplicates:=dupIgnore;
fValues.Sorted:=false;
end;
destructor ldapAttribute.Destroy;
begin
fValues.Free;
inherited;
end;
function ldapAttribute.getExists(V:
string): boolean;
begin
result:=Self.fValues.IndexOf(V)>=0;
end;
function ldapAttribute.Getvalue(I:integer):
string;
begin
if (I>=0)
and (I<fValues.Count)
then
Result:=fValues[I]
else Result:='
';
end;
procedure ldapAttribute.Delete(S:
string);
var I:integer;
begin
I:=fValues.Indexof(S);
if I>=0
then fValues.Delete(I);
end;
procedure ldapAttribute.Add(S:
String);
begin
fValues.Add(S);
end;
{ ldapEntry }
constructor ldapEntry.Create;
begin
inherited;
fAttributes:=TStringList.create;
fattributes.Duplicates:=dupIgnore;
fattributes.sorted:=false;
fChildren:=ldapEntrylist.create;
end;
constructor ldapEntry.Create(le: ldapEntry);
begin
Create;
Assign(le);
end;
procedure ldapEntry.Assign(le: ldapEntry);
var
I:integer;
la:ldapAttribute;
newle:ldapEntry;
begin
Self.ClearAll;
fDN:=le.fdn;
for I:=0
to le.NameList.count-1
do
begin
la:=ldapAttribute.Create(le.NameList[i]);
la.ValueList.Assign(le.Attribute[le.NameList[i]].ValueList);
Self.fAttributes.AddObject(le.NameList[i],la);
end;
for I:=0
to le.fChildren.count-1
do
begin
newle:=ldapEntry.Create(le.Children[I]);
Self.Children.AddObject(le.Children[I].DN,newle);
newle.fParent:=Self;
end;
end;
procedure ldapEntry.ClearAll;
var
I:integer;
begin
fdn:='
';
Self.DisposeLDAPArray;
if assigned(fAttributes)
then
begin
for I:=0
to fAttributes.count-1
do
ldapAttribute(fAttributes.Objects[I]).Free;
fAttributes.Clear;
end;
end;
destructor ldapEntry.Destroy;
begin
ClearAll;
fChildren.Free;
fAttributes.free;
inherited;
end;
function ldapEntry.GetNiceName:
string;
var
I:integer;
begin
result:='
';
if Self.Exists['
objectclass','
groupofuniquenames']
then
result:='
['+Self.GetAttributeValue('
cn',0)+'
]'
else if Self.GetAttributeValue('
sn',0)<>'
'
then
result:=trim(Self.GetAttributeValue('
sn',0)+'
, '+Self.GetAttributeValue('
personaltitle',0)+'
'+Self.GetAttributeValue('
givenname',0))
else if Self.GetAttributeValue('
cn',0)<>'
'
then
result:=Self.GetAttributeValue('
cn',0)
else begin
if Self.AttributeValue['
ou',0]<>'
'
then
begin
for I:=0
to Self.Attribute['
ou'].ValueList.Count-1
do
if pos(uppercase(Self.GetAttributeValue('
ou',I)),uppercase(RDN(self.DN)))<>0
then
Result:=Self.GetAttributeValue('
ou',I);
end;
if Result='
'
then
Result:=RDN(Self.DN);
end;
end;
procedure ldapEntry.Modify(
Name:
string;Value:
array of string);
var
I:integer;
begin
if uppercase(
name)='
DN'
then
raise ELDAP.Create('
Cannot Modify DN of Entry')
else
begin
Self.Delete(
Name);
for I:=low(value)
to high(value)
do
Self.Add(
Name,value[I]);
end;
end;
procedure ldapEntry.Modify(
Name,Value:
string);
begin
if uppercase(
name)='
DN'
then
raise ELDAP.Create('
Cannot Modify DN of Entry')
else
begin
Self.Delete(
Name);
Self.Add(
Name,value);
end;
end;
procedure ldapEntry.Add(
Name:
string;Value:
array of string);
var
I:integer;
begin
for I:=low(value)
to high(value)
do
Add(
Name,value[I]);
end;
procedure ldapEntry.Add(
Name,Value:
string);
var
la:ldapAttribute;
begin
if uppercase(
name)='
DN'
then
raise ELDAP.Create('
Cannot Modify DN of Entry')
else
begin
la:=Self.Attribute[
Name];
if not assigned(la)
then
begin
la:=ldapAttribute.Create(
Name);
self.NameList.AddObject(
Name,la);
end;
la.Add(Value);
end;
end;
procedure ldapEntry.Delete(
Name:
string);
var
la:ldapAttribute;
Idx:integer;
begin
la:=Self.Attribute[
Name];
if assigned(la)
then
begin
idx:=self.NameList.IndexOfObject(la);
if idx>=0
then
Self.NameList.Delete(Idx);
la.Free;
end;
end;
procedure ldapEntry.Delete(
Name,Value:
string);
var
la:ldapAttribute;
begin
la:=Self.Attribute[
Name];
la.Delete(Value);
if la.ValueList.Count=0
then
Self.Delete(
Name);
end;
function ldapEntry.GetAttribute(
Name:
string): ldapAttribute;
var
I:integer;
begin
I:=fAttributes.Indexof(
Name);
if I>=0
then Result:=ldapAttribute(fAttributes.Objects[I])
else Result:=nil;
end;
function ldapEntry.GetAttributeValue(
Name:
string; Idx:Integer):
string;
var
lda:ldapAttribute;
begin
lda:=self.GetAttribute(
Name);
if lda=nil
then result:='
'
else Result:=lda[idx];
end;
procedure ldapEntry.SetLDIF(S:
string);
var
SL:TStringlist;
I:integer;
N,V:
string;
begin
try
Self.ClearAll;
SL:=TSTringlist.Create;
SL.Text:=S;
for I:=0
to SL.Count-1
do
begin
N:=copy(SL[I],1,pos('
:',SL[I])-1);
V:=copy(SL[I],pos('
:',SL[I])+1,32000);
if uppercase(N)='
DN'
then
Self.fdn:=V
else
Self.Add(N,V);
end;
finally
SL.Free;
end;
end;
function ldapEntry.GetLDIF:
string;
var
I,J:integer;
begin
result:='
dn:'+self.DN+^M^J;
for I:=0
to NameList.Count-1
do
for J:=0
to Self.Attribute[NameList[I]].ValueList.Count-1
do
if integer(Attribute[NameList[I]].ValueList.Objects[J])<>LDAP_MOD_DELETE
then
result:=Result+NameList[I]+'
:'+Attribute[NameList[I]].ValueList[J]+^M^J;
end;
function ldapEntry.AddsOnly(
Name:
string;le:ldapEntry;
var SL:Tstringlist):boolean;
var
I:integer;
a1,a2:ldapAttribute;
begin
a1:=Self.Attribute[
Name];
a2:=le.Attribute[
Name];
if assigned(a1)
and not assigned(a2)
then
result:=false
else if not assigned(a1)
and assigned(a2)
then
begin
result:=true;
SL.Assign(a2.ValueList);
end
else
begin // Adds only - all "a1" are in "a2" - some "a2" not in "a1"
Result:=true;
for I:=0
to a1.ValueList.Count-1
do
if a2.ValueList.IndexOf(a1.ValueList[I])=-1
then begin Result:=false; break;
end;
Result:=Result
and (a2.ValueList.Count>a1.ValueList.Count);
if Result
then
for I:=0
to a2.ValueList.Count-1
do
if a1.ValueList.IndexOf(a2.ValueList[I])=-1
then SL.Add(a2.ValueList[I])
end;
end;
function ldapEntry.DeletesOnly(
Name:
string;le:ldapEntry;
var SL:Tstringlist):boolean;
begin
Result:=le.AddsOnly(
Name,Self,SL);
end;
function ldapEntry.Equal(
Name:
string;le:ldapEntry;
var SL:Tstringlist):boolean;
var
I:integer;
a1,a2:ldapAttribute;
begin
a1:=Self.Attribute[
Name];
a2:=le.Attribute[
Name];
if not (assigned(a1)
and assigned(a2))
then Result:=false
else if a1.ValueList.Count<>a2.ValueList.Count
then Result:=false
else begin
Result:=true;
for I:=0
to a1.ValueList.Count-1
do
if a2.ValueList.IndexOf(a1.ValueList[I])=-1
then begin Result:=false; break;
end;
if not Result
then
SL.Assign(a2.ValueList);
end;
end;
procedure ldapEntry.MakeModLDAPArray(le: ldapEntry);
var
I,J:integer;
full_at_list,done_at:TStringlist;
cmd:integer;
cChanges:integer;
function IncludeAttribute(at:
string):boolean;
begin
Result:=(uppercase(at) <> '
CREATORSNAME')
and
(uppercase(at) <> '
MODIFIERSNAME')
and
(uppercase(at) <> '
CREATETIMESTAMP')
and
(uppercase(at) <> '
MODIFYTIMESTAMP');
end;
begin
try
done_at:=Tstringlist.create;
full_at_list:=Tstringlist.create;
full_at_list.Duplicates:=dupIgnore;
full_at_list.Sorted:=true;
DisposeLDAPArray;
cChanges:=0;
for I:=0
to Namelist.count-1
do
if IncludeAttribute(NameList[i])
then
full_at_list.Add(NameList[i]);
for I:=0
to le.Namelist.count-1
do
if IncludeAttribute(le.NameList[i])
then
full_at_list.Add(le.NameList[i]);
for I:=0
to full_at_list.Count-1
do
begin
done_at.Clear;
if AddsOnly(full_at_list[I],le,done_at)
then // Add
cmd:=LDAP_MOD_ADD
else if DeletesOnly(full_at_list[I],le,done_at)
then // Delete
cmd:=LDAP_MOD_DELETE
else if not Equal(full_at_list[I],le,done_at)
then // Replace
cmd:=LDAP_MOD_REPLACE
else
cmd:=LDAP_MOD_NOCHANGE;
if Cmd<>LDAP_MOD_NOCHANGE
then
begin
inc(cChanges);
SetLength(P,cChanges+1);
New(P[cChanges-1]);
P[cChanges-1]^.mod_op:=Cmd;
P[cChanges-1]^.mod_type:=Strnew(PChar(full_at_list[i]));
SetLength(P[cChanges-1]^.modv_strvals,done_at.count+1);
for J:=0
to done_at.count-1
do
P[cChanges-1]^.modv_strvals[J]:=Strnew(PChar(done_at[J]));
end;
end;
finally
full_at_list.free;
done_at.Free;
end;
end;
procedure ldapEntry.MakeLDAPArray;
var
A:ldapAttribute;
I,J:integer;
begin
SetLength(P,NameList.Count);
for I:=0
to NameList.Count-1
do
begin
New(P[I]);
P[I]^.mod_op:=LDAP_MOD_ADD;
P[I]^.mod_type:=StrNew(PChar(NameList[I]));
A:=Attribute[NameList[I]];
SetLength(P[I]^.modv_strvals,A.ValueList.Count+1);
for J:=0
to A.ValueList.Count-1
do
P[I]^.modv_strvals[J]:=StrNew(PChar(A.Valuelist[J]));
end;
end;
procedure ldapEntry.ApplyChangesInMemory;
var
I,J:integer;
begin
if assigned(P)
then
begin
for I:=low(P)
to high(P)
do
if assigned(P[I])
then
begin
if P[I]^.mod_op = LDAP_MOD_REPLACE
then
Self.Delete(P[I]^.mod_type);
for J:=low(P[I]^.modv_strvals)
to high(P[I]^.modv_strvals)
do
if assigned(P[I]^.modv_strvals[J])
then
case P[I]^.mod_op
of
LDAP_MOD_ADD:Self.Add(P[I]^.mod_type,P[I]^.modv_strvals[J]);
LDAP_MOD_DELETE:Self.Delete(P[I]^.mod_type,P[I]^.modv_strvals[J]);
LDAP_MOD_REPLACE:Self.Add(P[I]^.mod_type,P[I]^.modv_strvals[J]);
end;
end;
end;
end;
procedure ldapEntry.DisposeLDAPArray;
var
I,J:integer;
begin
if assigned(P)
then
begin
for I:=low(P)
to high(P)
do
if assigned(P[I])
then
begin
StrDispose(P[I]^.mod_type);
for J:=low(P[I]^.modv_strvals)
to high(P[I]^.modv_strvals)
do
if assigned(P[I]^.modv_strvals[J])
then
StrDispose(P[I]^.modv_strvals[J]);
P[I]^.modv_strvals:=nil;
Dispose(P[I]);
end;
P:=nil;
end;
end;
function ldapEntry.GetExists(
Name, Value:
string): boolean;
begin
if assigned(Self.Attribute[
Name])
then
Result:=Self.Attribute[
Name].Exists[Value]
else
Result:=false;
end;
function ldapEntry.FreeChild(ee:ldapEntry):boolean;
begin
if Assigned(ee)
and (Self.Children.IndexOfObject(ee)>=0)
then
begin
Children.Delete(Children.IndexofObject(ee));
ee.free;
Result:=true;
end
else
Result:=false;
end;
{ ldapEntryList }
function ldapEntryList.GetDN(Idx:integer):
string;
begin
if (idx>=0)
and (Idx<Self.Count)
then
Result:=self.strings[Idx]
else
REsult:='
';
end;
function ldapEntryList.GetEntryValue(Idx:integer;Attribute:
string;AttributeIndex:integer):
string;
var
lde:ldapEntry;
begin
lde:=Self.GetEntry(Idx);
Result:=lde.AttributeValue[Attribute,AttributeIndex];
end;
function ldapEntryList.GetEntry(Idx:integer):ldapEntry;
begin
if (idx>=0)
and (Idx<Self.Count)
then
Result:=ldapEntry(self.objects[Idx])
else
REsult:=nil;
end;
function ldapEntryList.NewEntry(
const DN:
string):ldapEntry;
var
Idx:integer;
begin
Idx:=Self.AddObject(DN,ldapEntry.Create);
Result:=ldapEntry(Self.Objects[Idx]);
Result.fdn:=DN;
end;
procedure ldapEntryList.ClearAll;
var
I:integer;
begin
for I:=0
to Self.count-1
do
ldapEntry(Self.Objects[I]).Free;
Self.Clear;
end;
destructor ldapEntryList.Destroy;
begin
ClearAll;
inherited;
end;
{ ldapConnection }
procedure ldapConnection.LDAPError(
const s:
string);
begin
raise ELDAP.Create(s);
end;
procedure ldapConnection.LDAPCheck(err: ULONG);
begin
if (err <> LDAP_SUCCESS)
then LDAPError(ldap_err2string(err));
end;
procedure ldapConnection.Fill(
var Entry:ldapEntry);
var
el:ldapEntryList;
old_dn:
string;
begin
try
el:=ldapEntrylist.create;
old_dn:=Entry.dn;
Entry.ClearAll;
Entry.dn:=old_dn;
Search(el,Entry.dn,'
(objectclass=*)','
base');
if el.Count=1
then
Entry.Assign(el[0]);
finally
el.free;
end;
end;
function ldapConnection.UidToDN(
const Uid:
string;
const Base:
string):
string;
var
plmSearch, plmEntry: PLDAPMessage;
begin
if Assigned(fConn)
then
begin
LDAPCheck(ldap_simple_bind_s(fConn,
nil,
nil));
LDAPCheck(ldap_search_s(fconn, pchar(Base), LDAP_SCOPE_SUBTREE ,pchar('
(uid='+uid+'
)'),
nil, 0, @plmSearch));
plmEntry := ldap_first_entry(fConn, plmSearch);
if Assigned(plmEntry)
then
Result := ldap_get_DN(fConn,plmEntry)
else
LDAPError('
UID not found');
end
else
LDAPError('
Error Opening Connection to Server');
end;
procedure ldapConnection.Search(
var Results: ldapEntryList;
const DNs: ldapAttribute);
var
I:integer;
el:ldapEntryList;
begin
if assigned(Results)
and assigned(DNs)
then
begin
try
el:=ldapEntryList.Create;
for I:=0
to DNs.ValueList.Count-1
do
begin
try
el.ClearAll;
Search(el,DNs.ValueList[I],'
(objectclass=*)','
base');
if el.Count=1
then
Results.AddObject(el[0].DN,ldapEntry.create(el[0]))
except
end;
end;
finally
el.ClearAll;
el.Free;
end;
end;
end;
procedure ldapConnection.Search(
var Results:ldapEntryList;
const Base:
string;
const Search:string='
(objectclass=*)';
const Scope:string='
sub');
var
plmSearch, plmEntry: PLDAPMessage;
i,iScope:integer;
psEntryDN:pchar;
CurrentEntry:ldapEntry;
pszAttr: pchar;
pbe: PBerElement;
ppcVals: PPCHAR;
begin
if lowercase(scope)='
base'
then iScope:=LDAP_SCOPE_BASE
else if lowercase(scope)='
one'
then iScope:=LDAP_SCOPE_ONELEVEL
else if lowercase(scope)='
sub'
then iScope:=LDAP_SCOPE_SUBTREE;
try
LDAPCheck(ldap_search_s(fconn, pchar(Base), iScope ,pchar(Search),
nil, 0, @plmSearch));
try
plmEntry := ldap_first_entry(fConn, plmSearch);
while Assigned(plmEntry)
do
begin
try
try
psEntryDN := ldap_get_DN(fConn,plmEntry);
CurrentEntry:=REsults.NewEntry(psEntryDN);
except
ldaperror('
Error Retrieving DN for entry');
end;
finally
ldap_memfree(psEntryDN);
end;
pszAttr := ldap_first_attribute(fConn, plmEntry, pbe);
while Assigned(pszAttr)
do
begin
ppcVals := ldap_get_values(fConn, plmEntry, pszAttr);
if Assigned(ppcVals)
then
try
i := 0;
while Assigned(pchararray(ppcVals)[i])
do
begin
CurrentEntry.Add(pszAttr,pchararray(ppcVals)[i]);
Inc(i);
end;
finally
LDAPCheck(ldap_value_free(ppcVals));
end;
pszAttr := ldap_next_attribute(fConn, plmEntry, pbe);
end;
plmEntry :=ldap_next_entry(fConn, plmEntry);
end;
finally
end;
finally
ldap_msgfree(plmSearch);
end;
end;
procedure ldapConnection.Delete(
const DN:
string);
begin
LDAPCheck(ldap_delete_s(fConn,PChar(DN)));
end;
procedure ldapConnection.Delete(
const Entry: ldapEntry);
begin
LDAPCheck(ldap_delete_s(fConn,PChar(Entry.DN)));
end;
procedure ldapConnection.Add(
const Entry: ldapEntry);
begin
try
Entry.MakeLDAPArray;
LDAPCheck(ldap_add_s(fConn,PChar(Entry.fdn),pointer(Entry.P)));
finally
Entry.DisposeLDAPArray;
end;
end;
procedure ldapConnection.Modify(
const Entry,NewEntry: ldapEntry);
begin
try
Entry.MakeModLDAPArray(NewEntry);
if (assigned(Entry.P))
and (High(Entry.P)<>Low(Entry.P))
then
LDAPCheck(ldap_modify_s(fConn,PChar(Entry.fdn),pointer(Entry.P)));
Entry.ApplyChangesInMemory;
finally
Entry.DisposeLDAPArray;
end;
end;
procedure ldapConnection.Close;
begin
LDAPCheck(ldap_unbind_s(fConn));
fConn:=nil;
end;
procedure ldapConnection.Open;
begin
fConn := ldap_open(pchar(fHost), fPort);
if Assigned(fConn)
then
if (fPWD='
')
or (fDN='
')
then
LDAPCheck(ldap_simple_bind_s(fConn,
nil,
nil))
else
LDAPCheck(ldap_simple_bind_s(fConn, pchar(fDN), pchar(fPwd)))
else
LDAPError('
Error Opening Connection to Server');
end;
procedure ldapConnection.ReBind(
const BindAs, BindPassword:
string);
begin
fDN:=BindAs;
fPWD:=BindPassword;
if Assigned(fConn)
then
if (BindPassword='
')
or (BindAs='
')
then
LDAPCheck(ldap_simple_bind_s(fConn,
nil,
nil))
else
LDAPCheck(ldap_simple_bind_s(fConn, pchar(BindAs), pchar(BindPassword)))
else
LDAPError('
No Exisiting Connection to Server');
end;
procedure ldapConnection.Open(
const Hostname, BindAs, BindPassword:
string;
const PortNumber: integer);
begin
fHost:=Hostname;
fPwd:=BindPassword;
fPort:=PortNumber;
fDN:=BindAS;
open;
end;
function FindDn(
const server,base,Uid:
string):
string;
var
conn:ldapConnection;
el:ldapEntryList;
begin
try
try
Conn:=ldapConnection.Create;
Conn.Open(server);
el:=ldapEntryList.Create;
Conn.Search(el,base,'
(uid='+uid+'
)');
result:=el.Dn[0];
finally
el.Free;
conn.Close;
conn.free;
end;
except
Result:='
';
end;
end;
function ValidDn(
const server,dn,uid,pwd:
string):boolean;
var
conn:ldapConnection;
el:ldapEntryList;
begin
try
try
Conn:=ldapConnection.Create;
Conn.Open(Server,dn,pwd);
el:=ldapEntryList.Create;
Conn.Search(el,dn,'
(uid='+uid+'
)','
base');
Result:= uppercase(el.GetEntryValue(0,'
uid',0))=uppercase(uid);
finally
el.free;
conn.close;
conn.free;
end;
except
Result:=false;
end;
end;
function Check(
const Server:
string;
const PortNumber:integer;
const Uid,Password,BaseDN:
string):boolean;
var
dn:
string;
conn:ldapConnection;
el1:ldapEntryList;
begin
result:=true;
try
try
Conn:=ldapConnection.Create;
Conn.Open(Server,'
','
',PortNumber);
el1:=ldapEntryList.create;
Conn.Search(el1,baseDN,'
(uid='+uid+'
)');
if (el1.Count=1)
then dn:=el1.dn[0]
else dn:='
';
if dn='
'
then Result:=false
else Conn.ReBind(dn,Password);
finally
el1.Free;
conn.Close;
conn.free;
end;
except
Result:=false;
end;
end;
end.