CentrED/Server/UConfig.pas

(*
 * CDDL HEADER START
 *
 * The contents of this file are subject to the terms of the
 * Common Development and Distribution License, Version 1.0 only
 * (the "License").  You may not use this file except in compliance
 * with the License.
 *
 * You can obtain a copy of the license at
 * http://www.opensource.org/licenses/cddl1.php.
 * See the License for the specific language governing permissions
 * and limitations under the License.
 *
 * When distributing Covered Code, include this CDDL HEADER in each
 * file and include the License file at
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
 * add the following below this CDDL HEADER, with the fields enclosed
 * by brackets "[]" replaced with your own identifying * information:
 *      Portions Copyright [yyyy] [name of copyright owner]
 *
 * CDDL HEADER END
 *
 *
 *      Portions Copyright 2008 Andreas Schneider
 *)
unit UConfig;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, DOM, XMLRead, XMLWrite, md5, Keyboard, UAccount,
  UXmlHelper, UInterfaces, UEnums, URegions, LConvEncoding, Language;

type

  TInvalidConfigException = class(Exception);

  { TMapInfo }

  TMapInfo = class(TObject, ISerializable)
    constructor Create(AOwner: IInvalidate);
    constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
    procedure Serialize(AElement: TDOMElement);
  protected
    FOwner: IInvalidate;
    FMapFile: string;
    FStaticsFile: string;
    FStaIdxFile: string;
    FWidth: Word;
    FHeight: Word;
    FFormatFlags: Cardinal;
    procedure SetHeight(const AValue: Word);
    procedure SetMapFile(const AValue: string);
    procedure SetStaIdxFile(const AValue: string);
    procedure SetStaticsFile(const AValue: string);
    procedure SetWidth(const AValue: Word);
    procedure SetFormatFlags(const AValue: Cardinal);
  public
    property MapFile: string read FMapFile write SetMapFile;
    property StaticsFile: string read FStaticsFile write SetStaticsFile;
    property StaIdxFile: string read FStaIdxFile write SetStaIdxFile;
    property Width: Word read FWidth write SetWidth;
    property Height: Word read FHeight write SetHeight;
    property FormatFlags: Cardinal read FFormatFlags write SetFormatFlags;
  end;

  { TConfig }

  TConfig = class(TObject, ISerializable, IInvalidate)
    constructor Create(AFilename: string);
    constructor Init(AFilename: string);
    destructor Destroy; override;
    procedure Serialize(AElement: TDOMElement);
  protected
    FFilename: string;
    FPort: Integer;
    FMap: TMapInfo;
    FTiledata: string;
    FRadarcol: string;
    FLanguage: string;
    FRegions: TRegionList;
    FAccounts: TAccountList;
    FChanged: Boolean;
    procedure SetPort(const AValue: Integer);
    procedure SetRadarcol(const AValue: string);
    procedure SetTiledata(const AValue: string);
  public
    property Port: Integer read FPort write SetPort;
    property Map: TMapInfo read FMap;
    property Tiledata: string read FTiledata write SetTiledata;
    property Radarcol: string read FRadarcol write SetRadarcol;
    property Regions: TRegionList read FRegions;
    property Accounts: TAccountList read FAccounts;
    property Language: string read FLanguage;
    procedure Flush;
    procedure Invalidate;
  end;
  
var
  AppDir: string;
  ConfigFile: string;
  Config: TConfig;
  tmp_i: Integer;
  
function TimeStamp: string;

implementation

const
  CONFIGVERSION = 5;
  
function QueryPassword: String;
var
  pwChar: char;
begin
  Result := '';

  InitKeyboard;
  try
    repeat
      pwChar := GetKeyEventChar(TranslateKeyEvent(GetKeyEvent));
      case pwChar of
        #8: Result := Copy(Result, 1, Length(Result) - 1);
        #13: break;
      else
        Result := Result + pwChar;
      end;
    until pwChar = #13;
  finally
    DoneKeyboard;
  end;
  writeln('');
end;

function TimeStamp: string;
begin
  //Result := '[' + DateTimeToStr(Now) + '] ';
  //Result := FormatDateTime('[yyyy.mm.dd hh:mm:ss] ', Now);
  Result := FormatDateTime('[hh:mm:ss] ', Now);
end;

{ TMapInfo }

constructor TMapInfo.Create(AOwner: IInvalidate);
begin
  inherited Create;
  FOwner := AOwner;
end;

