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

* Added CentrED+ code (thanks to StaticZ for his awesome work!)

Browse Source
This commit is contained in:
Andreas Schneider
2015-05-01 12:23:03 +02:00
parent 2e62fd570a
commit 34637d40ce
97 changed files with 22628 additions and 4243 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
Server/UAccount.pas
View File

@@ -49,15 +49,18 @@ type
FPasswordHash: string;
FLastPos: TPoint;
FRegions: TStringList;
FLastLogon: TDateTime;
procedure SetAccessLevel(const AValue: TAccessLevel);
procedure SetPasswordHash(const AValue: string);
procedure SetLastPos(const AValue: TPoint);
procedure SetLastLogon(const ADateTime: TDateTime);
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;
property Regions: TStringList read FRegions;
property LastLogon: TDateTime read FLastLogon write SetLastLogon;
procedure Invalidate;
end;
@@ -154,6 +157,11 @@ begin
Invalidate;
end;
procedure TAccount.SetLastLogon(const ADateTime: TDateTime);
begin
FLastLogon := ADateTime;
end;
procedure TAccount.Invalidate;
begin
FOwner.Invalidate;

8
Server/UAdminHandling.pas
View File

@@ -108,9 +108,13 @@ procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
packetHandler: TPacketHandler;
packetID: Byte;
begin
if not ValidateAccess(ANetState, alAdministrator) then Exit;
packetHandler := AdminPacketHandlers[ABuffer.ReadByte];
if not ValidateAccess(ANetState, alDeveloper) then Exit;
packetID := ABuffer.ReadByte;
if ((packetID <> $01) and not ValidateAccess(ANetState, alAdministrator)) then Exit;
packetHandler := AdminPacketHandlers[packetID];
if packetHandler <> nil then
packetHandler.Process(ABuffer, ANetState);
end;

59
Server/UCEDServer.pas
View File

