configstorage.pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

{-------------------------------------------------------------------------------
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/

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

The Original Code is: ConfigStorage.pas, released 06 May 2001.

The Initial Developer of the Original Code is J黵gen G黱therodt.

Portions created by J黵gen G黱therodt <[e-mail]>
are Copyright (C) 2001-2002 J黵gen G黱therodt. All Rights Reserved.

Alternatively, the contents of this file may be used under the terms of the
GNU General Public License Version 2 or later (the "GPL"), in which case
the provisions of the GPL are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms
of the GPL and not to allow others to use your version of this file
under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the GPL.
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.

$Id: ConfigStorage.pas,v 1.3 2002/05/26 13:47:35 jguentherodt Exp $

You may retrieve the latest version of this file at the Open Perl IDE webpage,
located at http://open-perl-ide.sourceforge.net or http://www.lost-sunglasses.de
-------------------------------------------------------------------------------}
unit ConfigStorage;

interface

uses
  Classes, sysUtils;

type
  TConfigStorage = class
  private
    m_slSections: TStringList;
  protected
    function InternalGetSectionList(sSection: String; bCreateIfNotExists: Boolean): TStringList; virtual;
    procedure InternalClear; virtual;
    function GetSectionNames: String; virtual;
    function GetSections(sSectionName: String): String; virtual;
    procedure SetSections(sSectionName: String; s: String); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear; virtual;
    procedure Refresh; virtual;
    procedure Flush; virtual;
    procedure ReadSection(sSection: String; sl: TStringList); virtual;
    procedure EraseSection(sSection: String); virtual;
    function ReadString(sSection, sEntry, sDefaultValue: String): String; virtual;
    function ReadInteger(sSection, sEntry: String; nDefaultValue: Integer): Integer; virtual;
    procedure WriteString(sSection, sEntry, sValue: String); virtual;
    procedure WriteInteger(sSection, sEntry: String; nValue: Integer); virtual;
    property SectionNames: String Read GetSectionNames;
    property Sections[sSectionName: String]: String Read GetSections Write SetSections;
  end;


  TConfigFileStorage = class(TConfigStorage)
  private
    m_sFileName: String;
  protected
    procedure InternalLoadFromFile; virtual;
    procedure InternalSaveToFile; virtual;
  public
    constructor Create(sFileName: String);
    destructor Destroy; override;
    procedure Refresh; override;
    procedure Flush; override;
    property FileName: String Read m_sFileName;
  end;

  
implementation


////////////////////////////////////////////////////////////////////////////////
//  TConfigFileStorage = class(TConfigStorage)
////////////////////////////////////////////////////////////////////////////////
constructor TConfigFileStorage.Create(sFileName: String);
begin
  inherited Create;
  m_sFileName := sFileName;
  Refresh;
end;


destructor TConfigFileStorage.Destroy;
begin
  Flush;
  inherited Destroy;
end;


procedure TConfigFileStorage.InternalLoadFromFile;
var
  sl: TStringList;
  slSection: TStringList;
  s: String;
  i: Integer;
begin
  if not FileExists(m_sFileName) then exit;
  sl := TStringList.Create;
  try
    sl.LoadFromFile(m_sFileName);
    Clear;
    // Retreive sections and entries
    slSection := nil;
    for i := 0 to sl.Count - 1 do begin
      s := sl[i];
      if s <> '' then begin
        if (copy(s, 1, 1) = '[') and (copy(s, Length(s), 1) = ']') then begin
          slSection := InternalGetSectionList(copy(s, 2, Length(s) - 2), True);
        end else begin
          if (slSection <> nil) and (Pos('=', s) > 0) then slSection.Add(s);
        end;
      end;
    end;
  finally
    sl.Free;
  end;
end;


procedure TConfigFileStorage.InternalSaveToFile;
var
  sl, slOut, slSections: TStringList;
  i: Integer;
begin
  slOut := TStringList.Create;
  slSections := TStringList.Create;
  try
    slSections.CommaText := SectionNames;
    for i := 0 to slSections.Count - 1 do begin
      sl := InternalGetSectionList(slSections[i], False);
      if sl <> nil then begin
        slOut.Add('[' + slSections[i] + ']');
        slOut.AddStrings(sl);
        slOut.Add('');
      end;
    end;
    slOut.SaveToFile(m_sFileName);
  finally
    slSections.Free;
    slOut.Free;
  end;
