créé une liste ou un groupement de classesRésolu

Question

Bonjour a tous,

Mon probleme est simple, j'ai créé une classe Tusers sous delphi et je dois créé une liste ou un groupement de ces classes

si possible avec un index ????


Merci d'avance.

cs_Delphiprog · Accepted Answer

Dans ce cas, les collections semblent tout à fait adaptées.

Voici le code minimum à déclarer et à implémenter pour gérer une telle collection :

unit Unit2;

interface

uses Classes;

type
  //Classe de base des utilisateurs
  TUser =   class (TCollectionItem)
  private
    FUserName: string;
    procedure SetUserName(const Value: string);
  public
    procedure Assign(Source: TPersistent);override;
  published
    property UserName: stringread FUserName write SetUserName;
  end;

  TUserClass  = classof TUser;

  //Collection d'utilisateurs;
  TUsers =   class (TCollection)
  private
    function GetItem(Index: integer): TUser;
    procedure SetItem(Index: integer; const Value: TUser);
  public
    constructor Create(UserClass: TUserClass);
    function Add: TUser;
    property Items[Index: integer]: TUser read GetItem write SetItem;default;
  end;

implementation

{ TUser }

procedure TUser.Assign(Source: TPersistent);
begin
  if Source is TUser then
  begin
    UserName : = (Source as TUser).UserName;
  end
  else
    inherited;

end;

procedure TUser.SetUserName(const Value: string);
begin
  FUserName :=  Value;
 end ;

{ TUsers }

function TUsers.Add: TUser;
begin
  Result : = inherited Add as TUser;
end;

constructor TUsers.Create(UserClass: TUserClass);
begin
  inherited Create(UserClass);
end;

function TUsers.GetItem(Index: integer): TUser; begin
  Result := inherited GetItem(Index) as TUser;
end;

procedure TUsers.SetItem(Index: integer; const Value: TUser);
begin
  inherited SetItem(Index, Value);
end;

end.

Les propriétés peuvent être déclarées Public. Si j'ai choisi de les déclarer Published ici, c'est uniquement pour pouvoir utiliser le système de mise en flux qui facilite énormément la sauvegarde.
Ensuite, la classe TUsers (note bien le "s"), descendante de TCollection, possède un ensemble de méthodes pour gérer la collection très facilement.

Voilà, c'est la démarche que j'adopterais si c'était moi.

May Delphi be with you !
<hr />
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.

Francky23012301 · Answer

Salut,

PREMI7REMENT : Merci de mêttre un titre explicite

DEUXIEMEMENT : Merci de chercher avant de poster

TROISIEMENT : On ne réclame pas de code

f0xi · Answer

+1 pour la TCollection c'est ce qu'il y a de mieux pour ce genre de chose ...

a savoir que ont peu directement utiliser la Collection en dynamique ou encore l'inclure dans un Tcomponent qui servirat de manager global entre la collection et l'application et egalement de l'inclure dans la palette de composants afin d'en faciliter l'accés.

<hr size="2" width="100%" />Croc (click me)

jixy · Answer

Rebonjour , c'est remoi,


Le soucis maintenant c'est ke bizarrement je n'arrive pas à ajouter un Tuser a ma collection, je comprend pas.

cs_Delphiprog · Answer

Peux-tu nous dire comment tu t'y prends pour ajouter un TUser à la collection ?

May Delphi be with you !
<hr color="#008000" />
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.

jixy · Answer

Voila ma source , personnellement je débute donc on se moque pas!! ^^ 

unit Tuse;

interface 
uses classes;

type
  
  //Classe de base des utilisateurs
  Tuser = class (TcollectionItem)
  private 
    FUserName: string;
    floggin:string;
    fpass:string;
    fip:string;
    fport:integer;
    famis:Tlist;
    fpseudo:string;
    fconfig:boolean;
    procedure SetUserName(const Value: string);
    procedure Setloggin(const log:string); 
    procedure Setconfig(const co:boolean);
    procedure Setpass(const passe:string);
    procedure Setip(const ips:string);
    procedure Setport(const por:integer);
    procedure Setamis(const ami:Tlist);
    procedure Setpseudo(const pseud:string);
  public
    procedure Assign(Source: TPersistent);override;
    //constructor overload Create(log:string;passe:string;ips:string;por:integer;ami:Tlist;pseud:string);
  published
    property UserName: string read FUserName write SetUserName;
    property loggin: string read Floggin write Setloggin;
    property pass: string read Fpass write Setpass;    
    property ip: string read Fip write Setip;       
    property port: integer read Fport write Setport;
    property pseudo: string read Fpseudo write Setpseudo;
    property config: boolean read Fconfig write Setconfig;
    property amis: Tlist read Famis write Setamis;
    end;