@@ -31,7 +31,7 @@ interface
uses
Classes, SysUtils, lNet, UEnhancedMemoryStream, UConfig, ULandscape,
UNetState, UPacket, dateutils,
UNetState, UPacket, dateutils, LConvEncoding, Language,
{$IFDEF Linux}BaseUnix,{$ENDIF}
{$IFDEF Windows}Windows,{$ENDIF}
UPacketHandlers, UConnectionHandling;
@@ -44,6 +44,7 @@ type
constructor Create;
destructor Destroy; override;
protected
FWorkStart: TDateTime;
FLandscape: TLandscape;
FTCPServer: TLTcp;
FQuit: Boolean;
@@ -57,6 +58,7 @@ type
procedure ProcessBuffer(ANetState: TNetState);
procedure CheckNetStates;
public
property WorkStart: TDateTime read FWorkStart;
property Landscape: TLandscape read FLandscape;
property TCPServer: TLTcp read FTCPServer;
property Quit: Boolean read FQuit write FQuit;
@@ -79,13 +81,13 @@ uses
{$IFDEF Linux}
procedure OnSigInt(ASignal: cint); cdecl;
begin
Writeln(TimeStamp, 'Killed');
Writeln(TimeStamp, GetText('Aborting'));
if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end;
procedure OnSigSegv(ASignal: cint); cdecl;
begin
Writeln(TimeStamp, 'Internal error');
Writeln(TimeStamp, GetText('InternEr'));
Halt;
//if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
end;
@@ -97,7 +99,7 @@ begin
Result := False;
if (ACtrl = CTRL_C_EVENT) or (ACtrl = CTRL_BREAK_EVENT) then
begin
Writeln(TimeStamp, 'Killed');
Writeln(TimeStamp, GetText('Aborting'));
if CEDServerInstance <> nil then CEDServerInstance.Quit := True;
Result := True;
end;
@@ -109,9 +111,10 @@ end;
constructor TCEDServer.Create;
begin
inherited Create;
FWorkStart := Now;
FLandscape := TLandscape.Create(Config.Map.MapFile, Config.Map.StaticsFile,
Config.Map.StaIdxFile, Config.Tiledata, Config.Radarcol, Config.Map.Width,
Config.Map.Height, FValid);
Config.Map.Height, Config.Map.FormatFlags, FValid);
FTCPServer := TLTcp.Create(nil);
FTCPServer.OnAccept := @OnAccept;
FTCPServer.OnCanSend := @OnCanSend;
@@ -145,7 +148,7 @@ end;
procedure TCEDServer.OnAccept(ASocket: TLSocket);
begin
writeln(TimeStamp, 'Connect: ', ASocket.PeerAddress);
writeln(TimeStamp, GetText('Connects') + ' ', ASocket.PeerAddress);
ASocket.UserData := TNetState.Create(ASocket);
SendPacket(TNetState(ASocket.UserData), TProtocolVersionPacket.Create(ProtocolVersion));
end;
@@ -172,11 +175,16 @@ procedure TCEDServer.OnDisconnect(ASocket: TLSocket);
var
netState: TNetState;
begin
writeln(TimeStamp, 'Disconnect: ', ASocket.PeerAddress);
writeln(TimeStamp, GetText('ConLosts') + ' ', ASocket.PeerAddress);
if ASocket.UserData <> nil then
begin
netState := TNetState(ASocket.UserData);
ASocket.UserData := nil;
{$IFDEF NetLog}
if netState.Account <> nil
then writeln(TimeStamp, '$OnDisconnect("',netState.Account.Name,'")')
else writeln(TimeStamp, '$OnDisconnect("UNKNOWN")')
{$ENDIF}
if netState.Account <> nil then
SendPacket(nil, TClientDisconnectedPacket.Create(netState.Account.Name));
netState.Free;
@@ -203,8 +211,9 @@ end;
procedure TCEDServer.OnError(const AError: string; ASocket: TLSocket);
begin
writeln(TimeStamp, 'Error: ', ASocket.PeerAddress, ' :: ', AError);
writeln(TimeStamp, GetText('ErrorLbl') + ' ', ASocket.PeerAddress, ' :: ', TranslateTextA(AError));
//OnDisconnect(ASocket);
ASocket.Disconnect(True);
end;
procedure TCEDServer.ProcessBuffer(ANetState: TNetState);
@@ -220,6 +229,12 @@ begin
while (buffer.Size >= 1) and ANetState.Socket.Connected do
begin
packetID := buffer.ReadByte;
{$IFDEF NetLog}
if (ANetState.Account <> nil)
then writeln(TimeStamp, Format('NetState: [0x%.2x] <<-- "%s"', [packetID, ANetState.Account.Name]))
else writeln(TimeStamp, Format('NetState: [0x%.2x] <<-- "NEW (%s:%d)"', [packetID, ANetState.Socket.PeerAddress, ANetState.Socket.PeerPort]));
{$ENDIF}
packetHandler := PacketHandlers[packetID];
if packetHandler <> nil then
begin
@@ -243,7 +258,7 @@ begin
Break; //wait for more data
end else
begin
Writeln(TimeStamp, 'Dropping client due to unknown packet [', packetID, ']: ', ANetState.Socket.PeerAddress);
Writeln(TimeStamp, GetText('UnkPack1'), packetID, GetText('UnkPack2') + ' ', ANetState.Socket.PeerAddress);
Disconnect(ANetState.Socket);
buffer.Clear;
end;
@@ -253,7 +268,7 @@ begin
on E: Exception do
begin
Logger.SendException([lcServer], 'Error processing buffer', E);
Writeln(TimeStamp, 'Error processing buffer of client: ', ANetState.Socket.PeerAddress);
Writeln(TimeStamp, GetText('BufferEr') + ' ', ANetState.Socket.PeerAddress);
end;
end;
end;
@@ -273,13 +288,16 @@ begin
if (SecondsBetween(netState.LastAction, Now) > 120) then
begin
if netState.Account <> nil then
Writeln(TimeStamp, 'Timeout: ', netState.Account.Name, ' (', netState.Socket.PeerAddress, ')')
Writeln(TimeStamp, GetText('TimeOuts') + ' ', netState.Account.Name, ' (', netState.Socket.PeerAddress, ')')
else
Writeln(TimeStamp, 'Timeout: ', netState.Socket.PeerAddress);
Writeln(TimeStamp, GetText('TimeOuts') + ' ', netState.Socket.PeerAddress);
Disconnect(netState.Socket);
end;
end else {TODO : Unnecessary ...}
begin
{$IFDEF NetLog}
Writeln(TimeStamp, GetText('$CheckNetStates - OnDisconnect'));
{$ENDIF}
OnDisconnect(FTCPServer.Iterator);
end;
end;
@@ -290,7 +308,7 @@ procedure TCEDServer.Run;
begin
if not FValid then
begin
Writeln(TimeStamp, 'Invalid data. Check the map size and the files.');
Writeln(TimeStamp, GetText('BadFacet'));
Exit;
end;
@@ -317,22 +335,37 @@ var
begin
if ANetState <> nil then
begin
{$IFDEF NetLog}
if (ANetState.Account <> nil)
then writeln(TimeStamp, Format('NetState: [0x%.2x] -->> "%s"', [APacket.PacketID, ANetState.Account.Name]))
else writeln(TimeStamp, Format('NetState: [0x%.2x] -->> "NEW (%s:%d)"', [APacket.PacketID, ANetState.Socket.PeerAddress, ANetState.Socket.PeerPort]));
{$ENDIF}
ANetState.SendQueue.Seek(0, soFromEnd);
ANetState.SendQueue.CopyFrom(APacket.Stream, 0);
OnCanSend(ANetState.Socket);
end else //broadcast
begin
{$IFDEF NetLog}
write(TimeStamp, Format('NetState: [0x%.2x] -->> "BROADCAST: ', [APacket.PacketID]));
{$ENDIF}
FTCPServer.IterReset;
while FTCPServer.IterNext do
begin
netState := TNetState(FTCPServer.Iterator.UserData);
if (netState <> nil) and (FTCPServer.Iterator.Connected) then
begin
{$IFDEF NetLog}
write('.');
{$ENDIF}
netState.SendQueue.Seek(0, soFromEnd);
netState.SendQueue.CopyFrom(APacket.Stream, 0);
OnCanSend(netState.Socket);
end;
end;
{$IFDEF NetLog}
writeln(' "');
{$ENDIF}
end;
if AFreePacket then
APacket.Free;

14
Server/UClientHandling.pas
View File

