jvqappinistorage.pas

East make Tray Icon in delphi

{******************************************************************************}
{* WARNING:  JEDI VCL To CLX Converter generated unit.                        *}
{*           Manual modifications will be lost on next release.               *}
{******************************************************************************}

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvAppIniStorage.pas, released on --.

The Initial Developer of the Original Code is Marcel Bestebroer
Portions created by Marcel Bestebroer are Copyright (C) 2002 - 2003 Marcel
Bestebroer
All Rights Reserved.

Contributor(s):
  Jens Fudickar
  Olivier Sannier

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvQAppIniStorage.pas,v 1.25 2005/02/11 10:11:55 asnepvangers Exp $

unit JvQAppIniStorage;

{$I jvcl.inc}

interface

uses
  QWindows, Classes, IniFiles,
  JvQAppStorage, JvQPropertyStore;

type
  TJvAppIniStorageOptions = class(TJvAppStorageOptions)
  private
    FReplaceCRLF: Boolean;
    FPreserveLeadingTrailingBlanks: Boolean;
  protected
    procedure SetReplaceCRLF(Value: Boolean); virtual;
    procedure SetPreserveLeadingTrailingBlanks(Value: Boolean); virtual;
  public
    constructor Create; override;
  published
    property ReplaceCRLF: Boolean read FReplaceCRLF write SetReplaceCRLF default False;
    property PreserveLeadingTrailingBlanks: Boolean read FPreserveLeadingTrailingBlanks
      write SetPreserveLeadingTrailingBlanks default False;
    property FloatAsString default False;
  end;

  // Storage to INI file, all in memory. This is the base class
  // for INI type storage, descendents will actually implement
  // the writing to a file or anything else
  TJvCustomAppIniStorage = class(TJvCustomAppMemoryFileStorage)
  private
    FIniFile: TMemIniFile;
    FDefaultSection: string;
    function CalcDefaultSection(Section: string): string;
  protected
    class function GetStorageOptionsClass: TJvAppStorageOptionsClass; override;

    // Replaces all CRLF through "\n"
    function ReplaceCRLFToSlashN(const Value: string): string;
    // Replaces all "\n" through CRLF
    function ReplaceSlashNToCRLF(const Value: string): string;
    // Adds " at the beginning and the end
    function SaveLeadingTrailingBlanks(const Value: string): string;
    // Removes " at the beginning and the end
    function RestoreLeadingTrailingBlanks(const Value: string): string;

    function GetAsString: string; override;
    procedure SetAsString(const Value: string); override;
    function DefaultExtension: string; override;

    procedure EnumFolders(const Path: string; const Strings: TStrings;
      const ReportListAsValue: Boolean = True); override;
    procedure EnumValues(const Path: string; const Strings: TStrings;
      const ReportListAsValue: Boolean = True); override;
    function PathExistsInt(const Path: string): Boolean; override;
    function ValueExists(const Section, Key: string): Boolean;
    function IsFolderInt(const Path: string; ListIsValue: Boolean = True): Boolean; override;
    function ReadValue(const Section, Key: string): string;
    procedure WriteValue(const Section, Key, Value: string); virtual;
    procedure RemoveValue(const Section, Key: string); virtual;
    procedure DeleteSubTreeInt(const Path: string); override;
    procedure SplitKeyPath(const Path: string; out Key, ValueName: string); override;
    function ValueStoredInt(const Path: string): Boolean; override;
    procedure DeleteValueInt(const Path: string); override;
    function DoReadInteger(const Path: string; Default: Integer): Integer; override;
    procedure DoWriteInteger(const Path: string; Value: Integer); override;
    function DoReadFloat(const Path: string; Default: Extended): Extended; override;
    procedure DoWriteFloat(const Path: string; Value: Extended); override;
    function DoReadString(const Path: string; const Default: string): string; override;
    procedure DoWriteString(const Path: string; const Value: string); override;
    function DoReadBinary(const Path: string; Buf: Pointer; BufSize: Integer): Integer; override;
    procedure DoWriteBinary(const Path: string; Buf: Pointer; BufSize: Integer); override;
    property DefaultSection: string read FDefaultSection write FDefaultSection;
    property IniFile: TMemIniFile read FIniFile;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  // This class handles the flushing into a disk file
  // and publishes a few properties for them to be
  // used by the user in the IDE
  TJvAppIniFileStorage = class(TJvCustomAppIniStorage)
  public
    procedure Flush; override;
    procedure Reload; override;
    property AsString;
    property IniFile;
  published
    property AutoFlush;
    property AutoReload;
    property FileName;
    property Location;
    property DefaultSection;
    property SubStorages;
    property OnGetFileName;
  end;

