Tfolderslist ou comment utiliser les interfaces pour masquer certaines methodes d'un objet

Description

J'avais besoin d'un objet type tStringList qui serait orienté stockage de repertoires (autoriser les repertoires enfants ou non...)

J'avais donc besoin que la plupart des methodes de tStringList soient invisibles à l'utilisateur de ma classe, tout en introduisant de nouvelles fonctionnalités

J'ai donc fait une tStringList triée, n'authorisant qu'une occurence de chaque chaines, puis l'ai lié à une interface qui masque l'objet sous-jacent.

Source / Exemple :


unit uStringListInterface;

{

  Version : 1 (18/10/2010)

              Cette utilisation des interfaces permet de réduire la visibilité des methodes et propriétés
              des tSTringLsit sous-jacents.

              Il est à noter qu'une interface gère elle même les instances de l'objet sous jacent grace
              aux fonctions "QueryInterface", "_AddRef" et "_Release" , ces fonctions ne doivent pas être
              appelées manuellement

  Cette unité contient :

   - tOnceOccurSortedStringList : Une liste de chaines qui impose un tri alphabétique et n'autorise qu'une seule occurance de
      chaque chaine (hérite de tStringList).

   - tFoldersStringList : Objet conçu pour maintenir une liste de répertoires en autorisant ou non l'ajout de répertoires enfants
      (c'est à dire de repertoires dont une racine directe ou indirecte figurerait déja dans la liste), il hérite de
      "tOnceOccurSortedStringList".

   - iBasicListFunctions : Définition d'interface permetant un accès simplifié et restreint à tStringList et à ses déscendants
      (Ajout / Suppresson / Vidage)

   - tiOnceOccurSortedStringList et tiFoldersStringList : Les version Objets-Interfacés des deux premiers Types décris ci-dessus

   -> Les methodes LoadFromStream() et SaveToStream() sont surchargées afin de de conserver en le nombre d'octets utilisés dans le
      fux pour la sauvegarde

   -> Cette unité ne teste jamais ni la validité des chemins de répertoires, ni leur existance réelle

}

// !! Vérifier que la liste est bien vidée automatiquement dans LoadFromStream

interface

uses
  Classes, SysUtils, Dialogs;

Const
      TXT_CHILD_ERROR = 'Répertoires enfants non autorisés';
      TXT_DUPLICATES_ERROR = 'Doublons non autorisés';

type

  eFoldersStringListError = Class(Exception);

  iBasicListFunctions = interface(iInterface)
    ['{90B7E761-5A52-4AC6-B9B3-E14EF3B5C290}']
    Function GetCount : Integer;
    Function Get(i : integer) : String;
    Function GetStrings : tStrings;
    
    Function Add(Const S : String) : Integer;
    Function IndexOf(Const S : string):Integer;
    Procedure Delete(Index : Integer);
    Procedure Clear;
    Property Count : Integer read GetCount;

    property Items[i : integer] : String Read Get;
  end;

  iFoldersListFunctions = interface(iBasicListFunctions)
    Function GetAllowChildren : Boolean;
    Procedure SetAllowChildren(Allow : Boolean);

    Function ParentIndex(Const Folder : String) : Integer;
    Function ChildIndex(Const Folder : String) : Integer;
    Function Add(Const S : String) : Integer;
    Property AllowChildren : Boolean Read GetAllowChildren Write SetAllowChildren;
  End;

  { Hérite de tStringList en forçant le tri alphanumérique et en n'authorisant qu'une seule occurence de chaque chaine }
  tOnceOccurSortedStringList = Class(tStringList)
   Private
    vRefCounter : Integer;  // Compteur de references, indique le nombre d'interfaces qui pointent sur l'instance de "tOnceOccurSortedStringList"
   Public
    Constructor Create; OverLoad;

    Function GetStrings : tStrings;

    Procedure SaveToStream(Stream : tStream); OverRide;
    Procedure LoadFromStream(Stream : tStream); OverRide;

    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  end;

  { Maintient une liste triée de chaines représentant des répertoires }
  tFoldersStringList = Class(tOnceOccurSortedStringList)
   Private
    vAllowChildren : Boolean;
    Function GetAllowChildren : Boolean;
    Procedure SetAllowChildren(AllowChildren : Boolean);
    Function DeleteChildren(Const Folder : String = '') : Integer;               
   Public
    Function Add(Const S : String) : Integer; OverRide;
    Function ParentIndex(Const Folder : String) : Integer;
    Function ChildIndex(Const Folder : String) : Integer;

    Property AllowChildren : Boolean Read vAllowChildren Write SetAllowChildren;
  end;

  tiOnceOccurSortedStringList = Class(tOnceOccurSortedStringList, iBasicListFunctions);
  tiFoldersStringList = Class(tFoldersStringList, iBasicListFunctions, iFoldersListFunctions);

implementation

{ ---------- Implémentation de tOnceOccurSortedStringList ---------- }

{ Instancie une nouvelle liste de chaine triée sans doublons et renvoi un pointeur sur celle-ci }
Constructor tOnceOccurSortedStringList.Create;
Begin
Inherited;
Sorted := True;         // Spécifie que la liste est triée
Duplicates := DupError; // Indique qu'une tentative d'ajout de doublon genère une Exception
End;

{ Renvoi le contenu de la liste }
Function tOnceOccurSortedStringList.GetStrings : tStrings;
Begin
Result := Self;
End;

{ Sauvegarde la liste dans un flux, précédée par sa taille, pour relecture }
Procedure tOnceOccurSortedStringList.SaveToStream(Stream : tStream);
Var
  BufferStream : tMemoryStream;
  BufferLength : int64;

Begin
BufferStream := TMemoryStream.Create; // Instancie un flux qui sera utilisé comme buffer
Inherited SaveToStream(BufferStream); // Sauvegarde la liste dans ce flux
BufferLength := BufferStream.Size;    // Recupère la taille du buffer
Stream.WriteBuffer(BufferLength, SizeOf(BufferLength)); // Ecrit la taille dans le flux final
BufferStream.Position := 0;                             // Se positionne au début du buffer
Stream.CopyFrom(BufferStream, BufferLength);            // Copie le buffer dans le flux final
BufferStream.Free;                                      // Libère le buffer
End;

{ Charge la liste depuis un flux }
Procedure tOnceOccurSortedStringList.LoadFromStream(Stream : tStream);
Var
  BufferStream : tMemoryStream;
  BufferLength : int64;

Begin
Stream.ReadBuffer(BufferLength, SizeOf(BufferLength));  // Lis la taille du contenu à charger
If BufferLength > 0
Then
    Begin
    BufferStream := tMemoryStream.Create;         // Instancie un flux qui sera utilisé comme buffer
    BufferStream.CopyFrom(Stream, BufferLength);  // Copie le contenu à charger dans ce buffer
    BufferStream.Position := 0;                   // Se positionne au début du buffer
    Inherited LoadFromStream(BufferStream);       // Charge la liste depuis le buffer
    BufferStream.Free;                            // Libère le buffer
    End;
End;

{ Gestion du compteur d'instances de l'interface }

// Ce compteur inhérant aux interface permet la liberation automatique
// des celles-çi lorsque plus aucune instance d'objet ne les utilise

function tOnceOccurSortedStringList.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;   // Permet de retrouver l'interface dans le "Tableaux des interfaces" de delphi
Begin
If GetInterface(IID, Obj)
Then
    Result := 0
Else
    Result := E_NOINTERFACE;
End;

function tOnceOccurSortedStringList._AddRef: Integer; stdcall;      // Incrémente le compteur de références d'interface
Begin
Inc(vRefCounter);
Result := vRefCounter;
End;

function tOnceOccurSortedStringList._Release: Integer; stdcall;     // Décrémente le compteur de références d'interface, puis, s'il arrive à 0, libère l'instance d'interface
Begin
Dec(vRefCounter);
Result := vRefCounter;
If vRefCounter = 0
Then
    Destroy;
End;

{ ---------- Implémentation de tFoldersStringList ---------- }

Function tFoldersStringList.GetAllowChildren : Boolean;  // Indique si les repertoires enfants sont autorisés
Begin
Result := vAllowChildren;
End;

Procedure tFoldersStringList.SetAllowChildren(AllowChildren : Boolean);   // Définit si la liste peut contenir ou non des Repertoires dont un parent est déja intégré.
Begin                                                                     // Passer cette propriété à "False" supprime tous les "Répertoires Enfants" de la liste
If vAllowChildren And Not AllowChildren                                   // ( Voir l'implémentation de "Add" pour plus d'informations )
Then
    DeleteChildren;
vAllowChildren := AllowChildren
End;

Function tFoldersStringList.ParentIndex(Const Folder : String) : Integer; // Renvoi l'indice du répertoire parent de "Folder" le plus primitif (c'est à dire le plus proche de la racine), ou -1 si aucun parent n'est trouvé
Var
  PathLength : Integer;
  SepIndex : Integer;

Begin
PathLength := Length(Folder);
SepIndex := 1;
Repeat
  Inc(SepIndex, AnsiPos('\', Copy(Folder, SepIndex+1, PathLength-SepIndex)));
  Result :=  IndexOf(Copy(Folder, 1, SepIndex));
Until (SepIndex = PathLength) Or (Result > -1);
If SepIndex = PathLength
Then
    Result := -1
End;

Function tFoldersStringList.ChildIndex(Const Folder : String) : Integer;  // Renvoi l'indice du premier repertoire de la liste qui est contenu dans "Folder" (que folder soit inclus dans la liste ou non), -1 si aucun enfant de "Folder" n'est trouvé
var
  Index : Integer;

Begin
Inc(Index, Ord(Find(Folder, Index))); // Recherche la chaine, si elle est trouvée on incrémente pour pointer sur un eventuel enfant
If (Index < Count) And (AnsiPos(Folder, Strings[Index]) > 0)
Then
    Result := Index   // Si on est pas hors limite et que la chaine courante contient "Folder" on renvoi son indice
Else
    Result := -1;     // Renvoi -1 si aucun repertoire enfant n'est trouvé
End;

Function tFoldersStringList.DeleteChildren(Const Folder : String = '') : Integer; // Supprime tout les enfants de "Folder" présents dans la liste. Si "Folder" est omis, supprime les enfants de chaque répertoire primitf de la liste
Var
   Index : Integer;
   DelCount : Integer;

Begin
DelCount := 0;
If Folder <> ''
Then
    Begin
    Index := ChildIndex(Folder);
    If Index > -1
    Then
        Repeat                                      // Supprime tout les enfants de "folder" de la liste
          Delete(Index);
          Inc(DelCount);
        Until (AnsiPos(Folder, Strings[Index]) = 0)
    End
Else
    Begin
    Index := 0;
    While Index + 1 < Count
    Do
      If AnsiPos(Strings[Index], Strings[Index+1]) > 0
      Then                                              // Supprime tout les repertoires enfants de la liste
          Begin
          Delete(Index+1);
          Inc(DelCount);
          End
      Else
          Inc(Index);
    End;
Result := DelCount;
End;

Function tFoldersStringList.Add(Const S : String) : Integer;  // Ajoute un répertoire à la liste de répertoires, renvoi son indice
Begin
If Not vAllowChildren       // Si les repertoires enfants sont interdits..
Then
    If ParentIndex(s) > -1                           // ..si un parent du repertoire est déja dans la liste..
    Then                                                       
        Raise eFoldersStringListError.Create(TXT_CHILD_ERROR)  // .. On genere une erreur
    Else
        DeleteChildren(s);                                      // .. Sinon efface les enfants du repertoire à ajouter
  Try
    Result := Inherited Add(s);                      // Tente d'Ajouter le repertoire à la liste..
  Except
    Raise eFoldersStringListError.Create(TXT_DUPLICATES_ERROR);   // .. Genère une erreur s'il y figure déja
  End;
End;

end.

Conclusion :


Ceci est ma première utilisation des interfaces, il se peut que j'ai mal assimilé certaines techniques, c'est aussi pour avoir des conseils que je poste cette source, donc n'hésitez pas !

Codes Sources

A voir également

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.