optionsmgr.pas

=== === === MiniHex 1.61 源程序说明 ============================== “$(MiniHex)Source”目录中的所有

{******************************************************************}
{                                                                  }
{    Options Manager                                               }
{    Version 1.4                                                   }
{                                                                  }
{    Copyright 2000-2004 DayDream Software                         }
{    All rights reserved.                                          }
{                                                                  }
{    Email: [e-mail]                                         }
{    URL: http://haoxg.yeah.net                                    }
{                                                                  }
{    Update history:                                               }
{    # v1.4 (2006-01-14)                                           }
{      * Accesser -> Accessor.                                     }
{    # v1.3 (2004-11-27)                                           }
{      * Enhanced TOptionsManager.SetValues.                       }
{    # v1.2 (2004-05-16)                                           }
{      * Splited the OptionsMgr.pas and OptSdasAcer.pas.           }
{    # v1.1 (2004-01-29)                                           }
{      * Added password supports.                                  }
{    # v1.0 (2004-01-16)                                           }
{                                                                  }
{******************************************************************}

unit OptionsMgr;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  Forms, Dialogs, SyncObjs, IniFiles;

const
  SDefFileName = 'Options.ini';
  SDefSection = 'Options';

const
  SNameNotFound = 'Name ''%s'' not found';
  SDuplicateName = 'Name ''%s'' already exists';

type

{ TOptionsAccessor }

  TOptAccessorClass = class of TOptionsAccessor;

  TOptionsAccessor = class(TObject)
  protected
    FFileName: string;
    FPassword: string;
    procedure SetFileName(const Value: string); virtual;
    procedure SetPassword(const Value: string); virtual;
  public
    procedure BeginUpdate; virtual;
    procedure EndUpdate; virtual;
    procedure GetNames(const Section: string; Names: TStrings); virtual; abstract;
    function Read(const Section, Name: string; var Default: Variant): Variant; virtual; abstract;
    procedure Write(const Section, Name: string; const Value: Variant); virtual; abstract;
    property FileName: string read FFileName write SetFileName;
    property Password: string read FPassword write SetPassword;
  end;

{ TIniOptAccessor }

  TIniOptAccessor = class(TOptionsAccessor)
  private
    FIniFile: TIniFile;
  public
    procedure BeginUpdate; override;
    procedure EndUpdate; override;
    procedure GetNames(const Section: string; Names: TStrings); override;
    function Read(const Section, Name: string; var Default: Variant): Variant; override;
    procedure Write(const Section, Name: string; const Value: Variant); override;
  end;

{ TOptionsManager }

  POptionData = ^TOptionData;
  TOptionData = record
    Value: Variant;
    Modified: Boolean;
  end;

  TOptionsManager = class(TObject)
  private
    FItems: TStrings;
    FFileName: string;
    FPassword: string;
    FSection: string;
    FAccessorClass: TOptAccessorClass;
    FLock: TCriticalSection;

    function GetNames(Index: Integer): string;
    function GetValues(const Name: string): Variant;
    function GetCount: Integer;
    procedure SetFileName(const Value: string);
    procedure SetSection(const Value: string);
    procedure SetValues(const Name: string; const Value: Variant);
    function CreateAccessor: TOptionsAccessor;
    function DoAdd(const Name: string; const Value: Variant): Integer;
    procedure DoClear;
  protected
    procedure InitDefault; virtual;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Add(const Name: string; const Value: Variant);
    procedure Delete(const Name: string);
    procedure Clear;
    procedure Load;
    procedure Save(const Name: string = '');

    property FileName: string read FFileName write SetFileName;
    property Password: string read FPassword write FPassword;
    property AccessorClass: TOptAccessorClass read FAccessorClass write FAccessorClass;
    property Section: string read FSection write SetSection;
    property Names[Index: Integer]: string read GetNames;
    property Values[const Name: string]: Variant read GetValues write SetValues;
    property Count: Integer read GetCount;
  end;

implementation

{ Misc }

procedure RaiseError(const Message: string);
begin
  raise Exception.Create(Message);
end;

procedure RaiseErrorFmt(const Message: string; const Args: array of const);
begin
  RaiseError(Format(Message, Args));
end;

{ TOptionsAccessor }

procedure TOptionsAccessor.SetFileName(const Value: string);
begin
  FFileName := Value;
end;

procedure TOptionsAccessor.SetPassword(const Value: string);
begin
  FPassword := Value;
end;

procedure TOptionsAccessor.BeginUpdate;
begin
end;

procedure TOptionsAccessor.EndUpdate;
begin
end;

{ TIniOptAccessor }

procedure TIniOptAccessor.BeginUpdate;
begin
  FIniFile := TIniFile.Create(FFileName);
end;

procedure TIniOptAccessor.EndUpdate;
begin
  FIniFile.Free;
end;

procedure TIniOptAccessor.GetNames(const Section: string; Names: TStrings);
begin
  FIniFile.ReadSection(Section, Names);
end;

function TIniOptAccessor.Read(const Section, Name: string;
  var Default: Variant): Variant;
begin
  Result := FIniFile.ReadString(Section, Name, Default);
end;

procedure TIniOptAccessor.Write(const Section, Name: string;
  const Value: Variant);
begin
  FIniFile.WriteString(Section, Name, Value);
end;

{ TOptionsManager }

constructor TOptionsManager.Create;
begin
  inherited;
  FItems := THashedStringList.Create;
  FFileName := ExtractFilePath(Application.ExeName) + SDefFileName;
  FSection := SDefSection;
  FAccessorClass := TIniOptAccessor;
  FLock := TCriticalSection.Create;
end;

destructor TOptionsManager.Destroy;
begin
  Clear;
  FItems.Free;
  FLock.Free;
  inherited;
end;

function TOptionsManager.GetNames(Index: Integer): string;
begin
  if (Index >= 0) and (Index < FItems.Count) then
    Result := FItems[Index]
  else
    Result := '';
end;

function TOptionsManager.GetValues(const Name: string): Variant;
var
  P: POptionData;
  I: Integer;
begin
  FLock.Enter;
  try
    I := FItems.IndexOf(Name);
    if I <> -1 then
    begin
      P := POptionData(FItems.Objects[I]);
      Result := P.Value;
    end else
      RaiseErrorFmt(SNameNotFound, [Name]);
  finally
    FLock.Leave;
  end;
end;

function TOptionsManager.GetCount: Integer;
begin
  Result := FItems.Count;
end;

procedure TOptionsManager.SetFileName(const Value: string);
begin
  FFileName := Value;
end;

procedure TOptionsManager.SetSection(const Value: string);
begin
  if Value = '' then
    FSection := SDefSection
  else
    FSection := Value;
end;

procedure TOptionsManager.SetValues(const Name: string;
  const Value: Variant);
var
  P: POptionData;
  I: Integer;
begin
  FLock.Enter;
  try
    I := FItems.IndexOf(Name);
    if I = -1 then
    begin
      I := DoAdd(Name, Value);
      P := POptionData(FItems.Objects[I]);
      P.Modified := True;
    end else
    begin
      P := POptionData(FItems.Objects[I]);
      if P.Value <> Value then
      begin
        P.Value := Value;
        P.Modified := True;
      end;
    end;
  finally
    FLock.Leave;
  end;
end;

function TOptionsManager.CreateAccessor: TOptionsAccessor;
begin
  Result := FAccessorClass.Create;
end;

function TOptionsManager.DoAdd(const Name: string; const Value: Variant): Integer;
var
  P: POptionData;
  I: Integer;
begin
  I := FItems.IndexOf(Name);
  if I = -1 then
  begin
    New(P);
    P.Value := Value;
    P.Modified := False;
    FItems.AddObject(Name, TObject(P));
    Result := FItems.Count - 1;
  end else
  begin
    Result := -1;
    RaiseErrorFmt(SDuplicateName, [Name]);
  end;
end;

procedure TOptionsManager.DoClear;
var
  I: Integer;
begin
  for I := 0 to FItems.Count - 1 do
    Dispose(POptionData(FItems.Objects[I]));
  FItems.Clear;
end;

procedure TOptionsManager.InitDefault;
begin
end;

procedure TOptionsManager.Add(const Name: string; const Value: Variant);
begin
  FLock.Enter;
  try
    DoAdd(Name, Value);
  finally
    FLock.Leave;
  end;
end;

procedure TOptionsManager.Delete(const Name: string);
var
  I: Integer;
begin
  FLock.Enter;
  try
    I := FItems.IndexOf(Name);
    if I <> -1 then
    begin
      Dispose(POptionData(FItems.Objects[I]));
      FItems.Delete(I);
    end;
  finally
    FLock.Leave;
  end;
end;

procedure TOptionsManager.Clear;
begin
  FLock.Enter;
  try
    DoClear;
  finally
    FLock.Leave;
  end;
end;

procedure TOptionsManager.Load;
var
  Accessor: TOptionsAccessor;
  Names: TStrings;
  P: POptionData;
  I, Index: Integer;
  Value: Variant;
begin
  FLock.Enter;
  Accessor := CreateAccessor;
  Names := TStringList.Create;
  try
    InitDefault;
    Accessor.FileName := FFileName;
    Accessor.Password := FPassword;
    Accessor.BeginUpdate;
    try
      Accessor.GetNames(FSection, Names);
      for I := 0 to Names.Count - 1 do
      begin
        Index := FItems.IndexOf(Names[I]);
        if Index = -1 then
        begin
          VarClear(Value);
          Value := Accessor.Read(FSection, Names[I], Value);
          DoAdd(Names[I], Value);
        end else
        begin
          P := POptionData(FItems.Objects[Index]);
          P.Value := Accessor.Read(FSection, Names[I], P.Value);
          P.Modified := False;
        end;
      end;
    finally
      Accessor.EndUpdate;
    end;
  finally
    Names.Free;
    Accessor.Free;
    FLock.Leave;
  end;
end;

procedure TOptionsManager.Save(const Name: string);
var
  Accessor: TOptionsAccessor;
  P: POptionData;
  I: Integer;
begin
  FLock.Enter;
  Accessor := CreateAccessor;
  try
    ForceDirectories(ExtractFilePath(FFileName));

    Accessor.FileName := FFileName;
    Accessor.Password := FPassword;
    Accessor.BeginUpdate;
    try
      if Name = '' then
      begin
        for I := 0 to FItems.Count - 1 do
        begin
          P := POptionData(FItems.Objects[I]);
          if P.Modified then
          begin
            Accessor.Write(FSection, FItems[I], P.Value);
            P.Modified := False;
          end;
        end;
      end else
      begin
        I := FItems.IndexOf(Name);
        if I <> -1 then
        begin
          P := POptionData(FItems.Objects[I]);
          Accessor.Write(FSection, Name, P.Value);
          P.Modified := False;
        end;
      end;
    finally
      Accessor.EndUpdate;
    end;
  finally
    Accessor.Free;
    FLock.Leave;
  end;
end;

end.