TUserClass = Class of Tuser;

  TUsers = class (Tcollection)
  private
    function GetItem(index:integer):Tuser;
    procedure SetItem(Index: integer; const Value: TUser);
  public
    constructor Create(UsersClass : TUserCLass);
    function add:Tuser;
    property Items[index:integer]:Tuser read GetItem write SetItem;default;
  end;

implementation

    procedure TUser.Assign(Source: TPersistent);
begin
  if (Source is TUser) then
  begin
    Username := (Source as TUser).UserName;
    loggin := (Source as TUser).loggin;
    pass := (Source as TUser).pass;
    ip :=(source as Tuser).ip;
    port :=(source as Tuser).port;
    amis :=(source as Tuser).amis;
    pseudo :=(source as Tuser).pseudo;
    config :=(source as Tuser).config;
  end
  else
    inherited;

end;

procedure TUser.SetUserName(const Value: string);
begin
  FUserName := Value;
end;

function TUsers.Add: TUser;
begin
  Result := inherited Add as TUser;
end;

constructor TUsers.Create(UsersClass: TUserClass);
begin
  inherited Create(UsersClass);
end;

function TUsers.GetItem(Index: integer): TUser; begin
  Result := inherited GetItem(Index) as TUser;
end;

procedure TUsers.SetItem(Index: integer; const Value: TUser);
begin
  inherited SetItem(Index, Value);
end;

   { constructor Tusers.Create;
    begin  
      loggin:='';
      pass:='';
      ip:='';
      port:=0;
      pseudo:='';
      config:=false;

    end; }

   { constructor Tusers.Create(log:string;passe:string;ips:string;por:integer;ami:Tlist;pseud:string);
    begin
      loggin:=log;
      pass:=passe;
      ip:=ips;
      port:=por;
      amis:=ami;
      pseudo:=pseud;
    end;          }

  {  destructor Tusers.Detruit;
    begin

    end;    }

    {function Tusers.Getconfig:boolean;
    begin
      result := config;
    end;      }

    procedure Tuser.Setconfig(const co:boolean);
    begin
      fconfig:=co;
    end;

  {  function Tusers.Getloggin:string;
    begin
      Result := loggin;
    end;

    function Tusers.Getpass:string;
    begin
      Result := pass;
    end;

    function Tusers.Getip:string;
    begin
      Result := ip;
    end;

    function Tusers.Getport:integer;
    begin
      Result := port;
    end;

    function Tusers.Getamis:Tlist;
    begin
      Result := amis;
    end;

    function Tusers.Getpseudo:string;
    begin
      Result := pseudo;
    end;
                   }
    procedure Tuser.Setloggin(const log:string);
    begin
      floggin:=log;
    end;

    procedure Tuser.Setpass(const passe:string);
    begin
      fpass:=passe;
    end;

    procedure Tuser.Setip(const ips:string);
    begin
      fip:=ips;
    end;

    procedure Tuser.Setport(const por:integer);
    begin
      fport:=por;
    end;

    procedure Tuser.Setamis(const ami:Tlist);
    begin
      famis:=ami;
    end;

    procedure Tuser.Setpseudo(const pseud:string);
    begin
      fpseudo:=pseud;
    end;

end.

Et je me demande s'il ne manque pas kelke lignes mais j'ai tester avec la function Tusers.add;  mais c'est pas ca . Snif 

Merci d'avance!

cs_Delphiprog · Answer

Ok. Tout d'abord, quelques corrections à faire sur tes déclarations et implémentations dans la classes TUser (voir les commentaires) :

unit TUse;

interface

uses classes;

type
  //Classe de base des utilisateurs
  TUser =   class (TcollectionItem)
  private
    FUserName: string;
    floggin: string;
    fpass: string;
    fip: string;
    fport: integer;
    famis: Tlist;
    fpseudo: string;
    fconfig: boolean;
    procedure SetUserName(const Value: string);
    procedure Setloggin(const log: string);
    procedure Setconfig(const co: boolean);
    procedure Setpass(const passe: string);
    procedure Setip(const ips: string);
    procedure Setport(const por: integer);
    procedure Setamis(const ami: Tlist);
    procedure Setpseudo(const pseud: string);
  public
    procedure Assign(Source: TPersistent); override;
    //Nécessité d'un constructor pour initialiser FAmis
    constructor Create(Collection: TCollection);override;
    //Nécessité d'un destructeur pour détruire FAmis
    destructor Destroy;override;
  published
    property UserName: stringread FUserName write SetUserName;
    property loggin: stringread Floggin write Setloggin;
    property pass: stringread Fpass write Setpass;
    property ip: stringread Fip write Setip;
    property port: integer read Fport write Setport;
    property pseudo: stringread Fpseudo write Setpseudo;
    property config: boolean read Fconfig write Setconfig;
    property amis: Tlist read Famis write Setamis;
  end;

  TUserClass  = classof TUser;

  TUsers =   class (Tcollection)
  private
    function GetItem(index: integer): TUser;
    procedure SetItem(Index: integer; const Value: TUser);
  public
    constructor Create(UsersClass: TUserCLass);
    function add: TUser;
    property Items[index: integer]: TUser read GetItem write SetItem; default;
  end;

