kann dieses Konstrukt überhaupt funktionieren? (Arrays...)

[cherry]

Hallo Zusammen...

Ich bin grade an einem (Massen)Importassistenten um Benutzer im AD zu erstellen...
nachdem man das Template und die CSV Datei (als Liste mit z.B. Namen, Adressen usw.) und die Felder zugewiesen hat,
soll man nun noch jeden zu erstellenden Benutzer bearbeiten können, bevor diese dann endgültig erstellt werden.

Dazu habe ich mir nachfolgendes "Arraykonstrukt" geschaffen, welches ich mitlerweile schwer anzweifle...
Da ich sowas bisher noch nicht brauchte, habe ich k.A. wo die Kritischen Stellen sind, wenn mir vielleicht mal jemand auf die Sprünge helfen könnte?

Im grossen und ganzen funktioniert das alles eingentlich ganz gut...
Ein Problem tritt aber z.B. nach folgender Verwendung auf:

Man nehme an: TUser wurden erstellt mit dazugehörigen werten. Jetzt will man die Gruppenzugehörigkeiten (AD) bearbeiten...
Im GUI hab ichs mit TListBoxen gelöst, so sieht dann die Funktion aus, die die Gruppenzugehörigkeiten in mein Userobjekt speichert...

Delphi-Quellcode:

procedure TFormWzrEditUser.saveGroupsIntoUser;
var
  I: Integer;
  grps: TGroups;
begin

  // cleanup
  user.ClearGroups; // <--- IMMER NACH DEM ZWEITEN AUFRUF DIESR FUNKTION HIER DER SCHWERWIEGENDE FEHLER...

  // create groups...
  SetLength(grps, ListBox2.Count);
  for I := 0 to ListBox2.Count - 1 do
  begin
    // WITZIG IST: WENN MAN DUMMY STRINGS WIE Z.B. 'TEST' VERWENDET TRITT NIE EIN PROBLEM AUF
    grps[I].name := String(ListBox2.Items.Strings[I]);//Copy(ListBox2.Items.Strings[I], 1, Length(ListBox2.Items.Strings[I]));
    grps[I].ldappath := String(ListBox2.Items.Objects[I]);//Copy(String(ListBox2.Items.Objects[I]), 1, Length(String(ListBox2.Items.Objects[I])));
  end;

  // add groups
  user.AssignGroups(grps);
  SetLength(grps, 0);

end;

Wenn man die Zugehörigkeiten 1 Mal ändert funktionierts... immer beim Zweiten Aufruf von "saveGroupsIntoUser" tritt ein "EInvalidPointer" Üngültige Zeigeroperation auf...
Der Debugger hält immer an dieser Stelle an: in der Systemfunktion "_LStrClr(var S)" bei "CALL _FreeMem"

Hier also noch das angezweifelte Konstrukt selber:

Delphi-Quellcode:

unit UUserCrossTable;

interface

type

  // type for filesettings
  TDirectory = record
    Name: string;
    FullAccess: Boolean;
    Modify: Boolean;
    Execute: Boolean;
    List: Boolean;
    Read: Boolean;
    Write: Boolean;
  end;
  PDirectory = ^TDirectory;
  TDirectories = array of TDirectory;

  // type for optional ad attributes
  TOptAttr = record
    name: string; //string[50]
    value: string;
  end;
  POptAttr = ^TOptAttr;
  TOptAttrs = array of TOptAttr;

  // type for group
  TGroup = record
    name: string;
    ldappath: string;
  end;
  PGroup = ^TGroup;
  TGroups = array of TGroup;

  // type for quota
  TQuota = record
    volume: string;
    limit: Integer;
    Threshold: Integer;
  end;
  PQuota = ^TQuota;
  TQuotas = array of TQuota;

  // THIS IS ONE USER
  TUser = class(TObject)
    private
      arrGroups: TGroups;
      arrDirectories: TDirectories;
      arrQuotas: TQuotas;
      arrOptAttrs: TOptAttrs;
    public
      sAMAccountName: string;
      givenName: string;
      sn: string;
      password: string;
      containerPath: string;

      function Groups: TGroups;
      function AddGroup(group: TGroup): Integer;
      procedure removeGroup(index: Integer);
      function GroupCount: Integer;
      procedure AssignGroups(Groups: TGroups);
      procedure ClearGroups;

      function Directories: TDirectories;
      function AddDirectory(directory: TDirectory): Integer;
      procedure removeDirectory(index: Integer);
      function DirectoryCount: Integer;
      procedure AssignDirectories(Directories: TDirectories);
      procedure ClearDirectories;

      function Quotas: TQuotas;
      function AddQuota(quota: TQuota): Integer;
      procedure removeQuota(index: Integer);
      function QuotaCount: Integer;
      procedure AssignQuotas(Quotas: TQuotas);
      procedure ClearQuotas;

      function OptionalAttributes: TOptAttrs;
      function AddOptionalAttribute(attribute: TOptAttr): Integer;
      procedure removeOptionalAttribute(index: Integer);
      function OptionalAttributeCount: Integer;
      procedure AssignOptionalAttributes(Attributes: TOptAttrs);
      procedure ClearOptionalAttributes;

  end;
  TUsers = array of TUser;

  // THIS IS THE TABLE CLASS WHO HANDLES THE ENTRIES
  TUserCrossTable = class(TObject)
    private
      arrUsers: TUsers;
    public
      function Users: TUsers;
      function addUser(user: TUser): Integer;
      procedure removeUser(index: Integer);
      function UserCount: Integer;