@@ -31,14 +31,14 @@ interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, Math;
UEnhancedMemoryStream, UEnums, dateutils, Math;
type
{ TClientConnectedPacket }
TClientConnectedPacket = class(TPacket)
constructor Create(AUsername: string);
constructor Create(AAccount: TAccount);
end;
{ TClientDisconnectedPacket }
@@ -170,11 +170,12 @@ end;
{ TClientConnectedPacket }
constructor TClientConnectedPacket.Create(AUsername: string);
constructor TClientConnectedPacket.Create(AAccount: TAccount);
begin
inherited Create($0C, 0);
FStream.WriteByte($01);
FStream.WriteStringNull(AUsername);
FStream.WriteStringNull(AAccount.Name);
FStream.WriteByte(Byte(AAccount.AccessLevel));
end;
{ TClientDisconnectedPacket }
@@ -200,8 +201,11 @@ begin
repeat
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState <> AAvoid) and
(netState.Account <> nil) then
(netState.Account <> nil) then begin
FStream.WriteStringNull(netState.Account.Name);
FStream.WriteByte(Byte(netState.Account.AccessLevel));
FStream.WriteDWord(DWord(SecondsBetween(netState.Account.LastLogon, CEDServerInstance.WorkStart)));
end;
until not CEDServerInstance.TCPServer.IterNext;
end;
end;

108
Server/UConfig.pas
View File

