... save (object) configuration data easily?

Author: Sven Lorenz
Homepage: http://www.Sven-of-Nine.de

Category: VCL

unit Unit_UserConfig;
//////////////////////////////////////////////////////////////////////
///
/// Unit zur vereinfachten Speicherung von User-Daten
///
/// Mittels Save werden die Eigenschaften ALLER Child-Komponenten einer
/// Komponente gespeichert.
/// Load holt diese dann wieder
///
/// In Datei speichern
/// UserConfig:=TUserConfig.Create(0); //Nur auf Festplatte speichern
/// aufruf z.B. SaveToFile  (GroupBox1,'configuratio.cfg');
///             LoadFromFile(GroupBox1,'configuratio.cfg');
///
/// In Speicher ablegen
/// (Damit kann z.B eine Undo-Funktion für Optionen realisiert werden)
/// UserConfig:=TUserConfig.Create(10); //Plätze zur Speicherung bereithalten
/// aufruf z.B. SaveToFile  (Form1,5); //Auf Platz 5 speichern
///             LoadFromFile(Form1,5); //von Platz 4 laden
///
///
///(c) 2005 Borg@Sven-of-Nine.de
///
///Beispielprogramm unter www.Sven-of-Nine.de
///
//////////////////////////////////////////////////////////////////////

interface

uses 
Classes;

type
  
TUserConfig = class(TObject)
  private
    
{ Private-Deklarationen }
    //Direkter Zugriff auf Eigenschaften
    //set properties using winapi
    
function IsProperty(Obj: TObject; sProp: string): Boolean;
    function SetProperty(Obj: TObject; sProp: string; vValue: Variant): Boolean;
    function HasAncestor(Child: TComponent; Name: string): Boolean;

  public
    
{ Public-Deklarationen }
    
constructor Create(MaxMemory: Integer = 10);
    destructor Destroy(); override;

    //Komponenten in Datei schreiben
    //save/load components to/from file
    
function SaveToFile(Component: TComponent; sFilename: string): Boolean;
    function LoadFromFile(Component: TComponent; sFilename: string): Boolean;

    //Komponenten in Speicher schreiben (UNDO-Funktion)
    //save/load components to/from mem
    
function SaveToMemory(Component: TComponent; Index: Integer): Boolean;
    function LoadFromMemory(Component: TComponent; Index: Integer): Boolean;
  end;

implementation

uses 
Windows, SysUtils, Controls, Forms, TypInfo;

var
  
aMemStream: array of TMemoryStream;
  //////////////////////////////////////////////////////////////////////
  /// Konstruktor und Destruktor
  //////////////////////////////////////////////////////////////////////
constructor TUserConfig.Create(MaxMemory: Integer = 10);
var
  
iIndex: Integer;
begin
  
//Alle angeforderten Speicherstreams initialisieren
  //initialize memorystreams
  
if (MaxMemory > 255) then MaxMemory := 255;
  try
    
SetLength(aMemStream, MaxMemory);
    for iIndex := 0 to MaxMemory - 1 do
    begin
      
aMemStream[iIndex] := TMemoryStream.Create;
    end;
  finally
  end
;
end;

destructor TUserConfig.Destroy();
var
  
iIndex: Integer;
begin
  
//Alle angeforderten Speicherstreams freimachen
  //free all
  
for iIndex := 0 to Length(aMemStream) - 1 do
  begin
    
aMemStream[iIndex].Free;
  end;
  SetLength(aMemStream, 0);
end;

//////////////////////////////////////////////////////////////////////
/// Prüfen, ob ein Object die gewünschte Eigenschaft hat
/// Check for properties
//////////////////////////////////////////////////////////////////////
function TUserConfig.IsProperty(Obj: TObject; sProp: string): Boolean;
var
  
plList: tPropList;
  iIndex1: Integer;

  iIndex2: Integer;
begin
  
Result := False;
  //Alle verfügbaren Properties holen
  //get properties
  
iIndex2 := GetPropList(PTypeInfo(Obj.ClassInfo),
    [tkUnknown, tkVariant, tkInteger, tkInt64, tkFloat,
    tkString, tkWString, tkLString, tkChar, tkWChar,
    tkEnumeration, tkSet, tkClass, tkMethod, tkArray,
    tkDynArray, tkRecord, tkInterface], @plList);
  //nach der gewünschten suchen
  //search for the wanted
  