//      procedure SaveToFile(name: string);
//      procedure LoadFromFile(name: string);
  end;

implementation

//------------------------------------------------------------------------------
//  CLASS USER
//------------------------------------------------------------------------------

// GET ALL GROUPS
function TUser.Groups: TGroups;
begin
  result := arrGroups;
end;

// ADD NEW GROUP
function TUser.AddGroup(group: TGroup): Integer;
begin
  SetLength(arrGroups, Length(arrGroups)+1);
  arrGroups[Length(arrGroups)-1] := group;
  result := Length(arrGroups)-1;
end;

// REMOVE A GROUP
procedure TUser.removeGroup(index: Integer);
begin
  if index < 0 then exit;
  if index > Length(arrGroups) then exit;
  if index = Length(arrGroups) then
  begin
    SetLength(arrGroups, Length(arrGroups)-1);
    Exit;
  end;
  System.Move(arrGroups[index+1], arrGroups[index], (Length(arrGroups) - index - 1) * SizeOf(TGroup) + 1 ); // move
  SetLength(arrGroups, Length(arrGroups)-1); // set new length
  Exit; // exit
end;

// GET GROUP COUNT
function TUser.GroupCount;
begin
  result := Length(arrGroups);
end;

// ASSIGN GROUPS
procedure TUser.AssignGroups(Groups: TGroups);
begin
  arrGroups := Copy(Groups, 0, Length(Groups));
end;

// CLEAR GROUPS
procedure TUser.ClearGroups;
begin
  SetLength(arrGroups, 0);
end;

// GET ALL DIRECTORIES
function TUser.Directories: TDirectories;
begin
  result := arrDirectories;
end;

// ADD NEW DIRECTORY
function TUser.AddDirectory(directory: TDirectory): Integer;
begin
  SetLength(arrDirectories, Length(arrDirectories)+1);
  arrDirectories[Length(arrDirectories)-1] := directory;
  result := Length(arrDirectories)-1;
end;

// REMOVE A DIRECTORY
procedure TUser.removeDirectory(index: Integer);
begin
  if index < 0 then exit;
  if index > Length(arrDirectories) then exit;
  if index = Length(arrDirectories) then
  begin
    SetLength(arrDirectories, Length(arrDirectories)-1);
    Exit;
  end;
  System.Move(arrDirectories[index+1], arrDirectories[index], (Length(arrDirectories) - index - 1) * SizeOf(TDirectory) + 1 ); // move
  SetLength(arrDirectories, Length(arrDirectories)-1); // set new length
  Exit; // exit
end;

// GET DIRECOTRY COUNT
function TUser.DirectoryCount;
begin
  result := Length(arrDirectories);
end;

// ASSIGN DIRECTORIES
procedure TUser.AssignDirectories(Directories: TDirectories);
begin
  arrDirectories := Copy(Directories, 0, Length(Directories));
end;

// CLEAR DIRECTORIES
procedure TUser.ClearDirectories;
begin
  SetLength(arrDirectories, 0);
end;

// GET ALL QUOTAS
function TUser.Quotas: TQuotas;
begin
  result := arrQuotas;
