RealICQClient/Config/BaseConfig.pas

unit BaseConfig;

interface

uses
  mybean.core.objects, Classes, SysUtils, TypInfo, superobject,  
  InterfaceConfig;

type
  TConfigType = (ctPublic, ctUser);
  TBaseConfig = class(TMyBeanInterfacedObject, IBaseConfig)
  private
    FData: ISuperObject;
    FFileName: string;
    FBaseDir: string;

    FConfigType: TConfigType;
    FLoginName: string;
    procedure SetData(const Value: ISuperObject);
    procedure SetFileName(const Value: string);
    procedure SetConfigType(const Value: TConfigType);
    procedure SetLoginName(const Value: string);
    function GetBaseDir: string;
    function GetUserDir(ALoginName: string): string;
    function GetPublicDir: string;
    function JsnParseFromFile(AFileName: string): ISuperObject;
  protected
    function GetFile: string;


    procedure New; virtual;
    property Data: ISuperObject read FData write SetData;
    property FileName: string read FFileName write SetFileName;
    property ConfigType: TConfigType read FConfigType write SetConfigType;
    property LoginName: string read FLoginName write SetLoginName;
  public
    constructor Create(); override;
    function Load(ALoginName: string = ''): Boolean;
    procedure Save;
    procedure RestoreDefault;
    procedure UndoChange;
    function ToJsonStr: string;
  end;

implementation

uses
  RealICQUtility;

{ TBaseConfig }

constructor TBaseConfig.Create;
begin
  inherited;
  Load;
end;

function TBaseConfig.GetBaseDir: string;
var
  strs: TStrings;
  ADir: string;
  i: Integer;
begin
  Result := ExtractFilePath(ParamStr(0));
//  if FBaseDir <> '' then
//    Result := FBaseDir;
//
//  ADir := GetSpecialFolderLocation(CSIDL_APPDATA);
//  if (ADir = '') or (not DirectoryExists(ADir)) then
//  begin
//    raise Exception.CreateFmt('%s', ['找不到系统的AppData目录，不能正常创建或读取程序的配置文件，程序初始化失败！']);
//    Exit;
//  end;
//  ADir := MakeDir(ADir);
//
//  OnlineConfig.LoadFromFile('Online.ini');
//  strs := TRealICQUtility.SplitString(OnlineConfig.MainHomePath, '.');
//  try
//    for I := 0 to strs.Count - 1 do
//    begin
//      if SameText(strs[i], 'Produces') or (Trim(strs[i]) = '') then
//        Continue;
//      ADir := ADir + '\' + strs[i];
//    end;
//  finally
//    strs.Free;
//  end;
//
//  if ForceDirectories(ADir) then
//  begin
//    Result := ADir;
//    FBaseDir := ADir;
//  end;       
end;

function TBaseConfig.GetFile: string;
var
  ADir: string;
begin
  Result := '';
  case FConfigType of
    ctPublic: ADir := GetPublicDir;
    ctUser:
    begin
      if FLoginName = '' then
        Exit;
      ADir := GetUserDir(FLoginName);
    end;
  end;
  if ADir <> '' then
    Result := ADir + FFileName;
end;

function TBaseConfig.GetPublicDir: string;
begin                        
  Result := GetBaseDir + 'Config\public\';
end;

function TBaseConfig.GetUserDir(ALoginName: string): string;
begin
  Result := GetBaseDir + 'Config\user\' + ALoginName + '\';
  ForceDirectories(Result);
end;

function TBaseConfig.JsnParseFromFile(AFileName: string): ISuperObject;
var
  lvStream: TMemoryStream;
  lvStr: AnsiString;
begin
  Result := nil;
  if FileExists(AFileName) then
  begin
    lvStream := TMemoryStream.Create;
    try
      lvStream.LoadFromFile(AFileName);
      lvStream.Position := 0;
      SetLength(lvStr, lvStream.Size);
      lvStream.ReadBuffer(lvStr[1], lvStream.Size);
      Result := SO(UTF8ToAnsi(lvStr));
    finally
      lvStream.Free;
    end;
  end;
  if Result <> nil then
    if not (Result.DataType in [stArray, stObject]) then
      Result := nil;
end;

function TBaseConfig.Load(ALoginName: string = ''): Boolean;
var
  AFile: string;
begin
  if (ALoginName = '') and (FConfigType = ctUser) then
    Exit;
  
//  if ALoginName = '' then
//    FConfigType := ctPublic
//  else
//    FConfigType := ctUser;
  FData := TRealICQUtility.JsnParseFromFile(GetFile);
  if (FData = nil) then
  begin
    New;
    Save;
  end;
end;

procedure TBaseConfig.New;
begin
  FData := SO();
end;

procedure TBaseConfig.RestoreDefault;
begin
  New;
  Save;
end;

procedure TBaseConfig.Save;
var
  AFile: string;
begin
  AFile :=  GetFile;
  if AFile = '' then
    Exit;
  TRealICQUtility.JsnSaveToFile(FData, GetFile);
end;

procedure TBaseConfig.SetConfigType(const Value: TConfigType);
begin
  FConfigType := Value;
end;

procedure TBaseConfig.SetData(const Value: ISuperObject);
begin
  FData := Value;
end;

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

procedure TBaseConfig.SetLoginName(const Value: string);
begin
  FLoginName := Value;
end;

function TBaseConfig.ToJsonStr: string;
begin
  if FData = nil then
  begin
    Result := '{}';
    Exit;
  end;

  Result := FData.AsString;
end;

procedure TBaseConfig.UndoChange;
begin
  Load;
end;

end.