@@ -31,7 +31,7 @@ interface
uses
Classes, SysUtils, DOM, XMLRead, XMLWrite, md5, Keyboard, UAccount,
UXmlHelper, UInterfaces, UEnums, URegions;
UXmlHelper, UInterfaces, UEnums, URegions, LConvEncoding, Language;
type
@@ -50,17 +50,20 @@ type
FStaIdxFile: string;
FWidth: Word;
FHeight: Word;
FFormatFlags: Cardinal;
procedure SetHeight(const AValue: Word);
procedure SetMapFile(const AValue: string);
procedure SetStaIdxFile(const AValue: string);
procedure SetStaticsFile(const AValue: string);
procedure SetWidth(const AValue: Word);
procedure SetFormatFlags(const AValue: Cardinal);
public
property MapFile: string read FMapFile write SetMapFile;
property StaticsFile: string read FStaticsFile write SetStaticsFile;
property StaIdxFile: string read FStaIdxFile write SetStaIdxFile;
property Width: Word read FWidth write SetWidth;
property Height: Word read FHeight write SetHeight;
property FormatFlags: Cardinal read FFormatFlags write SetFormatFlags;
end;
{ TConfig }
@@ -76,6 +79,7 @@ type
FMap: TMapInfo;
FTiledata: string;
FRadarcol: string;
FLanguage: string;
FRegions: TRegionList;
FAccounts: TAccountList;
FChanged: Boolean;
@@ -89,6 +93,7 @@ type
property Radarcol: string read FRadarcol write SetRadarcol;
property Regions: TRegionList read FRegions;
property Accounts: TAccountList read FAccounts;
property Language: string read FLanguage;
procedure Flush;
procedure Invalidate;
end;
@@ -97,13 +102,14 @@ var
AppDir: string;
ConfigFile: string;
Config: TConfig;
tmp_i: Integer;
function TimeStamp: string;
implementation
const
CONFIGVERSION = 3;
CONFIGVERSION = 5;
function QueryPassword: String;
var
@@ -130,7 +136,9 @@ end;
function TimeStamp: string;
begin
Result := '[' + DateTimeToStr(Now) + '] ';
//Result := '[' + DateTimeToStr(Now) + '] ';
//Result := FormatDateTime('[yyyy.mm.dd hh:mm:ss] ', Now);
Result := FormatDateTime('[hh:mm:ss] ', Now);
end;
{ TMapInfo }
@@ -149,22 +157,19 @@ begin
FStaticsFile := TXmlHelper.ReadString(AElement, 'Statics', 'statics0.mul');
FWidth := TXmlHelper.ReadInteger(AElement, 'Width', 768);
FHeight := TXmlHelper.ReadInteger(AElement, 'Height', 512);
FFormatFlags := $F0000000 + Cardinal(TXmlHelper.ReadInteger(AElement, 'Format', $0000) and $0000FFFF);
end;
procedure TMapInfo.Serialize(AElement: TDOMElement);
begin
TXmlHelper.WriteString(AElement, 'Map', FMapFile);
TXmlHelper.WriteString(AElement, 'Map', FMapFile);
TXmlHelper.WriteString(AElement, 'StaIdx', FStaIdxFile);
TXmlHelper.WriteString(AElement, 'Statics', FStaticsFile);
TXmlHelper.WriteInteger(AElement, 'Width', FWidth);
TXmlHelper.WriteInteger(AElement, 'Height', FHeight);
TXmlHelper.WriteString(AElement, 'Statics',FStaticsFile);
TXmlHelper.WriteInteger(AElement,'Width', FWidth);
TXmlHelper.WriteInteger(AElement,'Height', FHeight);
TXmlHelper.WriteString(AElement, 'Format', Format('0x%.8x', [(FFormatFlags and $0000FFFF)]));
end;
procedure TMapInfo.SetHeight(const AValue: Word);
begin
FHeight := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetMapFile(const AValue: string);
begin
@@ -190,6 +195,18 @@ begin
FOwner.Invalidate;
end;
procedure TMapInfo.SetHeight(const AValue: Word);
begin
FHeight := AValue;
FOwner.Invalidate;
end;
procedure TMapInfo.SetFormatFlags(const AValue: Cardinal);
begin
FFormatFlags := AValue;
FOwner.Invalidate;
end;
{ TConfig }
constructor TConfig.Create(AFilename: string);
@@ -216,8 +233,9 @@ begin
FTiledata := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Tiledata', 'tiledata.mul');
FRadarcol := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Radarcol', 'radarcol.mul');
FLanguage := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Language', '..\Language\English.ini');
xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Regions'));
if assigned(xmlElement) then
FRegions := TRegionList.Deserialize(Self, xmlElement)
else
@@ -243,27 +261,37 @@ begin
FMap := TMapInfo.Create(Self);
FAccounts := TAccountList.Create(Self);
FRegions := TRegionList.Create(Self);
Writeln('Configuring Network');
Writeln('===================');
Write ('Port [2597]: ');
Writeln('');
Writeln('==============');
FLanguage := '..\Language\English.ini';
Writeln(UTF8ToCP866('language file [' + FLanguage + ']'));
Readln (stringValue);
if (stringValue <> '')
then FLanguage := stringValue;
LanguageLoad(FLanguage);
Writeln('');
Writeln(GetText('iNetwork'));
Writeln('==============');
Write (GetText('iSetPort') + UTF8ToCP866(' [2597]: '));
Readln (stringValue);
intValue := 0;
if not TryStrToInt(stringValue, intValue) then intValue := 2597;
FPort := intValue;
Writeln('');
Writeln('Configuring Paths');
Writeln('=================');
Write ('map [map0.mul]: ');
Writeln(GetText('iDatPath'));
Writeln('===============');
Write ('map [map0.mul]: ');
Readln (FMap.FMapFile);
if FMap.MapFile = '' then FMap.MapFile := 'map0.mul';
Write ('statics [statics0.mul]: ');
Readln (FMap.FStaticsFile);
if FMap.StaticsFile = '' then FMap.StaticsFile := 'statics0.mul';
Write ('staidx [staidx0.mul]: ');
Write ('staidx [staidx0.mul]: ');
Readln (FMap.FStaIdxFile);
if FMap.StaIdxFile = '' then FMap.StaIdxFile := 'staidx0.mul';
Write ('statics [statics0.mul]: ');
Readln (FMap.FStaticsFile);
if FMap.StaticsFile = '' then FMap.StaticsFile := 'statics0.mul';
Write ('tiledata [tiledata.mul]: ');
Readln (FTiledata);
if FTiledata = '' then FTiledata := 'tiledata.mul';
@@ -272,25 +300,29 @@ begin
if FRadarcol = '' then FRadarcol := 'radarcol.mul';
Writeln('');
Writeln('Parameters');
Writeln('==========');
Write ('Map width [768]: ');
Writeln(GetText('iMapDesc'));
Writeln('===============');
Write (GetText('iMapWidt') + UTF8ToCP866(' [768]: '));
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 768;
FMap.Width := intValue;
Write ('Map height [512]: ');
Write (GetText('iMapHeig') + UTF8ToCP866(' [512]: '));
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := 512;
FMap.Height := intValue;
Write (GetText('iDFormat') + UTF8ToCP866(' [0x0000]: '));
Readln (stringValue);
if not TryStrToInt(stringValue, intValue) then intValue := $0000;
FMap.FormatFlags := $F0000000 + Cardinal(intValue);
Writeln('');
Writeln('Admin account');
Writeln('=============');
Writeln(GetText('iAccount'));
Writeln('======================');
repeat
Write('Account name: ');
Write(GetText('iUserAcc') + UTF8ToCP866(' '));
Readln(stringValue);
until stringValue <> '';
Write ('Password [hidden]: ');
Write (GetText('iUserPas') + UTF8ToCP866(' '));
password := QueryPassword;
FAccounts.Add(TAccount.Create(FAccounts, stringValue,
MD5Print(MD5String(password)), alAdministrator, nil));
@@ -308,6 +340,7 @@ end;
procedure TConfig.Serialize(AElement: TDOMElement);
begin
TXmlHelper.WriteString(AElement, 'Language', FLanguage);
TXmlHelper.WriteInteger(AElement, 'Port', FPort);
FMap.Serialize(TXmlHelper.AssureElement(AElement, 'Map'));
TXmlHelper.WriteString(AElement, 'Tiledata', FTiledata);
@@ -360,10 +393,15 @@ 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');
ConfigFile := '';
for tmp_i := 0 to ParamCount do begin
if LowerCase(ExtractFileExt(ParamStr(tmp_i))) = '.xml'
then ConfigFile := ExtractFilePath(ParamStr(0)) + ParamStr(1);
end;
if ConfigFile = ''
then ConfigFile := ChangeFileExt(ParamStr(0), '.xml');
end;
end.

22
Server/UConnectionHandling.pas
View File

