aksdb
/
CentrED
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

- Fixed "UTiledata" spelling in ULandscape.pas 

- Added ISerializable and IInvalidate interfaces
- Implemented a TConfig class and XML storage
- Added some more detailed messages when a login fails to the server console
- Removed obsolete IStream interface references
- Readded lbHue in TfrmHueSettings
This commit is contained in:
Andreas Schneider 2008-03-06 22:55:49 +01:00
parent 04a459b524
commit 12773fd63e
18 changed files with 2346 additions and 2525 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
Client/Tools/UfrmHueSettings.lfm
View File

@ -5,7 +5,6 @@ object frmHueSettings: TfrmHueSettings
Width = 217 Width = 217
HorzScrollBar.Page = 216 HorzScrollBar.Page = 216
VertScrollBar.Page = 206 VertScrollBar.Page = 206
ActiveControl = lbHue
BorderIcons = [] BorderIcons = []
BorderStyle = bsToolWindow BorderStyle = bsToolWindow
Caption = 'Hue Settings' Caption = 'Hue Settings'
@ -15,14 +14,23 @@ object frmHueSettings: TfrmHueSettings
OnClose = FormClose OnClose = FormClose
OnCreate = FormCreate OnCreate = FormCreate
OnDeactivate = FormDeactivate OnDeactivate = FormDeactivate
LCLVersion = '0.9.25'
object lblHue: TLabel object lblHue: TLabel
Left = 8 Left = 8
Height = 16 Height = 12
Top = 12 Top = 12
Width = 26 Width = 27
Caption = 'Hue:' Caption = 'Hue:'
ParentColor = False ParentColor = False
end end
object edHue: TEdit
Left = 48
Height = 23
Top = 10
Width = 80
OnEditingDone = edHueEditingDone
TabOrder = 0
end
object lbHue: TListBox object lbHue: TListBox
Left = 8 Left = 8
Height = 160 Height = 160
@ -32,14 +40,7 @@ object frmHueSettings: TfrmHueSettings
OnDrawItem = lbHueDrawItem OnDrawItem = lbHueDrawItem
OnSelectionChange = lbHueSelectionChange OnSelectionChange = lbHueSelectionChange
Style = lbOwnerDrawFixed Style = lbOwnerDrawFixed
TabOrder = 0
end
object edHue: TEdit
Left = 48
Height = 23
Top = 10
Width = 80
OnEditingDone = edHueEditingDone
TabOrder = 1 TabOrder = 1
TopIndex = -1
end end
end end

312
Client/Tools/UfrmHueSettings.pas
View File

@ -1,156 +1,156 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2007 Andreas Schneider
*) *)
unit UfrmHueSettings; unit UfrmHueSettings;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
LMessages, LCLIntf, UHue; LMessages, LCLIntf, UHue;
type type
{ TfrmHueSettings } { TfrmHueSettings }
TfrmHueSettings = class(TForm) TfrmHueSettings = class(TForm)
edHue: TEdit; edHue: TEdit;
lblHue: TLabel; lblHue: TLabel;
lbHue: TListBox; lbHue: TListBox;
procedure edHueEditingDone(Sender: TObject); procedure edHueEditingDone(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDeactivate(Sender: TObject); procedure FormDeactivate(Sender: TObject);
procedure lbHueDrawItem(Control: TWinControl; Index: Integer; ARect: TRect; procedure lbHueDrawItem(Control: TWinControl; Index: Integer; ARect: TRect;
State: TOwnerDrawState); State: TOwnerDrawState);
procedure lbHueSelectionChange(Sender: TObject; User: boolean); procedure lbHueSelectionChange(Sender: TObject; User: boolean);
protected protected
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave; procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
public public
class procedure DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect; class procedure DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect;
ACaption: string); ACaption: string);
end; end;
var var
frmHueSettings: TfrmHueSettings; frmHueSettings: TfrmHueSettings;
implementation implementation
uses uses
UGameResources, UGraphicHelper; UGameResources, UGraphicHelper;
{ TfrmHueSettings } { TfrmHueSettings }
procedure TfrmHueSettings.FormClose(Sender: TObject; procedure TfrmHueSettings.FormClose(Sender: TObject;
var CloseAction: TCloseAction); var CloseAction: TCloseAction);
begin begin
CloseAction := caHide; CloseAction := caHide;
end; end;
procedure TfrmHueSettings.edHueEditingDone(Sender: TObject); procedure TfrmHueSettings.edHueEditingDone(Sender: TObject);
var var
hueID: Integer; hueID: Integer;
begin begin
if (not TryStrToInt(edHue.Text, hueID)) or (hueID >= lbHue.Items.Count) then if (not TryStrToInt(edHue.Text, hueID)) or (hueID >= lbHue.Items.Count) then
begin begin
edHue.Text := Format('$%x', [lbHue.ItemIndex]); edHue.Text := Format('$%x', [lbHue.ItemIndex]);
MessageDlg('Invalid Hue', 'The hue you''ve entered is invalid.', mtWarning, [mbOK], 0); MessageDlg('Invalid Hue', 'The hue you''ve entered is invalid.', mtWarning, [mbOK], 0);
end else end else
lbHue.ItemIndex := hueID; lbHue.ItemIndex := hueID;
end; end;
procedure TfrmHueSettings.FormCreate(Sender: TObject); procedure TfrmHueSettings.FormCreate(Sender: TObject);
var var
i: Integer; i: Integer;
hue: THue; hue: THue;
begin begin
lbHue.Clear; lbHue.Clear;
lbHue.Items.Add('$0 (no hue)'); lbHue.Items.Add('$0 (no hue)');
for i := 1 to ResMan.Hue.Count do for i := 1 to ResMan.Hue.Count do
begin begin
hue := ResMan.Hue.Hues[i-1]; hue := ResMan.Hue.Hues[i-1];
lbHue.Items.AddObject(Format('$%x (%s)', [i, hue.Name]), hue); lbHue.Items.AddObject(Format('$%x (%s)', [i, hue.Name]), hue);
end; end;
lbHue.ItemIndex := 0; lbHue.ItemIndex := 0;
end; end;
procedure TfrmHueSettings.FormDeactivate(Sender: TObject); procedure TfrmHueSettings.FormDeactivate(Sender: TObject);
begin begin
Close; Close;
end; end;
procedure TfrmHueSettings.lbHueDrawItem(Control: TWinControl; Index: Integer; procedure TfrmHueSettings.lbHueDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState); ARect: TRect; State: TOwnerDrawState);
var var
hue: THue; hue: THue;
begin begin
if Index > 0 then if Index > 0 then
hue := ResMan.Hue.Hues[Index-1] hue := ResMan.Hue.Hues[Index-1]
else else
hue := nil; hue := nil;
DrawHue(hue, lbHue.Canvas, ARect, lbHue.Items.Strings[Index]); DrawHue(hue, lbHue.Canvas, ARect, lbHue.Items.Strings[Index]);
end; end;
procedure TfrmHueSettings.lbHueSelectionChange(Sender: TObject; User: boolean); procedure TfrmHueSettings.lbHueSelectionChange(Sender: TObject; User: boolean);
begin begin
edHue.Text := Format('$%x', [lbHue.ItemIndex]); edHue.Text := Format('$%x', [lbHue.ItemIndex]);
end; end;
procedure TfrmHueSettings.MouseLeave(var msg: TLMessage); procedure TfrmHueSettings.MouseLeave(var msg: TLMessage);
begin begin
try try
if not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos)) then if not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos)) then
Close; Close;
except except
Close; Close;
end; end;
end; end;
class procedure TfrmHueSettings.DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect; class procedure TfrmHueSettings.DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect;
ACaption: string); ACaption: string);
var var
hueColor: TColor; hueColor: TColor;
i: Integer; i: Integer;
begin begin
ACanvas.Pen.Color := clWhite; ACanvas.Pen.Color := clWhite;
ACanvas.Rectangle(ARect); ACanvas.Rectangle(ARect);
if AHue <> nil then if AHue <> nil then
for i := 0 to 31 do for i := 0 to 31 do
begin begin
hueColor := ARGB2RGB(AHue.ColorTable[i]); hueColor := ARGB2RGB(AHue.ColorTable[i]);
ACanvas.Pen.Color := hueColor; ACanvas.Pen.Color := hueColor;
ACanvas.MoveTo(ARect.Left + 2 + i, ARect.Top + 1); ACanvas.MoveTo(ARect.Left + 2 + i, ARect.Top + 1);
ACanvas.LineTo(ARect.Left + 2 + i, ARect.Bottom - 1); ACanvas.LineTo(ARect.Left + 2 + i, ARect.Bottom - 1);
end; end;
ACanvas.TextOut(ARect.Left + 36, ARect.Top, ACaption); ACanvas.TextOut(ARect.Left + 36, ARect.Top, ACaption);
end; end;
initialization initialization
{$I UfrmHueSettings.lrs} {$I UfrmHueSettings.lrs}
end. end.

2
Client/ULandscape.pas
View File

@ -32,7 +32,7 @@ interface
uses uses
SysUtils, Classes, math, contnrs, LCLIntf, GL, GLU, ImagingOpenGL, SysUtils, Classes, math, contnrs, LCLIntf, GL, GLU, ImagingOpenGL,
Imaging, ImagingClasses, ImagingTypes, ImagingUtility, Imaging, ImagingClasses, ImagingTypes, ImagingUtility,
UGenericIndex, UMap, UStatics, UArt, UTexture, UTileData, UHue, UWorldItem, UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem,
UMulBlock, UMulBlock,
UListSort, UVector, UEnhancedMemoryStream, UListSort, UVector, UEnhancedMemoryStream,
UCacheManager, ULinkedList; UCacheManager, ULinkedList;

237
Client/UfrmLogin.lfm
View File

