Ich habs mal noch ein wenig angepasst:
Delphi-Quellcode:
procedure TForm1.ListMemberOfTR(MyObjName:
String; list: TStringList);
var rs, conn,
com : Variant;
strBase, strFilter, strAttributes, strADS :
string;
ft : TFileTime;
arrVar:
Array of variant;
strTxt,strSearch:
String;
procedure getMem(obj:
String);
var
i:Integer;
begin
Application.ProcessMessages;
StatusBar1.Panels[0].Text := IntToStr(list.Count);
// if list.Count > 100 then
// Exit;
strFilter := '
(&(objectClass=group)(cn='+obj+'
))';
strAttributes := '
memberOf';
strADS := strBase + '
;' + strFilter + '
;' + strAttributes + '
;subtree';
Com.CommandText := strADS;
Com.Properties['
Page Size'] := 100000;
Com.Properties['
Searchscope'] := 2;
Com.Properties['
Cache Results'] := False;
rs :=
Com.Execute;
if Not rs.EOF
then
begin
try
arrVar := rs.Fields['
memberOf'].Value;
except
end;
end;
for i := 0
to Length(arrVar) - 1
do
begin
strTxt := arrVar[i];
strSearch := MidStr(strTxt,Pos('
=',strTxt)+1,Pos('
,',strTxt)-Pos('
=',strTxt)-1);
list.Add(strSearch);
getMem(strSearch);
end;
end;
begin
conn := CreateOleObject('
ADODB.Connection');
com := CreateOleObject('
ADODB.Command');
list.BeginUpdate;
try
conn.Provider := '
ADsDSOObject';
conn.open;
com.ActiveConnection := conn;
strBase := '
<LDAP://thun.lan>';
GetMem(MyObjName);
finally
list.EndUpdate;
Rs := NULL;
com := NULL;
conn.Close;
conn := NULL;
end;
end;
Mit dem ausgeklammerten Code:
Delphi-Quellcode:
// if list.Count > 100 then
// Exit;
konnte ich die "Endlosschleife" stoppen und habe gesehen, dass es immer der erste Gruppe ausliest und das immer wieder. Schuld daran ist der Aufruf von "getMem(strSearch);" in getMem ...
Aber wie z.T. soll ich denn nun eine Rekursive Abfrage machen, denn so scheints ja nicht zu funktionieren.
Hat da jmd eine bessere Idee?
-> Ich mag aber nicht sämtliche Gruppen nach einem Benutzer durchsuchen, denn so komm ich auch auf keinen grünen Zweig.