AD member, memberOf

[cherry]

So, ich hab mir mal was zusammengebastelt. Mit dieser Prozedur kann ich nun MemberOf auslesen:

Aufruf: ListMemberOf('user',Edit1.Text,list);

Delphi-Quellcode:

procedure TForm1.ListMemberOf(MyObjClass, MyObjName: String; list: TStringList);
var rs, conn, com : Variant;
    strBase, strFilter, strAttributes, strADS : string;
    ft : TFileTime;

    arrVar: Array of variant;

    SearchObj: String;
    i:Integer;
begin

  conn := CreateOleObject('ADODB.Connection');
  com := CreateOleObject('ADODB.Command');
  try
    conn.Provider := 'ADsDSOObject';
    conn.open;
    com.ActiveConnection := conn;
    strBase := '<LDAP://thun.lan>';

    if MyObjClass = 'user' then
      SearchObj := 'sAMAccountName'
    else
      SearchObj := 'CN';

    strFilter := '(&(objectClass='+MyObjClass+')('+SearchObj+'='+MyObjName+'))';

    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
        SetLength(arrVar,1);
        arrVar[0] := 'is not member of a group ...';
      end;
    end
    else
      MessageDlg('Kein Datensatz gefunden.',mtInformation,[mbOK],0);

    Rs := NULL;
  finally
    com := NULL;
    conn.Close;
    conn := NULL;
  end;

  for i := 0 to Length(arrVar) - 1 do
  begin
    list.Add(arrVar[i]);
  end;

end;

Nun müsste ich ja noch die alle Gruppen haben von denen die erhaltenen Gruppen members sind, und das natürlich rekursiv. Dazu habe ich folgendes probiert:

Aufruf wie folgt:

Delphi-Quellcode:

for i := 0 to list.count - 1 do
    begin
      ListBox1.Items.Add(list.Strings[i]);
      strTxt := list.Strings[i];
      strSearch := MidStr(strTxt,Pos('=',strTxt)+1,Pos(',',strTxt)-Pos('=',strTxt)-1);
      ListMemberOfR(strSearch,list2,True);
    end;

Delphi-Quellcode:

procedure TForm1.ListMemberOfR(MyObjName: String; list: TStringList; WithSubGroups: Boolean = False);
var rs, conn, com : Variant;
    strBase, strFilter, strAttributes, strADS : string;
    ft : TFileTime;
    arrVar: Array of variant;

procedure GetMemberOf(Group:String);
var
  strSearch, strTxt: String;
  i: Integer;
begin

  rs := Null;

  strFilter := '(&(objectClass=group)(CN='+Group+'))';
  strADS := strBase + ';' + strFilter + ';' + strAttributes + ';subtree';
  Com.CommandText := strADS;
  rs := Com.Execute;

  if Not rs.EOF then
  begin
    try
      arrVar := rs.Fields['memberOf'].Value
    except
      SetLength(arrVar,1);
    end;
  end;
  for i := 0 to Length(arrVar) - 1 do
  begin
   list.Add(MidStr(arrVar[i],Pos('=',arrVar[i])+1,Pos(',',arrVar[i])-Pos('=',arrVar[i])-1));
  end;

  if WithSubGroups then
  begin
    if list.count > 0 then
    begin
      strTxt := list.Strings[list.count-1];
      strSearch := MidStr(strTxt,Pos('=',strTxt)+1,Pos(',',strTxt)-Pos('=',strTxt)-1);
      GetMemberOf(strSearch);
    end;
  end;

end;

begin
  list.BeginUpdate;
  try
    conn := CreateOleObject('ADODB.Connection');
    com := CreateOleObject('ADODB.Command');
    conn.Provider := 'ADsDSOObject';
    conn.open;
    com.ActiveConnection := conn;
    strBase := '<LDAP://thun.lan>';
    strAttributes := 'memberOf';

    Com.Properties['Page Size'] := 100000;
    Com.Properties['Searchscope'] := 2;
    Com.Properties['Cache Results'] := False;

    GetMemberOf(MyObjName);
  finally
    com := NULL;
    conn.Close;
    conn := NULL;
    list.EndUpdate;
  end;

end;

Das kleine "Problem": Bei einigen Gruppen wird das Attribut memberOf nicht gefunden, das habe ich mit try catch so weit im Griff.
Das Grosse PROBLEM: Wenn ich das Programm in der Entwiklungsumgebung ausführe wird es nach ca. 20 Sekunden wegen einer Zugriffsverletzung beendet...

?! PS: Meldung im Anhang