- Initial import from internal repository

This commit is contained in:
2007-12-21 21:31:58 +01:00
commit c0a125042b
194 changed files with 86503 additions and 0 deletions

181
Server/UAccount.pas Normal file
View File

@@ -0,0 +1,181 @@
(*
* 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.

226
Server/UAdminHandling.pas Normal file
View File

@@ -0,0 +1,226 @@
(*
* 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.

361
Server/UCEDServer.pas Normal file
View File

@@ -0,0 +1,361 @@
(*
* 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.

207
Server/UClientHandling.pas Normal file
View File

@@ -0,0 +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.

182
Server/UConfig.pas Normal file
View File

@@ -0,0 +1,182 @@
(*
* 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.

View File

@@ -0,0 +1,195 @@
(*
* 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.

1101
Server/ULandscape.pas Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,380 @@
(*
* 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 ULargeScaleOperations;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UMap, UStatics, UEnhancedMemoryStream, math,
ULandscape;
type
TCopyMoveType = (cmCopy = 0, cmMove = 1);
TSetAltitudeType = (saTerrain = 1, saRelative = 2);
TStaticsPlacement = (spTerrain = 1, spTop = 2, spFix = 3);
{ TLargeScaleOperation }
TLargeScaleOperation = class(TObject)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); virtual;
protected
FLandscape: TLandscape;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); virtual; abstract;
end;
{ TLSCopyMove }
TLSCopyMove = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FType: TCopyMoveType;
FOffsetX: Integer;
FOffsetY: Integer;
FErase: Boolean;
public
property OffsetX: Integer read FOffsetX;
property OffsetY: Integer read FOffsetY;
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
{ TLSSetAltitude }
TLSSetAltitude = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FType: TSetAltitudeType;
FMinZ: ShortInt;
FMaxZ: ShortInt;
FRelativeZ: ShortInt;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
{ TLSDrawTerrain }
TLSDrawTerrain = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FTileIDs: array of Word;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
{ TLSDeleteStatics }
TLSDeleteStatics = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FTileIDs: array of Word;
FMinZ: ShortInt;
FMaxZ: ShortInt;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
{ TLSInsertStatics }
TLSInsertStatics = class(TLargeScaleOperation)
constructor Init(AData: TEnhancedMemoryStream; ALandscape: TLandscape); override;
protected
FTileIDs: array of Word;
FProbability: Byte;
FPlacementType: TStaticsPlacement;
FFixZ: ShortInt;
public
procedure Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits); override;
end;
implementation
uses
UCEDServer, UTiledata;
{ TLargeScaleOperation }
constructor TLargeScaleOperation.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
begin
inherited Create;
FLandscape := ALandscape;
end;
{ TLSCopyMove }
constructor TLSCopyMove.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
begin
inherited Init(AData, ALandscape);
FType := TCopyMoveType(AData.ReadByte);
FOffsetX := AData.ReadInteger;
FOffsetY := AData.ReadInteger;
FErase := AData.ReadBoolean;
end;
procedure TLSCopyMove.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
var
x, y: Word;
targetCell: TMapCell;
targetStatics: TList;
targetStaticsBlock: TSeperatedStaticBlock;
i: Integer;
staticItem: TStaticItem;
begin
x := EnsureRange(AMapCell.X + FOffsetX, 0, FLandscape.CellWidth - 1);
y := EnsureRange(AMapCell.Y + FOffsetY, 0, FLandscape.CellHeight - 1);
//writeln('target: ', x, ',', y);
targetCell := FLandscape.MapCell[x, y];
targetStaticsBlock := FLandscape.GetStaticBlock(x div 8, y div 8);
targetStatics := targetStaticsBlock.Cells[(y mod 8) * 8 + (x mod 8)];
if FErase then
begin
for i := 0 to targetStatics.Count - 1 do
begin
TStaticItem(targetStatics.Items[i]).Delete;
end;
targetStatics.Clear;
end;
targetCell.TileID := AMapCell.TileID;
targetCell.Z := AMapCell.Z;
if FType = cmCopy then
begin
for i := 0 to AStatics.Count - 1 do
begin
staticItem := TStaticItem.Create(nil, nil, 0, 0);
staticItem.X := x;
staticItem.Y := y;
staticItem.Z := TStaticItem(AStatics.Items[i]).Z;
staticItem.TileID := TStaticItem(AStatics.Items[i]).TileID;
staticItem.Hue := TStaticItem(AStatics.Items[i]).Hue;
staticItem.Owner := targetStaticsBlock;
targetStatics.Add(staticItem);
end;
end else
begin
{for i := 0 to AStatics.Count - 1 do}
while AStatics.Count > 0 do
begin
targetStatics.Add(AStatics.Items[0]);
TStaticItem(AStatics.Items[0]).UpdatePos(x, y, TStaticItem(AStatics.Items[0]).Z);
TStaticItem(AStatics.Items[0]).Owner := targetStaticsBlock;
AStatics.Delete(0);
end;
//AStatics.Clear;
end;
FLandscape.SortStaticsList(targetStatics);
AAdditionalAffectedBlocks.Bits[(x div 8) * FLandscape.Height + (y div 8)] := True;
end;
{ TLSSetAltitude }
constructor TLSSetAltitude.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
begin
inherited Init(AData, ALandscape);
FType := TSetAltitudeType(AData.ReadByte);
case FType of
saTerrain:
begin
FMinZ := AData.ReadShortInt;
FMaxZ := AData.ReadShortInt;
end;
saRelative:
begin
FRelativeZ := AData.ReadShortInt;
end;
end;
end;
procedure TLSSetAltitude.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
var
i: Integer;
newZ: ShortInt;
diff: ShortInt;
static: TStaticItem;
begin
if FType = saTerrain then
begin
newZ := FMinZ + Random(FMaxZ - FMinZ + 1);
diff := newZ - AMapCell.Z;
AMapCell.Z := newZ;
end else
begin
diff := FRelativeZ;
AMapCell.Z := EnsureRange(AMapCell.Z + diff, -128, 127);
end;
for i := 0 to AStatics.Count - 1 do
begin
static := TStaticItem(AStatics.Items[i]);
static.Z := EnsureRange(static.Z + diff, -128, 127);
end;
end;
{ TLSDrawTerrain }
constructor TLSDrawTerrain.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
var
count: Word;
begin
inherited Init(AData, ALandscape);
count := AData.ReadWord;
SetLength(FTileIDs, count);
AData.Read(FTileIDs[0], count * SizeOf(Word));
end;
procedure TLSDrawTerrain.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
begin
if Length(FTileIDs) > 0 then
AMapCell.TileID := FTileIDs[Random(Length(FTileIDs))];
end;
{ TLSDeleteStatics }
constructor TLSDeleteStatics.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
var
count: Word;
begin
inherited Init(AData, ALandscape);
count := AData.ReadWord;
SetLength(FTileIDs, count);
AData.Read(FTileIDs[0], count * SizeOf(Word));
FMinZ := AData.ReadShortInt;
FMaxZ := AData.ReadShortInt;
end;
procedure TLSDeleteStatics.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
var
i, j: Integer;
static: TStaticItem;
begin
i := 0;
while i < AStatics.Count do
begin
static := TStaticItem(AStatics.Items[i]);
if InRange(static.Z, FMinZ, FMaxZ) then
begin
if Length(FTileIDs) > 0 then
begin
for j := Low(FTileIDs) to High(FTileIDs) do
begin
if static.TileID = FTileIDs[j] - $4000 then
begin
AStatics.Delete(i);
static.Delete;
Dec(i);
Break;
end;
end;
Inc(i);
end else
begin
AStatics.Delete(i);
static.Delete;
end;
end else
Inc(i);
end;
end;
{ TLSInsertStatics }
constructor TLSInsertStatics.Init(AData: TEnhancedMemoryStream;
ALandscape: TLandscape);
var
count: Word;
begin
inherited Init(AData, ALandscape);
count := AData.ReadWord;
SetLength(FTileIDs, count);
AData.Read(FTileIDs[0], count * SizeOf(Word));
FProbability := AData.ReadByte;
FPlacementType := TStaticsPlacement(AData.ReadByte);
if FPlacementType = spFix then
FFixZ := AData.ReadShortInt;
end;
procedure TLSInsertStatics.Apply(AMapCell: TMapCell; AStatics: TList;
AAdditionalAffectedBlocks: TBits);
var
staticItem, static: TStaticItem;
topZ, staticTop: ShortInt;
i: Integer;
begin
if (Length(FTileIDs) = 0) or (Random(100) >= FProbability) then Exit;
staticItem := TStaticItem.Create(nil, nil, 0, 0);
staticItem.X := AMapCell.X;
staticItem.Y := AMapCell.Y;
staticItem.TileID := FTileIDs[Random(Length(FTileIDs))] - $4000;
staticItem.Hue := 0;
case FPlacementType of
spTerrain:
begin
staticItem.Z := AMapCell.Z;
end;
spTop:
begin
topZ := AMapCell.Z;
for i := 0 to AStatics.Count - 1 do
begin
static := TStaticItem(AStatics.Items[i]);
staticTop := EnsureRange(static.Z + CEDServerInstance.Landscape.TiledataProvider.StaticTiles[static.TileID].Height, -128, 127);
if staticTop > topZ then topZ := staticTop;
end;
end;
spFix:
begin
staticItem.Z := FFixZ;
end;
end;
AStatics.Add(staticItem);
staticItem.Owner := CEDServerInstance.Landscape.GetStaticBlock(staticItem.X div 8,
staticItem.Y div 8);
end;
end.

89
Server/UNetState.pas Normal file
View File

@@ -0,0 +1,89 @@
(*
* 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 UNetState;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, lNet, UEnhancedMemoryStream, UAccount, ULinkedList;
type
{ TNetState }
TNetState = class(TObject)
constructor Create(ASocket: TLSocket);
destructor Destroy; override;
protected
FSocket: TLSocket;
FSendQueue: TEnhancedMemoryStream;
FReceiveQueue: TEnhancedMemoryStream;
FAccount: TAccount;
FSubscriptions: TList;
FLastAction: TDateTime;
public
property Socket: TLSocket read FSocket;
property SendQueue: TEnhancedMemoryStream read FSendQueue;
property ReceiveQueue: TEnhancedMemoryStream read FReceiveQueue;
property Account: TAccount read FAccount write FAccount;
property Subscriptions: TList read FSubscriptions;
property LastAction: TDateTime read FLastAction write FLastAction;
end;
implementation
{ TNetState }
constructor TNetState.Create(ASocket: TLSocket);
begin
inherited Create;
FSocket := ASocket;
FSendQueue := TEnhancedMemoryStream.Create;
FReceiveQueue := TEnhancedMemoryStream.Create;
FAccount := nil;
FSubscriptions := TList.Create;
FLastAction := Now;
end;
destructor TNetState.Destroy;
var
i: Integer;
begin
if FSendQueue <> nil then FreeAndNil(FSendQueue);
if FReceiveQueue <> nil then FreeAndNil(FReceiveQueue);
if FSubscriptions <> nil then
begin
for i := 0 to FSubscriptions.Count - 1 do
TLinkedList(FSubscriptions.Items[i]).Delete(Self);
FreeAndNil(FSubscriptions);
end;
inherited Destroy;
end;
end.

189
Server/UPacketHandlers.pas Normal file
View File

@@ -0,0 +1,189 @@
(*
* 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 UPacketHandlers;
interface
uses
SysUtils, dzlib, UConfig, UNetState, UEnhancedMemoryStream, UEnums,
ULinkedList;
type
TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState) of object;
{ TPacketHandler }
TPacketHandler = class(TObject)
constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload;
constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload;
procedure Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
protected
FLength: Cardinal;
FPacketProcessor: TPacketProcessor;
FPacketProcessorMethod: TPacketProcessorMethod;
published
property PacketLength: Cardinal read FLength;
end;
var
PacketHandlers: array[0..$FF] of TPacketHandler;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
implementation
uses
UCEDServer, UPackets, UConnectionHandling, UAdminHandling, UClientHandling;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean;
begin
Result := (ANetState.Account <> nil) and (ANetState.Account.AccessLevel >= ALevel);
end;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
begin
if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]);
PacketHandlers[AID] := APacketHandler;
end;
{ TPacketHandler }
constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor);
begin
inherited Create;
FLength := ALength;
FPacketProcessor := APacketProcessor;
FPacketProcessorMethod := nil;
end;
constructor TPacketHandler.Create(ALength: Cardinal;
APacketProcessorMethod: TPacketProcessorMethod);
begin
inherited Create;
FLength := ALength;
FPacketProcessor := nil;
FPacketProcessorMethod := APacketProcessorMethod;
end;
procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
if Assigned(FPacketProcessor) then
FPacketProcessor(ABuffer, ANetState)
else if Assigned(FPacketProcessorMethod) then
FPacketProcessorMethod(ABuffer, ANetState);
end;
procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
uncompStream: TEnhancedMemoryStream;
uncompBuffer: TDecompressionStream;
targetSize: Cardinal;
packetID: Byte;
begin
targetSize := ABuffer.ReadCardinal;
uncompBuffer := TDecompressionStream.Create(ABuffer);
uncompStream := TEnhancedMemoryStream.Create;
try
uncompStream.CopyFrom(uncompBuffer, targetSize);
uncompStream.Position := 0;
packetID := uncompStream.ReadByte;
if PacketHandlers[packetID] <> nil then
begin
if PacketHandlers[PacketID].PacketLength = 0 then
uncompStream.Position := uncompStream.Position + 4;
uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position);
PacketHandlers[PacketID].Process(uncompStream, ANetState);
uncompStream.Unlock;
end else
begin
Writeln(TimeStamp, 'Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);
ANetState.ReceiveQueue.Clear;
CEDServerInstance.Disconnect(ANetState.Socket);
end;
finally
if uncompBuffer <> nil then uncompBuffer.Free;
if uncompStream <> nil then uncompStream.Free;
end;
end;
procedure OnRequestBlocksPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
coords: TBlockCoordsArray;
i: Integer;
begin
if not ValidateAccess(ANetState, alView) then Exit;
SetLength(coords, (ABuffer.Size - ABuffer.Position) div SizeOf(TBlockCoords));
ABuffer.Read(coords[0], Length(coords) * SizeOf(TBlockCoords));
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TBlockPacket.Create(coords, ANetState)));
end;
procedure OnFreeBlockPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
x, y: Word;
blockSubscriptions: TLinkedList;
begin
if not ValidateAccess(ANetState, alView) then Exit;
x := ABuffer.ReadWord;
y := ABuffer.ReadWord;
blockSubscriptions := CEDServerInstance.Landscape.BlockSubscriptions[X, Y];
if blockSubscriptions <> nil then
begin
blockSubscriptions.Delete(ANetState);
ANetState.Subscriptions.Remove(blockSubscriptions);
end;
end;
procedure OnNoOpPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
//no operation
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
PacketHandlers[i] := nil;
PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket);
PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlerPacket);
PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket);
PacketHandlers[$04] := TPacketHandler.Create(0, @OnRequestBlocksPacket);
PacketHandlers[$05] := TPacketHandler.Create(5, @OnFreeBlockPacket);
//$06-$0B handled by landscape
PacketHandlers[$0C] := TPacketHandler.Create(0, @OnClientHandlerPacket);
//$0D handled by radarmap
//$0E handled by landscape
PacketHandlers[$FF] := TPacketHandler.Create(1, @OnNoOpPacket);
finalization
for i := 0 to $FF do
if PacketHandlers[i] <> nil then
PacketHandlers[i].Free;
{$WARNINGS ON}
end.

