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

312
Client/Tools/UfrmHueSettings.pas
View File

@ -1,156 +1,156 @@
(*
* 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
*)
unit UfrmHueSettings;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
LMessages, LCLIntf, UHue;
type
{ TfrmHueSettings }
TfrmHueSettings = class(TForm)
edHue: TEdit;
lblHue: TLabel;
lbHue: TListBox;
procedure edHueEditingDone(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure lbHueDrawItem(Control: TWinControl; Index: Integer; ARect: TRect;
State: TOwnerDrawState);
procedure lbHueSelectionChange(Sender: TObject; User: boolean);
protected
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
public
class procedure DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect;
ACaption: string);
end;
var
frmHueSettings: TfrmHueSettings;
implementation
uses
UGameResources, UGraphicHelper;
{ TfrmHueSettings }
procedure TfrmHueSettings.FormClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
CloseAction := caHide;
end;
procedure TfrmHueSettings.edHueEditingDone(Sender: TObject);
var
hueID: Integer;
begin
if (not TryStrToInt(edHue.Text, hueID)) or (hueID >= lbHue.Items.Count) then
begin
edHue.Text := Format('$%x', [lbHue.ItemIndex]);
MessageDlg('Invalid Hue', 'The hue you''ve entered is invalid.', mtWarning, [mbOK], 0);
end else
lbHue.ItemIndex := hueID;
end;
procedure TfrmHueSettings.FormCreate(Sender: TObject);
var
i: Integer;
hue: THue;
begin
lbHue.Clear;
lbHue.Items.Add('$0 (no hue)');
for i := 1 to ResMan.Hue.Count do
begin
hue := ResMan.Hue.Hues[i-1];
lbHue.Items.AddObject(Format('$%x (%s)', [i, hue.Name]), hue);
end;
lbHue.ItemIndex := 0;
end;
procedure TfrmHueSettings.FormDeactivate(Sender: TObject);
begin
Close;
end;
procedure TfrmHueSettings.lbHueDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
var
hue: THue;
begin
if Index > 0 then
hue := ResMan.Hue.Hues[Index-1]
else
hue := nil;
DrawHue(hue, lbHue.Canvas, ARect, lbHue.Items.Strings[Index]);
end;
procedure TfrmHueSettings.lbHueSelectionChange(Sender: TObject; User: boolean);
begin
edHue.Text := Format('$%x', [lbHue.ItemIndex]);
end;
procedure TfrmHueSettings.MouseLeave(var msg: TLMessage);
begin
try
if not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos)) then
Close;
except
Close;
end;
end;
class procedure TfrmHueSettings.DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect;
ACaption: string);
var
hueColor: TColor;
i: Integer;
begin
ACanvas.Pen.Color := clWhite;
ACanvas.Rectangle(ARect);
if AHue <> nil then
for i := 0 to 31 do
begin
hueColor := ARGB2RGB(AHue.ColorTable[i]);
ACanvas.Pen.Color := hueColor;
ACanvas.MoveTo(ARect.Left + 2 + i, ARect.Top + 1);
ACanvas.LineTo(ARect.Left + 2 + i, ARect.Bottom - 1);
end;
ACanvas.TextOut(ARect.Left + 36, ARect.Top, ACaption);
end;
initialization
{$I UfrmHueSettings.lrs}
end.
(*
* 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
*)
unit UfrmHueSettings;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
LMessages, LCLIntf, UHue;
type
{ TfrmHueSettings }
TfrmHueSettings = class(TForm)
edHue: TEdit;
lblHue: TLabel;
lbHue: TListBox;
procedure edHueEditingDone(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure lbHueDrawItem(Control: TWinControl; Index: Integer; ARect: TRect;
State: TOwnerDrawState);
procedure lbHueSelectionChange(Sender: TObject; User: boolean);
protected
procedure MouseLeave(var msg: TLMessage); message CM_MouseLeave;
public
class procedure DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect;
ACaption: string);
end;
var
frmHueSettings: TfrmHueSettings;
implementation
uses
UGameResources, UGraphicHelper;
{ TfrmHueSettings }
procedure TfrmHueSettings.FormClose(Sender: TObject;
var CloseAction: TCloseAction);
begin
CloseAction := caHide;
end;
procedure TfrmHueSettings.edHueEditingDone(Sender: TObject);
var
hueID: Integer;
begin
if (not TryStrToInt(edHue.Text, hueID)) or (hueID >= lbHue.Items.Count) then
begin
edHue.Text := Format('$%x', [lbHue.ItemIndex]);
MessageDlg('Invalid Hue', 'The hue you''ve entered is invalid.', mtWarning, [mbOK], 0);
end else
lbHue.ItemIndex := hueID;
end;
procedure TfrmHueSettings.FormCreate(Sender: TObject);
var
i: Integer;
hue: THue;
begin
lbHue.Clear;
lbHue.Items.Add('$0 (no hue)');
for i := 1 to ResMan.Hue.Count do
begin
hue := ResMan.Hue.Hues[i-1];
lbHue.Items.AddObject(Format('$%x (%s)', [i, hue.Name]), hue);
end;
lbHue.ItemIndex := 0;
end;
procedure TfrmHueSettings.FormDeactivate(Sender: TObject);
begin
Close;
end;
procedure TfrmHueSettings.lbHueDrawItem(Control: TWinControl; Index: Integer;
ARect: TRect; State: TOwnerDrawState);
var
hue: THue;
begin
if Index > 0 then
hue := ResMan.Hue.Hues[Index-1]
else
hue := nil;
DrawHue(hue, lbHue.Canvas, ARect, lbHue.Items.Strings[Index]);
end;
procedure TfrmHueSettings.lbHueSelectionChange(Sender: TObject; User: boolean);
begin
edHue.Text := Format('$%x', [lbHue.ItemIndex]);
end;
procedure TfrmHueSettings.MouseLeave(var msg: TLMessage);
begin
try
if not PtInRect(ClientRect, ScreenToClient(Mouse.CursorPos)) then
Close;
except
Close;
end;
end;
class procedure TfrmHueSettings.DrawHue(AHue: THue; ACanvas: TCanvas; ARect: TRect;
ACaption: string);
var
hueColor: TColor;
i: Integer;
begin
ACanvas.Pen.Color := clWhite;
ACanvas.Rectangle(ARect);
if AHue <> nil then
for i := 0 to 31 do
begin
hueColor := ARGB2RGB(AHue.ColorTable[i]);
ACanvas.Pen.Color := hueColor;
ACanvas.MoveTo(ARect.Left + 2 + i, ARect.Top + 1);
ACanvas.LineTo(ARect.Left + 2 + i, ARect.Bottom - 1);
end;
ACanvas.TextOut(ARect.Left + 36, ARect.Top, ACaption);
end;
initialization
{$I UfrmHueSettings.lrs}
end.

2
Client/ULandscape.pas
View File

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

237
Client/UfrmLogin.lfm
View File