@@ -31,7 +31,7 @@ interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums;
UEnhancedMemoryStream, UEnums, dateutils, LConvEncoding, Language;
type
@@ -109,29 +109,29 @@ begin
if not invalid then
begin
Writeln(TimeStamp, 'Login (', username, '): ', ANetState.Socket.PeerAddress);
Writeln(TimeStamp, GetText('UserReg1'), username, GetText('UserReg2'), ANetState.Socket.PeerAddress);
ANetState.Account := account;
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsOK, account));
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
TClientListPacket.Create(ANetState)));
CEDServerInstance.SendPacket(nil, TClientConnectedPacket.Create(username));
CEDServerInstance.SendPacket(nil, TClientConnectedPacket.Create(account));
CEDServerInstance.SendPacket(ANetState, TSetClientPosPacket.Create(account.LastPos));
end;
end else
begin
Writeln(TimeStamp, 'Invalid password for ', username);
Writeln(TimeStamp, GetText('WrongPas') + ' ', username);
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidPassword));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end else
begin
Writeln(TimeStamp, 'Access denied for ', username);
Writeln(TimeStamp, GetText('UserBan1') + ' ', username, ' ' + GetText('UserBan2'));
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsNoAccess));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
end else
begin
Writeln(TimeStamp, 'Invalid account specified: ', ANetState.Socket.PeerAddress);
Writeln(TimeStamp, GetText('WrongAcc') + ' ', ANetState.Socket.PeerAddress);
CEDServerInstance.SendPacket(ANetState, TLoginResponsePacket.Create(lsInvalidUser));
CEDServerInstance.Disconnect(ANetState.Socket);
end;
@@ -148,22 +148,26 @@ constructor TProtocolVersionPacket.Create(AVersion: Cardinal);
begin
inherited Create($02, 0);
FStream.WriteByte($01);
FStream.WriteCardinal(AVersion);
FStream.WriteCardinal($1000 + AVersion);
end;
{ TLoginResponsePacket }
constructor TLoginResponsePacket.Create(AState: TLoginState;
AAccount: TAccount = nil);
constructor TLoginResponsePacket.Create(AState: TLoginState; AAccount: TAccount = nil);
var
val1, val2, val3, val4 : Word;
begin
inherited Create($02, 0);
FStream.WriteByte($03);
FStream.WriteByte(Byte(AState));
if AState = lsOK then
begin
AAccount.LastLogon := Now;
FStream.WriteByte(Byte(AAccount.AccessLevel));
FStream.WriteDWord(DWord(SecondsBetween(Now, CEDServerInstance.WorkStart)));
FStream.WriteWord(Config.Map.Width);
FStream.WriteWord(Config.Map.Height);
FStream.WriteCardinal(Config.Map.FormatFlags);
WriteAccountRestrictions(FStream, AAccount);
end;
end;

51
Server/ULandscape.pas
View File