@ -16,8 +16,8 @@ object frmLogin: TfrmLogin
Position = poScreenCenter Position = poScreenCenter
ShowInTaskBar = stAlways ShowInTaskBar = stAlways
object lblCopyright: TLabel object lblCopyright: TLabel
Height = 17 Height = 19
Top = 248 Top = 246
Width = 489 Width = 489
Align = alBottom Align = alBottom
Alignment = taCenter Alignment = taCenter
@ -146,6 +146,7 @@ object frmLogin: TfrmLogin
233023312332233323342335517451745174222C0A2251745174517451745174 233023312332233323342335517451745174222C0A2251745174517451745174
51745174517451745174517451745174517451745174227D3B0A 51745174517451745174517451745174517451745174227D3B0A
} }
Transparent = False
end end
object imgUsername: TImage object imgUsername: TImage
Left = 6 Left = 6
@ -237,6 +238,7 @@ object frmLogin: TfrmLogin
233123322333233423355174517451745174222C0A2251745174517451745174 233123322333233423355174517451745174222C0A2251745174517451745174
51745174517451745174517451745174517451745174227D3B0A 51745174517451745174517451745174517451745174227D3B0A
} }
Transparent = False
end end
object imgPassword: TImage object imgPassword: TImage
Left = 6 Left = 6
@ -318,6 +320,7 @@ object frmLogin: TfrmLogin
5174222C0A2251742349234A236E234B51745174517451745174517451745174 5174222C0A2251742349234A236E234B51745174517451745174517451745174
517451745174227D3B0A 517451745174227D3B0A
} }
Transparent = False
end end
object edHost: TEdit object edHost: TEdit
Left = 101 Left = 101
@ -433,103 +436,40 @@ object frmLogin: TfrmLogin
Width = 23 Width = 23
Color = clBtnFace Color = clBtnFace
Glyph.Data = { Glyph.Data = {
010C00002F2A2058504D202A2F0A7374617469632063686172202A6772617068 36040000424D3604000000000000360000002800000010000000100000000100
69635B5D203D207B0A223136203136203135332032222C0A222E2E2063204E6F 2000000000000004000064000000640000000000000000000000BA6A36FFB969
6E65222C0A222E2C20632023333636424243222C0A222E2D2063202333363642 35FFB86935FFB76835FFB56835FFB46734FFB26634FFB06533FFAE6433FFAC63
4242222C0A222E2A20632023333636414242222C0A222E612063202333393643 32FFAA6232FFA96132FFA86031FFA76031FFA66031FFA86131FFBA6A35FFEBC6
4243222C0A222E6220632023334236454244222C0A222E632063202333413644 ADFFEAC5ADFFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFB
4242222C0A222E6420632023333836424242222C0A222E652063202333453730 F8FFFEFBF8FFFEFBF8FFFEFBF8FFC89A7CFFC79879FFA76031FFBA6B37FFEDCA
4242222C0A222E6620632023443145304636222C0A222E672063202344314530 B3FFE0A27AFFFEFAF7FF62C088FF62C088FF62C088FF62C088FF62C088FF62C0
4637222C0A222E6820632023463846424645222C0A222E692063202346374642 88FF62C088FF62C088FFFDF9F6FFCA8D65FFC99B7CFFA76031FFBB6C38FFEECC
4645222C0A222E6A20632023463646394644222C0A222E6B2063202346304635 B6FFE1A27AFFFEFAF7FFBFDCC2FFBFDCC2FFBFDCC2FFBFDCC2FFBFDCC2FFBFDC
4643222C0A222E6C20632023454146304641222C0A222E6D2063202345444632 C2FFBFDCC2FFBFDCC2FFFDF9F6FFCD9068FFCC9E81FFA86132FFBB6B38FFEFCE
4642222C0A222E6E20632023463746414644222C0A222E6F2063202345424631 B8FFE1A279FFFEFAF7FF62C088FF62C088FF62C088FF62C088FF62C088FF62C0
4642222C0A222E7020632023444645394638222C0A222E712063202342444430 88FF62C088FF62C088FFFDF9F6FFCF936AFFCEA384FFAA6132FFBA6A36FFEFD0
4543222C0A222E7220632023354538394339222C0A222E732063202344314446 BBFFE2A27AFFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFB
4636222C0A222E7420632023383041414539222C0A222E752063202346364641 F8FFFEFBF8FFFEFBF8FFFEFBF8FFD3966DFFD2A78AFFAB6232FFBB6A36FFF0D2
4645222C0A222E7620632023463646414644222C0A222E772063202336343843 BEFFE2A37AFFE2A37AFFE1A37AFFE2A37BFFE1A37BFFE0A178FFDE9F77FFDD9F
4338222C0A222E7820632023454546334642222C0A222E792063202345414631 76FFDC9D74FFD99B72FFD89971FFD69970FFD5AB8EFFAD6333FFBB6A36FFF2D5
4642222C0A222E7A20632023463246364643222C0A222E412063202346314636 C2FFE3A37AFFE3A37AFFE2A37BFFE2A37BFFE2A47BFFE1A279FFE0A178FFDEA0
4643222C0A222E4220632023453245434639222C0A222E432063202344424537 77FFDE9E75FFDC9D74FFDA9B73FFD99B73FFDAB095FFAF6433FFBB6A36FFF2D8
4638222C0A222E4420632023424144304545222C0A222E452063202344304446 C5FFE3A47BFFE3A37AFFE3A47AFFE2A47BFFE2A37BFFE1A37BFFE1A279FFDFA0
4636222C0A222E4620632023374541384538222C0A222E472063202345394631 77FFDE9F76FFDD9E74FFDB9C72FFDC9D74FFDDB59AFFB16534FFBB6B36FFF4D9
4641222C0A222E4820632023454546344642222C0A222E492063202345384630 C7FFE6A67DFFC88C64FFC98D65FFC98E67FFCB926CFFCB926DFFCA9069FFC88C
4641222C0A222E4A20632023444445384638222C0A222E4B2063202344424536 65FFC88C64FFC88C64FFC88C64FFDA9C74FFE1BA9FFFB36634FFBB6B36FFF4DC
4637222C0A222E4C20632023374141334531222C0A222E4D2063202343334435 C9FFE7A77DFFF9ECE1FFF9ECE1FFF9EDE3FFFCF4EEFFFDFAF7FFFDF7F3FFFAED
4546222C0A222E4E20632023333536394237222C0A222E4F2063202343434444 E5FFF7E7DBFFF7E5D9FFF6E5D8FFDEA077FFE4BEA4FFB46734FFBC6B36FFF5DD
4635222C0A222E5020632023374541384537222C0A222E512063202336363844 CCFFE7A87EFFFAF0E8FFFAF0E8FFC98D66FFFAF0E9FFFDF8F3FFFEFAF8FFFCF4
4339222C0A222E5220632023453946304641222C0A222E532063202346334638 EFFFF9E9DFFFF7E7DBFFF7E5D9FFE0A278FFE7C2A9FFB66835FFBC6B36FFF6DF
4644222C0A222E5420632023463846414645222C0A222E552063202345464634 D0FFE8A87EFFFCF6F1FFFCF6F1FFC88C64FFFAF1E9FFFBF4EEFFFDFAF7FFFDF9
4643222C0A222E5620632023444645394639222C0A222E572063202344424537 F6FFFAF0E8FFF8E8DDFFF7E6DBFFE1A37AFFEFD5C3FFB76935FFBC6B36FFF6DF
4637222C0A222E5820632023443945354637222C0A222E592063202337384132 D1FFE9AA80FFFEFAF6FFFDFAF6FFC88C64FFFBF3EEFFFBF1EAFFFCF6F2FFFEFB
4530222C0A222E5A20632023413943324537222C0A222E302063202333353638 F8FFFCF6F1FFF9ECE2FFF8E7DBFFEED0BAFFECD0BDFFBB703EFFBC6B36FFF6E0
4236222C0A222E3120632023433944434634222C0A222E322063202337444137 D1FFF7E0D1FFFEFBF8FFFEFBF7FFFDF9F6FFFCF5F0FFFAF0EAFFFBF2EDFFFDF9
4537222C0A222E3320632023453145434639222C0A222E342063202345334544 F6FFFDFAF7FFFBF1EBFFF8E9DFFFECD0BDFFC9895EFF0000000000000000BC6B
4639222C0A222E3520632023454546344643222C0A222E362063202346334637 36FFBC6B36FFBC6B36FFBC6B36FFBB6B36FFBB6B36FFBB6A36FFBB6A36FFBC6C
4644222C0A222E3720632023453545444641222C0A222E382063202344384535 39FFBD6E3BFFBB6D3AFFBB6B38FFBB703EFF0000000000000000
4636222C0A222E3920632023373741304445222C0A222E402063202341344245
4534222C0A222E2320632023333436374234222C0A222E3B2063202343374439
4634222C0A222E3A20632023374441364536222C0A222E3D2063202336353844
4339222C0A222E2B20632023363738454339222C0A222E252063202336433932
4342222C0A222E2420632023364439324342222C0A222E282063202336393930
4341222C0A222E2920632023363538434338222C0A222E5B2063202337343943
4441222C0A222E5D20632023394642414531222C0A222C2E2063202333343636
4233222C0A222C2C20632023433544384632222C0A222C2D2063202337424134
4533222C0A222C2A20632023374141334533222C0A222C612063202337414134
4533222C0A222C6220632023374241344532222C0A222C632063202337424133
4532222C0A222C6420632023374241334531222C0A222C652063202337394132
4531222C0A222C6620632023373741304446222C0A222C672063202337363946
4445222C0A222C6820632023373439454444222C0A222C692063202337323943
4442222C0A222C6A20632023373439444443222C0A222C6B2063202339414235
4444222C0A222C6C20632023333436354231222C0A222C6D2063202343324435
4632222C0A222C6E20632023373841314530222C0A222C6F2063202337353945
4445222C0A222C7020632023373339424441222C0A222C712063202337333942
4439222C0A222C7220632023393542304441222C0A222C732063202333333634
4146222C0A222C7420632023424544324630222C0A222C752063202337414133
4532222C0A222C7620632023373739464445222C0A222C772063202337363946
4444222C0A222C7820632023373239424439222C0A222C792063202337313939
4438222C0A222C7A20632023373039394436222C0A222C412063202338454142
4435222C0A222C4220632023333336334144222C0A222C432063202333363641
4241222C0A222C4420632023424244304546222C0A222C452063202337414132
4532222C0A222C4620632023364439364433222C0A222C472063202338414137
4432222C0A222C4820632023333236324142222C0A222C492063202342384345
4546222C0A222C4A20632023463746414645222C0A222C4B2063202338384330
3632222C0A222C4C20632023364139334346222C0A222C4D2063202338344133
4345222C0A222C4E20632023333236314141222C0A222C4F2063202333383643
4242222C0A222C5020632023423643434545222C0A222C512063202337414132
4531222C0A222C5220632023433244434246222C0A222C532063202336383930
4344222C0A222C5420632023383139454343222C0A222C552063202333323631
4138222C0A222C5620632023333736424241222C0A222C572063202342334341
4544222C0A222C5820632023374141324530222C0A222C592063202336353844
4341222C0A222C5A20632023374339424339222C0A222C302063202333313630
4137222C0A222C3120632023333536414241222C0A222C322063202341444336
4542222C0A222C3320632023414443354541222C0A222C342063202337433941
4338222C0A222C3520632023373939384337222C0A222C362063202333353639
4239222C0A222C3720632023333536394238222C0A222C382063202333353638
4237222C0A222C3920632023333536384235222C0A222C402063202333343636
4232222C0A222C2320632023333336354230222C0A222C3B2063202333333634
4145222C0A222C3A20632023333236334143222C0A222C3D2063202333323632
4141222C0A222C2B20632023333236314139222C0A222C252063202333313630
4138222C0A222C2420632023333136304136222C0A222C282063202333313631
4138222C0A222E2E2E2C2E2C2E2C2E2C2E2D2E2D2E2A2E2A2E612E622E632E64
2E652E2E2E2E222C0A222E2C2E662E672E682E692E6A2E6B2E6C2E6D2E6A2E6E
2E6F2E702E712E722E2E222C0A222E2C2E732E742E752E762E772E782E792E7A
2E682E412E422E432E442E712E65222C0A222E2C2E452E462E412E412E772E47
2E482E6E2E6A2E492E4A2E4B2E4C2E4D2E4E222C0A222E2C2E4F2E502E492E49
2E512E522E532E542E552E562E572E582E592E5A2E30222C0A222E2D2E312E32
2E332E332E342E352E6E2E362E372E572E582E382E392E402E23222C0A222E2D
2E3B2E3A2E772E3D2E2B2E252E242E282E292E772E772E772E5B2E5D2C2E222C
0A222E2A2C2C2C2D2C2A2C612C622C632C642C652C662C672C682C692C6A2C6B
2C6C222C0A222E2A2C6D2C2A2C2A2C632C632C622C652C6E2E392C6F2C6A2C70
2C712C722C73222C0A222E2A2C742C752C752E4C2C632C642C6E2C762C772C6A
2C782C792C7A2C412C42222C0A222C432C442C452E682E682E682E682E682E68
2E682E682E682E682C462C472C48222C0A222E642C492C652C4A2C4B2C4B2C4B
2C4B2C4B2C4B2C4B2C4B2E6A2C4C2C4D2C4E222C0A222C4F2C502C512C4A2C52
2C522C522C522C522C522C522C522E6A2C532C542C55222C0A222C562C572C58
2C4A2C4B2C4B2C4B2C4B2C4B2C4B2C4B2C4B2E6A2C592C5A2C30222C0A222C31
2C322C332E682E682E682E682E682E682E682E682E682E682C342C352C30222C
0A222C432C362C372C382C392E232C402C232C3B2C3A2C3D2C2B2C252C302C24
2C28227D0A
} }
NumGlyphs = 0 NumGlyphs = 0
OnClick = btnSaveProfileClick OnClick = btnSaveProfileClick
@ -545,71 +485,40 @@ object frmLogin: TfrmLogin
Width = 23 Width = 23
Color = clBtnFace Color = clBtnFace
Glyph.Data = { Glyph.Data = {
100800002F2A2058504D202A2F0A7374617469632063686172202A6772617068 36040000424D3604000000000000360000002800000010000000100000000100
69635B5D203D207B0A2231362031362039302032222C0A222E2E2063204E6F6E 2000000000000004000064000000640000000000000000000000000000000000
65222C0A222E2C20632023464637373741222C0A222E2D206320234645373637 0000000000000000000000000000000000000000000000000000000000000000
39222C0A222E2A20632023463836313634222C0A222E61206320234639363836 0000000000000000000000000000000000000000000000000000000000000000
41222C0A222E6220632023463335313534222C0A222E63206320234646374538 0000000000000000000000000000000000000000000000000000000000000000
31222C0A222E6420632023464537453831222C0A222E65206320234644373137 0000000000000000000000000000000000000000000000000000000000000000
34222C0A222E6620632023463835463632222C0A222E67206320234642364436 0000000000004F4CF2FF403EEDFF000000000000000000000000000000000000
46222C0A222E6820632023464637433745222C0A222E69206320234645373137 0000000000002422E4FF312FEAFF000000000000000000000000000000000000
34222C0A222E6A20632023464537413744222C0A222E6B206320234646383738 00005856F5FF6361FAFF5855F6FF413FEDFF0000000000000000000000000000
41222C0A222E6C20632023464437393743222C0A222E6D206320234642363936 00002C2AE6FF413FF1FF4C4AF6FF312FEAFF0000000000000000000000000000
43222C0A222E6E20632023463835453631222C0A222E6F206320234641364336 00005B58F6FF6562FAFF7170FFFF5956F6FF4240EEFF00000000000000003532
45222C0A222E7020632023464637413744222C0A222E71206320234637354636 E9FF4745F2FF6362FFFF4A48F4FF2F2DE9FF0000000000000000000000000000
31222C0A222E7220632023463034363439222C0A222E73206320234643364236 0000000000005B59F6FF6663FAFF7471FFFF5A58F6FF4341EEFF3E3CECFF504D
45222C0A222E7420632023464437343737222C0A222E75206320234646383238 F4FF6867FFFF504EF5FF3634EBFF000000000000000000000000000000000000
36222C0A222E7620632023464337333736222C0A222E77206320234638363236 000000000000000000005C5AF6FF6764FAFF7472FFFF7370FFFF706EFFFF6E6C
34222C0A222E7820632023463735443630222C0A222E79206320234641364136 FFFF5755F7FF3F3DEEFF00000000000000000000000000000000000000000000
44222C0A222E7A20632023464637393742222C0A222E41206320234546343534 00000000000000000000000000005D5BF7FF7976FFFF5956FFFF5754FFFF7270
38222C0A222E4220632023463936333636222C0A222E43206320234642364437 FFFF4846F0FF0000000000000000000000000000000000000000000000000000
30222C0A222E4420632023464637453830222C0A222E45206320234646374237 00000000000000000000000000005D5AF6FF7D79FFFF5E5BFFFF5B58FFFF7674
45222C0A222E4620632023464637393743222C0A222E47206320234646373737 FFFF4643EFFF0000000000000000000000000000000000000000000000000000
39222C0A222E4820632023463735433545222C0A222E49206320234546343434 000000000000000000006663F9FF706DFBFF807EFFFF7E7BFFFF7C79FFFF7977
37222C0A222E4A20632023463635413544222C0A222E4B206320234646373937 FFFF5E5CF7FF4744EFFF00000000000000000000000000000000000000000000
44222C0A222E4C20632023464635423545222C0A222E4D206320234646353835 0000000000006E6BFCFF7774FDFF8682FFFF7673FCFF6462F8FF605DF7FF6D6A
42222C0A222E4E20632023464637343736222C0A222E4F206320234546343334 FAFF7B79FFFF605DF7FF4845EFFF000000000000000000000000000000000000
36222C0A222E5020632023463735423544222C0A222E51206320234646373637 00007471FEFF7D7AFEFF8A87FFFF7C79FDFF6C69FBFF0000000000000000615E
39222C0A222E5220632023464635363539222C0A222E53206320234646353435 F8FF6E6CFAFF7D7AFFFF615FF7FF4946F0FF0000000000000000000000000000
37222C0A222E5420632023464637303732222C0A222E55206320234630343634 00007A77FFFF817EFFFF817EFEFF7471FDFF0000000000000000000000000000
38222C0A222E5620632023463635413543222C0A222E57206320234641363436 0000625FF8FF6F6DFBFF7E7CFFFF625FF8FF0000000000000000000000000000
37222C0A222E5820632023464637323734222C0A222E59206320234646373037 0000000000007A77FFFF7976FEFF000000000000000000000000000000000000
33222C0A222E5A20632023464636453730222C0A222E30206320234646364336 0000000000006461F8FF6A68F9FF5451F3FF0000000000000000000000000000
45222C0A222E3120632023463735353537222C0A222E32206320234545334433 0000000000000000000000000000000000000000000000000000000000000000
46222C0A222E3320632023463635393542222C0A222E34206320234641363336 0000000000000000000000000000000000000000000000000000000000000000
36222C0A222E3520632023464637313734222C0A222E36206320234636353835 0000000000000000000000000000000000000000000000000000000000000000
41222C0A222E3720632023454534313433222C0A222E38206320234543334333 0000000000000000000000000000000000000000000000000000
45222C0A222E3920632023463434443530222C0A222E40206320234646363736
38222C0A222E2320632023463534453530222C0A222E3B206320234542333433
36222C0A222E3A20632023463635383542222C0A222E3D206320234641363236
35222C0A222E2B20632023464637303731222C0A222E25206320234636353635
39222C0A222E2420632023454534303432222C0A222E28206320234539333233
35222C0A222E2920632023463234353437222C0A222E5B206320234646363236
33222C0A222E5D20632023463434383441222C0A222C2E206320234539324432
46222C0A222C2C20632023463535363538222C0A222C2D206320234641363136
33222C0A222C2A20632023463635353538222C0A222C61206320234544334634
31222C0A222C6220632023453632413243222C0A222C63206320234631334634
31222C0A222C6420632023463634413443222C0A222C65206320234541324633
31222C0A222C6620632023463234433446222C0A222C67206320234544334534
30222C0A222C6820632023453432323234222C0A222E2E2E2E2E2E2E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E
2E2E2E2E2C2E2D2E2E2E2E2E2E2E2E2E2E2E2E2E2A2E612E622E2E2E2E222C0A
222E2E2E2E2E2C2E632E642E652E2E2E2E2E2E2E2E2E662E672E682E662E2E2E
2E222C0A222E2E2E2E2E692E6A2E6B2E6C2E6D2E2E2E2E2E6E2E6F2E702E712E
722E2E2E2E222C0A222E2E2E2E2E2E2E732E742E752E762E772E782E792E7A2E
782E412E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E422E432E442E452E462E
472E482E492E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E4A2E4B2E
4C2E4D2E4E2E4F2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E
502E512E522E532E542E552E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E
2E2E562E572E582E592E5A2E302E312E322E2E2E2E2E2E2E2E222C0A222E2E2E
2E2E2E2E332E342E352E362E372E382E392E402E232E3B2E2E2E2E2E2E222C0A
222E2E2E2E2E3A2E3D2E2B2E252E242E2E2E2E2E282E292E5B2E5D2C2E2E2E2E
2E222C0A222E2E2E2E2C2C2C2D2C2A2C612E2E2E2E2E2E2E2E2C622C632C642C
652E2E2E2E222C0A222E2E2E2E2E2E2C662C672E2E2E2E2E2E2E2E2E2E2E2E2C
682C652E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E2E2E222C0A222E2E2E2E2E2E2E2E2E2E2E2E2E2E2E
2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E2E227D0A
} }
NumGlyphs = 0 NumGlyphs = 0
OnClick = btnDeleteProfileClick OnClick = btnDeleteProfileClick