constructor TMapInfo.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
begin
  Create(AOwner);
  FMapFile := TXmlHelper.ReadString(AElement, 'Map', 'map0.mul');
  FStaIdxFile := TXmlHelper.ReadString(AElement, 'StaIdx', 'staidx0.mul');
  FStaticsFile := TXmlHelper.ReadString(AElement, 'Statics', 'statics0.mul');
  FWidth := TXmlHelper.ReadInteger(AElement, 'Width', 768);
  FHeight := TXmlHelper.ReadInteger(AElement, 'Height', 512);
  FFormatFlags := $F0000000 + Cardinal(TXmlHelper.ReadInteger(AElement, 'Format', $0000) and $0000FFFF);
end;

procedure TMapInfo.Serialize(AElement: TDOMElement);
begin
  TXmlHelper.WriteString(AElement, 'Map',    FMapFile);
  TXmlHelper.WriteString(AElement, 'StaIdx', FStaIdxFile);
  TXmlHelper.WriteString(AElement, 'Statics',FStaticsFile);
  TXmlHelper.WriteInteger(AElement,'Width',  FWidth);
  TXmlHelper.WriteInteger(AElement,'Height', FHeight);
  TXmlHelper.WriteString(AElement, 'Format', Format('0x%.8x', [(FFormatFlags and $0000FFFF)]));
end;


procedure TMapInfo.SetMapFile(const AValue: string);
begin
  FMapFile := AValue;
  FOwner.Invalidate;
end;

procedure TMapInfo.SetStaIdxFile(const AValue: string);
begin
  FStaIdxFile := AValue;
  FOwner.Invalidate;
end;

procedure TMapInfo.SetStaticsFile(const AValue: string);
begin
  FStaticsFile := AValue;
  FOwner.Invalidate;
end;

procedure TMapInfo.SetWidth(const AValue: Word);
begin
  FWidth := AValue;
  FOwner.Invalidate;
end;

procedure TMapInfo.SetHeight(const AValue: Word);
begin
  FHeight := AValue;
  FOwner.Invalidate;
end;

procedure TMapInfo.SetFormatFlags(const AValue: Cardinal);
begin
  FFormatFlags := AValue;
  FOwner.Invalidate;
end;

{ TConfig }

constructor TConfig.Create(AFilename: string);
var
  xmlDoc: TXMLDocument;
  version: Integer;
  xmlElement: TDOMElement;
begin
  inherited Create;
  FFilename := AFilename;
  ReadXMLFile(xmlDoc, AFilename);
  version := 0;
  if not ((xmlDoc.DocumentElement.NodeName = 'CEDConfig') and
    TryStrToInt(xmlDoc.DocumentElement.AttribStrings['Version'], version) and
    (version = CONFIGVERSION)) then
    raise TInvalidConfigException.Create(Format('Version mismatch: %d <> %d', [version, CONFIGVERSION]));

  FPort := TXmlHelper.ReadInteger(xmlDoc.DocumentElement, 'Port', 2597);

  xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Map'));
  if not assigned(xmlElement) then
    raise TInvalidConfigException.Create('Map information not found');
  FMap := TMapInfo.Deserialize(Self, xmlElement);
  
  FTiledata := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Tiledata', 'tiledata.mul');
  FRadarcol := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Radarcol', 'radarcol.mul');
  FLanguage := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Language', '..\Language\English.ini');
  xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Regions'));

  if assigned(xmlElement) then
    FRegions := TRegionList.Deserialize(Self, xmlElement)
  else
    Fregions := TRegionList.Create(Self);

  xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Accounts'));
  if not assigned(xmlElement) then
    raise TInvalidConfigException.Create('Account information not found');
  FAccounts := TAccountList.Deserialize(Self, xmlElement);

  xmlDoc.Free;
  
  FChanged := False;
end;

constructor TConfig.Init(AFilename: string);
var
  stringValue, password: string;
  intValue: Integer;