@@ -32,8 +32,8 @@ interface
uses
SysUtils, Classes, math, UGenericIndex, UMap, UStatics, UWorldItem,
UTileDataProvider, URadarMap,
UCacheManager, ULinkedList, UBufferedStreams,
UEnhancedMemoryStream, UPacketHandlers, UPackets, UNetState, UEnums;
UCacheManager, ULinkedList, UBufferedStreams, Language,
UEnhancedMemoryStream, UPacketHandlers, UPackets, UNetState, UEnums, LConvEncoding;
type
PRadarBlock = ^TRadarBlock;
@@ -79,9 +79,9 @@ type
TLandscape = class
constructor Create(AMap, AStatics, AStaIdx, ATiledata, ARadarCol: string;
AWidth, AHeight: Word; var AValid: Boolean);
AWidth, AHeight: Word; FormatFlags: Cardinal; var AValid: Boolean);
constructor Create(AMap, AStatics, AStaIdx, ATiledata: TStream;
ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
ARadarCol: string; AWidth, AHeight: Word; FormatFlags: Cardinal; var AValid: Boolean);
destructor Destroy; override;
protected
FWidth: Word;
@@ -194,7 +194,7 @@ begin
for i := 0 to 63 do
Cells[i] := TStaticItemList.Create(True);
if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
if (AData <> nil) and (AIndex.Lookup >= 0) and (AIndex.Size > 0) then
begin
AData.Position := AIndex.Lookup;
block := TMemoryStream.Create;
@@ -285,11 +285,11 @@ end;
{ TLandscape }
constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata,
ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
ARadarCol: string; AWidth, AHeight: Word; FormatFlags: Cardinal; var AValid: Boolean);
var
map, statics, staidx, tiledata: TStream;
begin
Write(TimeStamp, 'Loading Map');
Write(TimeStamp, GetText('dfLoader') + ' Map');
map := TFileStream.Create(AMap, fmOpenReadWrite);
Write(', Statics');
statics := TFileStream.Create(AStatics, fmOpenReadWrite);
@@ -297,12 +297,12 @@ begin
staidx := TBufferedReader.Create(TFileStream.Create(AStaIdx, fmOpenReadWrite), True);
Writeln(', Tiledata');
tiledata := TFileStream.Create(ATiledata, fmOpenRead or fmShareDenyWrite);
Create(map, statics, staidx, tiledata, ARadarCol, AWidth, AHeight, AValid);
Create(map, statics, staidx, tiledata, ARadarCol, AWidth, AHeight, FormatFlags, AValid);
FOwnsStreams := True;
end;
constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata: TStream;
ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
ARadarCol: string; AWidth, AHeight: Word; FormatFlags: Cardinal; var AValid: Boolean);
var
blockID: Integer;
begin
@@ -316,30 +316,33 @@ begin
FStaIdx := AStaIdx;
FTiledata := ATiledata;
FOwnsStreams := False;
if (FormatFlags and $F0000000) = 0 then
raise Exception.Create('TLandscape.Create Unknown Format data flags.');
UseStaticsOldFormat := (FormatFlags and $00000001) <> 0;
AValid := Validate;
if AValid then
begin
Write(TimeStamp, 'Creating Cache');
Write(TimeStamp, GetText('Creating') + ' ' + GetText('crtCache'));
FBlockCache := TBlockCache.Create(256);
FBlockCache.OnRemoveObject := @OnRemoveCachedObject;
Write(', Tiledata');
FTiledataProvider := TTiledataProvider.Create(ATiledata);
Write(', Subscriptions');
FTiledataProvider := TTiledataProvider.Create((FormatFlags and $00000008) = 0, ATiledata);
Write(UTF8ToCP866(', ') + GetText('crtIndex')); //Subscriptions
SetLength(FBlockSubscriptions, AWidth * AHeight);
for blockID := 0 to AWidth * AHeight - 1 do
FBlockSubscriptions[blockID] := TLinkedList.Create;
Writeln(', RadarMap');
FRadarMap := TRadarMap.Create(FMap, FStatics, FStaIdx, FWidth, FHeight,
ARadarCol);
FRadarMap := TRadarMap.Create(FMap, FStatics, FStaIdx, FWidth, FHeight, ARadarCol);
RegisterPacketHandler($06, TPacketHandler.Create(8, @OnDrawMapPacket));
RegisterPacketHandler($06, TPacketHandler.Create( 8, @OnDrawMapPacket));
RegisterPacketHandler($07, TPacketHandler.Create(10, @OnInsertStaticPacket));
RegisterPacketHandler($08, TPacketHandler.Create(10, @OnDeleteStaticPacket));
RegisterPacketHandler($09, TPacketHandler.Create(11, @OnElevateStaticPacket));
RegisterPacketHandler($0A, TPacketHandler.Create(14, @OnMoveStaticPacket));
RegisterPacketHandler($0B, TPacketHandler.Create(12, @OnHueStaticPacket));
RegisterPacketHandler($0E, TPacketHandler.Create(0, @OnLargeScaleCommandPacket));
RegisterPacketHandler($0E, TPacketHandler.Create( 0, @OnLargeScaleCommandPacket));
end;
end;
@@ -562,17 +565,21 @@ var
size: Integer;
index: TGenericIndex;
begin
// Карта
if AWorldBlock is TMapBlock then
begin
FMap.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 196;
AWorldBlock.Write(FMap);
AWorldBlock.Changed := False;
// Статика
end else if AWorldBlock is TStaticBlock then
begin
FStaIdx.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 12;
index := TGenericIndex.Create(FStaIdx);
size := AWorldBlock.GetSize;
if (size > index.Size) or (index.Lookup < 0) then
// Если размер блока больше чем в мул файле или в мул файле блока нет или
// смещение на блок равно 0 (статика океана), то создаем новый блок в конце файла
if (size > index.Size) or (index.Lookup <= 0) then
begin
FStatics.Position := FStatics.Size;
index.Lookup := FStatics.Position;
@@ -799,7 +806,7 @@ begin
if (staticInfo.X = newX) and (staticInfo.Y = newY) then Exit;
if ((abs(staticInfo.X - newX) > 8) or (abs(staticInfo.Y - newY) > 8)) and
(not ValidateAccess(ANetState, alAdministrator)) then Exit;
(not ValidateAccess(ANetState, alDeveloper)) then Exit;
sourceBlock := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
targetBlock := GetStaticBlock(newX div 8, newY div 8);
@@ -946,10 +953,10 @@ var
cmOperation: TLSCopyMove;
additionalAffectedBlocks: TBits;
begin
if not ValidateAccess(ANetState, alAdministrator) then Exit;
Writeln(TimeStamp, ANetState.Account.Name, ' begins large scale operation');
if not ValidateAccess(ANetState, alDeveloper) then Exit;
Writeln(TimeStamp, ANetState.Account.Name, ' ' + GetText('LCmdRuns'));
CEDServerInstance.SendPacket(nil, TServerStatePacket.Create(ssOther,
Format('%s is performing large scale operations ...', [ANetState.Account.Name])));
Format(GetText('LCmdUsed'), [ANetState.Account.Name])));
//Bitmask
emptyBits := TBits.Create(64);
@@ -1157,7 +1164,7 @@ begin
end;
CEDServerInstance.SendPacket(nil, TServerStatePacket.Create(ssRunning));
Writeln(TimeStamp, 'Large scale operation ended.');
Writeln(TimeStamp, GetText('LCmdEnds'));
end;
end.

4
Server/UPacketHandlers.pas
View File