957
Client/UfrmMain.lfm
View File

File diff suppressed because it is too large Load Diff

394
Server/UAccount.pas
View File

@ -1,181 +1,213 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2008 Andreas Schneider
*) *)
unit UAccount; unit UAccount;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, md5, contnrs, math, UEnums; Classes, SysUtils, md5, contnrs, math, DOM, UXmlHelper, UInterfaces,
UEnums;
type
type
{ TAccount }
{ TAccount }
TAccount = class(TObject)
constructor Create(AAccountString: string); TAccount = class(TObject, ISerializable, IInvalidate)
constructor Create(AName, APasswordHash: string; AAccessLevel: TAccessLevel); constructor Create(AOwner: IInvalidate; AName, APasswordHash: string;
protected AAccessLevel: TAccessLevel);
FName: string; constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
FAccessLevel: TAccessLevel; procedure Serialize(AElement: TDOMElement);
FPasswordHash: string; protected
FLastPos: TPoint; FOwner: IInvalidate;
procedure SetAccessLevel(const AValue: TAccessLevel); FName: string;
procedure SetPasswordHash(const AValue: string); FAccessLevel: TAccessLevel;
procedure SetLastPos(const AValue: TPoint); FPasswordHash: string;
public FLastPos: TPoint;
property Name: string read FName; procedure SetAccessLevel(const AValue: TAccessLevel);
property AccessLevel: TAccessLevel read FAccessLevel write SetAccessLevel; procedure SetPasswordHash(const AValue: string);
property PasswordHash: string read FPasswordHash write SetPasswordHash; procedure SetLastPos(const AValue: TPoint);
property LastPos: TPoint read FLastPos write SetLastPos; public
procedure Flush; property Name: string read FName;
end; property AccessLevel: TAccessLevel read FAccessLevel write SetAccessLevel;
property PasswordHash: string read FPasswordHash write SetPasswordHash;
{ TAccountList } property LastPos: TPoint read FLastPos write SetLastPos;
procedure Invalidate;
TAccountList = class(TObjectList) end;
constructor Create; reintroduce;
public { TAccountList }
function IndexOf(AName: string): Integer;
function Find(AName: string): TAccount; TAccountList = class(TObjectList, ISerializable, IInvalidate)
procedure Delete(AName: string); constructor Create(AOwner: IInvalidate); reintroduce;
end; constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
procedure Serialize(AElement: TDOMElement);
implementation protected
FOwner: IInvalidate;
uses public
UCEDServer, UConfig; function IndexOf(AName: string): Integer;
function Find(AName: string): TAccount;
{ TAccount } procedure Delete(AName: string);
procedure Invalidate;
constructor TAccount.Create(AAccountString: string); end;
var
i: Integer; implementation
attribs: TStringList;
begin uses
inherited Create; UCEDServer, UConfig;
i := Pos('=', AAccountString);
if i > 0 then { TAccount }
FName := Trim(Copy(AAccountString, 1, i-1));
AAccountString := Copy(AAccountString, i+1, Length(AAccountString)); constructor TAccount.Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel);
attribs := TStringList.Create; begin
if ExtractStrings([':'], [' '], PChar(AAccountString), attribs) >= 2 then inherited Create;
begin FOwner := AOwner;
FAccessLevel := TAccessLevel(StrToInt(attribs.Strings[0])); FName := AName;
FPasswordHash := attribs.Strings[1]; FPasswordHash := APasswordHash;
end; FAccessLevel := AAccessLevel;
if attribs.Count >= 4 then end;
begin
FLastPos.x := EnsureRange(StrToInt(attribs.Strings[2]), 0, Config.ReadInteger('Parameters', 'Width', 0) * 8 - 1); constructor TAccount.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
FLastPos.y := EnsureRange(StrToInt(attribs.Strings[3]), 0, Config.ReadInteger('Parameters', 'Height', 0) * 8 - 1); begin
end else inherited Create;
begin FOwner := AOwner;
FLastPos.x := 0; FName := TXmlHelper.ReadString(AElement, 'Name', '');
FLastPos.y := 0; FAccessLevel := TAccessLevel(TXmlHelper.ReadInteger(AElement, 'AccessLevel', 0));
end; FPasswordHash := TXmlHelper.ReadString(AElement, 'PasswordHash', '');
attribs.Free; FLastPos := Point(0, 0);
end; TXmlHelper.ReadCoords(AElement, 'LastPos', FLastPos.X, FLastPos.Y);
end;
constructor TAccount.Create(AName, APasswordHash: string;
AAccessLevel: TAccessLevel); procedure TAccount.SetAccessLevel(const AValue: TAccessLevel);
begin begin
inherited Create; FAccessLevel := AValue;
FName := AName; Invalidate;
FPasswordHash := APasswordHash; end;
FAccessLevel := AAccessLevel;
Flush; procedure TAccount.SetPasswordHash(const AValue: string);
end; begin
FPasswordHash := AValue;
procedure TAccount.SetAccessLevel(const AValue: TAccessLevel); Invalidate;
begin end;
FAccessLevel := AValue;
Flush; procedure TAccount.SetLastPos(const AValue: TPoint);
end; begin
FLastPos.x := EnsureRange(AValue.x, 0, CEDServerInstance.Landscape.CellWidth - 1);
procedure TAccount.SetPasswordHash(const AValue: string); FLastPos.y := EnsureRange(AValue.y, 0, CEDServerInstance.Landscape.CellHeight - 1);
begin Invalidate;
FPasswordHash := AValue; end;
Flush;
end; procedure TAccount.Invalidate;
begin
procedure TAccount.SetLastPos(const AValue: TPoint); FOwner.Invalidate;
begin end;
FLastPos.x := EnsureRange(AValue.x, 0, CEDServerInstance.Landscape.CellWidth - 1);
FLastPos.y := EnsureRange(AValue.y, 0, CEDServerInstance.Landscape.CellHeight - 1); procedure TAccount.Serialize(AElement: TDOMElement);
Flush; begin
end; TXmlHelper.WriteString(AElement, 'Name', FName);
TXmlHelper.WriteString(AElement, 'PasswordHash', FPasswordHash);
procedure TAccount.Flush; TXmlHelper.WriteInteger(AElement, 'AccessLevel', Integer(FAccessLevel));
begin TXmlHelper.WriteCoords(AElement, 'LastPos', FLastPos.X, FLastPos.Y);
Config.WriteString('Accounts', FName, IntToStr(Byte(FAccessLevel)) + ':' + end;
FPasswordHash + ':' + IntToStr(FLastPos.x) + ':' + IntToStr(FLastPos.y));
end; { TAccountList }
{ TAccountList } constructor TAccountList.Create(AOwner: IInvalidate);
begin
constructor TAccountList.Create; inherited Create(True);
begin FOwner := AOwner;
inherited Create(True); end;
end;
constructor TAccountList.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
function TAccountList.IndexOf(AName: string): Integer; var
var nodelist: TDOMNodeList;
i: Integer; i: Integer;
begin begin
Result := -1; Create(AOwner);
i := 0; nodeList := AElement.GetChildNodes;
while (i < Count) and (Result = -1) do for i := 0 to nodeList.Count - 1 do
begin begin
if TAccount(Items[i]).Name = AName then if nodeList.Item[i].NodeName = 'Account' then
Result := i; Add(TAccount.Deserialize(Self, TDOMElement(nodeList.Item[i])));
Inc(i); end;
end; nodeList.Free;
end; end;
function TAccountList.Find(AName: string): TAccount; function TAccountList.IndexOf(AName: string): Integer;
var var
i: Integer; i: Integer;
begin begin
i := IndexOf(AName); Result := -1;
if i > -1 then i := 0;
Result := TAccount(Items[i]) while (i < Count) and (Result = -1) do
else begin
Result := nil; if TAccount(Items[i]).Name = AName then
end; Result := i;
Inc(i);
procedure TAccountList.Delete(AName: string); end;
var end;
i: Integer;
begin function TAccountList.Find(AName: string): TAccount;
i := IndexOf(AName); var
if i > -1 then i: Integer;
inherited Delete(i); begin
end; i := IndexOf(AName);
if i > -1 then
end. Result := TAccount(Items[i])
else
Result := nil;
end;
procedure TAccountList.Delete(AName: string);
var
i: Integer;
begin
i := IndexOf(AName);
if i > -1 then
inherited Delete(i);
end;
procedure TAccountList.Invalidate;
begin
FOwner.Invalidate;
end;
procedure TAccountList.Serialize(AElement: TDOMElement);
var
i: Integer;
xmlAccount: TDOMElement;
begin
for i := 0 to Count - 1 do
begin
xmlAccount := AElement.OwnerDocument.CreateElement('Account');
AElement.AppendChild(xmlAccount);
TAccount(Items[i]).Serialize(xmlAccount);
end;
end;
end.

455
Server/UAdminHandling.pas
View File