end;

// ADD NEW QUOTA
function TUser.AddQuota(quota: TQuota): Integer;
begin
  SetLength(arrQuotas, Length(arrQuotas)+1);
  arrQuotas[Length(arrQuotas)-1] := quota;
  result := Length(arrQuotas)-1;
end;

// REMOVE A QUOTA
procedure TUser.removeQuota(index: Integer);
begin
  if index < 0 then exit;
  if index > Length(arrQuotas) then exit;
  if index = Length(arrQuotas) then
  begin
    SetLength(arrQuotas, Length(arrQuotas)-1);
    Exit;
  end;
  System.Move(arrQuotas[index+1], arrQuotas[index], (Length(arrQuotas) - index - 1) * SizeOf(TQuota) + 1 ); // move
  SetLength(arrQuotas, Length(arrQuotas)-1); // set new length
  Exit; // exit
end;

// GET QUOTA COUNT
function TUser.QuotaCount;
begin
  result := Length(arrQuotas);
end;

// ASSIGN QUOTA
procedure TUser.AssignQuotas(Quotas: TQuotas);
begin
  arrQuotas := Copy(Quotas, 0, Length(Quotas));
end;

// CLEAR QUOTAS
procedure TUser.ClearQuotas;
begin
  SetLength(arrQuotas, 0);
end;

// GET ALL OPTIONAL ATTRIBUTES
function TUser.OptionalAttributes: TOptAttrs;
begin
  result := arrOptAttrs;
end;

// ADD NEW OPTIONAL ATTRIBUTE
function TUser.AddOptionalAttribute(attribute: TOptAttr): Integer;
begin
  SetLength(arrOptAttrs, Length(arrOptAttrs)+1);
  arrOptAttrs[Length(arrOptAttrs)-1] := attribute;
  result := Length(arrOptAttrs)-1;
end;

// REMOVE A OPTIONAL ATTRIBUTE
procedure TUser.removeOptionalAttribute(index: Integer);
begin
  if index < 0 then exit;
  if index > Length(arrOptAttrs) then exit;
  if index = Length(arrOptAttrs) then
  begin
    SetLength(arrOptAttrs, Length(arrOptAttrs)-1);
    Exit;
  end;
  System.Move(arrOptAttrs[index+1], arrOptAttrs[index], (Length(arrOptAttrs) - index - 1) * SizeOf(TOptAttr) + 1 ); // move
  SetLength(arrOptAttrs, Length(arrOptAttrs)-1); // set new length
  Exit; // exit
end;

// GET OPTIONAL ATTRIBUTE COUNT
function TUser.OptionalAttributeCount;
begin
  result := Length(arrOptAttrs);
end;

// ASSIGN OPTIONAL ATTRIBUTES
procedure TUser.AssignOptionalAttributes(Attributes: TOptAttrs);
begin
  arrOptAttrs := Copy(Attributes, 0, Length(Attributes));
end;

// CLEAR OPTIONAL ATTRIBUTES
procedure TUser.ClearOptionalAttributes;
begin
  SetLength(arrOptAttrs, 0);
end;

//------------------------------------------------------------------------------
//  CLASS USER CROSS TABLE
//------------------------------------------------------------------------------

// GET ALL USERS
function TUserCrossTable.Users: TUsers;
begin
  result := arrUsers;
end;

// ADD AN USER
function TUserCrossTable.addUser(user: TUser): Integer;
begin
  SetLength(arrUsers, Length(arrUsers)+1);
  arrUsers[Length(arrUsers)-1] := user;
  result := Length(arrUsers)-1;
end;

// REMOVE AN USER
procedure TUserCrossTable.removeUser(index: Integer);
begin
  if index < 0 then exit;
  if index > Length(arrUsers) then exit;
  if index = Length(arrUsers) then
  begin
    SetLength(arrUsers, Length(arrUsers)-1);
    Exit;
  end;
  Finalize(arrUsers[index]);
  System.Move(arrUsers[index+1], arrUsers[index], (Length(arrUsers) - index - 1) * SizeOf(TUser) + 1 ); // move
  Pointer(arrUsers[Length(arrUsers)-1]) := nil; // set nil
  SetLength(arrUsers, Length(arrUsers)-1); // set new length
  Exit; // exit
end;