@ -16,8 +16,8 @@ object frmLogin: TfrmLogin
Position = poScreenCenter
ShowInTaskBar = stAlways
object lblCopyright: TLabel
Height = 17
Top = 248
Height = 19
Top = 246
Width = 489
Align = alBottom
Alignment = taCenter
@ -146,6 +146,7 @@ object frmLogin: TfrmLogin
233023312332233323342335517451745174222C0A2251745174517451745174
51745174517451745174517451745174517451745174227D3B0A
}
Transparent = False
end
object imgUsername: TImage
Left = 6
@ -237,6 +238,7 @@ object frmLogin: TfrmLogin
233123322333233423355174517451745174222C0A2251745174517451745174
51745174517451745174517451745174517451745174227D3B0A
}
Transparent = False
end
object imgPassword: TImage
Left = 6
@ -318,6 +320,7 @@ object frmLogin: TfrmLogin
5174222C0A2251742349234A236E234B51745174517451745174517451745174
517451745174227D3B0A
}
Transparent = False
end
object edHost: TEdit
Left = 101
@ -433,103 +436,40 @@ object frmLogin: TfrmLogin
Width = 23
Color = clBtnFace
Glyph.Data = {
010C00002F2A2058504D202A2F0A7374617469632063686172202A6772617068
69635B5D203D207B0A223136203136203135332032222C0A222E2E2063204E6F
6E65222C0A222E2C20632023333636424243222C0A222E2D2063202333363642
4242222C0A222E2A20632023333636414242222C0A222E612063202333393643
4243222C0A222E6220632023334236454244222C0A222E632063202333413644
4242222C0A222E6420632023333836424242222C0A222E652063202333453730
4242222C0A222E6620632023443145304636222C0A222E672063202344314530
4637222C0A222E6820632023463846424645222C0A222E692063202346374642
4645222C0A222E6A20632023463646394644222C0A222E6B2063202346304635
4643222C0A222E6C20632023454146304641222C0A222E6D2063202345444632
4642222C0A222E6E20632023463746414644222C0A222E6F2063202345424631
4642222C0A222E7020632023444645394638222C0A222E712063202342444430
4543222C0A222E7220632023354538394339222C0A222E732063202344314446
4636222C0A222E7420632023383041414539222C0A222E752063202346364641
4645222C0A222E7620632023463646414644222C0A222E772063202336343843
4338222C0A222E7820632023454546334642222C0A222E792063202345414631
4642222C0A222E7A20632023463246364643222C0A222E412063202346314636
4643222C0A222E4220632023453245434639222C0A222E432063202344424537
4638222C0A222E4420632023424144304545222C0A222E452063202344304446
4636222C0A222E4620632023374541384538222C0A222E472063202345394631
4641222C0A222E4820632023454546344642222C0A222E492063202345384630
4641222C0A222E4A20632023444445384638222C0A222E4B2063202344424536
4637222C0A222E4C20632023374141334531222C0A222E4D2063202343334435
4546222C0A222E4E20632023333536394237222C0A222E4F2063202343434444
4635222C0A222E5020632023374541384537222C0A222E512063202336363844
4339222C0A222E5220632023453946304641222C0A222E532063202346334638
4644222C0A222E5420632023463846414645222C0A222E552063202345464634
4643222C0A222E5620632023444645394639222C0A222E572063202344424537
4637222C0A222E5820632023443945354637222C0A222E592063202337384132
4530222C0A222E5A20632023413943324537222C0A222E302063202333353638
4236222C0A222E3120632023433944434634222C0A222E322063202337444137
4537222C0A222E3320632023453145434639222C0A222E342063202345334544
4639222C0A222E3520632023454546344643222C0A222E362063202346334637
4644222C0A222E3720632023453545444641222C0A222E382063202344384535
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
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000BA6A36FFB969
35FFB86935FFB76835FFB56835FFB46734FFB26634FFB06533FFAE6433FFAC63
32FFAA6232FFA96132FFA86031FFA76031FFA66031FFA86131FFBA6A35FFEBC6
ADFFEAC5ADFFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFB
F8FFFEFBF8FFFEFBF8FFFEFBF8FFC89A7CFFC79879FFA76031FFBA6B37FFEDCA
B3FFE0A27AFFFEFAF7FF62C088FF62C088FF62C088FF62C088FF62C088FF62C0
88FF62C088FF62C088FFFDF9F6FFCA8D65FFC99B7CFFA76031FFBB6C38FFEECC
B6FFE1A27AFFFEFAF7FFBFDCC2FFBFDCC2FFBFDCC2FFBFDCC2FFBFDCC2FFBFDC
C2FFBFDCC2FFBFDCC2FFFDF9F6FFCD9068FFCC9E81FFA86132FFBB6B38FFEFCE
B8FFE1A279FFFEFAF7FF62C088FF62C088FF62C088FF62C088FF62C088FF62C0
88FF62C088FF62C088FFFDF9F6FFCF936AFFCEA384FFAA6132FFBA6A36FFEFD0
BBFFE2A27AFFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFBF8FFFEFB
F8FFFEFBF8FFFEFBF8FFFEFBF8FFD3966DFFD2A78AFFAB6232FFBB6A36FFF0D2
BEFFE2A37AFFE2A37AFFE1A37AFFE2A37BFFE1A37BFFE0A178FFDE9F77FFDD9F
76FFDC9D74FFD99B72FFD89971FFD69970FFD5AB8EFFAD6333FFBB6A36FFF2D5
C2FFE3A37AFFE3A37AFFE2A37BFFE2A37BFFE2A47BFFE1A279FFE0A178FFDEA0
77FFDE9E75FFDC9D74FFDA9B73FFD99B73FFDAB095FFAF6433FFBB6A36FFF2D8
C5FFE3A47BFFE3A37AFFE3A47AFFE2A47BFFE2A37BFFE1A37BFFE1A279FFDFA0
77FFDE9F76FFDD9E74FFDB9C72FFDC9D74FFDDB59AFFB16534FFBB6B36FFF4D9
C7FFE6A67DFFC88C64FFC98D65FFC98E67FFCB926CFFCB926DFFCA9069FFC88C
65FFC88C64FFC88C64FFC88C64FFDA9C74FFE1BA9FFFB36634FFBB6B36FFF4DC
C9FFE7A77DFFF9ECE1FFF9ECE1FFF9EDE3FFFCF4EEFFFDFAF7FFFDF7F3FFFAED
E5FFF7E7DBFFF7E5D9FFF6E5D8FFDEA077FFE4BEA4FFB46734FFBC6B36FFF5DD
CCFFE7A87EFFFAF0E8FFFAF0E8FFC98D66FFFAF0E9FFFDF8F3FFFEFAF8FFFCF4
EFFFF9E9DFFFF7E7DBFFF7E5D9FFE0A278FFE7C2A9FFB66835FFBC6B36FFF6DF
D0FFE8A87EFFFCF6F1FFFCF6F1FFC88C64FFFAF1E9FFFBF4EEFFFDFAF7FFFDF9
F6FFFAF0E8FFF8E8DDFFF7E6DBFFE1A37AFFEFD5C3FFB76935FFBC6B36FFF6DF
D1FFE9AA80FFFEFAF6FFFDFAF6FFC88C64FFFBF3EEFFFBF1EAFFFCF6F2FFFEFB
F8FFFCF6F1FFF9ECE2FFF8E7DBFFEED0BAFFECD0BDFFBB703EFFBC6B36FFF6E0
D1FFF7E0D1FFFEFBF8FFFEFBF7FFFDF9F6FFFCF5F0FFFAF0EAFFFBF2EDFFFDF9
F6FFFDFAF7FFFBF1EBFFF8E9DFFFECD0BDFFC9895EFF0000000000000000BC6B
36FFBC6B36FFBC6B36FFBC6B36FFBB6B36FFBB6B36FFBB6A36FFBB6A36FFBC6C
39FFBD6E3BFFBB6D3AFFBB6B38FFBB703EFF0000000000000000
}
NumGlyphs = 0
OnClick = btnSaveProfileClick
@ -545,71 +485,40 @@ object frmLogin: TfrmLogin
Width = 23
Color = clBtnFace
Glyph.Data = {
100800002F2A2058504D202A2F0A7374617469632063686172202A6772617068
69635B5D203D207B0A2231362031362039302032222C0A222E2E2063204E6F6E
65222C0A222E2C20632023464637373741222C0A222E2D206320234645373637
39222C0A222E2A20632023463836313634222C0A222E61206320234639363836
41222C0A222E6220632023463335313534222C0A222E63206320234646374538
31222C0A222E6420632023464537453831222C0A222E65206320234644373137
34222C0A222E6620632023463835463632222C0A222E67206320234642364436
46222C0A222E6820632023464637433745222C0A222E69206320234645373137
34222C0A222E6A20632023464537413744222C0A222E6B206320234646383738
41222C0A222E6C20632023464437393743222C0A222E6D206320234642363936
43222C0A222E6E20632023463835453631222C0A222E6F206320234641364336
45222C0A222E7020632023464637413744222C0A222E71206320234637354636
31222C0A222E7220632023463034363439222C0A222E73206320234643364236
45222C0A222E7420632023464437343737222C0A222E75206320234646383238
36222C0A222E7620632023464337333736222C0A222E77206320234638363236
34222C0A222E7820632023463735443630222C0A222E79206320234641364136
44222C0A222E7A20632023464637393742222C0A222E41206320234546343534
38222C0A222E4220632023463936333636222C0A222E43206320234642364437
30222C0A222E4420632023464637453830222C0A222E45206320234646374237
45222C0A222E4620632023464637393743222C0A222E47206320234646373737
39222C0A222E4820632023463735433545222C0A222E49206320234546343434
37222C0A222E4A20632023463635413544222C0A222E4B206320234646373937
44222C0A222E4C20632023464635423545222C0A222E4D206320234646353835
42222C0A222E4E20632023464637343736222C0A222E4F206320234546343334
36222C0A222E5020632023463735423544222C0A222E51206320234646373637
39222C0A222E5220632023464635363539222C0A222E53206320234646353435
37222C0A222E5420632023464637303732222C0A222E55206320234630343634
38222C0A222E5620632023463635413543222C0A222E57206320234641363436
37222C0A222E5820632023464637323734222C0A222E59206320234646373037
33222C0A222E5A20632023464636453730222C0A222E30206320234646364336
45222C0A222E3120632023463735353537222C0A222E32206320234545334433
46222C0A222E3320632023463635393542222C0A222E34206320234641363336
36222C0A222E3520632023464637313734222C0A222E36206320234636353835
41222C0A222E3720632023454534313433222C0A222E38206320234543334333
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
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000004F4CF2FF403EEDFF000000000000000000000000000000000000
0000000000002422E4FF312FEAFF000000000000000000000000000000000000
00005856F5FF6361FAFF5855F6FF413FEDFF0000000000000000000000000000
00002C2AE6FF413FF1FF4C4AF6FF312FEAFF0000000000000000000000000000
00005B58F6FF6562FAFF7170FFFF5956F6FF4240EEFF00000000000000003532
E9FF4745F2FF6362FFFF4A48F4FF2F2DE9FF0000000000000000000000000000
0000000000005B59F6FF6663FAFF7471FFFF5A58F6FF4341EEFF3E3CECFF504D
F4FF6867FFFF504EF5FF3634EBFF000000000000000000000000000000000000
000000000000000000005C5AF6FF6764FAFF7472FFFF7370FFFF706EFFFF6E6C
FFFF5755F7FF3F3DEEFF00000000000000000000000000000000000000000000
00000000000000000000000000005D5BF7FF7976FFFF5956FFFF5754FFFF7270
FFFF4846F0FF0000000000000000000000000000000000000000000000000000
00000000000000000000000000005D5AF6FF7D79FFFF5E5BFFFF5B58FFFF7674
FFFF4643EFFF0000000000000000000000000000000000000000000000000000
000000000000000000006663F9FF706DFBFF807EFFFF7E7BFFFF7C79FFFF7977
FFFF5E5CF7FF4744EFFF00000000000000000000000000000000000000000000
0000000000006E6BFCFF7774FDFF8682FFFF7673FCFF6462F8FF605DF7FF6D6A
FAFF7B79FFFF605DF7FF4845EFFF000000000000000000000000000000000000
00007471FEFF7D7AFEFF8A87FFFF7C79FDFF6C69FBFF0000000000000000615E
F8FF6E6CFAFF7D7AFFFF615FF7FF4946F0FF0000000000000000000000000000
00007A77FFFF817EFFFF817EFEFF7471FDFF0000000000000000000000000000
0000625FF8FF6F6DFBFF7E7CFFFF625FF8FF0000000000000000000000000000
0000000000007A77FFFF7976FEFF000000000000000000000000000000000000
0000000000006461F8FF6A68F9FF5451F3FF0000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000
}
NumGlyphs = 0
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
*
* 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
*)
unit UAccount;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, md5, contnrs, math, UEnums;
type
{ TAccount }
TAccount = class(TObject)
constructor Create(AAccountString: string);
constructor Create(AName, APasswordHash: string; AAccessLevel: TAccessLevel);
protected
FName: string;
FAccessLevel: TAccessLevel;
FPasswordHash: string;
FLastPos: TPoint;
procedure SetAccessLevel(const AValue: TAccessLevel);
procedure SetPasswordHash(const AValue: string);
procedure SetLastPos(const AValue: TPoint);
public
property Name: string read FName;
property AccessLevel: TAccessLevel read FAccessLevel write SetAccessLevel;
property PasswordHash: string read FPasswordHash write SetPasswordHash;
property LastPos: TPoint read FLastPos write SetLastPos;
procedure Flush;
end;
{ TAccountList }
TAccountList = class(TObjectList)
constructor Create; reintroduce;
public
function IndexOf(AName: string): Integer;
function Find(AName: string): TAccount;
procedure Delete(AName: string);
end;
implementation
uses
UCEDServer, UConfig;
{ TAccount }
constructor TAccount.Create(AAccountString: string);
var
i: Integer;
attribs: TStringList;
begin
inherited Create;
i := Pos('=', AAccountString);
if i > 0 then
FName := Trim(Copy(AAccountString, 1, i-1));
AAccountString := Copy(AAccountString, i+1, Length(AAccountString));
attribs := TStringList.Create;
if ExtractStrings([':'], [' '], PChar(AAccountString), attribs) >= 2 then
begin
FAccessLevel := TAccessLevel(StrToInt(attribs.Strings[0]));
FPasswordHash := attribs.Strings[1];
end;
if attribs.Count >= 4 then
begin
FLastPos.x := EnsureRange(StrToInt(attribs.Strings[2]), 0, Config.ReadInteger('Parameters', 'Width', 0) * 8 - 1);
FLastPos.y := EnsureRange(StrToInt(attribs.Strings[3]), 0, Config.ReadInteger('Parameters', 'Height', 0) * 8 - 1);
end else
begin
FLastPos.x := 0;
FLastPos.y := 0;
end;
attribs.Free;
end;
constructor TAccount.Create(AName, APasswordHash: string;
AAccessLevel: TAccessLevel);
begin
inherited Create;
FName := AName;
FPasswordHash := APasswordHash;
FAccessLevel := AAccessLevel;
Flush;
end;
procedure TAccount.SetAccessLevel(const AValue: TAccessLevel);
begin
FAccessLevel := AValue;
Flush;
end;
procedure TAccount.SetPasswordHash(const AValue: string);
begin
FPasswordHash := AValue;
Flush;
end;
procedure TAccount.SetLastPos(const AValue: TPoint);
begin
FLastPos.x := EnsureRange(AValue.x, 0, CEDServerInstance.Landscape.CellWidth - 1);
FLastPos.y := EnsureRange(AValue.y, 0, CEDServerInstance.Landscape.CellHeight - 1);
Flush;
end;
procedure TAccount.Flush;
begin
Config.WriteString('Accounts', FName, IntToStr(Byte(FAccessLevel)) + ':' +
FPasswordHash + ':' + IntToStr(FLastPos.x) + ':' + IntToStr(FLastPos.y));
end;
{ TAccountList }
constructor TAccountList.Create;
begin
inherited Create(True);
end;
function TAccountList.IndexOf(AName: string): Integer;
var
i: Integer;
begin
Result := -1;
i := 0;
while (i < Count) and (Result = -1) do
begin
if TAccount(Items[i]).Name = AName then
Result := i;
Inc(i);
end;
end;
function TAccountList.Find(AName: string): TAccount;
var
i: Integer;
begin
i := IndexOf(AName);
if i > -1 then
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;
end.
(*
* 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 UAccount;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, md5, contnrs, math, DOM, UXmlHelper, UInterfaces,
UEnums;
type
{ TAccount }
TAccount = class(TObject, ISerializable, IInvalidate)
constructor Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel);
constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
procedure Serialize(AElement: TDOMElement);
protected
FOwner: IInvalidate;
FName: string;
FAccessLevel: TAccessLevel;
FPasswordHash: string;
FLastPos: TPoint;
procedure SetAccessLevel(const AValue: TAccessLevel);
procedure SetPasswordHash(const AValue: string);
procedure SetLastPos(const AValue: TPoint);
public
property Name: string read FName;
property AccessLevel: TAccessLevel read FAccessLevel write SetAccessLevel;
property PasswordHash: string read FPasswordHash write SetPasswordHash;
property LastPos: TPoint read FLastPos write SetLastPos;
procedure Invalidate;
end;
{ TAccountList }
TAccountList = class(TObjectList, ISerializable, IInvalidate)
constructor Create(AOwner: IInvalidate); reintroduce;
constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
procedure Serialize(AElement: TDOMElement);
protected
FOwner: IInvalidate;
public
function IndexOf(AName: string): Integer;
function Find(AName: string): TAccount;
procedure Delete(AName: string);
procedure Invalidate;
end;
implementation
uses
UCEDServer, UConfig;
{ TAccount }
constructor TAccount.Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel);
begin
inherited Create;
FOwner := AOwner;
FName := AName;
FPasswordHash := APasswordHash;
FAccessLevel := AAccessLevel;
end;
constructor TAccount.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
begin
inherited Create;
FOwner := AOwner;
FName := TXmlHelper.ReadString(AElement, 'Name', '');
FAccessLevel := TAccessLevel(TXmlHelper.ReadInteger(AElement, 'AccessLevel', 0));
FPasswordHash := TXmlHelper.ReadString(AElement, 'PasswordHash', '');
FLastPos := Point(0, 0);
TXmlHelper.ReadCoords(AElement, 'LastPos', FLastPos.X, FLastPos.Y);
end;
procedure TAccount.SetAccessLevel(const AValue: TAccessLevel);
begin
FAccessLevel := AValue;
Invalidate;
end;
procedure TAccount.SetPasswordHash(const AValue: string);
begin
FPasswordHash := AValue;
Invalidate;
end;
procedure TAccount.SetLastPos(const AValue: TPoint);
begin
FLastPos.x := EnsureRange(AValue.x, 0, CEDServerInstance.Landscape.CellWidth - 1);
FLastPos.y := EnsureRange(AValue.y, 0, CEDServerInstance.Landscape.CellHeight - 1);
Invalidate;
end;
procedure TAccount.Invalidate;
begin
FOwner.Invalidate;
end;
procedure TAccount.Serialize(AElement: TDOMElement);
begin
TXmlHelper.WriteString(AElement, 'Name', FName);
TXmlHelper.WriteString(AElement, 'PasswordHash', FPasswordHash);
TXmlHelper.WriteInteger(AElement, 'AccessLevel', Integer(FAccessLevel));
TXmlHelper.WriteCoords(AElement, 'LastPos', FLastPos.X, FLastPos.Y);
end;
{ TAccountList }
constructor TAccountList.Create(AOwner: IInvalidate);
begin
inherited Create(True);
FOwner := AOwner;
end;
constructor TAccountList.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
var
nodelist: TDOMNodeList;
i: Integer;
begin
Create(AOwner);
nodeList := AElement.GetChildNodes;
for i := 0 to nodeList.Count - 1 do
begin
if nodeList.Item[i].NodeName = 'Account' then
Add(TAccount.Deserialize(Self, TDOMElement(nodeList.Item[i])));
end;
nodeList.Free;
end;
function TAccountList.IndexOf(AName: string): Integer;
var
i: Integer;
begin
Result := -1;
i := 0;
while (i < Count) and (Result = -1) do
begin
if TAccount(Items[i]).Name = AName then
Result := i;
Inc(i);
end;
end;
function TAccountList.Find(AName: string): TAccount;
var
i: Integer;
begin
i := IndexOf(AName);
if i > -1 then
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
*
* 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
*)
unit UAdminHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, lNet;
type
{ TModifyUserResponsePacket }
TModifyUserResponsePacket = class(TPacket)
constructor Create(AStatus: TModifyUserStatus; AAccount: TAccount);
end;
{ TDeleteUserResponsePacket }
TDeleteUserResponsePacket = class(TPacket)
constructor Create(AStatus: TDeleteUserStatus; AUsername: string);
end;
{ TUserListPacket }
TUserListPacket = class(TPacket)
constructor Create;
end;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
AdminPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
uses
md5, UCEDServer, UPackets, UClientHandling;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
if not ValidateAccess(ANetState, alAdministrator) then Exit;
packetHandler := AdminPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;
procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.Landscape.Flush;
end;
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.Quit := True;
end;
procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
account: TAccount;
username, password: string;
accessLevel: TAccessLevel;
netState: TNetState;
begin
username := ABuffer.ReadStringNull;
password := ABuffer.ReadStringNull;
accessLevel := TAccessLevel(ABuffer.ReadByte);
account := Accounts.Find(username);
if account <> nil then
begin
if password <> '' then
account.PasswordHash := MD5Print(MD5String(password));
if account.AccessLevel <> accessLevel then
begin
account.AccessLevel := accessLevel;
CEDServerInstance.TCPServer.IterReset;
while CEDServerInstance.TCPServer.IterNext do
begin
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.SendPacket(netState, TAccessLevelChangedPacket.Create(accessLevel));
end;
end;
end;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muModified, account));
end else
begin
account := TAccount.Create(username, MD5Print(MD5String(password)), accessLevel);
if (username = '') or (Pos('=', username) > 0) then
begin
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muInvalidUsername, account));
account.Free;
Exit;
end;
Accounts.Add(account);
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muAdded, account));
end;
end;
procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
account: TAccount;
username: string;
netState: TNetState;
begin
username := ABuffer.ReadStringNull;
account := Accounts.Find(username);
if (account <> nil) and (account <> ANetState.Account) then
begin
Config.DeleteKey('Accounts', username);
CEDServerInstance.TCPServer.IterReset;
while CEDServerInstance.TCPServer.IterNext do
begin
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.Disconnect(CEDServerInstance.TCPServer.Iterator);
netState.Account := nil;
end;
end;
Accounts.Remove(account);
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duDeleted, username));
end else
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duNotFound, username));
end;
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TUserListPacket.Create));
end;
{ TModifyUserResponsePacket }
constructor TModifyUserResponsePacket.Create(AStatus: TModifyUserStatus; AAccount: TAccount);
begin
inherited Create($03, 0);
FStream.WriteByte($05);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(AAccount.Name);
FStream.WriteByte(Byte(AAccount.AccessLevel));
end;
{ TDeleteUserResponsePacket }
constructor TDeleteUserResponsePacket.Create(AStatus: TDeleteUserStatus; AUsername: string);
begin
inherited Create($03, 0);
FStream.WriteByte($06);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(AUsername);
end;
{ TUserListPacket }
constructor TUserListPacket.Create;
var
i: Integer;
account: TAccount;
begin
inherited Create($03, 0);
FStream.WriteByte($07);
FStream.WriteWord(Accounts.Count);
for i := 0 to Accounts.Count - 1 do
begin
account := TAccount(Accounts.Items[i]);
FStream.WriteStringNull(account.Name);
FStream.WriteByte(Byte(account.AccessLevel));
end;
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
AdminPacketHandlers[i] := nil;
AdminPacketHandlers[$01] := TPacketHandler.Create(0, @OnFlushPacket);
AdminPacketHandlers[$02] := TPacketHandler.Create(0, @OnQuitPacket);
AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserPacket);
AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserPacket);
AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket);
finalization
for i := 0 to $FF do
if AdminPacketHandlers[i] <> nil then
AdminPacketHandlers[i].Free;
{$WARNINGS ON}
end.
(*
* 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 UAdminHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, lNet;
type
{ TModifyUserResponsePacket }
TModifyUserResponsePacket = class(TPacket)
constructor Create(AStatus: TModifyUserStatus; AAccount: TAccount);
end;
{ TDeleteUserResponsePacket }
TDeleteUserResponsePacket = class(TPacket)
constructor Create(AStatus: TDeleteUserStatus; AUsername: string);
end;
{ TUserListPacket }
TUserListPacket = class(TPacket)
constructor Create;
end;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
AdminPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
uses
md5, UCEDServer, UPackets, UClientHandling;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
if not ValidateAccess(ANetState, alAdministrator) then Exit;
packetHandler := AdminPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;
procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.Landscape.Flush;
Config.Flush;
end;
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.Quit := True;
end;
procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
account: TAccount;
username, password: string;
accessLevel: TAccessLevel;
netState: TNetState;
begin
username := ABuffer.ReadStringNull;
password := ABuffer.ReadStringNull;
accessLevel := TAccessLevel(ABuffer.ReadByte);
account := Config.Accounts.Find(username);
if account <> nil then
begin
if password <> '' then
account.PasswordHash := MD5Print(MD5String(password));
if account.AccessLevel <> accessLevel then
begin
account.AccessLevel := accessLevel;
CEDServerInstance.TCPServer.IterReset;
while CEDServerInstance.TCPServer.IterNext do
begin
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.SendPacket(netState, TAccessLevelChangedPacket.Create(accessLevel));
end;
end;
end;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muModified, account));
end else
begin
account := TAccount.Create(Config.Accounts, username,
MD5Print(MD5String(password)), accessLevel);
if (username = '') or (Pos('=', username) > 0) then
begin
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muInvalidUsername, account));
account.Free;
Exit;
end;
Config.Accounts.Add(account);
Config.Invalidate;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muAdded, account));
end;
end;
procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
account: TAccount;
username: string;
netState: TNetState;
begin
username := ABuffer.ReadStringNull;
account := Config.Accounts.Find(username);
if (account <> nil) and (account <> ANetState.Account) then
begin
CEDServerInstance.TCPServer.IterReset;
while CEDServerInstance.TCPServer.IterNext do
begin
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.Disconnect(CEDServerInstance.TCPServer.Iterator);
netState.Account := nil;
end;
end;
Config.Accounts.Remove(account);
Config.Invalidate;
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duDeleted, username));
end else
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duNotFound, username));
end;
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TUserListPacket.Create));
end;
{ TModifyUserResponsePacket }
constructor TModifyUserResponsePacket.Create(AStatus: TModifyUserStatus; AAccount: TAccount);
begin
inherited Create($03, 0);
FStream.WriteByte($05);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(AAccount.Name);
FStream.WriteByte(Byte(AAccount.AccessLevel));
end;
{ TDeleteUserResponsePacket }
constructor TDeleteUserResponsePacket.Create(AStatus: TDeleteUserStatus; AUsername: string);
begin
inherited Create($03, 0);
FStream.WriteByte($06);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(AUsername);
end;
{ TUserListPacket }
constructor TUserListPacket.Create;
var
i: Integer;
account: TAccount;
begin
inherited Create($03, 0);
FStream.WriteByte($07);
FStream.WriteWord(Config.Accounts.Count);
for i := 0 to Config.Accounts.Count - 1 do
begin
account := TAccount(Config.Accounts.Items[i]);
FStream.WriteStringNull(account.Name);
FStream.WriteByte(Byte(account.AccessLevel));
end;
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
AdminPacketHandlers[i] := nil;
AdminPacketHandlers[$01] := TPacketHandler.Create(0, @OnFlushPacket);
AdminPacketHandlers[$02] := TPacketHandler.Create(0, @OnQuitPacket);
AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserPacket);
AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserPacket);
AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket);
finalization
for i := 0 to $FF do
if AdminPacketHandlers[i] <> nil then
AdminPacketHandlers[i].Free;
{$WARNINGS ON}
end.