begin
  inherited Create;
  FFilename := AFilename;
  FMap := TMapInfo.Create(Self);
  FAccounts := TAccountList.Create(Self);
  FRegions := TRegionList.Create(Self);

  Writeln('');
  Writeln('==============');
  FLanguage := '../Language/English.ini';
  Writeln(UTF8ToCP866('language file [' + FLanguage + ']'));
  Readln (stringValue);
  if (stringValue <> '')
  then FLanguage := stringValue;
  LanguageLoad(FLanguage);
  Writeln('');

  Writeln(GetText('iNetwork'));
  Writeln('==============');
  Write  (GetText('iSetPort') + UTF8ToCP866(' [2597]: '));
  Readln (stringValue);
  intValue := 0;
  if not TryStrToInt(stringValue, intValue) then intValue := 2597;
  FPort := intValue;
  Writeln('');

  Writeln(GetText('iDatPath'));
  Writeln('===============');
  Write  ('map      [map0.mul]: ');
  Readln (FMap.FMapFile);
  if FMap.MapFile = '' then FMap.MapFile := 'map0.mul';
  Write  ('staidx   [staidx0.mul]: ');
  Readln (FMap.FStaIdxFile);
  if FMap.StaIdxFile = '' then FMap.StaIdxFile := 'staidx0.mul';
  Write  ('statics  [statics0.mul]: ');
  Readln (FMap.FStaticsFile);
  if FMap.StaticsFile = '' then FMap.StaticsFile := 'statics0.mul';
  Write  ('tiledata [tiledata.mul]: ');
  Readln (FTiledata);
  if FTiledata = '' then FTiledata := 'tiledata.mul';
  Write  ('radarcol [radarcol.mul]: ');
  Readln (FRadarcol);
  if FRadarcol = '' then FRadarcol := 'radarcol.mul';
  Writeln('');

  Writeln(GetText('iMapDesc'));
  Writeln('===============');
  Write  (GetText('iMapWidt') + UTF8ToCP866(' [768]: '));
  Readln (stringValue);
  if not TryStrToInt(stringValue, intValue) then intValue := 768;
  FMap.Width := intValue;
  Write  (GetText('iMapHeig') + UTF8ToCP866(' [512]: '));
  Readln (stringValue);
  if not TryStrToInt(stringValue, intValue) then intValue := 512;
  FMap.Height := intValue;
  Write  (GetText('iDFormat') + UTF8ToCP866(' [0x0000]: '));
  Readln (stringValue);
  if not TryStrToInt(stringValue, intValue) then intValue := $0000;
  FMap.FormatFlags := $F0000000 + Cardinal(intValue);
  Writeln('');

  Writeln(GetText('iAccount'));
  Writeln('======================');
  repeat
    Write(GetText('iUserAcc') + UTF8ToCP866(' '));
    Readln(stringValue);
  until stringValue <> '';
  Write  (GetText('iUserPas') + UTF8ToCP866(' '));
  password := QueryPassword;
  FAccounts.Add(TAccount.Create(FAccounts, stringValue,
    MD5Print(MD5String(password)), alAdministrator, nil));
  
  FChanged := True;
end;

destructor TConfig.Destroy;
begin
  if Assigned(FMap) then FreeAndNil(FMap);
  if Assigned(FAccounts) then FreeAndNil(FAccounts);
  if Assigned(FRegions) then FreeAndNil(FRegions);
  inherited Destroy;
end;

procedure TConfig.Serialize(AElement: TDOMElement);
begin
  TXmlHelper.WriteString(AElement, 'Language', FLanguage);
  TXmlHelper.WriteInteger(AElement, 'Port', FPort);
  FMap.Serialize(TXmlHelper.AssureElement(AElement, 'Map'));
  TXmlHelper.WriteString(AElement, 'Tiledata', FTiledata);
  TXmlHelper.WriteString(AElement, 'Radarcol', FRadarcol);
  FAccounts.Serialize(TXmlHelper.AssureElement(AElement, 'Accounts'));
  FRegions.Serialize(TXmlHelper.AssureElement(AElement, 'Regions'));
end;

procedure TConfig.SetPort(const AValue: Integer);
begin
  FPort := AValue;
  Invalidate;
end;

procedure TConfig.SetRadarcol(const AValue: string);
begin
  FRadarcol := AValue;
  Invalidate;
end;

procedure TConfig.SetTiledata(const AValue: string);
begin
  FTiledata := AValue;
  Invalidate;
end;

procedure TConfig.Flush;
var
  xmlDoc: TXMLDocument;
begin
  if FChanged then
  begin
    xmlDoc := TXMLDocument.Create;
    xmlDoc.AppendChild(xmlDoc.CreateElement('CEDConfig'));
    xmlDoc.DocumentElement.AttribStrings['Version'] := IntToStr(CONFIGVERSION);
    Serialize(xmlDoc.DocumentElement);
    WriteXMLFile(xmlDoc, FFilename);
    xmlDoc.Free;
    FChanged := False;
  end;
end;

procedure TConfig.Invalidate;
begin
  FChanged := True;
end;

initialization
begin
  AppDir := ExtractFilePath(ParamStr(0));
  if AppDir[Length(AppDir)] <> PathDelim then
    AppDir := AppDir + PathDelim;

  Config := nil;
  ConfigFile := '';
  for tmp_i := 0 to ParamCount do begin
    if LowerCase(ExtractFileExt(ParamStr(tmp_i))) = '.xml'
      then ConfigFile := ExtractFilePath(ParamStr(0)) + ParamStr(1);
  end;
  if ConfigFile = ''
      then ConfigFile := ChangeFileExt(ParamStr(0), '.xml');
end;

end.