226
Server/UPackets.pas Normal file
View File

@@ -0,0 +1,226 @@
(*
* 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 UPackets;
interface
uses
Classes, dzlib, UEnhancedMemoryStream, UPacket, UMap, UStatics, ULinkedList,
UNetState;
type
TBlockCoords = packed record
X: Word;
Y: Word;
end;
TBlockCoordsArray = array of TBlockCoords;
{ TCompressedPacket }
TCompressedPacket = class(TPacket)
constructor Create(APacket: TPacket);
end;
{ TSendBlocksPacket }
TBlockPacket = class(TPacket)
constructor Create(ACoords: TBlockCoordsArray; ANetState: TNetState);
end;
{ TDrawMapPacket }
TDrawMapPacket = class(TPacket)
constructor Create(AMapCell: TMapCell);
end;
{ TInsertStaticPacket }
TInsertStaticPacket = class(TPacket)
constructor Create(AStaticItem: TStaticItem);
end;
{ TDeleteStaticPacket }
TDeleteStaticPacket = class(TPacket)
constructor Create(AStaticItem: TStaticItem);
end;
{ TElevateStaticPacket }
TElevateStaticPacket = class(TPacket)
constructor Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
end;
{ TMoveStaticPacket }
TMoveStaticPacket = class(TPacket)
constructor Create(AStaticItem: TStaticItem; ANewX, ANewY: Word);
end;
{ THueStaticPacket }
THueStaticPacket = class(TPacket)
constructor Create(AStaticItem: TStaticItem; ANewHue: Word);
end;
implementation
uses
UCEDServer;
{ TCompressedPacket }
constructor TCompressedPacket.Create(APacket: TPacket);
var
compBuffer: TEnhancedMemoryStream;
compStream: TCompressionStream;
sourceStream: TEnhancedMemoryStream;
begin
inherited Create($01, 0);
sourceStream := APacket.Stream;
compBuffer := TEnhancedMemoryStream.Create;
compStream := TCompressionStream.Create(clMax, compBuffer);
compStream.CopyFrom(sourceStream, 0);
compStream.Free;
FStream.WriteCardinal(sourceStream.Size);
FStream.CopyFrom(compBuffer, 0);
compBuffer.Free;
APacket.Free;
end;
{ TBlockPacket }
constructor TBlockPacket.Create(ACoords: TBlockCoordsArray; ANetState: TNetState);
var
i: Integer;
mapBlock: TMapBlock;
staticsBlock: TStaticBlock;
subscriptions: TLinkedList;
begin
inherited Create($04, 0);
for i := Low(ACoords) to High(ACoords) do
begin
mapBlock := CEDServerInstance.Landscape.GetMapBlock(ACoords[i].X, ACoords[i].Y);
if mapBlock = nil then Continue;
mapBlock.GetSize;
staticsBlock := CEDServerInstance.Landscape.GetStaticBlock(ACoords[i].X, ACoords[i].Y);
if staticsBlock = nil then Continue;
staticsBlock.GetSize;
FStream.Write(ACoords[i], SizeOf(TBlockCoords));
mapBlock.Write(FStream);
FStream.WriteWord(staticsBlock.Items.Count);
staticsBlock.Write(FStream);
if ANetState <> nil then
begin
subscriptions := CEDServerInstance.Landscape.BlockSubscriptions[ACoords[i].X, ACoords[i].Y];
subscriptions.Delete(ANetState);
subscriptions.Add(Integer(ANetState), ANetState);
if ANetState.Subscriptions.IndexOf(subscriptions) = -1 then
ANetState.Subscriptions.Add(subscriptions);
end;
end;
end;
{ TDrawMapPacket }
constructor TDrawMapPacket.Create(AMapCell: TMapCell);
begin
inherited Create($06, 8);
FStream.WriteWord(AMapCell.X);
FStream.WriteWord(AMapCell.Y);
FStream.WriteShortInt(AMapCell.Altitude);
FStream.WriteWord(AMapCell.TileID);
end;
{ TInsertStaticPacket }
constructor TInsertStaticPacket.Create(AStaticItem: TStaticItem);
begin
inherited Create($07, 10);
FStream.WriteWord(AStaticItem.X);
FStream.WriteWord(AStaticItem.Y);
FStream.WriteShortInt(AStaticItem.Z);
FStream.WriteWord(AStaticItem.TileID);
FStream.WriteWord(AStaticItem.Hue);
end;
{ TDeleteStaticPacket }
constructor TDeleteStaticPacket.Create(AStaticItem: TStaticItem);
begin
inherited Create($08, 10);
FStream.WriteWord(AStaticItem.X);
FStream.WriteWord(AStaticItem.Y);
FStream.WriteShortInt(AStaticItem.Z);
FStream.WriteWord(AStaticItem.TileID);
FStream.WriteWord(AStaticItem.Hue);
end;
{ TElevateStaticPacket }
constructor TElevateStaticPacket.Create(AStaticItem: TStaticItem; ANewZ: ShortInt);
begin
inherited Create($09, 11);
FStream.WriteWord(AStaticItem.X);
FStream.WriteWord(AStaticItem.Y);
FStream.WriteShortInt(AStaticItem.Z);
FStream.WriteWord(AStaticItem.TileID);
FStream.WriteWord(AStaticItem.Hue);
FStream.WriteShortInt(ANewZ);
end;
{ TMoveStaticPacket }
constructor TMoveStaticPacket.Create(AStaticItem: TStaticItem; ANewX,
ANewY: Word);
begin
inherited Create($0A, 14);
FStream.WriteWord(AStaticItem.X);
FStream.WriteWord(AStaticItem.Y);
FStream.WriteShortInt(AStaticItem.Z);
FStream.WriteWord(AStaticItem.TileID);
FStream.WriteWord(AStaticItem.Hue);
FStream.WriteWord(ANewX);
FStream.WriteWord(ANewY);
end;
{ THueStaticPacket }
constructor THueStaticPacket.Create(AStaticItem: TStaticItem; ANewHue: Word);
begin
inherited Create($0B, 12);
FStream.WriteWord(AStaticItem.X);
FStream.WriteWord(AStaticItem.Y);
FStream.WriteShortInt(AStaticItem.Z);
FStream.WriteWord(AStaticItem.TileID);
FStream.WriteWord(AStaticItem.Hue);
FStream.WriteWord(ANewHue);
end;
end.

267
Server/URadarMap.pas Normal file
View File

@@ -0,0 +1,267 @@
(*
* 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 URadarMap;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UConfig, UNetState, UEnhancedMemoryStream, UEnums;
type
TRadarColorArray = array of Word;
{ TRadarMap }
TRadarMap = class(TObject)
constructor Create(AMap, AStatics, AStaIdx: TStream; AWidth, AHeight: Word;
ARadarCol: string);
destructor Destroy; override;
protected
FWidth: Word;
FHeight: Word;
FRadarColors: TRadarColorArray;
FRadarMap: TRadarColorArray;
FPackets: TList;
FPacketSize: Cardinal;
procedure OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
public
procedure Update(AX, AY, ATileID: Word);
procedure BeginUpdate;
procedure EndUpdate;
end;
implementation
uses
UPacket, UPackets, UPacketHandlers, UCEDServer, crc;
type
TMulIndex = packed record
Position: Cardinal;
Size: Cardinal;
Userdata: Cardinal;
end;
TMapCell = packed record
TileID: Word;
Altitude: ShortInt;
end;
TStaticItem = packed record
TileID: Word;
X, Y: Byte;
Z: ShortInt;
Hue: Word;
end;
{ TRadarChecksumPacket }
TRadarChecksumPacket = class(TPacket)
constructor Create(ARadarMap: TRadarColorArray);
end;
{ TRadarMapPacket }
TRadarMapPacket = class(TPacket)
constructor Create(ARadarMap: TRadarColorArray);
end;
{ TUpdateRadarPacket }
TUpdateRadarPacket = class(TPacket)
constructor Create(AX, AY, AColor: Word);
end;
{ TRadarChecksumPacket }
constructor TRadarChecksumPacket.Create(ARadarMap: TRadarColorArray);
var
checksum: Cardinal;
begin
inherited Create($0D, 0);
FStream.WriteByte($01);
checksum := crc32(0, nil, 0);
checksum := crc32(checksum, @ARadarMap[0], Length(ARadarMap) * SizeOf(Word));
FStream.WriteCardinal(checksum);
end;
{ TRadarMapPacket }
constructor TRadarMapPacket.Create(ARadarMap: TRadarColorArray);
begin
inherited Create($0D, 0);
FStream.WriteByte($02);
FStream.Write(ARadarMap[0], Length(ARadarMap) * SizeOf(Word));
end;
{ TUpdateRadarPacket }
constructor TUpdateRadarPacket.Create(AX, AY, AColor: Word);
begin
inherited Create($0D, 0);
FStream.WriteByte($03);
FStream.WriteWord(AX);
FStream.WriteWord(AY);
FStream.WriteWord(AColor);
end;
{ TRadarMap }
constructor TRadarMap.Create(AMap, AStatics, AStaIdx: TStream; AWidth,
AHeight: Word; ARadarCol: string);
var
radarcol: TFileStream;
count, i, item, highestZ: Integer;
staticsItems: array of TStaticItem;
mapCell: TMapCell;
index: TMulIndex;
begin
radarcol := TFileStream.Create(ARadarCol, fmOpenRead);
SetLength(FRadarColors, radarcol.Size div SizeOf(Word));
radarcol.Read(FRadarColors[0], radarcol.Size);
radarcol.Free;
FWidth := AWidth;
FHeight := AHeight;
count := AWidth * AHeight;
SetLength(FRadarMap, count);
AMap.Position := 4;
AStaIdx.Position := 0;
for i := 0 to count - 1 do
begin
AMap.Read(mapCell, SizeOf(TMapCell));
AMap.Seek(193, soFromCurrent);
FRadarMap[i] := FRadarColors[mapCell.TileID];
AStaIdx.Read(index, SizeOf(TMulIndex));
if (index.Position < $FFFFFFFF) and (index.Size > 0) then
begin
AStatics.Position := index.Position;
SetLength(staticsItems, index.Size div 7);
AStatics.Read(staticsItems[0], index.Size);
highestZ := mapCell.Altitude;
for item := Low(staticsItems) to High(staticsItems) do
begin
if (staticsItems[item].X = 0) and (staticsItems[item].Y = 0) and
(staticsItems[item].Z >= highestZ) then
begin
highestZ := staticsItems[item].Z;
FRadarMap[i] := FRadarColors[staticsItems[item].TileID + $4000];
end;
end;
end;
end;
FPackets := nil;
RegisterPacketHandler($0D, TPacketHandler.Create(2, @OnRadarHandlingPacket));
inherited Create;
end;
destructor TRadarMap.Destroy;
begin
RegisterPacketHandler($0D, nil);
inherited Destroy;
end;
procedure TRadarMap.OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
subID: Byte;
begin
if not ValidateAccess(ANetState, alView) then Exit;
subID := ABuffer.ReadByte;
case subID of
$01: //request checksum
begin
CEDServerInstance.SendPacket(ANetState, TRadarChecksumPacket.Create(
FRadarMap));
end;
$02: //request radarmap
begin
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
TRadarMapPacket.Create(FRadarMap)));
end;
end;
end;
procedure TRadarMap.Update(AX, AY, ATileID: Word);
var
color: Word;
block: Cardinal;
packet: TPacket;
begin
block := AX * FHeight + AY;
color := FRadarColors[ATileID];
if FRadarMap[block] <> color then
begin
FRadarMap[block] := color;
packet := TUpdateRadarPacket.Create(AX, AY, color);
if FPackets <> nil then
begin
FPackets.Add(packet);
Inc(FPacketSize, packet.Stream.Size);
end else
CEDServerInstance.SendPacket(nil, packet);
end;
end;
procedure TRadarMap.BeginUpdate;
begin
if FPackets <> nil then Exit;
FPackets := TList.Create;
FPacketSize := 0;
end;
procedure TRadarMap.EndUpdate;
var
completePacket: TPacket;
i: Integer;
begin
if FPackets = nil then Exit;
completePacket := TCompressedPacket.Create(TRadarMapPacket.Create(FRadarMap));
if completePacket.Stream.Size <= (FPacketSize div 4) * 5 then
begin
CEDServerInstance.SendPacket(nil, completePacket);
for i := 0 to FPackets.Count - 1 do
TPacket(FPackets.Items[i]).Free;
end else
begin
for i := 0 to FPackets.Count - 1 do
CEDServerInstance.SendPacket(nil, TPacket(FPackets.Items[i]));
completePacket.Free;
end;
FreeAndNil(FPackets);
end;
end.