iIndex1 := 0;
  while (iIndex1 < iIndex2) do
  begin
    if 
plList[iIndex1].Name = sProp then
    begin
      
Result  := True;
      iIndex1 := iIndex2;
    end;
    Inc(iIndex1);
  end;
end;

//////////////////////////////////////////////////////////////////////
/// Eine Egenschaft direkt setzen
/// set properties
//////////////////////////////////////////////////////////////////////
function TUserConfig.SetProperty(Obj: TObject; sProp: string; vValue: Variant): Boolean;
begin
  if 
(IsProperty(Obj, sProp)) then
  begin
    
SetPropValue(Obj, sProp, vValue);
    Result := True;
  end
  else
  begin
    
Result := False;
  end;
end;

//////////////////////////////////////////////////////////////////////
/// Nach einem Vorfahr mit dem Namen "Name" suchen
/// check for ancestor named "Name"
//////////////////////////////////////////////////////////////////////
function TUserConfig.HasAncestor(Child: TComponent; Name: string): Boolean;
var
  
cWork: TComponent;
begin
  
Result := False;
  cWork  := Child;
  while (cWork.HasParent) do
  begin
    
//Eltern holen
    
cWork := cWork.GetParentComponent;
    //Sind die Eltern die gesuchten ?
    
if (cWork.Name = Name) then
    begin
      
//Dann Suche beenden
      
Result := True;
      break;
    end;
  end;
  cWork := nil;
end;



//////////////////////////////////////////////////////////////////////
/// Save all components to disk
/// alle komponenten in datei speichern
//////////////////////////////////////////////////////////////////////
function TUserConfig.SaveToFile(Component: TComponent; sFilename: string): Boolean;
var
  
hFile: THandle;
  Stream: THandleStream;
  iIndex: Integer;
  sName: string[255];
  cWork: TComponent;
begin
  
Result := False;

  //Datei auf jeden Fall immer neu erzeugen
  //Create File
  
hFile := FileCreate(sFilename);
  if (hFile > 0) then
  begin
    
//Die Hauptkomponente finden (das Formular)
    //Find parent
    
cWork := Component;
    while (cWork.HasParent) do
    begin
      
cWork := cWork.GetParentComponent;
    end;
    //Stream erzeugen
    //Create stream
    
Stream := THandleStream.Create(hFile);
    try
      
//Und los
      //enumerate all
      
for iIndex := 0 to cWork.ComponentCount - 1 do
      begin
        
//Ist es ein Win-Control und eine Nachfahre der gewünschten Componente?
        //save only TWinControls and childs of Component
        
if (cWork.Components[iIndex] is TWinControl) and
          
(HasAncestor(cWork.Components[iIndex], Component.Name)) then
        begin
          
//Hier ein paar Ausnahmen
          //some exceptions
          
if (cWork.Components[iIndex].ClassName <> 'TFlatTitlebar')
            and
            
(cWork.Components[iIndex].ClassName <>
            'TFlatSpinEd1itInteger') then
          begin
            
//Erst den Namen
            //save name first
            
sName := cWork.Components[iIndex].Name;
            Stream.Write(sName, Length(sName) + 1);

            //Und dann die Komponente hinterher
            //and component
            
Stream.WriteComponent(cWork.Components[iIndex]);
          end;
        end;
      end;
      Result := True;
    finally
      
//Fertig
      //done
      
Stream.Free;
    end;
    //close handle
    
FileClose(hFile);
  end;
  cWork := nil;
end;


//////////////////////////////////////////////////////////////////////
/// load all components from disk
/// alle komponenten aus datei laden
//////////////////////////////////////////////////////////////////////
function TUserConfig.LoadFromFile(Component: TComponent; sFilename: string): Boolean;
var
  
hFile: THandle;
  Stream: THandleStream;
  iIndex: Integer;
  sName: string[255];
  iName: Integer;
  cWork: TComponent;
begin
  
Result := False;
  //Date öffnen
  //open read
  
hFile := FileOpen(sFilename, fmOPENREAD);
  if (hFile > 0) then
  begin
    
//Das die Hauptkomponente finden (das Formular)
    