end;


procedure TConfigFileStorage.Refresh;
begin
  InternalLoadFromFile;
end;


procedure TConfigFileStorage.Flush;
begin
  InternalSaveToFile;
end;


////////////////////////////////////////////////////////////////////////////////
//  TConfigStorage = class
////////////////////////////////////////////////////////////////////////////////
constructor TConfigStorage.Create;
begin
  inherited Create;
  m_slSections := TStringList.Create;
  m_slSections.Sorted := True;
  m_slSections.Duplicates := dupIgnore;
end;


destructor TConfigStorage.Destroy;
begin
  InternalClear;
  m_slSections.Free;
  inherited Destroy;
end;


procedure TConfigStorage.SetSections(sSectionName: String; s: String);
var
  slSource: TStringList;
begin
  slSource := InternalGetSectionList(sSectionName, True);
  slSource.CommaText := s;
end;


function TConfigStorage.GetSections(sSectionName: String): String;
var
  slSource: TStringList;
begin
  slSource := InternalGetSectionList(sSectionName, False);
  if slSource <> nil then begin
    Result := slSource.CommaText;
  end else Result := '';
end;


procedure TConfigStorage.EraseSection(sSection: String);
var
  idx: Integer;
begin
  idx := m_slSections.IndexOf(sSection);
  if idx > -1 then begin
    m_slSections.Objects[idx].Free;
    m_slSections.Delete(idx);
  end;
end;


procedure TConfigStorage.ReadSection(sSection: String; sl: TStringList);
var
  slSource: TStringList;
  i: Integer;
begin
  sl.Clear;
  slSource := InternalGetSectionList(sSection, False);
  if slSource <> nil then begin
    for i := 0 to slSource.Count - 1 do sl.Add(slSource.Names[i]);
  end else sl.Clear;
end;


function TConfigStorage.GetSectionNames: String;
begin
  Result := m_slSections.CommaText;
end;


procedure TConfigStorage.Clear;
begin
  InternalClear;
end;


procedure TConfigStorage.Flush;
begin
end;


procedure TConfigStorage.Refresh;
begin
end;


procedure TConfigStorage.InternalClear;
var
  i: Integer;
begin
  for i := 0 to m_slSections.Count - 1 do m_slSections.Objects[i].Free;
  m_slSections.Clear;
end;


function TConfigStorage.InternalGetSectionList(sSection: String; bCreateIfNotExists: Boolean): TStringList;
var
  idx: Integer;
begin
  idx := m_slSections.IndexOf(sSection);
  if idx > -1 then begin
    Result := TStringList(m_slSections.Objects[idx]);
  end else begin
    if bCreateIfNotExists then begin
      Result := TStringList.Create;
      m_slSections.AddObject(sSection, Result);
    end else Result := nil;
  end;
end;


function TConfigStorage.ReadString(sSection, sEntry, sDefaultValue: String): String;
var
  sl: TStringList;
begin
  sl := InternalGetSectionList(sSection, False);
  if sl <> nil then begin
    Result := sl.Values[sEntry];
    if Result = '' then Result := sDefaultValue;
  end else begin
    Result := sDefaultValue;
  end;
end;


function TConfigStorage.ReadInteger(sSection, sEntry: String; nDefaultValue: Integer): Integer;
var
  sl: TStringList;
begin
  sl := InternalGetSectionList(sSection, False);
  if sl <> nil then begin
    Result := StrToIntDef(sl.Values[sEntry], nDefaultValue);
  end else begin
    Result := nDefaultValue;
  end;
end;


procedure TConfigStorage.WriteString(sSection, sEntry, sValue: String);
var
  sl: TStringList;
begin
  sl := InternalGetSectionList(sSection, True);
  sl.Values[sEntry] := sValue;
end;


procedure TConfigStorage.WriteInteger(sSection, sEntry: String; nValue: Integer);
var
  sl: TStringList;
begin
  sl := InternalGetSectionList(sSection, True);
  sl.Values[sEntry] := IntToStr(nValue);
end;


end.