AD member, memberOf

[cherry]

Hallo liebe Delphi-Freaks...

Ich bin schon langsam am verzweifeln. Ich versuche die

-> Benutzer einer Gruppe

und die

-> Gruppen (inkl Untergruppen) von einem Benutzer

Aus dem Active Directory zu lesen. (W2K3 Server SP2)

Ich habe schon jenstes versucht, leider bis jetzt alles ohne Erfolg. Natürlich habe ich die Delphi suche benützt,
nur haben mir die Threads nicht wirklich weitergeholfen.

Etwas sehr interessanntes dazu habe ich hier gefunden: http://dunnry.com/blog/TransitiveLin...valuation.aspx
Das ist die Lösung, nur leider kann ich das nicht in Delphi übersetzten. (.NET ! ;-( )

Vielen Dank schon mal für Deine Bemühungen.

[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

[hoika]

Hallo,

die IDE müsset dir doch die Stelle anzeigen ?
ev. F7 drücken, besser aber per Breakpoint durchlaufen.

Das

Delphi-Quellcode:

try
  arrVar := rs.Fields['memberOf'].Value
except
  SetLength(arrVar,1);
  arrVar[0] := 'is not member of a group ...';
end;

ist halt nicht schön.
Gibt es da kein FindField oder FieldExists ?


<Update>: Klammer mal die SubGroups aus (beginnend ab if WithSubGroups then )



Heiko

[cherry]

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.

[hoika]

Hall,

GetMem braucht eine sinnvolle Abbruchbedingung.
Im Moment blicke ich nicht durch den Code, den für GetMem sehe ich z.B. gar nicht.


Heiko

[cherry]

Zitat von hoika:

Hall,
GetMem braucht eine sinnvolle Abbruchbedingung.

Wieso denn das? es funktioniert ja sowieso nicht bis jetzt!

Zitat von hoika:

Im Moment blicke ich nicht durch den Code, den für GetMem sehe ich z.B. gar nicht.

"GetMem" ist im oben geposteten Code in der Procedure "ListMemberOfTR" eingebettet!


Kommt schon Leute, das hat doch schon mal einer gemacht von euch?! Bitte wenigstens einen Tipp?!

[cherry]

So, ich hab noch etwas gefunden und angepasst:

Delphi-Quellcode:

  if Not rs.EOF then
  begin
    try
      arrVar := rs.Fields['memberOf'].Value;
    except
      SetLength(arrVar,0);
    end;
  end;

Vorher hatte ich im exception Block keine Aktion stehen. So ists nun eigentlich richtig.

Das Problem ist wohl hier ganz klar die For-Schleiffe, aber ich mit meiner Abfrage alle Members gleichzeitig erhalte, weiss ich nicht wie ich es sonst machen soll...

[EDIT]Ich hab eben mal ein paar Anhaltspunkte gesetzt. Nachdem die erste Untergruppe gefunden wird und nach deren weiteren Abfrage, gibts dann in der For Schleiffe eine Zugriffsverletztung. Denn die Schleiffe ist ja noch nicht beendet und dann starte ich ja schon wieder die selbe Prozedur -> Das kann ja nicht gut gehen!!! -> Aber wie soll ichs sonst machen? ... *verzweifel*[/EDIT]

Versteht ihr mein Problem...? ich komm einfach nicht weiter...

[hoika]

Hallo,

definier mal alle in GetMem benutzen Variablen lokal in GetMem.

das arrVar: Array of variant; kannst du ja nicht in mehreren Aufrufen gleichzeitig benutzen.


Heiko

[cherry]

Zitat von hoika:

definier mal alle in GetMem benutzen Variablen lokal in GetMem.

Und du hast natürlich recht! Funktioniert nun prima!
Hier mein Code:

Delphi-Quellcode:

procedure TForm1.ListMemberOfTR(strGroup: String; list: TStringList);
procedure getMem(obj,strPath:String);
var
  i:Integer;
  arrVar: Array of variant;
  arrDis: Array of variant;
  strTxt,strSearch: String;
  strFilter, strAttributes, strADS, strBase : string;
  rs, conn, com : Variant;
begin
  try
    conn := CreateOleObject('ADODB.Connection');
    com := CreateOleObject('ADODB.Command');
    conn.Provider := 'ADsDSOObject';
    conn.open;
    com.ActiveConnection := conn;
    strBase := '<LDAP://thun.lan>';
    Application.ProcessMessages;
    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
        SetLength(arrVar,0);
      end;
    end;
    for i := Low(arrVar) to High(arrVar) -1 do
    begin
      strTxt := arrVar[i];
      strSearch := MidStr(strTxt,Pos('=',strTxt)+1,Pos(',',strTxt)-Pos('=',strTxt)-1);
      list.Add(strPath + ' \ ' + strSearch);
      getMem(strSearch, strPath + ' \ ' + strSearch);
    end;
  finally
    Rs := NULL;
    com := NULL;
    conn.Close;
    conn := NULL;
  end;
end;
begin
  list.BeginUpdate;
  try
    GetMem(strGroup,strGroup);
  finally
    list.EndUpdate;
  end;
end;

vielen Dank hoika!

[MaBuSE]

Zitat von cherry:

Und du hast natürlich recht! Funktioniert nun prima!

Hallo leider nein Es ist ein kleiner Fehler enthalten.

Zitat von cherry:

Hier mein Code:

Delphi-Quellcode:

...
    for i := Low(arrVar) to High(arrVar) -1 do
...

Das -1 muss weg, sonst lässt er immer den letzten weg.
Ist mir aufgefallen, als nur ein Eintrag enthalten war.