107
Server/cedserver.lpi Normal file
View File

@@ -0,0 +1,107 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<Version Value="6"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</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>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="lnetbase"/>
</Item1>
</RequiredPackages>
<Units Count="8">
<Unit0>
<Filename Value="cedserver.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="cedserver"/>
</Unit0>
<Unit1>
<Filename Value="UConfig.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UConfig"/>
</Unit1>
<Unit2>
<Filename Value="UCEDServer.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UCEDServer"/>
</Unit2>
<Unit3>
<Filename Value="UNetState.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UNetState"/>
</Unit3>
<Unit4>
<Filename Value="UAccount.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UAccount"/>
</Unit4>
<Unit5>
<Filename Value="UConnectionHandling.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UConnectionHandling"/>
</Unit5>
<Unit6>
<Filename Value="URadarMap.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="URadarMap"/>
</Unit6>
<Unit7>
<Filename Value="ULargeScaleOperations.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ULargeScaleOperations"/>
</Unit7>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<Target>
<Filename Value="../bin/cedserver"/>
</Target>
<SearchPaths>
<IncludeFiles Value="../;../Imaging/"/>
<OtherUnitFiles Value="../;../UOLib/;../MulProvider/;../Imaging/ZLib/"/>
<UnitOutputDirectory Value="../obj"/>
<SrcPath Value="../;../UOLib/;../MulProvider/;../Imaging/ZLib/"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Generate Value="Faster"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
<TargetOS Value="Win32"/>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other>
<CustomOptions Value="-FE..\bin\
"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

75
Server/cedserver.lpr Normal file
View File

@@ -0,0 +1,75 @@
(*
* 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.