719
Server/UCEDServer.pas
View File

@ -1,361 +1,358 @@
(*
* 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
*)
unit UCEDServer;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, lNet, UEnhancedMemoryStream, UConfig, ULandscape,
UNetState, UPacket, dateutils,
{$IFDEF Linux}BaseUnix,{$ENDIF}
{$IFDEF Windows}Windows,{$ENDIF}
UPacketHandlers, UConnectionHandling;
type
{ TCEDServer }
TCEDServer = class(TObject)
constructor Create;
destructor Destroy; override;
protected
FLandscape: TLandscape;
FTCPServer: TLTcp;
FQuit: Boolean;
FLastFlush: TDateTime;
FValid: Boolean;
procedure OnAccept(ASocket: TLSocket);
procedure OnCanSend(ASocket: TLSocket);
procedure OnDisconnect(ASocket: TLSocket);
procedure OnReceive(ASocket: TLSocket);
procedure OnError(const AError: string; ASocket: TLSocket);
procedure ProcessBuffer(ANetState: TNetState);
procedure CheckNetStates;
public
property Landscape: TLandscape read FLandscape;
property TCPServer: TLTcp read FTCPServer;
property Quit: Boolean read FQuit write FQuit;
procedure Run;
procedure SendPacket(ANetState: TNetState; APacket: TPacket;
AFreePacket: Boolean = True);
procedure Disconnect(ASocket: TLSocket);
end;
var
CEDServerInstance: TCEDServer;
implementation
uses
UClientHandling;
{$I version.inc}
{$IFDEF Linux}
procedure OnSigInt(ASignal: cint); cdecl;
begin
Writeln(TimeStamp, 'Killed');
if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end;
procedure OnSigSegv(ASignal: cint); cdecl;
begin
Writeln(TimeStamp, 'Internal error');
Halt;
//if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end;
{$ENDIF}
{$IFDEF Windows}
function OnConsoleCtrlEvent(ACtrl: DWord): LongBool; stdcall; far;
begin
Result := False;
if (ACtrl = CTRL_C_EVENT) or (ACtrl = CTRL_BREAK_EVENT) then
begin
Writeln(TimeStamp, 'Killed');
if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
Result := True;
end;
end;
{$ENDIF}
{ TCEDServer }
constructor TCEDServer.Create;
begin
inherited Create;
FLandscape := TLandscape.Create(Config.ReadString('Paths', 'map', 'map0.mul'),
Config.ReadString('Paths', 'statics', 'statics0.mul'),
Config.ReadString('Paths', 'staidx', 'staidx0.mul'),
Config.ReadString('Paths', 'tiledata', 'tiledata.mul'),
Config.ReadString('Paths', 'radarcol', 'radarcol.mul'),
Config.ReadInteger('Parameters', 'Width', 0),
Config.ReadInteger('Parameters', 'Height', 0),
FValid);
FTCPServer := TLTcp.Create(nil);
FTCPServer.OnAccept := @OnAccept;
FTCPServer.OnCanSend := @OnCanSend;
FTCPServer.OnDisconnect := @OnDisconnect;
FTCPServer.OnReceive := @OnReceive;
FTCPServer.OnError := @OnError;
FQuit := False;
FLastFlush := Now;
end;
destructor TCEDServer.Destroy;
begin
if FTCPServer <> nil then
begin
FTCPServer.IterReset;
if FTCPServer.Iterator <> nil then
while FTCPServer.IterNext do
begin
FTCPServer.Iterator.Disconnect;
if FTCPServer.Iterator.UserData <> nil then
begin
TObject(FTCPServer.Iterator.UserData).Free;
FTCPServer.Iterator.UserData := nil;
end;
end;
FreeAndNil(FTCPServer);
end;
if FLandscape <> nil then FreeAndNil(FLandscape);
inherited Destroy;
end;
procedure TCEDServer.OnAccept(ASocket: TLSocket);
begin
writeln(TimeStamp, 'Connect: ', ASocket.PeerAddress);
ASocket.UserData := TNetState.Create(ASocket);
SendPacket(TNetState(ASocket.UserData), TProtocolVersionPacket.Create(ProtocolVersion));
end;
procedure TCEDServer.OnCanSend(ASocket: TLSocket);
var
netState: TNetState;
size: Integer;
begin
//writeln('CanSend: ', ASocket.PeerAddress);
netState := TNetState(ASocket.UserData);
if netState = nil then Exit;
while netState.SendQueue.Size > 0 do
begin
size := FTCPServer.Send(netState.SendQueue.Memory^, netState.SendQueue.Size, ASocket);
if size > 0 then
netState.SendQueue.Dequeue(size)
else
Break;
end;
end;
procedure TCEDServer.OnDisconnect(ASocket: TLSocket);
var
netState: TNetState;
begin
writeln(TimeStamp, 'Disconnect: ', ASocket.PeerAddress);
if ASocket.UserData <> nil then
begin
netState := TNetState(ASocket.UserData);
ASocket.UserData := nil;
if netState.Account <> nil then
SendPacket(nil, TClientDisconnectedPacket.Create(netState.Account.Name));
netState.Free;
end;
end;
procedure TCEDServer.OnReceive(ASocket: TLSocket);
var
netState: TNetState;
buffer: array[0..4095] of byte;
size: Integer;
begin
netState := TNetState(ASocket.UserData);
if netState <> nil then
begin
repeat
size := FTCPServer.Get(buffer, 4096, ASocket);
if size > 0 then
netState.ReceiveQueue.Enqueue(buffer, size);
until size <= 0;
ProcessBuffer(netState);
end;
end;
procedure TCEDServer.OnError(const AError: string; ASocket: TLSocket);
begin
writeln(TimeStamp, 'Error: ', ASocket.PeerAddress, ' :: ', AError);
//OnDisconnect(ASocket);
end;
procedure TCEDServer.ProcessBuffer(ANetState: TNetState);
var
buffer: TEnhancedMemoryStream;
packetID: Byte;
packetHandler: TPacketHandler;
size: Cardinal;
begin
try
buffer := ANetState.ReceiveQueue;
buffer.Position := 0;
while (buffer.Size >= 1) and ANetState.Socket.Connected do
begin
packetID := buffer.ReadByte;
packetHandler := PacketHandlers[packetID];
if packetHandler <> nil then
begin
ANetState.LastAction := Now;
size := packetHandler.PacketLength;
if size = 0 then
begin
if buffer.Size > 5 then
size := buffer.ReadCardinal
else
Break; //wait for more data
end;
if buffer.Size >= size then
begin
buffer.Lock(buffer.Position, size - buffer.Position); //prevent handler from reading too much
packetHandler.Process(buffer, ANetState);
buffer.Unlock;
buffer.Dequeue(size);
end else
Break; //wait for more data
end else
begin
Writeln(TimeStamp, 'Dropping client due to unknown packet [', packetID, ']: ', ANetState.Socket.PeerAddress);
Disconnect(ANetState.Socket);
buffer.Clear;
end;
end;
ANetState.LastAction := Now;
except
Writeln(TimeStamp, 'Error processing buffer of client: ', ANetState.Socket.PeerAddress);
end;
end;
procedure TCEDServer.CheckNetStates;
var
netState: TNetState;
begin
FTCPServer.IterReset;
while FTCPServer.IterNext do
begin
netState := TNetState(FTCPServer.Iterator.UserData);
if netState <> nil then
begin
if FTCPServer.Iterator.Connected then
begin
if (SecondsBetween(netState.LastAction, Now) > 120) then
begin
if netState.Account <> nil then
Writeln(TimeStamp, 'Timeout: ', netState.Account.Name, ' (', netState.Socket.PeerAddress, ')')
else
Writeln(TimeStamp, 'Timeout: ', netState.Socket.PeerAddress);
Disconnect(netState.Socket);
end;
end else {TODO : Unnecessary ...}
begin
OnDisconnect(FTCPServer.Iterator);
end;
end;
end;
end;
procedure TCEDServer.Run;
begin
if not FValid then
begin
Writeln(TimeStamp, 'Invalid data. Check the map size and the files.');
Exit;
end;
if FTCPServer.Listen(Config.ReadInteger('Network', 'Port', 2597)) then
begin
repeat
FTCPServer.CallAction;
CheckNetStates;
if SecondsBetween(FLastFlush, Now) >= 60 then
begin
FLandscape.Flush;
FLastFlush := Now;
end;
Sleep(1);
until FQuit;
end;
end;
procedure TCEDServer.SendPacket(ANetState: TNetState; APacket: TPacket;
AFreePacket: Boolean = True);
var
netState: TNetState;
begin
if ANetState <> nil then
begin
ANetState.SendQueue.Seek(0, soFromEnd);
ANetState.SendQueue.CopyFrom(APacket.Stream, 0);
OnCanSend(ANetState.Socket);
end else //broadcast
begin
FTCPServer.IterReset;
while FTCPServer.IterNext do
begin
netState := TNetState(FTCPServer.Iterator.UserData);
if (netState <> nil) and (FTCPServer.Iterator.Connected) then
begin
netState.SendQueue.Seek(0, soFromEnd);
netState.SendQueue.CopyFrom(APacket.Stream, 0);
OnCanSend(netState.Socket);
end;
end;
end;
if AFreePacket then
APacket.Free;
end;
procedure TCEDServer.Disconnect(ASocket: TLSocket);
begin
if ASocket.Connected then
begin
ASocket.Disconnect;
//OnDisconnect(ASocket);
//Handling of the disconnect is done in CheckNetStates after each CallAction
end;
end;
initialization
{$IFDEF Linux}
FpSignal(SIGINT, @OnSigInt);
//FpSignal(SIGSEGV, @OnSigSegv);
{$ENDIF}
{$IFDEF Windows}
SetConsoleCtrlHandler(@OnConsoleCtrlEvent, True);
{$ENDIF}
end.
(*
* 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
*)
unit UCEDServer;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, lNet, UEnhancedMemoryStream, UConfig, ULandscape,
UNetState, UPacket, dateutils,
{$IFDEF Linux}BaseUnix,{$ENDIF}
{$IFDEF Windows}Windows,{$ENDIF}
UPacketHandlers, UConnectionHandling;
type
{ TCEDServer }
TCEDServer = class(TObject)
constructor Create;
destructor Destroy; override;
protected
FLandscape: TLandscape;
FTCPServer: TLTcp;
FQuit: Boolean;
FLastFlush: TDateTime;
FValid: Boolean;
procedure OnAccept(ASocket: TLSocket);
procedure OnCanSend(ASocket: TLSocket);
procedure OnDisconnect(ASocket: TLSocket);
procedure OnReceive(ASocket: TLSocket);
procedure OnError(const AError: string; ASocket: TLSocket);
procedure ProcessBuffer(ANetState: TNetState);
procedure CheckNetStates;
public
property Landscape: TLandscape read FLandscape;
property TCPServer: TLTcp read FTCPServer;
property Quit: Boolean read FQuit write FQuit;
procedure Run;
procedure SendPacket(ANetState: TNetState; APacket: TPacket;
AFreePacket: Boolean = True);
procedure Disconnect(ASocket: TLSocket);
end;
var
CEDServerInstance: TCEDServer;
implementation
uses
UClientHandling;
{$I version.inc}
{$IFDEF Linux}
procedure OnSigInt(ASignal: cint); cdecl;
begin
Writeln(TimeStamp, 'Killed');
if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end;
procedure OnSigSegv(ASignal: cint); cdecl;
begin
Writeln(TimeStamp, 'Internal error');
Halt;
//if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end;
{$ENDIF}
{$IFDEF Windows}
function OnConsoleCtrlEvent(ACtrl: DWord): LongBool; stdcall; far;
begin
Result := False;
if (ACtrl = CTRL_C_EVENT) or (ACtrl = CTRL_BREAK_EVENT) then
begin
Writeln(TimeStamp, 'Killed');
if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
Result := True;
end;
end;
{$ENDIF}
{ TCEDServer }
constructor TCEDServer.Create;
begin
inherited Create;
FLandscape := TLandscape.Create(Config.Map.MapFile, Config.Map.StaticsFile,
Config.Map.StaIdxFile, Config.Tiledata, Config.Radarcol, Config.Map.Width,
Config.Map.Height, FValid);
FTCPServer := TLTcp.Create(nil);
FTCPServer.OnAccept := @OnAccept;
FTCPServer.OnCanSend := @OnCanSend;
FTCPServer.OnDisconnect := @OnDisconnect;
FTCPServer.OnReceive := @OnReceive;
FTCPServer.OnError := @OnError;
FQuit := False;
FLastFlush := Now;
end;
destructor TCEDServer.Destroy;
begin
if FTCPServer <> nil then
begin
FTCPServer.IterReset;
if FTCPServer.Iterator <> nil then
while FTCPServer.IterNext do
begin
FTCPServer.Iterator.Disconnect;
if FTCPServer.Iterator.UserData <> nil then
begin
TObject(FTCPServer.Iterator.UserData).Free;
FTCPServer.Iterator.UserData := nil;
end;
end;
FreeAndNil(FTCPServer);
end;
if FLandscape <> nil then FreeAndNil(FLandscape);
inherited Destroy;
end;
procedure TCEDServer.OnAccept(ASocket: TLSocket);
begin
writeln(TimeStamp, 'Connect: ', ASocket.PeerAddress);
ASocket.UserData := TNetState.Create(ASocket);
SendPacket(TNetState(ASocket.UserData), TProtocolVersionPacket.Create(ProtocolVersion));
end;
procedure TCEDServer.OnCanSend(ASocket: TLSocket);
var
netState: TNetState;
size: Integer;
begin
//writeln('CanSend: ', ASocket.PeerAddress);
netState := TNetState(ASocket.UserData);
if netState = nil then Exit;
while netState.SendQueue.Size > 0 do
begin
size := FTCPServer.Send(netState.SendQueue.Memory^, netState.SendQueue.Size, ASocket);
if size > 0 then
netState.SendQueue.Dequeue(size)
else
Break;
end;
end;
procedure TCEDServer.OnDisconnect(ASocket: TLSocket);
var
netState: TNetState;
begin
writeln(TimeStamp, 'Disconnect: ', ASocket.PeerAddress);
if ASocket.UserData <> nil then
begin
netState := TNetState(ASocket.UserData);
ASocket.UserData := nil;
if netState.Account <> nil then
SendPacket(nil, TClientDisconnectedPacket.Create(netState.Account.Name));
netState.Free;
end;
end;
procedure TCEDServer.OnReceive(ASocket: TLSocket);
var
netState: TNetState;
buffer: array[0..4095] of byte;
size: Integer;
begin
netState := TNetState(ASocket.UserData);
if netState <> nil then
begin
repeat
size := FTCPServer.Get(buffer, 4096, ASocket);
if size > 0 then
netState.ReceiveQueue.Enqueue(buffer, size);
until size <= 0;
ProcessBuffer(netState);
end;
end;
procedure TCEDServer.OnError(const AError: string; ASocket: TLSocket);
begin
writeln(TimeStamp, 'Error: ', ASocket.PeerAddress, ' :: ', AError);
//OnDisconnect(ASocket);
end;
procedure TCEDServer.ProcessBuffer(ANetState: TNetState);
var
buffer: TEnhancedMemoryStream;
packetID: Byte;
packetHandler: TPacketHandler;
size: Cardinal;
begin
try
buffer := ANetState.ReceiveQueue;
buffer.Position := 0;
while (buffer.Size >= 1) and ANetState.Socket.Connected do
begin
packetID := buffer.ReadByte;
packetHandler := PacketHandlers[packetID];
if packetHandler <> nil then
begin
ANetState.LastAction := Now;
size := packetHandler.PacketLength;
if size = 0 then
begin
if buffer.Size > 5 then
size := buffer.ReadCardinal
else
Break; //wait for more data
end;
if buffer.Size >= size then
begin
buffer.Lock(buffer.Position, size - buffer.Position); //prevent handler from reading too much
packetHandler.Process(buffer, ANetState);
buffer.Unlock;
buffer.Dequeue(size);
end else
Break; //wait for more data
end else
begin
Writeln(TimeStamp, 'Dropping client due to unknown packet [', packetID, ']: ', ANetState.Socket.PeerAddress);
Disconnect(ANetState.Socket);
buffer.Clear;
end;
end;
ANetState.LastAction := Now;
except
Writeln(TimeStamp, 'Error processing buffer of client: ', ANetState.Socket.PeerAddress);
end;
end;
procedure TCEDServer.CheckNetStates;
var
netState: TNetState;
begin
FTCPServer.IterReset;
while FTCPServer.IterNext do
begin
netState := TNetState(FTCPServer.Iterator.UserData);
if netState <> nil then
begin
if FTCPServer.Iterator.Connected then
begin
if (SecondsBetween(netState.LastAction, Now) > 120) then
begin
if netState.Account <> nil then
Writeln(TimeStamp, 'Timeout: ', netState.Account.Name, ' (', netState.Socket.PeerAddress, ')')
else
Writeln(TimeStamp, 'Timeout: ', netState.Socket.PeerAddress);
Disconnect(netState.Socket);
end;
end else {TODO : Unnecessary ...}
begin
OnDisconnect(FTCPServer.Iterator);
end;
end;
end;
end;
procedure TCEDServer.Run;
begin
if not FValid then
begin
Writeln(TimeStamp, 'Invalid data. Check the map size and the files.');
Exit;
end;
if FTCPServer.Listen(Config.Port) then
begin
repeat
FTCPServer.CallAction;
CheckNetStates;
if SecondsBetween(FLastFlush, Now) >= 60 then
begin
FLandscape.Flush;
Config.Flush;
FLastFlush := Now;
end;
Sleep(1);
until FQuit;
end;
end;
procedure TCEDServer.SendPacket(ANetState: TNetState; APacket: TPacket;
AFreePacket: Boolean = True);
var
netState: TNetState;
begin
if ANetState <> nil then
begin
ANetState.SendQueue.Seek(0, soFromEnd);
ANetState.SendQueue.CopyFrom(APacket.Stream, 0);
OnCanSend(ANetState.Socket);
end else //broadcast
begin
FTCPServer.IterReset;
while FTCPServer.IterNext do
begin
netState := TNetState(FTCPServer.Iterator.UserData);
if (netState <> nil) and (FTCPServer.Iterator.Connected) then
begin
netState.SendQueue.Seek(0, soFromEnd);
netState.SendQueue.CopyFrom(APacket.Stream, 0);
OnCanSend(netState.Socket);
end;
end;
end;
if AFreePacket then
APacket.Free;
end;
procedure TCEDServer.Disconnect(ASocket: TLSocket);
begin
if ASocket.Connected then
begin
ASocket.Disconnect;
//OnDisconnect(ASocket);
//Handling of the disconnect is done in CheckNetStates after each CallAction
end;
end;
initialization
{$IFDEF Linux}
FpSignal(SIGINT, @OnSigInt);
FpSignal(SIGTERM, @OnSigInt); //SIGTERM should shutdown the server cleanly too
//FpSignal(SIGSEGV, @OnSigSegv);
{$ENDIF}
{$IFDEF Windows}
SetConsoleCtrlHandler(@OnConsoleCtrlEvent, True);
{$ENDIF}
end.