procedure StorePropertyStoreToIniFile(APropertyStore: TJvCustomPropertyStore;
  const AFileName: string; const AAppStoragePath: string = '');
procedure LoadPropertyStoreFromIniFile(APropertyStore: TJvCustomPropertyStore;
  const AFileName: string; const AAppStoragePath: string = '');

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils,
  JvQJCLUtils, // BinStrToBuf & BufToBinStr
  JvQTypes, JvQConsts, JvQResources; // JvConsts or PathDelim under D5 and BCB5

const
  cNullDigit = '0';
  cCount = 'Count';
  cSectionHeaderStart = '[';
  cSectionHeaderEnd = ']';
  cKeyValueSeparator = '=';

//=== { TJvAppIniStorageOptions } ============================================

constructor TJvAppIniStorageOptions.Create;
begin
  inherited Create;
  FReplaceCRLF := False;
  FPreserveLeadingTrailingBlanks := False;
  FloatAsString := False;
end;

procedure TJvAppIniStorageOptions.SetReplaceCRLF(Value: Boolean);
begin
  FReplaceCRLF := Value;
end;

procedure TJvAppIniStorageOptions.SetPreserveLeadingTrailingBlanks(Value: Boolean);
begin
  FPreserveLeadingTrailingBlanks := Value;
end;

//=== { TJvCustomAppIniStorage } =============================================

constructor TJvCustomAppIniStorage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FIniFile := TMemIniFile.Create(Name);
end;

destructor TJvCustomAppIniStorage.Destroy;
begin
  inherited Destroy;
  // Has to be done AFTER inherited, see comment in
  // TJvCustomAppMemoryFileStorage
  FIniFile.Free;
end;