cWork := Component;
    while (cWork.HasParent) do
    begin
      
cWork := cWork.GetParentComponent;
    end;

    //Stream erzeugen
    //create stream
    
Stream := THandleStream.Create(hFile);
    try
      
//Vorne anfangen
      //from the beginning
      
Stream.Position := 0;
      //Und kpl. durchwurstem
      //the whole file
      
while (Stream.Position < Stream.Size) do
      begin
        
//erstes byte des namens
        //first byte of Name
        
Stream.read(sName[0], 1);
        //Größe rausholen
        //get size
        
iName := Byte(sName[0]);
        //Und den ganzen Namen lesen
        //Read the whole name
        
Stream.read(sName[1], iName);

        //Object holen
        //get object
        
try
          
//Nach dem namen suchens
          //search for the name
          
for iIndex := 0 to cWork.ComponentCount - 1 do
          begin
            if 
(cWork.Components[iIndex].Name = sName) then
            begin
              
//Bei allem, was Checked hat, dies erst auf FALSE
              // setzen
              //Uncheck all "checkables"
              
SetProperty(cWork.Components[iIndex],
                'Checked', False);

              //Und dann erst laden
              //load
              
Stream.ReadComponent(cWork.Components[iIndex]);
            end;
          end;
        except
        end
;
      end;
    finally
      
//done
      
Stream.Free;
    end;
    FileClose(hFile);
  end;
  cWork := nil;
end;

//////////////////////////////////////////////////////////////////////
/// Save all components to memory
/// alle komponenten in speicher schreiben
//////////////////////////////////////////////////////////////////////
function TUserConfig.SaveToMemory(Component: TComponent; Index: Integer): Boolean;
var
  
iIndex: Integer;
  sName: string[255];
  cWork: TComponent;
begin
  
Result := False;
  if (Index < 0) or (Index >= Length(aMemStream)) then Exit;
  try
    
//Die Hauptkomponente finden (das Formular)
    
cWork := Component;
    while (cWork.HasParent) do
    begin
      
cWork := cWork.GetParentComponent;
    end;

    for iIndex := 0 to cWork.ComponentCount - 1 do
    begin
      if 
(cWork.Components[iIndex] is TWinControl) and
        
(HasAncestor(cWork.Components[iIndex], Component.Name)) then
      begin
        if 
(cWork.Components[iIndex].ClassName <> 'TFlatTitlebar') and
          
(cWork.Components[iIndex].ClassName <> 'TFlatSpinEd1itInteger') then
        begin
          
sName := Component.Components[iIndex].Name;
          aMemStream[Index].Write(sName, Length(sName) + 1);
          aMemStream[Index].WriteComponent(cWork.Components[iIndex]);
        end;
      end;
    end;
    Result := True;
  finally
    
cWork := nil;
  end;
end;

//////////////////////////////////////////////////////////////////////
/// load components[index] from memory
/// komponenten[index] aus speicher lesen
//////////////////////////////////////////////////////////////////////
function TUserConfig.LoadFromMemory(Component: TComponent; Index: Integer): Boolean;
var
  
iIndex: Integer;
  sName: string[255];
  iName: Integer;
  cWork: TComponent;
begin
  
Result := False;
  if (Index < 0) or (Index >= Length(aMemStream)) then Exit;
  try
    
cWork := Component;
    while (cWork.HasParent) do
    begin
      
cWork := cWork.GetParentComponent;
    end;

    aMemStream[Index].Position := 0;
    while (aMemStream[Index].Position < aMemStream[Index].Size) do
    begin
      
aMemStream[Index].read(sName[0], 1);
      iName := Byte(sName[0]);
      aMemStream[Index].read(sName[1], iName);
      try
        for 
iIndex := 0 to cWork.ComponentCount - 1 do
        begin
          if 
(cWork.Components[iIndex].Name = sName) then
          begin
            
SetProperty(cWork.Components[iIndex],
              'Checked', False);
            aMemStream[Index].ReadComponent
            (cWork.Components[iIndex]);
          end;
        end;
      except
      end
;
    end;
    Result := True;
  finally
    
cWork := nil;
  end;
end;


end.

 

printed from
www.swissdelphicenter.ch
developers knowledge base