414
Server/UClientHandling.pas
View File

@ -1,207 +1,207 @@
(*
* 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
*)
unit UClientHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, math;
type
{ TClientConnectedPacket }
TClientConnectedPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TClientDisconnectedPacket }
TClientDisconnectedPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TClientListPacket }
TClientListPacket = class(TPacket)
constructor Create(AAvoid: TNetState = nil);
end;
{ TSetClientPosPacket }
TSetClientPosPacket = class(TPacket)
constructor Create(APos: TPoint);
end;
{ TChatMessagePacket }
TChatMessagePacket = class(TPacket)
constructor Create(ASender, AMessage: string);
end;
{ TAccessLevelChangedPacket }
TAccessLevelChangedPacket = class(TPacket)
constructor Create(AAccessLevel: TAccessLevel);
end;
procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
ClientPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
uses
UCEDServer, UPackets;
procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
if not ValidateAccess(ANetState, alView) then Exit;
packetHandler := ClientPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;
procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
pos: TPoint;
begin
pos.x := ABuffer.ReadWord;
pos.y := ABuffer.ReadWord;
ANetState.Account.LastPos := pos;
end;
procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
begin
CEDServerInstance.SendPacket(nil, TCompressedPacket.Create(
TChatMessagePacket.Create(ANetState.Account.Name, ABuffer.ReadStringNull)));
end;
procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
account: TAccount;
begin
account := Accounts.Find(ABuffer.ReadStringNull);
if account <> nil then
CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos));
end;
{ TClientConnectedPacket }
constructor TClientConnectedPacket.Create(AUsername: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($01);
FStream.WriteStringNull(AUsername);
end;
{ TClientDisconnectedPacket }
constructor TClientDisconnectedPacket.Create(AUsername: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($02);
FStream.WriteStringNull(AUsername);
end;
{ TClientListPacket }
constructor TClientListPacket.Create(AAvoid: TNetState = nil);
var
netState: TNetState;
begin
inherited Create($0C, 0);
FStream.WriteByte($03);
CEDServerInstance.TCPServer.IterReset;
if CEDServerInstance.TCPServer.Iterator <> nil then
begin
repeat
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState <> AAvoid) and (netState.Account <> nil) then
FStream.WriteStringNull(netState.Account.Name);
until not CEDServerInstance.TCPServer.IterNext;
end;
end;
{ TSetClientPosPacket }
constructor TSetClientPosPacket.Create(APos: TPoint);
begin
inherited Create($0C, 0);
FStream.WriteByte($04);
FStream.WriteWord(EnsureRange(APos.x, 0, CEDServerInstance.Landscape.CellWidth - 1));
FStream.WriteWord(EnsureRange(APos.y, 0, CEDServerInstance.Landscape.CellHeight - 1));
end;
{ TChatMessagePacket }
constructor TChatMessagePacket.Create(ASender, AMessage: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($05);
FStream.WriteStringNull(ASender);
FStream.WriteStringNull(AMessage);
end;
{ TAccessLevelChangedPacket }
constructor TAccessLevelChangedPacket.Create(AAccessLevel: TAccessLevel);
begin
inherited Create($0C, 0);
FStream.WriteByte($07);
FStream.WriteByte(Byte(AAccessLevel));
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
ClientPacketHandlers[i] := nil;
ClientPacketHandlers[$04] := TPacketHandler.Create(0, @OnUpdateClientPosPacket);
ClientPacketHandlers[$05] := TPacketHandler.Create(0, @OnChatMessagePacket);
ClientPacketHandlers[$06] := TPacketHandler.Create(0, @OnGotoClientPosPacket);
finalization
for i := 0 to $FF do
if ClientPacketHandlers[i] <> nil then
ClientPacketHandlers[i].Free;
{$WARNINGS ON}
end.
(*
* 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
*)
unit UClientHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, math;
type
{ TClientConnectedPacket }
TClientConnectedPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TClientDisconnectedPacket }
TClientDisconnectedPacket = class(TPacket)
constructor Create(AUsername: string);
end;
{ TClientListPacket }
TClientListPacket = class(TPacket)
constructor Create(AAvoid: TNetState = nil);
end;
{ TSetClientPosPacket }
TSetClientPosPacket = class(TPacket)
constructor Create(APos: TPoint);
end;
{ TChatMessagePacket }
TChatMessagePacket = class(TPacket)
constructor Create(ASender, AMessage: string);
end;
{ TAccessLevelChangedPacket }
TAccessLevelChangedPacket = class(TPacket)
constructor Create(AAccessLevel: TAccessLevel);
end;
procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
ClientPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
uses
UCEDServer, UPackets;
procedure OnClientHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
if not ValidateAccess(ANetState, alView) then Exit;
packetHandler := ClientPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;
procedure OnUpdateClientPosPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
pos: TPoint;
begin
pos.x := ABuffer.ReadWord;
pos.y := ABuffer.ReadWord;
ANetState.Account.LastPos := pos;
end;
procedure OnChatMessagePacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
begin
CEDServerInstance.SendPacket(nil, TCompressedPacket.Create(
TChatMessagePacket.Create(ANetState.Account.Name, ABuffer.ReadStringNull)));
end;
procedure OnGotoClientPosPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
account: TAccount;
begin
account := Config.Accounts.Find(ABuffer.ReadStringNull);
if account <> nil then
CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos));
end;
{ TClientConnectedPacket }
constructor TClientConnectedPacket.Create(AUsername: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($01);
FStream.WriteStringNull(AUsername);
end;
{ TClientDisconnectedPacket }
constructor TClientDisconnectedPacket.Create(AUsername: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($02);
FStream.WriteStringNull(AUsername);
end;
{ TClientListPacket }
constructor TClientListPacket.Create(AAvoid: TNetState = nil);
var
netState: TNetState;
begin
inherited Create($0C, 0);
FStream.WriteByte($03);
CEDServerInstance.TCPServer.IterReset;
if CEDServerInstance.TCPServer.Iterator <> nil then
begin
repeat
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState <> AAvoid) and (netState.Account <> nil) then
FStream.WriteStringNull(netState.Account.Name);
until not CEDServerInstance.TCPServer.IterNext;
end;
end;
{ TSetClientPosPacket }
constructor TSetClientPosPacket.Create(APos: TPoint);
begin
inherited Create($0C, 0);
FStream.WriteByte($04);
FStream.WriteWord(EnsureRange(APos.x, 0, CEDServerInstance.Landscape.CellWidth - 1));
FStream.WriteWord(EnsureRange(APos.y, 0, CEDServerInstance.Landscape.CellHeight - 1));
end;
{ TChatMessagePacket }
constructor TChatMessagePacket.Create(ASender, AMessage: string);
begin
inherited Create($0C, 0);
FStream.WriteByte($05);
FStream.WriteStringNull(ASender);
FStream.WriteStringNull(AMessage);
end;
{ TAccessLevelChangedPacket }
constructor TAccessLevelChangedPacket.Create(AAccessLevel: TAccessLevel);
begin
inherited Create($0C, 0);
FStream.WriteByte($07);
FStream.WriteByte(Byte(AAccessLevel));
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
ClientPacketHandlers[i] := nil;
ClientPacketHandlers[$04] := TPacketHandler.Create(0, @OnUpdateClientPosPacket);
ClientPacketHandlers[$05] := TPacketHandler.Create(0, @OnChatMessagePacket);
ClientPacketHandlers[$06] := TPacketHandler.Create(0, @OnGotoClientPosPacket);
finalization
for i := 0 to $FF do
if ClientPacketHandlers[i] <> nil then
ClientPacketHandlers[i].Free;
{$WARNINGS ON}
end.

539
Server/UConfig.pas
View File

@ -1,182 +1,357 @@
(*
* 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
*)
unit UConfig;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, IniFiles, md5, Keyboard, UAccount;
var
AppDir: string;
Config: TIniFile;
Accounts: TAccountList;
procedure InitConfig;
function LoadConfig: Boolean;
function TimeStamp: string;
implementation
const
CONFIGVERSION = 2;
function QueryPassword: String;
var
pwChar: char;
begin
Result := '';
InitKeyboard;
try
repeat
pwChar := GetKeyEventChar(TranslateKeyEvent(GetKeyEvent));
case pwChar of
#8: Result := Copy(Result, 1, Length(Result) - 1);
#13: break;
else
Result := Result + pwChar;
end;
until pwChar = #13;
finally
DoneKeyboard;
end;
writeln('');
end;
procedure InitConfig;
var
configFile: string;
stringValue, password: string;
intValue: Integer;
begin
configFile := ChangeFileExt(ParamStr(0), '.ini');
DeleteFile(configFile);
Config := TIniFile.Create(configFile);
Config.WriteInteger('Config', 'Version', CONFIGVERSION);
Writeln('Configuring Network');
Writeln('===================');
Write ('Port [2597]: ');
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 2597;
Config.WriteInteger('Network', 'Port', intValue);
Writeln('');
Writeln('Configuring Paths');
Writeln('=================');
Write ('map [map0.mul]: ');
Readln (stringValue);
if stringValue = '' then stringValue := 'map0.mul';
Config.WriteString('Paths', 'map', stringValue);
Write ('statics [statics0.mul]: ');
Readln (stringValue);
if stringValue = '' then stringValue := 'statics0.mul';
Config.WriteString('Paths', 'statics', stringValue);
Write ('staidx [staidx0.mul]: ');
Readln (stringValue);
if stringValue = '' then stringValue := 'staidx0.mul';
Config.WriteString('Paths', 'staidx', stringValue);
Write ('tiledata [tiledata.mul]: ');
Readln (stringValue);
if stringValue = '' then stringValue := 'tiledata.mul';
Config.WriteString('Paths', 'tiledata', stringValue);
Write ('radarcol [radarcol.mul]: ');
Readln (stringValue);
if stringValue = '' then stringValue := 'radarcol.mul';
Config.WriteString('Paths', 'radarcol', stringValue);
Writeln('');
Writeln('Parameters');
Writeln('==========');
Write ('Map width [768]: ');
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 768;
Config.WriteInteger('Parameters', 'Width', intValue);
Write ('Map height [512]: ');
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 512;
Config.WriteInteger('Parameters', 'Height', intValue);
Writeln('');
Writeln('Admin account');
Writeln('=============');
repeat
Write('Account name: ');
Readln(stringValue);
until stringValue <> '';
Write ('Password [hidden]: ');
password := QueryPassword;
Config.WriteString('Accounts', stringValue, '255:' + MD5Print(MD5String(password)));
end;
function LoadConfig: Boolean;
var
configFile: string;
values: TStringList;
i: Integer;
begin
configFile := ChangeFileExt(ParamStr(0), '.ini');
if FileExists(configFile) then
begin
Config := TIniFile.Create(configFile);
Result := (Config.ReadInteger('Config', 'Version', 0) = CONFIGVERSION);
if Result then
begin
Accounts := TAccountList.Create;
values := TStringList.Create;
Config.ReadSectionRaw('Accounts', values);
for i := 0 to values.Count - 1 do
Accounts.Add(TAccount.Create(values.Strings[i]));
values.Free;
end;
end else
Result := False;
end;
function TimeStamp: string;
begin
Result := '[' + DateTimeToStr(Now) + '] ';
end;
initialization
begin
AppDir := ExtractFilePath(ParamStr(0));
if AppDir[Length(AppDir)] <> PathDelim then
AppDir := AppDir + PathDelim;
end;
finalization
begin
if Config <> nil then FreeAndNil(Config);
if Accounts <> nil then FreeAndNil(Accounts);
end;
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2008 Andreas Schneider
*)
unit UConfig;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, DOM, XMLRead, XMLWrite, md5, Keyboard, UAccount,
UXmlHelper, UInterfaces, UEnums;
type
TInvalidConfigVersionExeption = class(Exception);
{ TMapInfo }
TMapInfo = class(TObject, ISerializable)
constructor Create(AOwner: IInvalidate);
constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
procedure Serialize(AElement: TDOMElement);
protected
FOwner: IInvalidate;
FMapFile: string;
FStaticsFile: string;
FStaIdxFile: string;
FWidth: Word;
FHeight: Word;
procedure SetHeight(const AValue: Word);
procedure SetMapFile(const AValue: string);
procedure SetStaIdxFile(const AValue: string);
procedure SetStaticsFile(const AValue: string);
procedure SetWidth(const AValue: Word);
public
property MapFile: string read FMapFile write SetMapFile;
property StaticsFile: string read FStaticsFile write SetStaticsFile;
property StaIdxFile: string read FStaIdxFile write SetStaIdxFile;
property Width: Word read FWidth write SetWidth;
property Height: Word read FHeight write SetHeight;
end;
{ TConfig }
TConfig = class(TObject, ISerializable, IInvalidate)
constructor Create(AFilename: string);
constructor Init(AFilename: string);
destructor Destroy; override;
procedure Serialize(AElement: TDOMElement);
protected
FFilename: string;
FPort: Integer;
FMap: TMapInfo;
FTiledata: string;
FRadarcol: string;
FAccounts: TAccountList;
FChanged: Boolean;
procedure SetPort(const AValue: Integer);
procedure SetRadarcol(const AValue: string);
procedure SetTiledata(const AValue: string);
public
property Port: Integer read FPort write SetPort;
property Map: TMapInfo read FMap;
property Tiledata: string read FTiledata write SetTiledata;
property Radarcol: string read FRadarcol write SetRadarcol;
property Accounts: TAccountList read FAccounts;
procedure Flush;
procedure Invalidate;
end;
var
AppDir: string;
ConfigFile: string;
Config: TConfig;
function TimeStamp: string;
implementation
const
CONFIGVERSION = 3;
function QueryPassword: String;
var
pwChar: char;
begin
Result := '';
InitKeyboard;
try
repeat
pwChar := GetKeyEventChar(TranslateKeyEvent(GetKeyEvent));
case pwChar of
#8: Result := Copy(Result, 1, Length(Result) - 1);
#13: break;
else
Result := Result + pwChar;
end;
until pwChar = #13;
finally
DoneKeyboard;
end;
writeln('');
end;
function TimeStamp: string;
begin
Result := '[' + DateTimeToStr(Now) + '] ';
end;
{ TMapInfo }
constructor TMapInfo.Create(AOwner: IInvalidate);
begin
inherited Create;
FOwner := AOwner;
end;
constructor TMapInfo.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
begin
Create(AOwner);
FMapFile := TXmlHelper.ReadString(AElement, 'Map', 'map0.mul');
FStaIdxFile := TXmlHelper.ReadString(AElement, 'StaIdx', 'staidx0.mul');
FStaticsFile := TXmlHelper.ReadString(AElement, 'Statics', 'statics0.mul');
FWidth := TXmlHelper.ReadInteger(AElement, 'Width', 768);
FHeight := TXmlHelper.ReadInteger(AElement, 'Height', 512);
end;
procedure TMapInfo.Serialize(AElement: TDOMElement);
begin
TXmlHelper.WriteString(AElement, 'Map', FMapFile);
TXmlHelper.WriteString(AElement, 'StaIdx', FStaIdxFile);
TXmlHelper.WriteString(AElement, 'Statics', FStaticsFile);
TXmlHelper.WriteInteger(AElement, 'Width', FWidth);
TXmlHelper.WriteInteger(AElement, 'Height', FHeight);
end;
procedure TMapInfo.SetHeight(const AValue: Word);
begin
FHeight := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetMapFile(const AValue: string);
begin
FMapFile := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetStaIdxFile(const AValue: string);
begin
FStaIdxFile := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetStaticsFile(const AValue: string);
begin
FStaticsFile := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetWidth(const AValue: Word);
begin
FWidth := AValue;
FOwner.Invalidate;
end;
{ 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
*
* 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
*)
unit UConnectionHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums;
type
{ TProtocolVersion }
TProtocolVersionPacket = class(TPacket)
constructor Create(AVersion: Cardinal);
end;
{ TLoginResponsePacket }
TLoginResponsePacket = class(TPacket)
constructor Create(AState: TLoginState; AAccessLevel: TAccessLevel = alNone);
end;
{ TServerStatePacket }
TServerStatePacket = class(TPacket)
constructor Create(AState: TServerState; AMessage: string = '');
end;
procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
ConnectionPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
uses
md5, UCEDServer, UClientHandling, UPackets;
procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
packetHandler := ConnectionPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;
procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
username, passwordHash: string;
account: TAccount;
pwHash: string;
netState: TNetState;
invalid: Boolean;
begin
username := ABuffer.ReadStringNull;
passwordHash := MD5Print(MD5String(ABuffer.ReadStringNull));
account := Accounts.Find(username);
if account <> nil then
begin
if account.AccessLevel > alNone then
begin
if account.PasswordHash = passwordHash then
begin
invalid := False;
CEDServerInstance.TCPServer.IterReset;
if CEDServerInstance.TCPServer.Iterator <> nil then
begin
repeat
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsAlreadyLoggedIn));
CEDServerInstance.Disconnect(ANetState.Socket);
invalid := True;
Break;
end;
until not CEDServerInstance.TCPServer.IterNext;
end;
if not invalid then
begin
Writeln(TimeStamp, 'Login (', username, '): ', ANetState.Socket.PeerAddress);
ANetState.Account := account;
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsOK, account.AccessLevel));
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
TClientListPacket.Create(ANetState)));
CEDServerInstance.SendPacket(nil, TClientConnectedPacket.Create(username));
CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos));
end;
end else
begin
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidPassword));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end else
begin
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsNoAccess));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end else
begin
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidUser));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end;
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.Disconnect(ANetState.Socket);
end;
{ TProtocolVersionPacket }
constructor TProtocolVersionPacket.Create(AVersion: Cardinal);
begin
inherited Create($02, 0);
FStream.WriteByte($01);
FStream.WriteCardinal(AVersion);
end;
{ TLoginResponsePacket }
constructor TLoginResponsePacket.Create(AState: TLoginState;
AAccessLevel: TAccessLevel = alNone);
begin
inherited Create($02, 0);
FStream.WriteByte($03);
FStream.WriteByte(Byte(AState));
if AState = lsOK then
begin
FStream.WriteByte(Byte(AAccessLevel));
FStream.WriteWord(Config.ReadInteger('Parameters', 'Width', 768));
FStream.WriteWord(Config.ReadInteger('Parameters', 'Height', 512));
end;
end;
{ TServerStatePacket }
constructor TServerStatePacket.Create(AState: TServerState; AMessage: string = '');
begin
inherited Create($02, 0);
FStream.WriteByte($04);
FStream.WriteByte(Byte(AState));
if AState = ssOther then
FStream.WriteStringNull(AMessage);
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
ConnectionPacketHandlers[i] := nil;
ConnectionPacketHandlers[$03] := TPacketHandler.Create(0, @OnLoginRequestPacket);
ConnectionPacketHandlers[$05] := TPacketHandler.Create(0, @OnQuitPacket);
finalization
for i := 0 to $FF do
if ConnectionPacketHandlers[i] <> nil then
ConnectionPacketHandlers[i].Free;
{$WARNINGS ON}
end.
(*
* 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 UConnectionHandling;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums;
type
{ TProtocolVersion }
TProtocolVersionPacket = class(TPacket)
constructor Create(AVersion: Cardinal);
end;
{ TLoginResponsePacket }
TLoginResponsePacket = class(TPacket)
constructor Create(AState: TLoginState; AAccessLevel: TAccessLevel = alNone);
end;
{ TServerStatePacket }
TServerStatePacket = class(TPacket)
constructor Create(AState: TServerState; AMessage: string = '');
end;
procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
ConnectionPacketHandlers: array[0..$FF] of TPacketHandler;
implementation
uses
md5, UCEDServer, UClientHandling, UPackets;
procedure OnConnectionHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
packetHandler := ConnectionPacketHandlers[ABuffer.ReadByte];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;
procedure OnLoginRequestPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
username, passwordHash: string;
account: TAccount;
pwHash: string;
netState: TNetState;
invalid: Boolean;
begin
username := ABuffer.ReadStringNull;
passwordHash := MD5Print(MD5String(ABuffer.ReadStringNull));
account := Config.Accounts.Find(username);
if account <> nil then
begin
if account.AccessLevel > alNone then
begin
if account.PasswordHash = passwordHash then
begin
invalid := False;
CEDServerInstance.TCPServer.IterReset;
if CEDServerInstance.TCPServer.Iterator <> nil then
begin
repeat
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsAlreadyLoggedIn));
CEDServerInstance.Disconnect(ANetState.Socket);
invalid := True;
Break;
end;
until not CEDServerInstance.TCPServer.IterNext;
end;
if not invalid then
begin
Writeln(TimeStamp, 'Login (', username, '): ', ANetState.Socket.PeerAddress);
ANetState.Account := account;
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsOK, account.AccessLevel));
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
TClientListPacket.Create(ANetState)));
CEDServerInstance.SendPacket(nil, TClientConnectedPacket.Create(username));
CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos));
end;
end else
begin
Writeln(TimeStamp, 'Invalid password for ', username);
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidPassword));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end else
begin
Writeln(TimeStamp, 'Access denied for ', username);
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsNoAccess));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end else
begin
Writeln(TimeStamp, 'Invalid account specified: ', ANetState.Socket.PeerAddress);
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidUser));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end;
procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
CEDServerInstance.Disconnect(ANetState.Socket);
end;
{ TProtocolVersionPacket }
constructor TProtocolVersionPacket.Create(AVersion: Cardinal);
begin
inherited Create($02, 0);
FStream.WriteByte($01);
FStream.WriteCardinal(AVersion);
end;
{ TLoginResponsePacket }
constructor TLoginResponsePacket.Create(AState: TLoginState;
AAccessLevel: TAccessLevel = alNone);
begin
inherited Create($02, 0);
FStream.WriteByte($03);
FStream.WriteByte(Byte(AState));
if AState = lsOK then
begin
FStream.WriteByte(Byte(AAccessLevel));
FStream.WriteWord(Config.Map.Width);
FStream.WriteWord(Config.Map.Height);
end;
end;
{ TServerStatePacket }
constructor TServerStatePacket.Create(AState: TServerState; AMessage: string = '');
begin
inherited Create($02, 0);
FStream.WriteByte($04);
FStream.WriteByte(Byte(AState));
if AState = ssOther then
FStream.WriteStringNull(AMessage);
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
ConnectionPacketHandlers[i] := nil;
ConnectionPacketHandlers[$03] := TPacketHandler.Create(0, @OnLoginRequestPacket);
ConnectionPacketHandlers[$05] := TPacketHandler.Create(0, @OnQuitPacket);
finalization
for i := 0 to $FF do
if ConnectionPacketHandlers[i] <> nil then
ConnectionPacketHandlers[i].Free;
{$WARNINGS ON}
end.