// Replaces all CRLF through "\n"
// (rom) probably better use JclStrings.StrEscapedToString and StrStringToEscaped
function TJvCustomAppIniStorage.ReplaceCRLFToSlashN(const Value: string): string;
begin
  if (Pos(#13, Value) > 0) or (Pos(#10, Value) > 0) then
  begin
    Result := StringReplace(Value, '\', '\\', [rfReplaceAll]);
    Result := StringReplace(Result , #13#10, '\n', [rfReplaceAll]);
    Result := StringReplace(Result , #10, '\n', [rfReplaceAll]);
    Result := StringReplace(Result , #13, '\n', [rfReplaceAll]);
  end
  else
    Result := Value;
end;

// Replaces all "\n" through CRLF
function TJvCustomAppIniStorage.ReplaceSlashNToCRLF(const Value: string): string;
var
  P: Integer;
  C1, C2: Char;

  function GetNext: Boolean;
  begin
    Result := Length(Value) >= P;
    if Result then
    begin
      C1 := Value[P];
      C2 := Value[P + 1];
    end;
    Inc(P);
  end;

begin
  P := 1;
  C1 := #0;
  C2 := #0;
  while GetNext do
  begin
    if (C1 = '\') and (C2 = '\') then
    begin
      Result := Result + C1;
      Inc(P);
    end
    else
    if (C1 = '\') and (C2 = 'n') then
    begin
      Result := Result + #13#10;
      Inc(P);
    end
    else
      Result := Result + C1;
  end;
end;

// Adds " at the beginning and the end
function TJvCustomAppIniStorage.SaveLeadingTrailingBlanks(const Value: string): string;
var
  C1, C2: Char;
begin
  if Value = '' then
    Result := ''
  else
  begin
    C1 := Value[1];
    C2 := Value[Length(Value)];
    if (C1 = ' ') or (C2 = ' ') or
      ((C1 = '"') and (C2 = '"')) then
      Result := '"' + Value + '"'
    else
      Result := Value;
  end;
end;

// Removes " at the beginning and the end
function TJvCustomAppIniStorage.RestoreLeadingTrailingBlanks(const Value: string): string;
begin
  if (Value[1] = '"') and (Value[Length(Value)] = '"') then
    Result := Copy(Value, 2, Length(Value) - 2)
  else
    Result := Value;
end;

procedure TJvCustomAppIniStorage.SplitKeyPath(const Path: string; out Key, ValueName: string);
begin
  inherited SplitKeyPath(Path, Key, ValueName);
  if Key = '' then
    Key := DefaultSection;
end;

function TJvCustomAppIniStorage.ValueStoredInt(const Path: string): Boolean;
var
  Section: string;
  Key: string;
begin
  SplitKeyPath(Path, Section, Key);
  Result := ValueExists(Section, Key);
end;

procedure TJvCustomAppIniStorage.DeleteValueInt(const Path: string);
var
  Section: string;
  Key: string;
begin
  SplitKeyPath(Path, Section, Key);
  RemoveValue(Section, Key);
end;

function TJvCustomAppIniStorage.DoReadInteger(const Path: string; Default: Integer): Integer;
var
  Section: string;
  Key: string;
  Value: string;
begin
  SplitKeyPath(Path, Section, Key);
  if ValueExists(Section, Key) then
  begin
    Value := ReadValue(Section, Key);
    if Value = '' then
      Value := cNullDigit;
    Result := StrToInt(Value);
  end
  else
    Result := Default;
end;

procedure TJvCustomAppIniStorage.DoWriteInteger(const Path: string; Value: Integer);
var
  Section: string;
  Key: string;
begin
  SplitKeyPath(Path, Section, Key);
  WriteValue(Section, Key, IntToStr(Value));
end;

function TJvCustomAppIniStorage.DoReadFloat(const Path: string; Default: Extended): Extended;
var
  Section: string;
  Key: string;
  Value: string;
begin
  SplitKeyPath(Path, Section, Key);
  if ValueExists(Section, Key) then
  begin
    Value := ReadValue(Section, Key);
    if BinStrToBuf(Value, @Result, SizeOf(Result)) <> SizeOf(Result) then
      Result := Default;
  end
  else
    Result := Default;
end;

procedure TJvCustomAppIniStorage.DoWriteFloat(const Path: string; Value: Extended);
var
  Section: string;
  Key: string;
begin
  SplitKeyPath(Path, Section, Key);
  WriteValue(Section, Key, BufToBinStr(@Value, SizeOf(Value)));
end;

function TJvCustomAppIniStorage.DoReadString(const Path: string; const Default: string): string;
var
  Section: string;
  Key: string;
begin
  SplitKeyPath(Path, Section, Key);
  if ValueExists(Section, Key) then
    Result := ReadValue(Section, Key)
  else
    Result := Default;
end;

procedure TJvCustomAppIniStorage.DoWriteString(const Path: string; const Value: string);
var
  Section: string;
  Key: string;
begin
  SplitKeyPath(Path, Section, Key);
  WriteValue(Section, Key, Value);
end;

function TJvCustomAppIniStorage.DoReadBinary(const Path: string; Buf: Pointer; BufSize: Integer): Integer;
var
  Section: string;
  Key: string;
  Value: string;
begin