@@ -29,7 +29,7 @@ interface
uses
Classes, SysUtils, dzlib, UConfig, UNetState, UEnhancedMemoryStream, UEnums,
ULinkedList, URegions;
ULinkedList, URegions, LConvEncoding, Language;
type
TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
@@ -151,7 +151,7 @@ begin
uncompStream.Unlock;
end else
begin
Writeln(TimeStamp, 'Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);
Writeln(TimeStamp, GetText('UnkPack1'), packetID, GetText('UnkPack2') + ' ', ANetState.Socket.PeerAddress);
ANetState.ReceiveQueue.Clear;
CEDServerInstance.Disconnect(ANetState.Socket);
end;

46
Server/URadarMap.pas
View File

@@ -60,7 +60,7 @@ type
implementation
uses
UPacket, UPackets, UPacketHandlers, UCEDServer, crc;
UPacket, UPackets, UPacketHandlers, UCEDServer, crc, UStatics;
type
TMulIndex = packed record
@@ -72,6 +72,13 @@ type
TileID: Word;
Altitude: ShortInt;
end;
TOldStaticItem = packed record
Unknown: Cardinal;
TileID: Word;
X, Y: Byte;
Z: ShortInt;
Hue: Word;
end;
TStaticItem = packed record
TileID: Word;
X, Y: Byte;
@@ -138,6 +145,7 @@ var
radarcol: TFileStream;
count, i, item, highestZ: Integer;
staticsItems: array of TStaticItem;
oldStaticsItems: array of TOldStaticItem;
mapCell: TMapCell;
index: TMulIndex;
begin
@@ -161,21 +169,39 @@ begin
AMap.Seek(193, soFromCurrent);
FRadarMap[i] := FRadarColors[mapCell.TileID];
AStaIdx.Read(index, SizeOf(TMulIndex));
if (index.Position < $FFFFFFFF) and (index.Size > 0) then
if (index.Position < $FFFFFFFF) and (index.Size > 0)
and (index.Position + index.Size < AStatics.Size) 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
if not UseStaticsOldFormat then
begin
if (staticsItems[item].X = 0) and (staticsItems[item].Y = 0) and
(staticsItems[item].Z >= highestZ) then
SetLength(staticsItems, index.Size div 7);
AStatics.Read(staticsItems[0], index.Size);
highestZ := mapCell.Altitude;
for item := Low(staticsItems) to High(staticsItems) do
begin
highestZ := staticsItems[item].Z;
FRadarMap[i] := FRadarColors[staticsItems[item].TileID + $4000];
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 else begin
SetLength(oldStaticsItems, index.Size div 11);
AStatics.Read(oldStaticsItems[0], index.Size);
highestZ := mapCell.Altitude;
for item := Low(oldStaticsItems) to High(oldStaticsItems) do
begin
if (oldStaticsItems[item].X = 0) and (oldStaticsItems[item].Y = 0) and
(oldStaticsItems[item].Z >= highestZ) then
begin
highestZ := oldStaticsItems[item].Z;
FRadarMap[i] := FRadarColors[oldStaticsItems[item].TileID + $4000];
end;
end;
end;
end;
end;

60
Server/cedserver.lpi
View File

@@ -1,29 +1,30 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="7"/>
<Version Value="9"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<UseAppBundle Value="False"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<VersionInfo>
<UseVersionInfo Value="True"/>
<CurrentMajorRevNr Value="6"/>
<CurrentMinorRevNr Value="1"/>
<CurrentBuildNr Value="209"/>
<ProjectVersion Value="0.6.1.209"/>
<CompanyName Value="AKS DataBasis"/>
<FileDescription Value="CentrED Server"/>
<InternalName Value="CentrED Server"/>
<LegalCopyright Value="Andreas Schneider"/>
<OriginalFilename Value="cedserver.exe"/>
<ProductName Value="CentrED"/>
<AutoIncrementBuild Value="True"/>
<MinorVersionNr Value="7"/>
<RevisionNr Value="7"/>
<BuildNr Value="261"/>
<StringTable CompanyName="www.uoquint.ru" FileDescription="UO CentrED+ Server" InternalName="CentrED+ Server" LegalCopyright="StaticZ" OriginalFilename="cedserver.exe" ProductName="CentrED+ Server" ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
@@ -43,7 +44,7 @@
<PackageName Value="lnetbase"/>
</Item2>
</RequiredPackages>
<Units Count="16">
<Units Count="17">
<Unit0>
<Filename Value="cedserver.lpr"/>
<IsPartOfProject Value="True"/>
@@ -124,40 +125,41 @@
<IsPartOfProject Value="True"/>
<UnitName Value="UMap"/>
</Unit15>
<Unit16>
<Filename Value="language.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Language"/>
</Unit16>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Version Value="9"/>
<Target>
<Filename Value="../bin/cedserver"/>
<Filename Value="../bin/PEBinaries/cedserver.exe"/>
</Target>
<SearchPaths>
<IncludeFiles Value="../;../Imaging/"/>
<OtherUnitFiles Value="../;../UOLib/;../MulProvider/;../Imaging/ZLib/"/>
<IncludeFiles Value="..;../obj;../Imaging"/>
<OtherUnitFiles Value="..;../UOLib;../Server;../MulProvider;../Imaging;../Imaging/JpegLib;../Imaging/ZLib;../Client"/>
<UnitOutputDirectory Value="../obj"/>
<SrcPath Value="../;../UOLib/;../MulProvider/;../Imaging/ZLib/"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<TargetProcessor Value="pentium4"/>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
<StripSymbols Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other>
<CustomOptions Value="-FE../bin/
-dNoLogging"/>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CustomOptions Value="-dWindows"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>

31
Server/cedserver.lpr
View File

@@ -31,44 +31,53 @@ uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
SysUtils, UConfig, UCEDServer;
SysUtils, UConfig, UCEDServer, LConvEncoding, vinfo, Language;
{$I version.inc}
{$IFDEF WINDOWS}{$R cedserver.rc}{$ENDIF}
//{$IFDEF WINDOWS}{$R cedserver.rc}{$ENDIF}
{$R *.res}
begin
Writeln('');
Writeln('CentrED Server Version ', ProductVersion);
Writeln('Copyright ', Copyright);
Writeln(Format('======= CentrED+ Server [Version: %s Build: %d] =======',
[VersionInfo.GetFileVersionString, VersionInfo.Build]));
Writeln('Copyright: ', Original);
Writeln(' : ', '"CentrED+" version (c) ', Copyright, ' (uoquint.ru)');
//Writeln(' : ', '!!! pre-release (not stable version) !!!');
//Writeln('Modified by StaticZ (uoquint.ru)');
//Writeln('================================');
Writeln('');
{$IFDEF Windows}
if FileExists(ConfigFile) then
Config := TConfig.Create(ConfigFile)
else
Config := TConfig.Init(ConfigFile);
LanguageLoad(Config.Language);
{$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.');
Writeln(UTF8ToCP866('Файл конфигурации не был найден. Запустите програму с параметром --init чтобы создать новый файл конфигурации.'));
Halt;
end;
LanguageLoad(Config.Language);
{$ENDIF}
Writeln(TimeStamp, 'Initialization started');
Writeln(TimeStamp, GetText('xmLoaded') + ' "' + ExtractFileName(ConfigFile) + '"');
Writeln(TimeStamp, GetText('dfStRead'));
Randomize;
CEDServerInstance := TCEDServer.Create;
Writeln(TimeStamp, 'Initialization done');
Writeln(TimeStamp, GetText('dfInited'));
CEDServerInstance.Run;
Write(TimeStamp, 'Shutting down ... ');
Write(TimeStamp, GetText('Quieting'));
FreeAndNil(CEDServerInstance);
Config.Flush;
FreeAndNil(Config);
Writeln('done');
Writeln(GetText('SucsDone'));
end.

120
Server/language.pas Normal file
View File

@@ -0,0 +1,120 @@
(*
* CDDL HEADER START
*
* gfgfgfg
*)
unit Language;
{$mode objfpc}{$H+}
interface
procedure LanguageLoad(path: string);
function TranslateText(text: string) : string;
function TranslateTextA(text: string) : string;
function GetText(section : string; key: string) : string;
function GetText(key: string) : string;
implementation
uses SysUtils, Classes, IniFiles, LConvEncoding, UConfig;
var
LangPath : string;
LangFile : TIniFile;
CodePage : Integer;
WinIsoCP : Integer;
LangAbbr : string;
LangName : string;
procedure LanguageLoad(path: string);
begin
if (Copy(path, 2, 1) = ':')
then LangPath := path
else LangPath := ExtractFilePath(ParamStr(0)) + path;
if not FileExists(LangPath) then begin
Writeln(TranslateText('Language files doesn''t exists: "' + LangPath + '"'));
Halt;
end;
LangFile := TIniFile.Create(LangPath);
LangAbbr := LangFile.ReadString( 'info', 'LangAbbr', '');
WinIsoCP := LangFile.ReadInteger(' info', 'CodePage', 1250);
CodePage := LangFile.ReadInteger('Server', 'CodePage', 850);
LangName := LangFile.ReadString('info', 'Language', '');
Writeln(TimeStamp, GetText('iLangUse') + ' ', TranslateText(LangName));
end;
function LanguageGetName() : string;
begin
Result := LangName;
end;
function TranslateText(text: string) : string;
begin
case CodePage of
437 : Result := UTF8ToCP437(text);
850 : Result := UTF8ToCP850(text);
866 : Result := UTF8ToCP866(text);
874 : Result := UTF8ToCP874(text);
932 : Result := UTF8ToCP932(text);
936 : Result := UTF8ToCP936(text);
949 : Result := UTF8ToCP949(text);
950 : Result := UTF8ToCP950(text);
1250 : Result := UTF8ToCP1250(text);
1251 : Result := UTF8ToCP1251(text);
1252 : Result := UTF8ToCP1252(text);
1253 : Result := UTF8ToCP1253(text);
1254 : Result := UTF8ToCP1254(text);
1255 : Result := UTF8ToCP1255(text);
1256 : Result := UTF8ToCP1256(text);
1257 : Result := UTF8ToCP1257(text);
1258 : Result := UTF8ToCP1258(text);
else Result := UTF8ToCP1250(text);
end;
end;
function TranslateTextA(text: string) : string;
begin
case WinIsoCP of
437 : Result := TranslateText(CP437ToUTF8(text));
850 : Result := TranslateText(CP850ToUTF8(text));
866 : Result := TranslateText(CP866ToUTF8(text));
874 : Result := TranslateText(CP874ToUTF8(text));
932 : Result := TranslateText(CP932ToUTF8(text));
936 : Result := TranslateText(CP936ToUTF8(text));
949 : Result := TranslateText(CP949ToUTF8(text));
950 : Result := TranslateText(CP950ToUTF8(text));
1250 : Result := TranslateText(CP1250ToUTF8(text));
1251 : Result := TranslateText(CP1251ToUTF8(text));
1252 : Result := TranslateText(CP1252ToUTF8(text));
1253 : Result := TranslateText(CP1253ToUTF8(text));
1254 : Result := TranslateText(CP1254ToUTF8(text));
1255 : Result := TranslateText(CP1255ToUTF8(text));
1256 : Result := TranslateText(CP1256ToUTF8(text));
1257 : Result := TranslateText(CP1257ToUTF8(text));
1258 : Result := TranslateText(CP1258ToUTF8(text));
else Result := TranslateText(CP1250ToUTF8(text));
end;
end;
function GetText(section : string; key: string) : string;
var text : string;
begin
text := LangFile.ReadString(section, key, '');
if (text <> '')
then result := TranslateText(text)
else result := Format('%%%%[%s]%s%%%%', [section, key]);
end;
function GetText(key: string) : string;
begin
Result := GetText('Server', key);
end;
end.