Créé une liste ou un groupement de classes [Résolu]

jixy 3 Messages postés mercredi 3 septembre 2003Date d'inscription 17 octobre 2006 Dernière intervention - 15 oct. 2006 à 03:38 - Dernière réponse : cs_Delphiprog 4580 Messages postés samedi 19 janvier 2002Date d'inscription 9 janvier 2013 Dernière intervention
- 21 oct. 2006 à 08:51
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.
Afficher la suite 

Votre réponse

15 réponses

Meilleure réponse
cs_Delphiprog 4580 Messages postés samedi 19 janvier 2002Date d'inscription 9 janvier 2013 Dernière intervention - 15 oct. 2006 à 08:06
3
Merci
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.

Merci cs_Delphiprog 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 93 internautes ce mois-ci

Commenter la réponse de cs_Delphiprog
Meilleure réponse
f0xi 4304 Messages postés samedi 16 octobre 2004Date d'inscription 9 mars 2018 Dernière intervention - 15 oct. 2006 à 17:22
3
Merci
+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)

Merci f0xi 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 93 internautes ce mois-ci

Commenter la réponse de f0xi
Utilisateur anonyme - 15 oct. 2006 à 03:57
0
Merci
Salut,

PREMI7REMENT : Merci de mêttre un titre explicite

DEUXIEMEMENT : Merci de chercher avant de poster

TROISIEMENT : On ne réclame pas de code
Commenter la réponse de Utilisateur anonyme
jixy 3 Messages postés mercredi 3 septembre 2003Date d'inscription 17 octobre 2006 Dernière intervention - 16 oct. 2006 à 16:55
0
Merci
Rebonjour , c'est remoi,


Le soucis maintenant c'est ke bizarrement je n'arrive pas à ajouter un Tuser a ma collection, je comprend pas.
Commenter la réponse de jixy
cs_Delphiprog 4580 Messages postés samedi 19 janvier 2002Date d'inscription 9 janvier 2013 Dernière intervention - 16 oct. 2006 à 21:48
0
Merci
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.
Commenter la réponse de cs_Delphiprog
jixy 3 Messages postés mercredi 3 septembre 2003Date d'inscription 17 octobre 2006 Dernière intervention - 17 oct. 2006 à 10:46
0
Merci
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!
Commenter la réponse de jixy
cs_Delphiprog 4580 Messages postés samedi 19 janvier 2002Date d'inscription 9 janvier 2013 Dernière intervention - 17 oct. 2006 à 21:22
0
Merci
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.
Commenter la réponse de cs_Delphiprog
f0xi 4304 Messages postés samedi 16 octobre 2004Date d'inscription 9 mars 2018 Dernière intervention - 18 oct. 2006 à 06:13
0
Merci
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.

<hr size="2" width="100%" />Croc (click me)
Commenter la réponse de f0xi
f0xi 4304 Messages postés samedi 16 octobre 2004Date d'inscription 9 mars 2018 Dernière intervention - 18 oct. 2006 à 06:17
0
Merci
ça ce vois que j'adore travailler sur ce genre de source non ?

<hr size="2" width="100%" />Croc (click me)
Commenter la réponse de f0xi
f0xi 4304 Messages postés samedi 16 octobre 2004Date d'inscription 9 mars 2018 Dernière intervention - 19 oct. 2006 à 15:59
0
Merci
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.

<hr size="2" width="100%" />Croc (click me)
Commenter la réponse de f0xi
cs_Delphiprog 4580 Messages postés samedi 19 janvier 2002Date d'inscription 9 janvier 2013 Dernière intervention - 19 oct. 2006 à 21:56
0
Merci
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.
Commenter la réponse de cs_Delphiprog
f0xi 4304 Messages postés samedi 16 octobre 2004Date d'inscription 9 mars 2018 Dernière intervention - 21 oct. 2006 à 01:36
0
Merci
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)
Commenter la réponse de f0xi
f0xi 4304 Messages postés samedi 16 octobre 2004Date d'inscription 9 mars 2018 Dernière intervention - 21 oct. 2006 à 01:49
0
Merci
mmm faut pas mettre Self apparement ... ça m'enregistre que le nom de la classe.

<hr size="2" width="100%" />Croc (click me)
Commenter la réponse de f0xi
f0xi 4304 Messages postés samedi 16 octobre 2004Date d'inscription 9 mars 2018 Dernière intervention - 21 oct. 2006 à 01:51
0
Merci
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)
Commenter la réponse de f0xi
cs_Delphiprog 4580 Messages postés samedi 19 janvier 2002Date d'inscription 9 janvier 2013 Dernière intervention - 21 oct. 2006 à 08:51
0
Merci
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.
Commenter la réponse de cs_Delphiprog

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.