@ -1,226 +1,229 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2008 Andreas Schneider
*) *)
unit UAdminHandling; unit UAdminHandling;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState, Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, lNet; UEnhancedMemoryStream, UEnums, lNet;
type type
{ TModifyUserResponsePacket } { TModifyUserResponsePacket }
TModifyUserResponsePacket = class(TPacket) TModifyUserResponsePacket = class(TPacket)
constructor Create(AStatus: TModifyUserStatus; AAccount: TAccount); constructor Create(AStatus: TModifyUserStatus; AAccount: TAccount);
end; end;
{ TDeleteUserResponsePacket } { TDeleteUserResponsePacket }
TDeleteUserResponsePacket = class(TPacket) TDeleteUserResponsePacket = class(TPacket)
constructor Create(AStatus: TDeleteUserStatus; AUsername: string); constructor Create(AStatus: TDeleteUserStatus; AUsername: string);
end; end;
{ TUserListPacket } { TUserListPacket }
TUserListPacket = class(TPacket) TUserListPacket = class(TPacket)
constructor Create; constructor Create;
end; end;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var var
AdminPacketHandlers: array[0..$FF] of TPacketHandler; AdminPacketHandlers: array[0..$FF] of TPacketHandler;
implementation implementation
uses uses
md5, UCEDServer, UPackets, UClientHandling; md5, UCEDServer, UPackets, UClientHandling;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var var
packetHandler: TPacketHandler; packetHandler: TPacketHandler;
begin begin
if not ValidateAccess(ANetState, alAdministrator) then Exit; if not ValidateAccess(ANetState, alAdministrator) then Exit;
packetHandler := AdminPacketHandlers[ABuffer.ReadByte]; packetHandler := AdminPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState); packetHandler.Process(ABuffer, ANetState);
end; end;
procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin begin
CEDServerInstance.Landscape.Flush; CEDServerInstance.Landscape.Flush;
end; Config.Flush;
end;
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
CEDServerInstance.Quit := True; begin
end; CEDServerInstance.Quit := True;
end;
procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState); procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream;
var ANetState: TNetState);
account: TAccount; var
username, password: string; account: TAccount;
accessLevel: TAccessLevel; username, password: string;
netState: TNetState; accessLevel: TAccessLevel;
begin netState: TNetState;
username := ABuffer.ReadStringNull; begin
password := ABuffer.ReadStringNull; username := ABuffer.ReadStringNull;
accessLevel := TAccessLevel(ABuffer.ReadByte); password := ABuffer.ReadStringNull;
account := Accounts.Find(username); accessLevel := TAccessLevel(ABuffer.ReadByte);
if account <> nil then account := Config.Accounts.Find(username);
begin if account <> nil then
if password <> '' then begin
account.PasswordHash := MD5Print(MD5String(password)); if password <> '' then
if account.AccessLevel <> accessLevel then account.PasswordHash := MD5Print(MD5String(password));
begin if account.AccessLevel <> accessLevel then
account.AccessLevel := accessLevel; begin
CEDServerInstance.TCPServer.IterReset; account.AccessLevel := accessLevel;
while CEDServerInstance.TCPServer.IterNext do CEDServerInstance.TCPServer.IterReset;
begin while CEDServerInstance.TCPServer.IterNext do
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData); begin
if (netState <> nil) and (netState.Account = account) then netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
begin if (netState <> nil) and (netState.Account = account) then
CEDServerInstance.SendPacket(netState, TAccessLevelChangedPacket.Create(accessLevel)); begin
end; CEDServerInstance.SendPacket(netState, TAccessLevelChangedPacket.Create(accessLevel));
end; end;
end; end;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muModified, account)); end;
end else CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muModified, account));
begin end else
account := TAccount.Create(username, MD5Print(MD5String(password)), accessLevel); begin
if (username = '') or (Pos('=', username) > 0) then account := TAccount.Create(Config.Accounts, username,
begin MD5Print(MD5String(password)), accessLevel);
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muInvalidUsername, account)); if (username = '') or (Pos('=', username) > 0) then
account.Free; begin
Exit; CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muInvalidUsername, account));
end; account.Free;
Accounts.Add(account); Exit;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muAdded, account)); end;
end; Config.Accounts.Add(account);
end; Config.Invalidate;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muAdded, account));
procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream; end;
ANetState: TNetState); end;
var
account: TAccount; procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream;
username: string; ANetState: TNetState);
netState: TNetState; var
begin account: TAccount;
username := ABuffer.ReadStringNull; username: string;
account := Accounts.Find(username); netState: TNetState;
if (account <> nil) and (account <> ANetState.Account) then begin
begin username := ABuffer.ReadStringNull;
Config.DeleteKey('Accounts', username); account := Config.Accounts.Find(username);
CEDServerInstance.TCPServer.IterReset; if (account <> nil) and (account <> ANetState.Account) then
while CEDServerInstance.TCPServer.IterNext do begin
begin CEDServerInstance.TCPServer.IterReset;
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData); while CEDServerInstance.TCPServer.IterNext do
if (netState <> nil) and (netState.Account = account) then begin
begin netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
CEDServerInstance.Disconnect(CEDServerInstance.TCPServer.Iterator); if (netState <> nil) and (netState.Account = account) then
netState.Account := nil; begin
end; CEDServerInstance.Disconnect(CEDServerInstance.TCPServer.Iterator);
end; netState.Account := nil;
Accounts.Remove(account); end;
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duDeleted, username)); end;
end else Config.Accounts.Remove(account);
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duNotFound, username)); Config.Invalidate;
end; CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duDeleted, username));
end else
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duNotFound, username));
begin end;
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TUserListPacket.Create));
end; procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
{ TModifyUserResponsePacket } CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TUserListPacket.Create));
end;
constructor TModifyUserResponsePacket.Create(AStatus: TModifyUserStatus; AAccount: TAccount);
begin { TModifyUserResponsePacket }
inherited Create($03, 0);
FStream.WriteByte($05); constructor TModifyUserResponsePacket.Create(AStatus: TModifyUserStatus; AAccount: TAccount);
FStream.WriteByte(Byte(AStatus)); begin
FStream.WriteStringNull(AAccount.Name); inherited Create($03, 0);
FStream.WriteByte(Byte(AAccount.AccessLevel)); FStream.WriteByte($05);
end; FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(AAccount.Name);
{ TDeleteUserResponsePacket } FStream.WriteByte(Byte(AAccount.AccessLevel));
end;
constructor TDeleteUserResponsePacket.Create(AStatus: TDeleteUserStatus; AUsername: string);
begin { TDeleteUserResponsePacket }
inherited Create($03, 0);
FStream.WriteByte($06); constructor TDeleteUserResponsePacket.Create(AStatus: TDeleteUserStatus; AUsername: string);
FStream.WriteByte(Byte(AStatus)); begin
FStream.WriteStringNull(AUsername); inherited Create($03, 0);
end; FStream.WriteByte($06);
FStream.WriteByte(Byte(AStatus));
{ TUserListPacket } FStream.WriteStringNull(AUsername);
end;
constructor TUserListPacket.Create;
var { TUserListPacket }
i: Integer;
account: TAccount; constructor TUserListPacket.Create;
begin var
inherited Create($03, 0); i: Integer;
FStream.WriteByte($07); account: TAccount;
FStream.WriteWord(Accounts.Count); begin
for i := 0 to Accounts.Count - 1 do inherited Create($03, 0);
begin FStream.WriteByte($07);
account := TAccount(Accounts.Items[i]); FStream.WriteWord(Config.Accounts.Count);
FStream.WriteStringNull(account.Name); for i := 0 to Config.Accounts.Count - 1 do
FStream.WriteByte(Byte(account.AccessLevel)); begin
end; account := TAccount(Config.Accounts.Items[i]);
end; FStream.WriteStringNull(account.Name);
FStream.WriteByte(Byte(account.AccessLevel));
{$WARNINGS OFF} end;
var end;
i: Integer;
{$WARNINGS OFF}
initialization var
for i := 0 to $FF do i: Integer;
AdminPacketHandlers[i] := nil;
AdminPacketHandlers[$01] := TPacketHandler.Create(0, @OnFlushPacket); initialization
AdminPacketHandlers[$02] := TPacketHandler.Create(0, @OnQuitPacket); for i := 0 to $FF do
AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserPacket); AdminPacketHandlers[i] := nil;
AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserPacket); AdminPacketHandlers[$01] := TPacketHandler.Create(0, @OnFlushPacket);
AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket); AdminPacketHandlers[$02] := TPacketHandler.Create(0, @OnQuitPacket);
finalization AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserPacket);
for i := 0 to $FF do AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserPacket);
if AdminPacketHandlers[i] <> nil then AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket);
AdminPacketHandlers[i].Free; finalization
{$WARNINGS ON} for i := 0 to $FF do
if AdminPacketHandlers[i] <> nil then
end. AdminPacketHandlers[i].Free;
{$WARNINGS ON}
end.

719
Server/UCEDServer.pas
View File