2
Server/ULandscape.pas
View File

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

10
Server/cedserver.lpi
View File

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

148
Server/cedserver.lpr
View File

@ -1,75 +1,73 @@
(*
* 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
*)
program cedserver;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
SysUtils, Classes,
lnetbase,
UConfig, UCEDServer, URadarMap, ULargeScaleOperations;
{$I version.inc}
begin
Writeln('UO CentrED Server Version ', ProductVersion);
Writeln('Copyright ', Copyright);
//Writeln('================================');
Writeln('');
{$IFDEF Windows}
if not LoadConfig then
begin
InitConfig;
Writeln('');
end;
{$ELSE}
if ParamStr(1) = '--init' then
begin
InitConfig;
Halt;
end;
if not LoadConfig then
begin
Writeln('No valid config file was found. Use --init to create one.');
Halt;
end;
{$ENDIF}
Write(TimeStamp, 'Initializing ... ');
Randomize;
CEDServerInstance := TCEDServer.Create;
Writeln('Done');
CEDServerInstance.Run;
Write(TimeStamp, 'Terminating ... ');
CEDServerInstance.Free;
Writeln('Done');
end.
(*
* 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
*)
program cedserver;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
SysUtils, Classes,
lnetbase,
UConfig, UCEDServer, URadarMap, ULargeScaleOperations;
{$I version.inc}
begin
Writeln('UO CentrED Server Version ', ProductVersion);
Writeln('Copyright ', Copyright);
//Writeln('================================');
Writeln('');
{$IFDEF Windows}
if FileExists(ConfigFile) then
Config := TConfig.Create(ConfigFile)
else
Config := TConfig.Init(ConfigFile);
{$ELSE}
if ParamStr(1) = '--init' then
Config := TConfig.Init(ConfigFile)
else if FileExists(ConfigFile) then
Config := TConfig.Create(ConfigFile)
else begin
Writeln('No valid config file was found. Use --init to create one.');
Halt;
end;
{$ENDIF}
Write(TimeStamp, 'Initializing ... ');
Randomize;
CEDServerInstance := TCEDServer.Create;
Writeln('Done');
CEDServerInstance.Run;
Write(TimeStamp, 'Terminating ... ');
FreeAndNil(CEDServerInstance);
Config.Flush;
FreeAndNil(Config);
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
uses
Classes, RtlConsts, SysUtils, UIStream;
Classes, RtlConsts, SysUtils;
type
{@name is the stub for the method which will handle the OnProgress callbacks.
@ -94,7 +94,7 @@ type
//generic TStreamWrapper<TStreamType> = class(TObject{, IStream})
{@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.))}
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.)
destructor Destroy; override; //<Is called when the current instance of @classname is destroyed. If it owns the underlying stream it is destroyed aswell.
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.