// GET USER COUNT
function TUserCrossTable.UserCount;
begin
  result := Length(arrUsers);
end;

end.

[Blup]

Man darf nicht einfach Records mit Move überschreiben, wenn diese Strings, Arrays oder Interfaces enthalten. Diese werden dann nicht mehr freigegeben. Noch schlimmer ist aber, das letzte Element wird in der Liste praktisch verdoppelt, ohne den Referenzzähler der Strings zu erhöhen. Durch SetLength wird der letzte Element freigegeben und damit auch diese Strings (Referenzzähler fällt auf 0).
Das vorletzte Element verweist danach auf ungültige Strings bzw. Speicher.

Hier mal ein Beispiel wie man trotzdem mit Move im Array arbeiten kann: MoveElements

Für Groups, Directories usw. sind im Prinzip immer wieder die selben Funktionen implementiert.
Ich denke es wäre sinnvoller mit TList oder TObjectList zu arbeiten und die Records auf Klassen umzustellen.

[Uwe Raabe]

Ich weiß nicht mehr, ob in D2009 die Generics schon richtig funktionierten, aber du kannst ja auch mal so was versuchen:

Delphi-Quellcode:

TDirectories = TList<TDirectory>;
TOptAttrs = TList<TOptAttr>;
TGroups = TList<TGroup>;
TQuotas = TList<TQuota>;

Viele deiner Methoden können damit vollständig entfallen oder einfach gemapt werden:

ClearGroups -> Groups.Clear
AddGroup -> Groups.Add
removeGroup -> Groups.Delete
GroupCount -> Groups.Count

entsprechend für die anderen Typen.

[cherry]

Hallo Ihr beiden. Erst mal danke für die prompte Hilfestellung.

@Blub
Du hast jetzt einfach die Funktionen remove angesprochen oder? - ansonsten mache ich das ja nirgens explizit.
An dem kanns aber nicht liegen, da ich diese Funktionen im ganzen Programm noch nicht verwendet habe. (Und werde dies folglich auch nicht tun)

> Grundsätzlich sollte aber ein solches Konstrukt, mal abgesehen von den removeFunctions funktionieren,
Oder macht man das einfach nicht und verwenden immer TObjectList o.ä. ?

@Uwe Raabe
Danke für den Hinweis... muss zugestehen, dass ich davon nichts wusste bis jetzt...
Hab jetzt mal n paar Sachen drüber gelesen und einfach mal propiert. Das kam dabei raus:

Delphi-Quellcode:

unit UUserCrossTable;

interface

uses
  Windows, SysUtils, Variants, Classes, Dialogs, Generics.Collections;

type

  // type for filesettings
  TDirectory = class(TObject)
  public
    Name: string;
    FullAccess: Boolean;
    Modify: Boolean;
    Execute: Boolean;
    List: Boolean;
    Read: Boolean;
    Write: Boolean;
  end;

  // type for optional ad attributes
  TOptAttr = class(TObject)
  public
    name: string[50];
    value: string[255];
  end;

  // type for group
  TGroup = class(TObject)
  public
    name: string[50];
    ldappath: string[255];
  end;

  // type for quota
  TQuota = class(TObject)
  public
    volume: string[255];
    limit: Integer;
    Threshold: Integer;
  end;

  TDirectories = TObjectList<TDirectory>;
  TOptAttrs = TObjectList<TOptAttr>;
  TGroups = TObjectList<TGroup>;
  TQuotas = TObjectList<TQuota>;

  // THIS IS ONE USER
  TUser = class(TObject)
    private
    public
      sAMAccountName: string[50];
      givenName: string[50];
      sn: string[50];
      password: string[50];
      Directories: TDirectories;
      OptionalAttributes: TOptAttrs;
      Groups: TGroups;
      Quotas: TQuotas;
  end;

implementation

end.

Folgendes hat schon mal funktioniert:

Delphi-Quellcode:

 

  uct: TObjectList<TUser>;
  usr: TUser;

implementation
  
  ....
 
  usr := TUser.Create;
  usr.sAMAccountName := Edit1.Text;
  usr.givenName := Edit1.Text;
  usr.password := 'pw';

  uct.Add(usr);

Wenn ich jetzt aber z.B. eine Gruppe an einen User hinzugügen möchte klappt folgendes nicht:

Delphi-Quellcode:

  grp := TGroup.Create;
  grp.name := Edit2.Text;
  grp.ldappath := 'ldap://'+Edit2.Text;
  uct.Items[ListBox1.ItemIndex].Groups.Add(grp); // << Zugriffsverletzung...

Zuvor habe ich versucht die Gruppen, Directories usw. als Records statt als Klassen zu definiren, das Ergebnis war dasselbe...
Was mache ich falsch?

[Uwe Raabe]

Zitat:

Zitat von cherry (Beitrag 1038307)

Was mache ich falsch?

Nur so 'ne Idee: Initialisierst du die Instanzen der jeweiligen Listen (z.B. TUser.Groups) denn auch? Es handelt sich dabei schließlich um Objekte.

Ich würde das so realisieren (reduziert auf Groups):

Delphi-Quellcode:

type
  TUser = class(TObject)
  private
    FGroups: TGroups;
  public
    constructor Create;
    destructor Destroy;
    property Groups: TGroups read FGroups;
  end;

constructor TUser.Create;
begin
  inherited Create;
  FGroups := TGroups.Create; // so ist TGroups für die Freigabe der enthaltenen Objekte zuständig
end;

destructor TUser.Destroy;
begin
  FGroups.Free;
  inherited;
end;

Analog muss man natürlich auch für die anderen Container verfahren.

Wie in dem Kommentar vermerkt, kümmert sich TObjectList<T> standardmäßig um die Freigabe der enthaltenen Instanzen bei Delete, Clear und Free. Will man das nicht (z.B. weil nur Referenzen gespeichert werden sollen), muss man Create(false) verwenden. Das kann z.B. Sinn machen, wenn die Gruppen global verwaltet werden und die User nur Referenzen auf die Gruppen speichern. Dann muss man aber auch darauf achten, daß diese Referenzen entfernt werden, bevor die entsprechenden Gruppen freigegeben werden.

[cherry]

Zitat:

Zitat von Uwe Raabe (Beitrag 1038324)

Nur so 'ne Idee: Initialisierst du die Instanzen der jeweiligen Listen (z.B. TUser.Groups) denn auch? Es handelt sich dabei schließlich um Objekte.

Ich Dummbatz, natürlich hab ich das Vergessen. Sorry... Hab irgendwie TGroup und TGroups verwechselt...
Könnte ich dann also auch ohne weiteres TGroup als Record deklarieren, oder sollte es ne Klasse sein?

Zitat:

Zitat von Uwe Raabe (Beitrag 1038324)

Ich würde das so realisieren (reduziert auf Groups): ...

Hmm... Warum TGroup als Property,
wenn keine Getter und Setter noch was spezielles machen?

[DeddyH]

Damit die Instanz einzig und allein von der übergeordneten Klasse verwaltet wird (deshalb ja auch eine ReadOnly-Property).

[cherry]

Ok ;-) werd jetzt mal in mein Programm einbauen und sehen obs so klappt...
Nur trotzdem schade, das mein Konstrukt nicht funktioniert... hätte mich schon interessiert woran das wohl liegt...
aber da müsste ich wahrscheinlich ein wenig mehr Speicherkenntnisse für haben.

THX

[cherry]

:wall: ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄHHHHHHHHHHHHHHHHHHHHH :wall:

Hab nun also mein ganzes Konstrukt über der Haufen geworfen und das ganze mit TObjectList schön umgesetzt. So weit so gut. Danach schön in das Programm implementriert und...
JAWOHL, der Fehler ist immer noch derselbe... nun habe ich aber herausgefunden wo der Fehler liegt und zwar:

Delphi-Quellcode:

  TGroup = record
    name: string[50];
    ldappath: string[255];
  end;

wenn ich auf

Delphi-Quellcode:

  TGroup = record
    name: string;
    ldappath: string;
  end;

Ändere klappts einwandfrei.
Obwohl ich meines Wissens die Grössen nirgens überschreite...

Habs jetzt nicht getestet aber zu 99.9 % müsste mein ursprüngliches Konstrukt also doch funktionieren...

Kann mir jemand sagen warum das Probleme geben kann mit string[n] ?

LG

[DeddyH]

AFAIK sind Shortstrings automatisch AnsiStrings. Ich habe das jetzt nicht in allen Einzelheiten verfolgt, aber möglicherweise liegt hier das Problem begründet.