@ -1,361 +1,358 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2007 Andreas Schneider
*) *)
unit UCEDServer; unit UCEDServer;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, lNet, UEnhancedMemoryStream, UConfig, ULandscape, Classes, SysUtils, lNet, UEnhancedMemoryStream, UConfig, ULandscape,
UNetState, UPacket, dateutils, UNetState, UPacket, dateutils,
{$IFDEF Linux}BaseUnix,{$ENDIF} {$IFDEF Linux}BaseUnix,{$ENDIF}
{$IFDEF Windows}Windows,{$ENDIF} {$IFDEF Windows}Windows,{$ENDIF}
UPacketHandlers, UConnectionHandling; UPacketHandlers, UConnectionHandling;
type type
{ TCEDServer } { TCEDServer }
TCEDServer = class(TObject) TCEDServer = class(TObject)
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
protected protected
FLandscape: TLandscape; FLandscape: TLandscape;
FTCPServer: TLTcp; FTCPServer: TLTcp;
FQuit: Boolean; FQuit: Boolean;
FLastFlush: TDateTime; FLastFlush: TDateTime;
FValid: Boolean; FValid: Boolean;
procedure OnAccept(ASocket: TLSocket); procedure OnAccept(ASocket: TLSocket);
procedure OnCanSend(ASocket: TLSocket); procedure OnCanSend(ASocket: TLSocket);
procedure OnDisconnect(ASocket: TLSocket); procedure OnDisconnect(ASocket: TLSocket);
procedure OnReceive(ASocket: TLSocket); procedure OnReceive(ASocket: TLSocket);
procedure OnError(const AError: string; ASocket: TLSocket); procedure OnError(const AError: string; ASocket: TLSocket);
procedure ProcessBuffer(ANetState: TNetState); procedure ProcessBuffer(ANetState: TNetState);
procedure CheckNetStates; procedure CheckNetStates;
public public
property Landscape: TLandscape read FLandscape; property Landscape: TLandscape read FLandscape;
property TCPServer: TLTcp read FTCPServer; property TCPServer: TLTcp read FTCPServer;
property Quit: Boolean read FQuit write FQuit; property Quit: Boolean read FQuit write FQuit;
procedure Run; procedure Run;
procedure SendPacket(ANetState: TNetState; APacket: TPacket; procedure SendPacket(ANetState: TNetState; APacket: TPacket;
AFreePacket: Boolean = True); AFreePacket: Boolean = True);
procedure Disconnect(ASocket: TLSocket); procedure Disconnect(ASocket: TLSocket);
end; end;
var var
CEDServerInstance: TCEDServer; CEDServerInstance: TCEDServer;
implementation implementation
uses uses
UClientHandling; UClientHandling;
{$I version.inc} {$I version.inc}
{$IFDEF Linux} {$IFDEF Linux}
procedure OnSigInt(ASignal: cint); cdecl; procedure OnSigInt(ASignal: cint); cdecl;
begin begin
Writeln(TimeStamp, 'Killed'); Writeln(TimeStamp, 'Killed');
if CEDServerInstance <> nil then CEDServerInstance.Quit := True; if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end; end;
procedure OnSigSegv(ASignal: cint); cdecl; procedure OnSigSegv(ASignal: cint); cdecl;
begin begin
Writeln(TimeStamp, 'Internal error'); Writeln(TimeStamp, 'Internal error');
Halt; Halt;
//if CEDServerInstance <> nil then CEDServerInstance.Quit := True; //if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end; end;
{$ENDIF} {$ENDIF}
{$IFDEF Windows} {$IFDEF Windows}
function OnConsoleCtrlEvent(ACtrl: DWord): LongBool; stdcall; far; function OnConsoleCtrlEvent(ACtrl: DWord): LongBool; stdcall; far;
begin begin
Result := False; Result := False;
if (ACtrl = CTRL_C_EVENT) or (ACtrl = CTRL_BREAK_EVENT) then if (ACtrl = CTRL_C_EVENT) or (ACtrl = CTRL_BREAK_EVENT) then
begin begin
Writeln(TimeStamp, 'Killed'); Writeln(TimeStamp, 'Killed');
if CEDServerInstance <> nil then CEDServerInstance.Quit := True; if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
Result := True; Result := True;
end; end;
end; end;
{$ENDIF} {$ENDIF}
{ TCEDServer } { TCEDServer }
constructor TCEDServer.Create; constructor TCEDServer.Create;
begin begin
inherited Create; inherited Create;
FLandscape := TLandscape.Create(Config.ReadString('Paths', 'map', 'map0.mul'), FLandscape := TLandscape.Create(Config.Map.MapFile, Config.Map.StaticsFile,
Config.ReadString('Paths', 'statics', 'statics0.mul'), Config.Map.StaIdxFile, Config.Tiledata, Config.Radarcol, Config.Map.Width,
Config.ReadString('Paths', 'staidx', 'staidx0.mul'), Config.Map.Height, FValid);
Config.ReadString('Paths', 'tiledata', 'tiledata.mul'), FTCPServer := TLTcp.Create(nil);
Config.ReadString('Paths', 'radarcol', 'radarcol.mul'), FTCPServer.OnAccept := @OnAccept;
Config.ReadInteger('Parameters', 'Width', 0), FTCPServer.OnCanSend := @OnCanSend;
Config.ReadInteger('Parameters', 'Height', 0), FTCPServer.OnDisconnect := @OnDisconnect;
FValid); FTCPServer.OnReceive := @OnReceive;
FTCPServer := TLTcp.Create(nil); FTCPServer.OnError := @OnError;
FTCPServer.OnAccept := @OnAccept; FQuit := False;
FTCPServer.OnCanSend := @OnCanSend; FLastFlush := Now;
FTCPServer.OnDisconnect := @OnDisconnect; end;
FTCPServer.OnReceive := @OnReceive;
FTCPServer.OnError := @OnError; destructor TCEDServer.Destroy;
FQuit := False; begin
FLastFlush := Now; if FTCPServer <> nil then
end; begin
FTCPServer.IterReset;
destructor TCEDServer.Destroy; if FTCPServer.Iterator <> nil then
begin while FTCPServer.IterNext do
if FTCPServer <> nil then begin
begin FTCPServer.Iterator.Disconnect;
FTCPServer.IterReset; if FTCPServer.Iterator.UserData <> nil then
if FTCPServer.Iterator <> nil then begin
while FTCPServer.IterNext do TObject(FTCPServer.Iterator.UserData).Free;
begin FTCPServer.Iterator.UserData := nil;
FTCPServer.Iterator.Disconnect; end;
if FTCPServer.Iterator.UserData <> nil then end;
begin FreeAndNil(FTCPServer);
TObject(FTCPServer.Iterator.UserData).Free; end;
FTCPServer.Iterator.UserData := nil; if FLandscape <> nil then FreeAndNil(FLandscape);
end; inherited Destroy;
end; end;
FreeAndNil(FTCPServer);
end; procedure TCEDServer.OnAccept(ASocket: TLSocket);
if FLandscape <> nil then FreeAndNil(FLandscape); begin
inherited Destroy; writeln(TimeStamp, 'Connect: ', ASocket.PeerAddress);
end; ASocket.UserData := TNetState.Create(ASocket);
SendPacket(TNetState(ASocket.UserData), TProtocolVersionPacket.Create(ProtocolVersion));
procedure TCEDServer.OnAccept(ASocket: TLSocket); end;
begin
writeln(TimeStamp, 'Connect: ', ASocket.PeerAddress); procedure TCEDServer.OnCanSend(ASocket: TLSocket);
ASocket.UserData := TNetState.Create(ASocket); var
SendPacket(TNetState(ASocket.UserData), TProtocolVersionPacket.Create(ProtocolVersion)); netState: TNetState;
end; size: Integer;
begin
procedure TCEDServer.OnCanSend(ASocket: TLSocket); //writeln('CanSend: ', ASocket.PeerAddress);
var netState := TNetState(ASocket.UserData);
netState: TNetState; if netState = nil then Exit;
size: Integer; while netState.SendQueue.Size > 0 do
begin begin
//writeln('CanSend: ', ASocket.PeerAddress); size := FTCPServer.Send(netState.SendQueue.Memory^, netState.SendQueue.Size, ASocket);
netState := TNetState(ASocket.UserData); if size > 0 then
if netState = nil then Exit; netState.SendQueue.Dequeue(size)
while netState.SendQueue.Size > 0 do else
begin Break;
size := FTCPServer.Send(netState.SendQueue.Memory^, netState.SendQueue.Size, ASocket); end;
if size > 0 then end;
netState.SendQueue.Dequeue(size)
else procedure TCEDServer.OnDisconnect(ASocket: TLSocket);
Break; var
end; netState: TNetState;
end; begin
writeln(TimeStamp, 'Disconnect: ', ASocket.PeerAddress);
procedure TCEDServer.OnDisconnect(ASocket: TLSocket); if ASocket.UserData <> nil then
var begin
netState: TNetState; netState := TNetState(ASocket.UserData);
begin ASocket.UserData := nil;
writeln(TimeStamp, 'Disconnect: ', ASocket.PeerAddress); if netState.Account <> nil then
if ASocket.UserData <> nil then SendPacket(nil, TClientDisconnectedPacket.Create(netState.Account.Name));
begin netState.Free;
netState := TNetState(ASocket.UserData); end;
ASocket.UserData := nil; end;
if netState.Account <> nil then
SendPacket(nil, TClientDisconnectedPacket.Create(netState.Account.Name)); procedure TCEDServer.OnReceive(ASocket: TLSocket);
netState.Free; var
end; netState: TNetState;
end; buffer: array[0..4095] of byte;
size: Integer;
procedure TCEDServer.OnReceive(ASocket: TLSocket); begin
var netState := TNetState(ASocket.UserData);
netState: TNetState; if netState <> nil then
buffer: array[0..4095] of byte; begin
size: Integer; repeat
begin size := FTCPServer.Get(buffer, 4096, ASocket);
netState := TNetState(ASocket.UserData); if size > 0 then
if netState <> nil then netState.ReceiveQueue.Enqueue(buffer, size);
begin until size <= 0;
repeat ProcessBuffer(netState);
size := FTCPServer.Get(buffer, 4096, ASocket); end;
if size > 0 then end;
netState.ReceiveQueue.Enqueue(buffer, size);
until size <= 0; procedure TCEDServer.OnError(const AError: string; ASocket: TLSocket);
ProcessBuffer(netState); begin
end; writeln(TimeStamp, 'Error: ', ASocket.PeerAddress, ' :: ', AError);
end; //OnDisconnect(ASocket);
end;
procedure TCEDServer.OnError(const AError: string; ASocket: TLSocket);
begin procedure TCEDServer.ProcessBuffer(ANetState: TNetState);
writeln(TimeStamp, 'Error: ', ASocket.PeerAddress, ' :: ', AError); var
//OnDisconnect(ASocket); buffer: TEnhancedMemoryStream;
end; packetID: Byte;
packetHandler: TPacketHandler;
procedure TCEDServer.ProcessBuffer(ANetState: TNetState); size: Cardinal;
var begin
buffer: TEnhancedMemoryStream; try
packetID: Byte; buffer := ANetState.ReceiveQueue;
packetHandler: TPacketHandler; buffer.Position := 0;
size: Cardinal; while (buffer.Size >= 1) and ANetState.Socket.Connected do
begin begin
try packetID := buffer.ReadByte;
buffer := ANetState.ReceiveQueue; packetHandler := PacketHandlers[packetID];
buffer.Position := 0; if packetHandler <> nil then
while (buffer.Size >= 1) and ANetState.Socket.Connected do begin
begin ANetState.LastAction := Now;
packetID := buffer.ReadByte; size := packetHandler.PacketLength;
packetHandler := PacketHandlers[packetID]; if size = 0 then
if packetHandler <> nil then begin
begin if buffer.Size > 5 then
ANetState.LastAction := Now; size := buffer.ReadCardinal
size := packetHandler.PacketLength; else
if size = 0 then Break; //wait for more data
begin end;
if buffer.Size > 5 then
size := buffer.ReadCardinal if buffer.Size >= size then
else begin
Break; //wait for more data buffer.Lock(buffer.Position, size - buffer.Position); //prevent handler from reading too much
end; packetHandler.Process(buffer, ANetState);
buffer.Unlock;
if buffer.Size >= size then buffer.Dequeue(size);
begin end else
buffer.Lock(buffer.Position, size - buffer.Position); //prevent handler from reading too much Break; //wait for more data
packetHandler.Process(buffer, ANetState); end else
buffer.Unlock; begin
buffer.Dequeue(size); Writeln(TimeStamp, 'Dropping client due to unknown packet [', packetID, ']: ', ANetState.Socket.PeerAddress);
end else Disconnect(ANetState.Socket);
Break; //wait for more data buffer.Clear;
end else end;
begin end;
Writeln(TimeStamp, 'Dropping client due to unknown packet [', packetID, ']: ', ANetState.Socket.PeerAddress); ANetState.LastAction := Now;
Disconnect(ANetState.Socket); except
buffer.Clear; Writeln(TimeStamp, 'Error processing buffer of client: ', ANetState.Socket.PeerAddress);
end; end;
end; end;
ANetState.LastAction := Now;
except procedure TCEDServer.CheckNetStates;
Writeln(TimeStamp, 'Error processing buffer of client: ', ANetState.Socket.PeerAddress); var
end; netState: TNetState;
end; begin
FTCPServer.IterReset;
procedure TCEDServer.CheckNetStates; while FTCPServer.IterNext do
var begin
netState: TNetState; netState := TNetState(FTCPServer.Iterator.UserData);
begin if netState <> nil then
FTCPServer.IterReset; begin
while FTCPServer.IterNext do if FTCPServer.Iterator.Connected then
begin begin
netState := TNetState(FTCPServer.Iterator.UserData); if (SecondsBetween(netState.LastAction, Now) > 120) then
if netState <> nil then begin
begin if netState.Account <> nil then
if FTCPServer.Iterator.Connected then Writeln(TimeStamp, 'Timeout: ', netState.Account.Name, ' (', netState.Socket.PeerAddress, ')')
begin else
if (SecondsBetween(netState.LastAction, Now) > 120) then Writeln(TimeStamp, 'Timeout: ', netState.Socket.PeerAddress);
begin Disconnect(netState.Socket);
if netState.Account <> nil then end;
Writeln(TimeStamp, 'Timeout: ', netState.Account.Name, ' (', netState.Socket.PeerAddress, ')') end else {TODO : Unnecessary ...}
else begin
Writeln(TimeStamp, 'Timeout: ', netState.Socket.PeerAddress); OnDisconnect(FTCPServer.Iterator);
Disconnect(netState.Socket); end;
end; end;
end else {TODO : Unnecessary ...} end;
begin end;
OnDisconnect(FTCPServer.Iterator);
end; procedure TCEDServer.Run;
end; begin
end; if not FValid then
end; begin
Writeln(TimeStamp, 'Invalid data. Check the map size and the files.');
procedure TCEDServer.Run; Exit;
begin end;
if not FValid then
begin if FTCPServer.Listen(Config.Port) then
Writeln(TimeStamp, 'Invalid data. Check the map size and the files.'); begin
Exit; repeat
end; FTCPServer.CallAction;
CheckNetStates;
if FTCPServer.Listen(Config.ReadInteger('Network', 'Port', 2597)) then if SecondsBetween(FLastFlush, Now) >= 60 then
begin begin
repeat FLandscape.Flush;
FTCPServer.CallAction; Config.Flush;
CheckNetStates; FLastFlush := Now;
if SecondsBetween(FLastFlush, Now) >= 60 then end;
begin Sleep(1);
FLandscape.Flush; until FQuit;
FLastFlush := Now; end;
end; end;
Sleep(1);
until FQuit; procedure TCEDServer.SendPacket(ANetState: TNetState; APacket: TPacket;
end; AFreePacket: Boolean = True);
end; var
netState: TNetState;
procedure TCEDServer.SendPacket(ANetState: TNetState; APacket: TPacket; begin
AFreePacket: Boolean = True); if ANetState <> nil then
var begin
netState: TNetState; ANetState.SendQueue.Seek(0, soFromEnd);
begin ANetState.SendQueue.CopyFrom(APacket.Stream, 0);
if ANetState <> nil then OnCanSend(ANetState.Socket);
begin end else //broadcast
ANetState.SendQueue.Seek(0, soFromEnd); begin
ANetState.SendQueue.CopyFrom(APacket.Stream, 0); FTCPServer.IterReset;
OnCanSend(ANetState.Socket); while FTCPServer.IterNext do
end else //broadcast begin
begin netState := TNetState(FTCPServer.Iterator.UserData);
FTCPServer.IterReset; if (netState <> nil) and (FTCPServer.Iterator.Connected) then
while FTCPServer.IterNext do begin
begin netState.SendQueue.Seek(0, soFromEnd);
netState := TNetState(FTCPServer.Iterator.UserData); netState.SendQueue.CopyFrom(APacket.Stream, 0);
if (netState <> nil) and (FTCPServer.Iterator.Connected) then OnCanSend(netState.Socket);
begin end;
netState.SendQueue.Seek(0, soFromEnd); end;
netState.SendQueue.CopyFrom(APacket.Stream, 0); end;
OnCanSend(netState.Socket); if AFreePacket then
end; APacket.Free;
end; end;
end;
if AFreePacket then procedure TCEDServer.Disconnect(ASocket: TLSocket);
APacket.Free; begin
end; if ASocket.Connected then
begin
procedure TCEDServer.Disconnect(ASocket: TLSocket); ASocket.Disconnect;
begin //OnDisconnect(ASocket);
if ASocket.Connected then //Handling of the disconnect is done in CheckNetStates after each CallAction
begin end;
ASocket.Disconnect; end;
//OnDisconnect(ASocket);
//Handling of the disconnect is done in CheckNetStates after each CallAction initialization
end; {$IFDEF Linux}
end; FpSignal(SIGINT, @OnSigInt);
FpSignal(SIGTERM, @OnSigInt); //SIGTERM should shutdown the server cleanly too
initialization //FpSignal(SIGSEGV, @OnSigSegv);
{$IFDEF Linux} {$ENDIF}
FpSignal(SIGINT, @OnSigInt); {$IFDEF Windows}
//FpSignal(SIGSEGV, @OnSigSegv); SetConsoleCtrlHandler(@OnConsoleCtrlEvent, True);
{$ENDIF} {$ENDIF}
{$IFDEF Windows}
SetConsoleCtrlHandler(@OnConsoleCtrlEvent, True); end.
{$ENDIF}
end.