implementation

procedure TUser.Assign(Source: TPersistent);
begin
  if (Source is TUser) then
  begin
    Username : = (Source as TUser).UserName;
    loggin :=  (Source  as  TUser).loggin;
    pass : = (Source as TUser).pass;
    ip :=  (source  as  TUser).ip;
    port : = (source as TUser).port;
    amis :=  (source  as  TUser).amis;
    pseudo : = (source as TUser).pseudo;
    config :=  (source  as  TUser).config;
    {Les amis de nos amis sont aussi nos amis !}
    Amis.Assign((Source as TUser).amis);
  end
  else
    inherited;
end;

procedure TUser.SetUserName(const Value: string);
begin
  FUserName : = Value;
end;

function TUsers.Add: TUser;
begin
  Result :=   inherited  Add as TUser;
end;

constructor TUsers.Create(UsersClass: TUserClass);
begin
  inherited Create(UsersClass);
end;

function TUsers.GetItem(Index: integer): TUser;
begin
  Result : = inherited GetItem(Index) as TUser;
end;

procedure TUsers.SetItem(Index: integer; const Value: TUser);
begin
  inherited SetItem(Index, Value);
end;

procedure TUser.Setconfig(const co: boolean);
begin
  fconfig :=  co;
 end ;

procedure TUser.Setloggin(const log: string);
begin
  floggin : = log;
end;

procedure TUser.Setpass(const passe: string);
begin
  fpass :=  passe;
 end ;

procedure TUser.Setip(const ips: string);
begin
  fip : = ips;
end;

procedure TUser.Setport(const por: integer);
begin
  fport :=  por;
 end ;

procedure TUser.Setamis(const ami: Tlist);
begin
  famis : = ami;
end;

procedure TUser.Setpseudo(const pseud: string);
begin
  fpseudo :=  pseud;
 end ;

constructor TUser.Create(Collection: TCollection);
begin
  inherited;
  FAmis : = TList.Create;
end;

destructor TUser.Destroy;
begin
  FAmis.Free;
  inherited;
end;

end.

Maintenant, tu as tout ce qu'il te faut pour bien débuter.
Passons aux tests.
Crée une fiche, mets deux boutons et un TMemo et ajoute le code suivant dans cette fiche :

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
  {ajouter TUse ici si nous utilisons un TUsers en tant 
   que membre de classe ci-dessous}
  TUse ;

type
  TForm1 =   class (TForm)
    btnAddUsers: TButton;
    Memo1: TMemo;
    btnListUsers: TButton;
    procedure btnAddUsersClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnListUsersClick(Sender: TObject);
  private
    { Déclarations privées }
    Users: TUsers;
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
  //crée la collection
  Users : = TUsers.Create(TUser);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  {Les éléments de la collection seront automatiquement libérés
  à condition de libérer la collection}
  Users.Free;
end;

procedure TForm1.btnAddUsersClick(Sender: TObject);
var
  i: integer;
const
  MaxUsers =  26;
