CentrED/Server/UConfig.pas

409 lines
12 KiB
Plaintext

(*
* 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.