414
Server/UClientHandling.pas
View File

@ -1,207 +1,207 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2007 Andreas Schneider
*) *)
unit UClientHandling; unit UClientHandling;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState, Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, math; UEnhancedMemoryStream, UEnums, math;
type type
{ TClientConnectedPacket } { TClientConnectedPacket }
TClientConnectedPacket = class(TPacket) TClientConnectedPacket = class(TPacket)
constructor Create(AUsername: string); constructor Create(AUsername: string);
end; end;
{ TClientDisconnectedPacket } { TClientDisconnectedPacket }
TClientDisconnectedPacket = class(TPacket) TClientDisconnectedPacket = class(TPacket)
constructor Create(AUsername: string); constructor Create(AUsername: string);
end; end;
{ TClientListPacket } { TClientListPacket }
TClientListPacket = class(TPacket) TClientListPacket = class(TPacket)
constructor Create(AAvoid: TNetState = nil); constructor Create(AAvoid: TNetState = nil);
end; end;
{ TSetClientPosPacket } { TSetClientPosPacket }
TSetClientPosPacket = class(TPacket) TSetClientPosPacket = class(TPacket)
constructor Create(APos: TPoint); constructor Create(APos: TPoint);
end; end;
{ TChatMessagePacket } { TChatMessagePacket }
TChatMessagePacket = class(TPacket) TChatMessagePacket = class(TPacket)
constructor Create(ASender, AMessage: string); constructor Create(ASender, AMessage: string);
end; end;
{ TAccessLevelChangedPacket } { TAccessLevelChangedPacket }
TAccessLevelChangedPacket = class(TPacket) TAccessLevelChangedPacket = class(TPacket)
constructor Create(AAccessLevel: TAccessLevel); constructor Create(AAccessLevel: TAccessLevel);
end; end;
procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var var
ClientPacketHandlers: array[0..$FF] of TPacketHandler; ClientPacketHandlers: array[0..$FF] of TPacketHandler;
implementation implementation
uses uses
UCEDServer, UPackets; UCEDServer, UPackets;
procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var var
packetHandler: TPacketHandler; packetHandler: TPacketHandler;
begin begin
if not ValidateAccess(ANetState, alView) then Exit; if not ValidateAccess(ANetState, alView) then Exit;
packetHandler := ClientPacketHandlers[ABuffer.ReadByte]; packetHandler := ClientPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState); packetHandler.Process(ABuffer, ANetState);
end; end;
procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream; procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState); ANetState: TNetState);
var var
pos: TPoint; pos: TPoint;
begin begin
pos.x := ABuffer.ReadWord; pos.x := ABuffer.ReadWord;
pos.y := ABuffer.ReadWord; pos.y := ABuffer.ReadWord;
ANetState.Account.LastPos := pos; ANetState.Account.LastPos := pos;
end; end;
procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream; procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState); ANetState: TNetState);
begin begin
CEDServerInstance.SendPacket(nil, TCompressedPacket.Create( CEDServerInstance.SendPacket(nil, TCompressedPacket.Create(
TChatMessagePacket.Create(ANetState.Account.Name, ABuffer.ReadStringNull))); TChatMessagePacket.Create(ANetState.Account.Name, ABuffer.ReadStringNull)));
end; end;
procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream; procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState); ANetState: TNetState);
var var
account: TAccount; account: TAccount;
begin begin
account := Accounts.Find(ABuffer.ReadStringNull); account := Config.Accounts.Find(ABuffer.ReadStringNull);
if account <> nil then if account <> nil then
CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos)); CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos));
end; end;
{ TClientConnectedPacket } { TClientConnectedPacket }
constructor TClientConnectedPacket.Create(AUsername: string); constructor TClientConnectedPacket.Create(AUsername: string);
begin begin
inherited Create($0C, 0); inherited Create($0C, 0);
FStream.WriteByte($01); FStream.WriteByte($01);
FStream.WriteStringNull(AUsername); FStream.WriteStringNull(AUsername);
end; end;
{ TClientDisconnectedPacket } { TClientDisconnectedPacket }
constructor TClientDisconnectedPacket.Create(AUsername: string); constructor TClientDisconnectedPacket.Create(AUsername: string);
begin begin
inherited Create($0C, 0); inherited Create($0C, 0);
FStream.WriteByte($02); FStream.WriteByte($02);
FStream.WriteStringNull(AUsername); FStream.WriteStringNull(AUsername);
end; end;
{ TClientListPacket } { TClientListPacket }
constructor TClientListPacket.Create(AAvoid: TNetState = nil); constructor TClientListPacket.Create(AAvoid: TNetState = nil);
var var
netState: TNetState; netState: TNetState;
begin begin
inherited Create($0C, 0); inherited Create($0C, 0);
FStream.WriteByte($03); FStream.WriteByte($03);
CEDServerInstance.TCPServer.IterReset; CEDServerInstance.TCPServer.IterReset;
if CEDServerInstance.TCPServer.Iterator <> nil then if CEDServerInstance.TCPServer.Iterator <> nil then
begin begin
repeat repeat
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData); netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState <> AAvoid) and (netState.Account <> nil) then if (netState <> nil) and (netState <> AAvoid) and (netState.Account <> nil) then
FStream.WriteStringNull(netState.Account.Name); FStream.WriteStringNull(netState.Account.Name);
until not CEDServerInstance.TCPServer.IterNext; until not CEDServerInstance.TCPServer.IterNext;
end; end;
end; end;
{ TSetClientPosPacket } { TSetClientPosPacket }
constructor TSetClientPosPacket.Create(APos: TPoint); constructor TSetClientPosPacket.Create(APos: TPoint);
begin begin
inherited Create($0C, 0); inherited Create($0C, 0);
FStream.WriteByte($04); FStream.WriteByte($04);
FStream.WriteWord(EnsureRange(APos.x, 0, CEDServerInstance.Landscape.CellWidth - 1)); FStream.WriteWord(EnsureRange(APos.x, 0, CEDServerInstance.Landscape.CellWidth - 1));
FStream.WriteWord(EnsureRange(APos.y, 0, CEDServerInstance.Landscape.CellHeight - 1)); FStream.WriteWord(EnsureRange(APos.y, 0, CEDServerInstance.Landscape.CellHeight - 1));
end; end;
{ TChatMessagePacket } { TChatMessagePacket }
constructor TChatMessagePacket.Create(ASender, AMessage: string); constructor TChatMessagePacket.Create(ASender, AMessage: string);
begin begin
inherited Create($0C, 0); inherited Create($0C, 0);
FStream.WriteByte($05); FStream.WriteByte($05);
FStream.WriteStringNull(ASender); FStream.WriteStringNull(ASender);
FStream.WriteStringNull(AMessage); FStream.WriteStringNull(AMessage);
end; end;
{ TAccessLevelChangedPacket } { TAccessLevelChangedPacket }
constructor TAccessLevelChangedPacket.Create(AAccessLevel: TAccessLevel); constructor TAccessLevelChangedPacket.Create(AAccessLevel: TAccessLevel);
begin begin
inherited Create($0C, 0); inherited Create($0C, 0);
FStream.WriteByte($07); FStream.WriteByte($07);
FStream.WriteByte(Byte(AAccessLevel)); FStream.WriteByte(Byte(AAccessLevel));
end; end;
{$WARNINGS OFF} {$WARNINGS OFF}
var var
i: Integer; i: Integer;
initialization initialization
for i := 0 to $FF do for i := 0 to $FF do
ClientPacketHandlers[i] := nil; ClientPacketHandlers[i] := nil;
ClientPacketHandlers[$04] := TPacketHandler.Create(0, @OnUpdateClientPosPacket); ClientPacketHandlers[$04] := TPacketHandler.Create(0, @OnUpdateClientPosPacket);
ClientPacketHandlers[$05] := TPacketHandler.Create(0, @OnChatMessagePacket); ClientPacketHandlers[$05] := TPacketHandler.Create(0, @OnChatMessagePacket);
ClientPacketHandlers[$06] := TPacketHandler.Create(0, @OnGotoClientPosPacket); ClientPacketHandlers[$06] := TPacketHandler.Create(0, @OnGotoClientPosPacket);
finalization finalization
for i := 0 to $FF do for i := 0 to $FF do
if ClientPacketHandlers[i] <> nil then if ClientPacketHandlers[i] <> nil then
ClientPacketHandlers[i].Free; ClientPacketHandlers[i].Free;
{$WARNINGS ON} {$WARNINGS ON}
end. end.

539
Server/UConfig.pas
View File