begin
  //ajoute 26 membres à la collection
   for  i : = 0 to MaxUsers - 1 do
    {L'appel de la méthode Add suffit à ajouter un élément}
    with Users.add do
    begin
      {Affectation de quelques propriétés à l'utilisateur}
      UserName :=  'User ' + Chr(65 + i);
      Loggin := '';
      Pass := '';
      IP := '127.0.0.' + IntToStr(i);
      Port := 80;
      Pseudo := 'Pseudo' + IntToStr(i);
      Config := False;
     end ;
end;

procedure TForm1.btnListUsersClick(Sender: TObject);
var
  i: integer;
begin
  Memo1.Clear;
  //Affiche la liste des utilisateurs
  for i : = 0 to Users.Count - 1 do
    Memo1.Lines.Append(Users[i].UserName);
end;

end.

Est-ce plus clair maintenant ?

Petit rappel : quand tu appelles Tusers.add, la méthode Add de la classe TUsers n'est pas une méthode de classe et tu ne peux donc pas l'appeler de cette manière.

May Delphi be with you !
<hr color="#008000" />
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.

f0xi · Answer

aller hop je m'y mets aussi, en corigeant et ameliorant certains trucs : TUser, tcollectionitem, correction des declarations, remise en ordre, réécriture du code. TUsers, tcollection, correction des declarations, ajout d'une function Add plus simple d'utilisation et d'une procedure GetUsersList permettant de lister dans un TStrings les DisplayName des TUser. TCustomUsersManager, TComponent, classes de base pour manager la collection, ajout de son propre format de fichier de stockage (format USF), d'une methode LoadFromFile et SaveToFile. Le chargement/sauvegarde s'effectue avec deux methode virtuelles GetStreamFromItem et SetItemFromStream qui peut permettre a l'avenir d'inclure les ZStream de la ZLib pour compresser le fichier USF. en passant, sauvegarder un string de taille indeterminé c'est relou d'ou le code de ces methodes. TUsersManager, TCustomUsersManager, classe fonctionnelle pour utilisation finale. classe a mettre dans la procedure Register si ajout a la palette de composants. Aussi, je ne vois pas trés bien a quoi sert la TList declarée dans TUser ... donc il n'y a aucun code pour elle et elle n'est pas non plus sauver par le manager. si le but est de créer des liens entre les TUser, il faut créer une nouvelle propriétée dans TUser de type cardinal pour lui associé un identifiant unique et invariable. il faudrat par la suite créé une fonction de recherche (GetIndexFromUserID(const UID : cardinal) : integer) pour recuperer l'index du TUser contenant cet ID et donc stocké ce dernier dans une liste qui pourrat etre sauvegardée. maintenant il faut voir comment le tout est utilisé, il y'a surrement plus simple. unit UsersMan; interface uses Sysutils, windows, Classes; type TUser = class(TCollectionItem) private fUserName : string; fPseudo : string; fLogin : string; fPass : string; fIp : string; fPort : integer; fFriends : Tlist; fConfig : boolean; procedure SetString(index : integer; val : string); procedure SetInteger(val : integer); procedure SetBoolean(val : boolean); procedure SetList(val : TList); procedure DoChange(Sender : TObject); protected function GetDisplayName : string; override; public constructor Create(Collection : TCollection); override; destructor Destroy; override; procedure Assign(Source : TPersistent); override; published property UserName : string index 0 read fUserName write SetString; property Pseudo : string index 1 read fPseudo write SetString; property Login : string index 2 read fLogin write SetString; property Password : string index 3 read fPass write SetString; property Ip : string index 4 read fIp write SetString; property Port : integer read fPort write SetInteger; property Config : boolean read fConfig write SetBoolean; property Friends : Tlist read fFriends write SetList; end; TUsers = class(TCollection) private fOwner : TComponent; function GetItem(Index: Integer): TUser; procedure SetItem(Index: Integer; Value: TUser); protected function GetOwner: TPersistent; override; public constructor Create(AOwner : TComponent); function Add : TUser; function AddUser(const AUserName, APseudo, ALogin, APassword, AIp : string; const APort : integer; const AConfig : boolean) : integer; property Items[Index: Integer]: TUser read GetItem write SetItem; default; procedure GetUserList(strings : TStrings); end; TCustomUsersManager = class(TComponent) private fUsers : TUsers; procedure SetUsers(val : TUsers); function GetCount : integer; protected procedure GetStreamFromItem(Item : TUser; Stream : TStream); virtual; procedure SetItemFromStream(Item : TUser; Stream : TStream); virtual; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; property Users : TUsers read fUSers write SetUsers; property Count : integer read GetCount; function LoadFromFile(const FileName : string) : boolean; virtual; function SaveToFile(const FileName : string) : boolean; virtual; end; TUsersManager = class(TCustomUsersManager); implementation Const USERS_FILE_SIGN : cardinal = $00465355; { TUsersManager -- TComponent } constructor TCustomUsersManager.Create(AOwner : TComponent); begin inherited Create(AOwner); fUsers := TUsers.Create(Self); end; destructor TCustomUsersManager.Destroy; begin fUsers.Free; inherited Destroy; end; procedure TCustomUsersManager.SetUsers(val : TUsers); begin fUsers.Assign(val); end; function TCustomUsersManager.GetCount : integer; begin result := fUsers.Count; end; procedure TCustomUsersManager.GetStreamFromItem(Item : TUser; Stream : TStream); var N,LU,LP,LL,LW,LI : word; begin if (not Assigned(Item)) or (not Assigned(Stream)) then exit; with Stream do begin Position := 0; with Item do begin LU := Length(fUserName); LP := Length(fPseudo); LL := Length(fLogin); LW := Length(fPass); LI := Length(fIp); WriteBuffer(LU,SizeOf(word)); WriteBuffer(LP,SizeOf(word)); WriteBuffer(LL,SizeOf(word)); WriteBuffer(LW,SizeOf(word)); WriteBuffer(LI,SizeOf(word)); WriteBuffer(fPort,SizeOf(integer)); WriteBuffer(fConfig,SizeOf(Boolean)); for N := 1 to LU do WriteBuffer(fUserName[n],1); for N := 1 to LP do WriteBuffer(fPseudo[n],1); for N := 1 to LL do WriteBuffer(fLogin[n],1); for N := 1 to LW do WriteBuffer(fPass[n],1); for N := 1 to LI do WriteBuffer(fIp[n],1); end; end; end; procedure TCustomUsersManager.SetItemFromStream(Item : TUser; Stream : TStream); var N,LU,LP,LL,LW,LI : word; begin if (not Assigned(Item)) or (not Assigned(Stream)) then exit; with Stream do begin position := 0; with Item do begin ReadBuffer(LU,SizeOf(word)); ReadBuffer(LP,SizeOf(word)); ReadBuffer(LL,SizeOf(word)); ReadBuffer(LW,SizeOf(word)); ReadBuffer(LI,SizeOf(word)); ReadBuffer(fPort,SizeOf(Integer)); ReadBuffer(fConfig,SizeOf(Boolean)); SetLength(fUserName,LU); SetLength(fPseudo,LP); SetLength(fLogin,LL); SetLength(fPass,LW); SetLength(fIp,LI); for N := 1 to LU do ReadBuffer(fUserName[n],1); for N := 1 to LP do ReadBuffer(fPseudo[n],1); for N := 1 to LL do ReadBuffer(fLogin[n],1); for N := 1 to LW do ReadBuffer(fPass[n],1); for N := 1 to LI do ReadBuffer(fIp[n],1); end; end; end; function TCustomUsersManager.LoadFromFile(const FileName : string) : boolean; var TFS : TFileStream; TMS : TMemoryStream; UFS : cardinal; STS : int64; N,CNT : integer; begin result := false; if not FileExists(FileName) then exit; TFS := TFileStream.Create(FileName,fmOpenRead); try TFS.ReadBuffer(UFS,SizeOf(Cardinal)); if UFS = USERS_FILE_SIGN then begin TFS.ReadBuffer(CNT,SizeOf(Integer)); for N := 0 to CNT-1 do begin TMS := TMemoryStream.Create; try TFS.ReadBuffer(STS,SizeOf(Int64)); TMS.CopyFrom(TFS,STS); TFS.Position := TFS.Position + STS; SetItemFromStream(fUsers.Add,TMS); finally TMS.Free; end; end; result := true; end; finally TFS.Free; end; end; function TCustomUsersManager.SaveToFile(const FileName : string) : boolean; var TFS : TFileStream; TMS : TMemoryStream; STS : int64; N,CNT : integer; begin result := false; TFS := TFileStream.Create(FileName,fmCreate); try TFS.WriteBuffer(USERS_FILE_SIGN,SizeOf(Cardinal)); CNT := fUsers.Count; TFS.WriteBuffer(CNT,SizeOf(Integer)); for N := 0 to Count-1 do begin TMS := TMemoryStream.Create; try GetStreamFromItem(fUSers.Items[n],TMS); STS := TMS.Size; TFS.WriteBuffer(STS,SizeOf(Int64)); TMS.Position := 0; TFS.CopyFrom(TMS,TMS.Size); TFS.Position := TFS.Position + STS; finally TMS.Free; end; end; result := true; finally TFS.Free; end; end; { TUsers -- TCollection } constructor TUsers.Create(AOwner : TComponent); begin fOwner := AOwner; inherited Create(TUser); end; function TUsers.GetItem(Index: Integer): TUser; begin Result := TUser(inherited GetItem(Index)); end; procedure TUsers.SetItem(Index: Integer; Value: TUser); begin inherited SetItem(Index, Value); end; function TUsers.GetOwner: TPersistent; begin Result := fOwner; end; function TUsers.Add : TUser; begin Result := (inherited Add) as TUser; end; function TUsers.AddUser(const AUserName, APseudo, ALogin, APassword, AIp : string; const APort : integer; const AConfig : boolean) : integer; begin with Add do begin UserName := AUserName; Pseudo := APseudo; Login := ALogin; Password := APassword; Ip := AIp; Port := APort; Config := AConfig; end; Result := Self.Count-1; end; procedure TUsers.GetUserList(strings : TStrings); var n : integer; begin Strings.BeginUpdate; Strings.Clear; for n := 0 to count-1 do Strings.Add(Items[n].GetDisplayName); Strings.EndUpdate; end; { TUser -- TCollectionItem } constructor TUser.Create(Collection : TCollection); begin inherited Create(Collection); fFriends := TList.Create; end; destructor TUser.Destroy; begin fFriends.Free; inherited Destroy; end; procedure TUser.SetString(index : integer; val : string); begin case index of 0 : if fUserName <> val then begin fUserName := val; changed(false); end; 1 : if fPseudo <> val then begin fPseudo := val; changed(false); end; 2 : if fLogin <> val then begin fLogin := val; changed(false); end; 3 : if fPass <> val then begin fPass := val; changed(false); end; 4 : if fIp <> val then begin fIp := val; changed(false); end; end; end; procedure TUser.SetInteger(val : integer); begin if fPort <> val then begin fPort := val; changed(false); end; end; procedure TUser.SetBoolean(val : boolean); begin if fConfig <> val then begin fConfig := val; changed(false); end; end; procedure TUser.SetList(val : TList); begin fFriends.Assign(val); changed(false); end; procedure TUser.DoChange(Sender : TObject); begin changed(false); end; function TUser.GetDisplayName : string; begin if Length(fUserName) > 0 then Result := 'User'+IntToStr(Self.Index+1)+' <'+fUserName+'>' else Result := 'User'+IntToStr(Self.Index+1); end; procedure TUser.Assign(Source : TPersistent); begin if source is TUser then with TUser(Source) do begin UserName := Self.fUserName; Pseudo := Self.fPseudo; Login := Self.fLogin; Password := Self.fPass; Ip := Self.fIp; Port := Self.fPort; Config := Self.fConfig; Friends.Assign(Self.fFriends); end else inherited Assign(source); end; end.

Croc (click me)

f0xi · Answer

ça ce vois que j'adore travailler sur ce genre de source non ? 

<hr size="2" width="100%" />Croc (click me)

f0xi · Answer

grosse modif, les stream avec les boucles me plaisait pas, en fait c'etait tout bete, il suffisait de faire un PChar sur la chaine pour pouvoir l'enregistrer d'un coups. du coups, le format USF a un peu changer ... mais c'est innerant a toute evolution d'un programme. unit UsersMan; interface uses Sysutils, windows, Classes; type TUser = class(TCollectionItem) private fUserInfos: array[0..4] of string; fPort : integer; fFriends : Tlist; fConfig : boolean; function GetString(index : integer) : string; procedure SetString(index : integer; val : string); procedure SetInteger(val : integer); procedure SetBoolean(val : boolean); procedure SetList(val : TList); procedure DoChange(Sender : TObject); protected function GetDisplayName : string; override; public constructor Create(Collection : TCollection); override; destructor Destroy; override; procedure Assign(Source : TPersistent); override; published property UserName : string index 0 read GetString write SetString; property Pseudo : string index 1 read GetString write SetString; property Login : string index 2 read GetString write SetString; property Password : string index 3 read GetString write SetString; property Ip : string index 4 read GetString write SetString; property Port : integer read fPort write SetInteger; property Config : boolean read fConfig write SetBoolean; property Friends : Tlist read fFriends write SetList; end; TUsers = class(TCollection) private fOwner : TComponent; function GetItem(Index: Integer): TUser; procedure SetItem(Index: Integer; Value: TUser); protected function GetOwner: TPersistent; override; public constructor Create(AOwner : TComponent); function Add : TUser; function AddUser(const AUserName, APseudo, ALogin, APassword, AIp : string; const APort : integer; const AConfig : boolean) : integer; property Items[Index: Integer]: TUser read GetItem write SetItem; default; procedure GetUserList(strings : TStrings); end; TCustomUsersManager = class(TComponent) private fUsers : TUsers; procedure SetUsers(val : TUsers); function GetCount : integer; protected procedure GetStreamFromItem(Item : TUser; Stream : TStream); virtual; procedure SetItemFromStream(Item : TUser; Stream : TStream); virtual; public constructor Create(AOwner : TComponent); override; destructor Destroy; override; property Users : TUsers read fUSers write SetUsers; property Count : integer read GetCount; function LoadFromFile(const FileName : string) : boolean; virtual; function SaveToFile(const FileName : string) : boolean; virtual; end; TUsersManager = class(TCustomUsersManager); implementation Const USERS_FILE_SIGN : cardinal = $00465355; { TUsersManager -- TComponent } constructor TCustomUsersManager.Create(AOwner : TComponent); begin inherited Create(AOwner); fUsers := TUsers.Create(Self); end; destructor TCustomUsersManager.Destroy; begin fUsers.Free; inherited Destroy; end; procedure TCustomUsersManager.SetUsers(val : TUsers); begin fUsers.Assign(val); end; function TCustomUsersManager.GetCount : integer; begin result := fUsers.Count; end; procedure TCustomUsersManager.GetStreamFromItem(Item : TUser; Stream : TStream); var N,LW : word; PS : PChar; begin if (not Assigned(Item)) or (not Assigned(Stream)) then exit; with Stream do begin Position := 0; with Item do begin for N := 0 to 4 do begin LW := Length(fUserInfos[N]); WriteBuffer(LW,SizeOf(word)); PS := PChar(fUserInfos[N]); WriteBuffer(PS^,LW); end; WriteBuffer(fPort,SizeOf(integer)); WriteBuffer(fConfig,SizeOf(Boolean)); end; end; end; procedure TCustomUsersManager.SetItemFromStream(Item : TUser; Stream : TStream); var N,LW : word; PS : PChar; begin if (not Assigned(Item)) or (not Assigned(Stream)) then exit; with Stream do begin position := 0; with Item do begin for N := 0 to 4 do begin ReadBuffer(LW,SizeOf(word)); SetLength(fUserInfos[N],LW); PS := PChar(fUserInfos[N]); ReadBuffer(PS^,LW); end; ReadBuffer(fPort,SizeOf(Integer)); ReadBuffer(fConfig,SizeOf(Boolean)); end; end; end; function TCustomUsersManager.LoadFromFile(const FileName : string) : boolean; var TFS : TFileStream; TMS : TMemoryStream; UFS : cardinal; STS : int64; N,CNT : integer; begin result := false; if not FileExists(FileName) then exit; TFS := TFileStream.Create(FileName,fmOpenRead); try TFS.ReadBuffer(UFS,SizeOf(Cardinal)); if UFS = USERS_FILE_SIGN then begin TFS.ReadBuffer(CNT,SizeOf(Integer)); for N := 0 to CNT-1 do begin TMS := TMemoryStream.Create; try TFS.ReadBuffer(STS,SizeOf(Int64)); TMS.CopyFrom(TFS,STS); TFS.Position := TFS.Position + STS; SetItemFromStream(fUsers.Add,TMS); finally TMS.Free; end; end; result := true; end; finally TFS.Free; end; end; function TCustomUsersManager.SaveToFile(const FileName : string) : boolean; var TFS : TFileStream; TMS : TMemoryStream; STS : int64; N,CNT : integer; begin result := false; TFS := TFileStream.Create(FileName,fmCreate); try TFS.WriteBuffer(USERS_FILE_SIGN,SizeOf(Cardinal)); CNT := fUsers.Count; TFS.WriteBuffer(CNT,SizeOf(Integer)); for N := 0 to Count-1 do begin TMS := TMemoryStream.Create; try GetStreamFromItem(fUSers.Items[n],TMS); STS := TMS.Size; TFS.WriteBuffer(STS,SizeOf(Int64)); TMS.Position := 0; TFS.CopyFrom(TMS,TMS.Size); TFS.Position := TFS.Position + STS; finally TMS.Free; end; end; result := true; finally TFS.Free; end; end; { TUsers -- TCollection } constructor TUsers.Create(AOwner : TComponent); begin fOwner := AOwner; inherited Create(TUser); end; function TUsers.GetItem(Index: Integer): TUser; begin Result := TUser(inherited GetItem(Index)); end; procedure TUsers.SetItem(Index: Integer; Value: TUser); begin inherited SetItem(Index, Value); end; function TUsers.GetOwner: TPersistent; begin Result := fOwner; end; function TUsers.Add : TUser; begin Result := (inherited Add) as TUser; end; function TUsers.AddUser(const AUserName, APseudo, ALogin, APassword, AIp : string; const APort : integer; const AConfig : boolean) : integer; begin with Add do begin UserName := AUserName; Pseudo := APseudo; Login := ALogin; Password := APassword; Ip := AIp; Port := APort; Config := AConfig; end; Result := Self.Count-1; end; procedure TUsers.GetUserList(strings : TStrings); var n : integer; begin Strings.BeginUpdate; Strings.Clear; for n := 0 to count-1 do Strings.Add(Items[n].GetDisplayName); Strings.EndUpdate; end; { TUser -- TCollectionItem } constructor TUser.Create(Collection : TCollection); begin inherited Create(Collection); fFriends := TList.Create; end; destructor TUser.Destroy; begin fFriends.Free; inherited Destroy; end; procedure TUser.SetString(index : integer; val : string); begin if fUserInfos[index] <> val then begin fUserInfos[index] := val; changed(false); end; end; function TUser.GetString(index : integer) : string; begin result := fUserInfos[index]; end; procedure TUser.SetInteger(val : integer); begin if fPort <> val then begin fPort := val; changed(false); end; end; procedure TUser.SetBoolean(val : boolean); begin if fConfig <> val then begin fConfig := val; changed(false); end; end; procedure TUser.SetList(val : TList); begin fFriends.Assign(val); changed(false); end; procedure TUser.DoChange(Sender : TObject); begin changed(false); end; function TUser.GetDisplayName : string; begin if Length(fUserInfos[0]) > 0 then Result := 'User'+IntToStr(Self.Index+1)+' <'+fUserInfos[0]+'>' else Result := 'User'+IntToStr(Self.Index+1); end; procedure TUser.Assign(Source : TPersistent); begin if source is TUser then with TUser(Source) do begin UserName := Self.fUserInfos[0]; Pseudo := Self.fUserInfos[1]; Login := Self.fUserInfos[2]; Password := Self.fUserInfos[3]; Ip := Self.fUserInfos[4]; Port := Self.fPort; Config := Self.fConfig; Friends.Assign(Self.fFriends); end else inherited Assign(source); end; end.

Croc (click me)

cs_Delphiprog · Answer

ALors là, mon cher Foxi, bravo !

Tu t'es bien cassé la tête pour sauvegarder la collection et pour la relire.
Savais-tu que Delphi est capable de mettre en flux les propriétés publiées d'un composant ?
En gros, la sauvegarde se résume à utiliser une classe descendant de TComponent et possédant un membre de la classe TCollection :
{La classe TCollectionHelper est utilisée pour mettre la collection TUSers dans un flux. Pour celà, nous utilisons les capacités de Delphi à sauvegarder les propriétés publiées (appel à la méthode WriteComponent d'un TStream).}
  TCollectionHelper =   class (TComponent)
  private
    FCollection: TCollection;
  public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;
  published
    {Les valeurs contenues dans la propriété Collection seront sauvegardées. Il est donc impératif de leur donner une portée Published pour utiliser le mécanisme de mise en flux de Delphi.}
    property Collection: TCollection read FCollection write FCollection;
  end;

{ TTemp }

constructor TCollectionHelper.Create(AOwner: TComponent);
begin
  inherited;
  //Création de la collection TCollection
  FCollection : = TCollection.Create;
end;

destructor TCollectionHelper.Destroy;
begin
  FCollection.Free;
  inherited;
end;

Et voici le code de la procédure en charge de sauvegarder n'importe quel descendant de TCollection :

procedure TCollectionMainForm.SaveToFile(const FileName: TFileName; Users: TUSers);
var
  Temp: TCollectionHelper;
  FS: TFileStream;
begin
{ Création d'une structure temporaire pour contenir les
  valeurs à sauvegarder}
  Temp :=  TCollectionHelper.Create( nil );
  try
    {Copie des éléments contenus dans FPleins}
    Temp.Collection.Assign(Users);
    FS : = TFileStream.Create(FileName, fmCreate or fmOpenWrite);
    try
      {Ecriture des valeurs contenues dans Temp dans le flux}
      FS.WriteComponent(Temp);
    finally
      FS.Free;
    end;
  finally
    Temp.Free;
  end;
end;

Puis la relecture du fichier et l'affectation à la collection :

procedure TCollectionMainForm.LoadFromFile(const FileName: TFileName; Users: TUsers);
var
  Temp: TCollectionHelper;
  fs: TFileStream;
begin
  Temp :=  TCollectionHelper.Create( nil );
  try
    try
      fs : = TFileStream.Create(FileName, fmOpenRead);
      try
        fs.ReadComponent(Temp);
        Users.Assign(Temp);
      finally
        fs.Free;
      end; {try..finally}
    except
      ShowMessage(FileName + ' n''est pas un fichier correct');
    end;{try..except}
  finally
    Temp.Free;
  end; {try..finally}
end;

En pratiquant ainsi, la classe TCollectionHelper est capable de sauvegarder n'importe quelle collection.
C'est pour cette raison que, dans une de mes premières réponses, j'avais fortement incité à déclarer les propriétés à sauvegarder en section Published.

Delphi is magic ! 

May Delphi be with you !
<hr color="#008000" />
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.

f0xi · Answer

WriteComponent ... et oui ... suis-je bete ... pourquoi n'y ais-je pas penser.
l'habitude de travailler avec les record surrement :)

on peut alors utiliser directement TUsersManager .... puisque descendant de TComponent.

function TCustomUsersManager.LoadFromFile(const FileName : string) : boolean;
var TFS : TFileStream;
begin
  result := false;
  if not FileExists(FileName) then exit;
  TFS := TFileStream.Create(FileName,fmOpenRead);
  try
    TFS.ReadComponent(self);
    result := true;
  finally
    TFS.Free;
  end;
end;

function TCustomUsersManager.SaveToFile(const FileName : string) : boolean;
var TFS : TFileStream;
begin
  result := false;
  TFS := TFileStream.Create(FileName,fmCreate);
  try
    TFS.WriteComponent(Self);
    result := true;
  finally
    TFS.Free;
  end;
end;

je vais de ce pas modifier mon programme tests pour teste son efficacitée.

<hr size="2" width="100%" />Croc (click me)

f0xi · Answer

mmm faut pas mettre Self apparement ... ça m'enregistre que le nom de la classe.

<hr size="2" width="100%" />Croc (click me)

f0xi · Answer

mais personnellement, je prefere la creation d'un format de fichier propre, independant de la structure du composant.
c'est plus facile de refaire le programme de lecture/ecriture sous php ou c++ par exemple.
ce qui peut etre interressant dans certain cas.

<hr size="2" width="100%" />Croc (click me)

cs_Delphiprog · Answer

A la place de Self, pourquoi ne mets-tu pas Users ?
En ce qui concerne la lecture par une appli écrite en C++, il n'y a aucun problème si tu utilises C++ Builder vu que la VCL est celle de Delphi !


Les deux techniques sont intéressantes mais ont toutes les deux la même limitation : si un membre de la classe TUser est une référence sur un instance d'une classe quelconque, il ne sera jamais possible de retrouver l'emplacemnt mémoire qui était le sien au moment de la sauvegarde. Comme tu le faisais remarquer précédemment à juste titre, il faut envisager un autre type pour la propriété TUser.Friends.

May Delphi be with you !


<hr color="#008000" />
Pensez à cliquer sur Réponse acceptée lorsque la réponse vous convient.

Créé une liste ou un groupement de classes

15 réponses

Votre réponse

Discussions similaires