@ -1,182 +1,357 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2008 Andreas Schneider
*) *)
unit UConfig; unit UConfig;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, IniFiles, md5, Keyboard, UAccount; Classes, SysUtils, DOM, XMLRead, XMLWrite, md5, Keyboard, UAccount,
UXmlHelper, UInterfaces, UEnums;
var type
AppDir: string;
Config: TIniFile; TInvalidConfigVersionExeption = class(Exception);
Accounts: TAccountList;
{ TMapInfo }
procedure InitConfig;
function LoadConfig: Boolean; TMapInfo = class(TObject, ISerializable)
function TimeStamp: string; constructor Create(AOwner: IInvalidate);
constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
implementation procedure Serialize(AElement: TDOMElement);
protected
const FOwner: IInvalidate;
CONFIGVERSION = 2; FMapFile: string;
FStaticsFile: string;
function QueryPassword: String; FStaIdxFile: string;
var FWidth: Word;
pwChar: char; FHeight: Word;
begin procedure SetHeight(const AValue: Word);
Result := ''; procedure SetMapFile(const AValue: string);
procedure SetStaIdxFile(const AValue: string);
InitKeyboard; procedure SetStaticsFile(const AValue: string);
try procedure SetWidth(const AValue: Word);
repeat public
pwChar := GetKeyEventChar(TranslateKeyEvent(GetKeyEvent)); property MapFile: string read FMapFile write SetMapFile;
case pwChar of property StaticsFile: string read FStaticsFile write SetStaticsFile;
#8: Result := Copy(Result, 1, Length(Result) - 1); property StaIdxFile: string read FStaIdxFile write SetStaIdxFile;
#13: break; property Width: Word read FWidth write SetWidth;
else property Height: Word read FHeight write SetHeight;
Result := Result + pwChar; end;
end;
until pwChar = #13; { TConfig }
finally
DoneKeyboard; TConfig = class(TObject, ISerializable, IInvalidate)
end; constructor Create(AFilename: string);
writeln(''); constructor Init(AFilename: string);
end; destructor Destroy; override;
procedure Serialize(AElement: TDOMElement);
procedure InitConfig; protected
var FFilename: string;
configFile: string; FPort: Integer;
stringValue, password: string; FMap: TMapInfo;
intValue: Integer; FTiledata: string;
begin FRadarcol: string;
configFile := ChangeFileExt(ParamStr(0), '.ini'); FAccounts: TAccountList;
DeleteFile(configFile); FChanged: Boolean;
Config := TIniFile.Create(configFile); procedure SetPort(const AValue: Integer);
Config.WriteInteger('Config', 'Version', CONFIGVERSION); procedure SetRadarcol(const AValue: string);
procedure SetTiledata(const AValue: string);
Writeln('Configuring Network'); public
Writeln('==================='); property Port: Integer read FPort write SetPort;
Write ('Port [2597]: '); property Map: TMapInfo read FMap;
Readln (stringValue); property Tiledata: string read FTiledata write SetTiledata;
if not TryStrToInt(stringValue, intValue) then intValue := 2597; property Radarcol: string read FRadarcol write SetRadarcol;
Config.WriteInteger('Network', 'Port', intValue); property Accounts: TAccountList read FAccounts;
Writeln(''); procedure Flush;
procedure Invalidate;
Writeln('Configuring Paths'); end;
Writeln('=================');
Write ('map [map0.mul]: '); var
Readln (stringValue); AppDir: string;
if stringValue = '' then stringValue := 'map0.mul'; ConfigFile: string;
Config.WriteString('Paths', 'map', stringValue); Config: TConfig;
Write ('statics [statics0.mul]: ');
Readln (stringValue); function TimeStamp: string;
if stringValue = '' then stringValue := 'statics0.mul';
Config.WriteString('Paths', 'statics', stringValue); implementation
Write ('staidx [staidx0.mul]: ');
Readln (stringValue); const
if stringValue = '' then stringValue := 'staidx0.mul'; CONFIGVERSION = 3;
Config.WriteString('Paths', 'staidx', stringValue);
Write ('tiledata [tiledata.mul]: '); function QueryPassword: String;
Readln (stringValue); var
if stringValue = '' then stringValue := 'tiledata.mul'; pwChar: char;
Config.WriteString('Paths', 'tiledata', stringValue); begin
Write ('radarcol [radarcol.mul]: '); Result := '';
Readln (stringValue);
if stringValue = '' then stringValue := 'radarcol.mul'; InitKeyboard;
Config.WriteString('Paths', 'radarcol', stringValue); try
Writeln(''); repeat
pwChar := GetKeyEventChar(TranslateKeyEvent(GetKeyEvent));
Writeln('Parameters'); case pwChar of
Writeln('=========='); #8: Result := Copy(Result, 1, Length(Result) - 1);
Write ('Map width [768]: '); #13: break;
Readln (stringValue); else
if not TryStrToInt(stringValue, intValue) then intValue := 768; Result := Result + pwChar;
Config.WriteInteger('Parameters', 'Width', intValue); end;
Write ('Map height [512]: '); until pwChar = #13;
Readln (stringValue); finally
if not TryStrToInt(stringValue, intValue) then intValue := 512; DoneKeyboard;
Config.WriteInteger('Parameters', 'Height', intValue); end;
Writeln(''); writeln('');
end;
Writeln('Admin account');
Writeln('============='); function TimeStamp: string;
repeat begin
Write('Account name: '); Result := '[' + DateTimeToStr(Now) + '] ';
Readln(stringValue); end;
until stringValue <> '';
Write ('Password [hidden]: '); { TMapInfo }
password := QueryPassword;
Config.WriteString('Accounts', stringValue, '255:' + MD5Print(MD5String(password))); constructor TMapInfo.Create(AOwner: IInvalidate);
end; begin
inherited Create;
function LoadConfig: Boolean; FOwner := AOwner;
var end;
configFile: string;
values: TStringList; constructor TMapInfo.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
i: Integer; begin
begin Create(AOwner);
configFile := ChangeFileExt(ParamStr(0), '.ini'); FMapFile := TXmlHelper.ReadString(AElement, 'Map', 'map0.mul');
if FileExists(configFile) then FStaIdxFile := TXmlHelper.ReadString(AElement, 'StaIdx', 'staidx0.mul');
begin FStaticsFile := TXmlHelper.ReadString(AElement, 'Statics', 'statics0.mul');
Config := TIniFile.Create(configFile); FWidth := TXmlHelper.ReadInteger(AElement, 'Width', 768);
Result := (Config.ReadInteger('Config', 'Version', 0) = CONFIGVERSION); FHeight := TXmlHelper.ReadInteger(AElement, 'Height', 512);
if Result then end;
begin
Accounts := TAccountList.Create; procedure TMapInfo.Serialize(AElement: TDOMElement);
values := TStringList.Create; begin
Config.ReadSectionRaw('Accounts', values); TXmlHelper.WriteString(AElement, 'Map', FMapFile);
for i := 0 to values.Count - 1 do TXmlHelper.WriteString(AElement, 'StaIdx', FStaIdxFile);
Accounts.Add(TAccount.Create(values.Strings[i])); TXmlHelper.WriteString(AElement, 'Statics', FStaticsFile);
values.Free; TXmlHelper.WriteInteger(AElement, 'Width', FWidth);
end; TXmlHelper.WriteInteger(AElement, 'Height', FHeight);
end else end;
Result := False;
end; procedure TMapInfo.SetHeight(const AValue: Word);
begin
function TimeStamp: string; FHeight := AValue;
begin FOwner.Invalidate;
Result := '[' + DateTimeToStr(Now) + '] '; end;
end;
procedure TMapInfo.SetMapFile(const AValue: string);
initialization begin
begin FMapFile := AValue;
AppDir := ExtractFilePath(ParamStr(0)); FOwner.Invalidate;
if AppDir[Length(AppDir)] <> PathDelim then end;
AppDir := AppDir + PathDelim;
end; procedure TMapInfo.SetStaIdxFile(const AValue: string);
begin
finalization FStaIdxFile := AValue;
begin FOwner.Invalidate;
if Config <> nil then FreeAndNil(Config); end;
if Accounts <> nil then FreeAndNil(Accounts);
end; procedure TMapInfo.SetStaticsFile(const AValue: string);
begin
end. FStaticsFile := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetWidth(const AValue: Word);
begin
FWidth := 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);
if not ((xmlDoc.DocumentElement.NodeName = 'CEDConfig') and
TryStrToInt(xmlDoc.DocumentElement.AttribStrings['Version'], version) and
(version = CONFIGVERSION)) then
raise TInvalidConfigVersionExeption.Create(Format('%d <> %d', [version, CONFIGVERSION]));
FPort := TXmlHelper.ReadInteger(xmlDoc.DocumentElement, 'Port', 2597);
xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Map'));
if not assigned(xmlElement) then
raise TInvalidConfigVersionExeption.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');
xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Accounts'));
if not assigned(xmlElement) then
raise TInvalidConfigVersionExeption.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);
Writeln('Configuring Network');
Writeln('===================');
Write ('Port [2597]: ');
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 2597;
FPort := intValue;
Writeln('');
Writeln('Configuring Paths');
Writeln('=================');
Write ('map [map0.mul]: ');
Readln (FMap.MapFile);
if FMap.MapFile = '' then FMap.MapFile := 'map0.mul';
Write ('statics [statics0.mul]: ');
Readln (FMap.StaticsFile);
if FMap.StaticsFile = '' then FMap.StaticsFile := 'statics0.mul';
Write ('staidx [staidx0.mul]: ');
Readln (FMap.StaIdxFile);
if FMap.StaIdxFile = '' then FMap.StaIdxFile := 'staidx0.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('Parameters');
Writeln('==========');
Write ('Map width [768]: ');
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 768;
FMap.Width := intValue;
Write ('Map height [512]: ');
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 512;
FMap.Height := intValue;
Writeln('');
Writeln('Admin account');
Writeln('=============');
repeat
Write('Account name: ');
Readln(stringValue);
until stringValue <> '';
Write ('Password [hidden]: ');
password := QueryPassword;
FAccounts.Add(TAccount.Create(FAccounts, stringValue,
MD5Print(MD5String(password)), alAdministrator));
FChanged := True;
end;
destructor TConfig.Destroy;
begin
if Assigned(FMap) then FreeAndNil(FMap);
if Assigned(FAccounts) then FreeAndNil(FAccounts);
inherited Destroy;
end;
procedure TConfig.Serialize(AElement: TDOMElement);
begin
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'));
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;
{TODO : add command line parameter to specify the config}
Config := nil;
ConfigFile := ChangeFileExt(ParamStr(0), '.xml');
end;
end.

393
Server/UConnectionHandling.pas
View File

@ -1,195 +1,198 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2008 Andreas Schneider
*) *)
unit UConnectionHandling; unit UConnectionHandling;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState, Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums; UEnhancedMemoryStream, UEnums;
type type
{ TProtocolVersion } { TProtocolVersion }
TProtocolVersionPacket = class(TPacket) TProtocolVersionPacket = class(TPacket)
constructor Create(AVersion: Cardinal); constructor Create(AVersion: Cardinal);
end; end;
{ TLoginResponsePacket } { TLoginResponsePacket }
TLoginResponsePacket = class(TPacket) TLoginResponsePacket = class(TPacket)
constructor Create(AState: TLoginState; AAccessLevel: TAccessLevel = alNone); constructor Create(AState: TLoginState; AAccessLevel: TAccessLevel = alNone);
end; end;
{ TServerStatePacket } { TServerStatePacket }
TServerStatePacket = class(TPacket) TServerStatePacket = class(TPacket)
constructor Create(AState: TServerState; AMessage: string = ''); constructor Create(AState: TServerState; AMessage: string = '');
end; end;
procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var var
ConnectionPacketHandlers: array[0..$FF] of TPacketHandler; ConnectionPacketHandlers: array[0..$FF] of TPacketHandler;
implementation implementation
uses uses
md5, UCEDServer, UClientHandling, UPackets; md5, UCEDServer, UClientHandling, UPackets;
procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var var
packetHandler: TPacketHandler; packetHandler: TPacketHandler;
begin begin
packetHandler := ConnectionPacketHandlers[ABuffer.ReadByte]; packetHandler := ConnectionPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState); packetHandler.Process(ABuffer, ANetState);
end; end;
procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream; procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState); ANetState: TNetState);
var var
username, passwordHash: string; username, passwordHash: string;
account: TAccount; account: TAccount;
pwHash: string; pwHash: string;
netState: TNetState; netState: TNetState;
invalid: Boolean; invalid: Boolean;
begin begin
username := ABuffer.ReadStringNull; username := ABuffer.ReadStringNull;
passwordHash := MD5Print(MD5String(ABuffer.ReadStringNull)); passwordHash := MD5Print(MD5String(ABuffer.ReadStringNull));
account := Accounts.Find(username); account := Config.Accounts.Find(username);
if account <> nil then if account <> nil then
begin begin
if account.AccessLevel > alNone then if account.AccessLevel > alNone then
begin begin
if account.PasswordHash = passwordHash then if account.PasswordHash = passwordHash then
begin begin
invalid := False; invalid := False;
CEDServerInstance.TCPServer.IterReset; CEDServerInstance.TCPServer.IterReset;
if CEDServerInstance.TCPServer.Iterator <> nil then if CEDServerInstance.TCPServer.Iterator <> nil then
begin begin
repeat repeat
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData); netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then if (netState <> nil) and (netState.Account = account) then
begin begin
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsAlreadyLoggedIn)); CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsAlreadyLoggedIn));
CEDServerInstance.Disconnect(ANetState.Socket); CEDServerInstance.Disconnect(ANetState.Socket);
invalid := True; invalid := True;
Break; Break;
end; end;
until not CEDServerInstance.TCPServer.IterNext; until not CEDServerInstance.TCPServer.IterNext;
end; end;
if not invalid then if not invalid then
begin begin
Writeln(TimeStamp, 'Login (', username, '): ', ANetState.Socket.PeerAddress); Writeln(TimeStamp, 'Login (', username, '): ', ANetState.Socket.PeerAddress);
ANetState.Account := account; ANetState.Account := account;
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsOK, account.AccessLevel)); CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsOK, account.AccessLevel));
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create( CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
TClientListPacket.Create(ANetState))); TClientListPacket.Create(ANetState)));
CEDServerInstance.SendPacket(nil, TClientConnectedPacket.Create(username)); CEDServerInstance.SendPacket(nil, TClientConnectedPacket.Create(username));
CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos)); CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos));
end; end;
end else end else
begin begin
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidPassword)); Writeln(TimeStamp, 'Invalid password for ', username);
CEDServerInstance.Disconnect(ANetState.Socket); CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidPassword));
end; CEDServerInstance.Disconnect(ANetState.Socket);
end else end;
begin end else
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsNoAccess)); begin
CEDServerInstance.Disconnect(ANetState.Socket); Writeln(TimeStamp, 'Access denied for ', username);
end; CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsNoAccess));
end else CEDServerInstance.Disconnect(ANetState.Socket);
begin end;
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidUser)); end else
CEDServerInstance.Disconnect(ANetState.Socket); begin
end; Writeln(TimeStamp, 'Invalid account specified: ', ANetState.Socket.PeerAddress);
end; CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidUser));
CEDServerInstance.Disconnect(ANetState.Socket);
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); end;
begin end;
CEDServerInstance.Disconnect(ANetState.Socket);
end; procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
{ TProtocolVersionPacket } CEDServerInstance.Disconnect(ANetState.Socket);
end;
constructor TProtocolVersionPacket.Create(AVersion: Cardinal);
begin { TProtocolVersionPacket }
inherited Create($02, 0);
FStream.WriteByte($01); constructor TProtocolVersionPacket.Create(AVersion: Cardinal);
FStream.WriteCardinal(AVersion); begin
end; inherited Create($02, 0);
FStream.WriteByte($01);
{ TLoginResponsePacket } FStream.WriteCardinal(AVersion);
end;
constructor TLoginResponsePacket.Create(AState: TLoginState;
AAccessLevel: TAccessLevel = alNone); { TLoginResponsePacket }
begin
inherited Create($02, 0); constructor TLoginResponsePacket.Create(AState: TLoginState;
FStream.WriteByte($03); AAccessLevel: TAccessLevel = alNone);
FStream.WriteByte(Byte(AState)); begin
if AState = lsOK then inherited Create($02, 0);
begin FStream.WriteByte($03);
FStream.WriteByte(Byte(AAccessLevel)); FStream.WriteByte(Byte(AState));
FStream.WriteWord(Config.ReadInteger('Parameters', 'Width', 768)); if AState = lsOK then
FStream.WriteWord(Config.ReadInteger('Parameters', 'Height', 512)); begin
end; FStream.WriteByte(Byte(AAccessLevel));
end; FStream.WriteWord(Config.Map.Width);
FStream.WriteWord(Config.Map.Height);
{ TServerStatePacket } end;
end;
constructor TServerStatePacket.Create(AState: TServerState; AMessage: string = '');
begin { TServerStatePacket }
inherited Create($02, 0);
FStream.WriteByte($04); constructor TServerStatePacket.Create(AState: TServerState; AMessage: string = '');
FStream.WriteByte(Byte(AState)); begin
if AState = ssOther then inherited Create($02, 0);
FStream.WriteStringNull(AMessage); FStream.WriteByte($04);
end; FStream.WriteByte(Byte(AState));
if AState = ssOther then
{$WARNINGS OFF} FStream.WriteStringNull(AMessage);
var end;
i: Integer;
{$WARNINGS OFF}
initialization var
for i := 0 to $FF do i: Integer;
ConnectionPacketHandlers[i] := nil;
ConnectionPacketHandlers[$03] := TPacketHandler.Create(0, @OnLoginRequestPacket); initialization
ConnectionPacketHandlers[$05] := TPacketHandler.Create(0, @OnQuitPacket); for i := 0 to $FF do
finalization ConnectionPacketHandlers[i] := nil;
for i := 0 to $FF do ConnectionPacketHandlers[$03] := TPacketHandler.Create(0, @OnLoginRequestPacket);
if ConnectionPacketHandlers[i] <> nil then ConnectionPacketHandlers[$05] := TPacketHandler.Create(0, @OnQuitPacket);
ConnectionPacketHandlers[i].Free; finalization
{$WARNINGS ON} for i := 0 to $FF do
if ConnectionPacketHandlers[i] <> nil then
end. ConnectionPacketHandlers[i].Free;
{$WARNINGS ON}
end.

2
Server/ULandscape.pas
View File

@ -30,7 +30,7 @@ unit ULandscape;
interface interface
uses uses
SysUtils, Classes, contnrs, UGenericIndex, UMap, UStatics, UTileData, SysUtils, Classes, contnrs, UGenericIndex, UMap, UStatics, UTiledata,
UWorldItem, UMulBlock, math, UWorldItem, UMulBlock, math,
UTileDataProvider, URadarMap, UTileDataProvider, URadarMap,
UListSort, UCacheManager, ULinkedList, UBufferedStreams, UListSort, UCacheManager, ULinkedList, UBufferedStreams,

10
Server/cedserver.lpi
View File

@ -14,7 +14,6 @@
</VersionInfo> </VersionInfo>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions> </PublishOptions>
@ -29,7 +28,7 @@
<PackageName Value="lnetbase"/> <PackageName Value="lnetbase"/>
</Item1> </Item1>
</RequiredPackages> </RequiredPackages>
<Units Count="8"> <Units Count="9">
<Unit0> <Unit0>
<Filename Value="cedserver.lpr"/> <Filename Value="cedserver.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -70,6 +69,11 @@
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="ULargeScaleOperations"/> <UnitName Value="ULargeScaleOperations"/>
</Unit7> </Unit7>
<Unit8>
<Filename Value="../UInterfaces.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UInterfaces"/>
</Unit8>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
@ -89,7 +93,7 @@
<Optimizations> <Optimizations>
<OptimizationLevel Value="3"/> <OptimizationLevel Value="3"/>
</Optimizations> </Optimizations>
<TargetOS Value="Win32"/> <TargetOS Value="Linux"/>
</CodeGeneration> </CodeGeneration>
<Linking> <Linking>
<Debugging> <Debugging>

148
Server/cedserver.lpr
View File

@ -1,75 +1,73 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2008 Andreas Schneider
*) *)
program cedserver; program cedserver;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
uses uses
{$IFDEF UNIX}{$IFDEF UseCThreads} {$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads, cthreads,
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
SysUtils, Classes, SysUtils, Classes,
lnetbase, lnetbase,
UConfig, UCEDServer, URadarMap, ULargeScaleOperations; UConfig, UCEDServer, URadarMap, ULargeScaleOperations;
{$I version.inc} {$I version.inc}
begin begin
Writeln('UO CentrED Server Version ', ProductVersion); Writeln('UO CentrED Server Version ', ProductVersion);
Writeln('Copyright ', Copyright); Writeln('Copyright ', Copyright);
//Writeln('================================'); //Writeln('================================');
Writeln(''); Writeln('');
{$IFDEF Windows} {$IFDEF Windows}
if not LoadConfig then if FileExists(ConfigFile) then
begin Config := TConfig.Create(ConfigFile)
InitConfig; else
Writeln(''); Config := TConfig.Init(ConfigFile);
end; {$ELSE}
{$ELSE} if ParamStr(1) = '--init' then
if ParamStr(1) = '--init' then Config := TConfig.Init(ConfigFile)
begin else if FileExists(ConfigFile) then
InitConfig; Config := TConfig.Create(ConfigFile)
Halt; else begin
end; Writeln('No valid config file was found. Use --init to create one.');
Halt;
if not LoadConfig then end;
begin {$ENDIF}
Writeln('No valid config file was found. Use --init to create one.');
Halt; Write(TimeStamp, 'Initializing ... ');
end; Randomize;
{$ENDIF} CEDServerInstance := TCEDServer.Create;
Writeln('Done');
Write(TimeStamp, 'Initializing ... '); CEDServerInstance.Run;
Randomize; Write(TimeStamp, 'Terminating ... ');
CEDServerInstance := TCEDServer.Create; FreeAndNil(CEDServerInstance);
Writeln('Done'); Config.Flush;
CEDServerInstance.Run; FreeAndNil(Config);
Write(TimeStamp, 'Terminating ... '); Writeln('Done');
CEDServerInstance.Free; end.
Writeln('Done');
end.

75
UIStream.pas
View File

@ -1,75 +0,0 @@
(*
* 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 2007 Andreas Schneider
*)
{This unit contains the interface for objects which offer read/write access and
therefore streaming capability.
@author(Andreas Schneider <aksdb@gmx.de>)
@created(2007-07-08)
@lastmod(2007-11-14)}
unit UIStream;
{$mode objfpc}{$H+}
{$interfaces corba}
interface
uses
Classes;
type
{@abstract(The @name interface is used in objects which offer read/write access and
therefore streaming capability.)}
IStream = interface
function ReadBoolean: Boolean; //<Reads a @link(Boolean) at the current position. @returns(The @link(Boolean) at the current position.)
function ReadByte: Byte; //<Reads a @link(Byte) at the current position. @returns(The @link(Byte) at the current position.)
function ReadCardinal: Cardinal; //<Reads a @link(Cardinal) at the current position. @returns(The @link(Cardinal) at the current position.)
function ReadInteger: Integer; //<Reads a @link(Integer) at the current position. @returns(The @link(Integer) at the current position.)
function ReadInt64: Int64; //<Reads a @link(Int64) at the current position. @returns(The @link(Int64) at the current position.)
function ReadSmallInt: SmallInt; //<Reads a @link(SmallInt) at the current position. @returns(The @link(SmallInt) at the current position.)
function ReadWord: Word; //<Reads a @link(Word) at the current position. @returns(The @link(Word) at the current position.)
function ReadString: string; //<Reads a @link(String) at the current position, by first querying the size (read as @link(Integer)). @returns(The @link(String) at the current position.)
function ReadStringFixed(ALength: Integer): string; //<Reads a @link(String) at the current position with the given length. @param(ALength The length of the @link(String) to be read.) @returns(The @link(String) at the current position.)
procedure WriteBoolean(AValue: Boolean); //<Writes a @link(Boolean) to the current position. @param(AValue The @link(Boolean) value to be written.)
procedure WriteByte(AValue: Byte); //<Writes a @link(Byte) to the current position. @param(AValue The @link(Byte) value to be written.)
procedure WriteCardinal(AValue: Cardinal); //<Writes a @link(Cardinal) to the current position. @param(AValue The @link(Cardinal) value to be written.)
procedure WriteInteger(AValue: Integer); //<Writes a @link(Integer) to the current position. @param(AValue The @link(Integer) value to be written.)
procedure WriteInt64(AValue: Int64); //<Writes a @link(Int64) to the current position. @param(AValue The @link(Int64) value to be written.)
procedure WriteSmallInt(AValue: SmallInt); //<Writes a @link(SmallInt) to the current position. @param(AValue The @link(SmallInt) value to be written.)
procedure WriteWord(AValue: Word); //<Writes a @link(Word) to the current position. @param(AValue The @link(Word) value to be written.)
procedure WriteString(AValue: string); //<Writes a @link(String) to the current position, preceeded by the length as @link(Integer). @param(AValue The @link(String) value to be written.)
procedure WriteStringFixed(AValue: string; ALength: Integer); //<Writes a @link(String) with the given length to the current position. @param(AValue The @link(String) value to be written.) @param(ALength The length of the @link(String).)
function Read(ABuffer: PByte; ACount: Cardinal): Cardinal; //<Reads a given number of bytes from the stream. @param(ABuffer A Pointer to the memory to write to.) @param(ACount The number of bytes to read.) @returns(The number of bytes actually read.)
function Write(ABuffer: PByte; ACount: Cardinal): Cardinal; //<Writes a given buffer to the stream. @param(ABuffer A Pointer to the memory to write to the stream.) @param(ACount The number of bytes to write.) @returns(The number of bytes actually written.)
procedure Skip(ACount: Cardinal); //<Skips a certain number of bytes from the current position. @param(ACount The number of bytes to skip.)
end;
implementation
end.

47
UInterfaces.pas Normal file
View File

@ -0,0 +1,47 @@
(*
* 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 UInterfaces;
{$mode objfpc}{$H+}
{$interfaces corba}
interface
uses
Classes, SysUtils, DOM;
type
ISerializable = interface
procedure Serialize(AElement: TDOMElement);
end;
IInvalidate = interface
procedure Invalidate;
end;
implementation
end.

4
UStreamHelper.pas
View File

@ -43,7 +43,7 @@ unit UStreamHelper;
interface interface
uses uses
Classes, RtlConsts, SysUtils, UIStream; Classes, RtlConsts, SysUtils;
type type
{@name is the stub for the method which will handle the OnProgress callbacks. {@name is the stub for the method which will handle the OnProgress callbacks.
@ -94,7 +94,7 @@ type
//generic TStreamWrapper<TStreamType> = class(TObject{, IStream}) //generic TStreamWrapper<TStreamType> = class(TObject{, IStream})
{@abstract(@name implements @link(IStream) and offers a bunch of functions to {@abstract(@name implements @link(IStream) and offers a bunch of functions to
ease reading and writing special types (like @link(Integer)s or @link(String)s.))} ease reading and writing special types (like @link(Integer)s or @link(String)s.))}
TStreamWrapper = class(TObject, IStream) TStreamWrapper = class(TObject)
constructor Create(AStream: TStreamType; AOwnsStream: Boolean = True); //<Creates a new instance of @classname. @param(AStream The underlying stream to perform the actual operations on.) @param(AOwnsStream Defines wheather to free the stream on destruction of @classname or not. Defaults to @false.) constructor Create(AStream: TStreamType; AOwnsStream: Boolean = True); //<Creates a new instance of @classname. @param(AStream The underlying stream to perform the actual operations on.) @param(AOwnsStream Defines wheather to free the stream on destruction of @classname or not. Defaults to @false.)
destructor Destroy; override; //<Is called when the current instance of @classname is destroyed. If it owns the underlying stream it is destroyed aswell. destructor Destroy; override; //<Is called when the current instance of @classname is destroyed. If it owns the underlying stream it is destroyed aswell.
protected protected

140
UXmlHelper.pas Normal file
View File

@ -0,0 +1,140 @@
(*
* 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 UXmlHelper;
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, dom;
type
{ TXmlHelper }
TXmlHelper = class(TObject)
class function AssureElement(AParent: TDOMElement; AName: string): TDOMElement;
class procedure WriteString(AParent: TDOMElement; AName, AValue: string);
class function ReadString(AParent: TDOMElement; AName, ADefault: string): string;
class procedure WriteInteger(AParent: TDOMElement; AName: string; AValue: Integer);
class function ReadInteger(AParent: TDOMElement; AName: string; ADefault: Integer): Integer;
class procedure WriteBoolean(AParent: TDOMElement; AName: string; AValue: Boolean);
class function ReadBoolean(AParent: TDOMElement; AName: string; ADefault: Boolean): Boolean;
class procedure WriteCoords(AParent: TDOMElement; AName: string; AX, AY: Integer);
class function ReadCoords(AParent: TDOMElement; AName: string; out X, Y: Integer): Boolean;
end;
implementation
{ TXmlHelper }
class function TXmlHelper.AssureElement(AParent: TDOMElement; AName: string): TDOMElement;
begin
Result := TDOMElement(AParent.FindNode(AName));
if not assigned(Result) then
begin
Result := AParent.OwnerDocument.CreateElement(AName);
AParent.AppendChild(Result);
end;
end;
class procedure TXmlHelper.WriteString(AParent: TDOMElement; AName, AValue: string);
var
element: TDOMElement;
begin
element := AssureElement(AParent, AName);
if assigned(element.FirstChild) then
TDOMText(element.FirstChild).NodeValue := AValue
else
element.AppendChild(AParent.OwnerDocument.CreateTextNode(AValue));
end;
class function TXmlHelper.ReadString(AParent: TDOMElement; AName, ADefault: string): string;
var
element: TDOMElement;
begin
element := TDOMElement(AParent.FindNode(AName));
if assigned(element) and assigned(element.FirstChild) then
Result := TDOMText(element.FirstChild).Data
else
Result := ADefault;
end;
class procedure TXmlHelper.WriteInteger(AParent: TDOMElement; AName: string;
AValue: Integer);
begin
WriteString(AParent, AName, IntToStr(AValue));
end;
class function TXmlHelper.ReadInteger(AParent: TDOMElement; AName: string;
ADefault: Integer): Integer;
begin
if not TryStrToInt(ReadString(AParent, AName, ''), Result) then
Result := ADefault;
end;
class procedure TXmlHelper.WriteBoolean(AParent: TDOMElement; AName: string;
AValue: Boolean);
begin
WriteString(AParent, AName, BoolToStr(AValue));
end;
class function TXmlHelper.ReadBoolean(AParent: TDOMElement; AName: string;
ADefault: Boolean): Boolean;
begin
Result := StrToBool(ReadString(AParent, AName, BoolToStr(ADefault)));
end;
class procedure TXmlHelper.WriteCoords(AParent: TDOMElement; AName: string; AX,
AY: Integer);
var
element: TDOMElement;
begin
element := AssureElement(AParent, AName);
element.AttribStrings['x'] := IntToStr(AX);
element.AttribStrings['y'] := IntToStr(AY);
end;
class function TXmlHelper.ReadCoords(AParent: TDOMElement; AName: string; out
X, Y: Integer): Boolean;
var
element: TDOMElement;
tempX, tempY: Integer;
begin
element := TDOMElement(AParent.FindNode(AName));
Result := assigned(element) and TryStrToInt(element.AttribStrings['x'], tempX)
and TryStrToInt(element.AttribStrings['y'], tempY);
if Result then
begin
X := tempX;
Y := tempY;
end;
end;
end.