- Imported server changes from Turley (with modifications)

- Bumped version to 0.3.7
- Changed ProtocolVersion o 6
- Fixed TXmlHelper's child node parsing (incorrect usage of FindNode)
- Added TModifyRegionStatus and TDeleteRegionStatus
This commit is contained in:
Andreas Schneider 2008-08-11 22:48:45 +02:00
parent 2409b861e3
commit c95ba906a7
10 changed files with 716 additions and 299 deletions

View File

@ -31,7 +31,7 @@ interface
uses uses
Classes, SysUtils, md5, contnrs, math, DOM, UXmlHelper, UInterfaces, Classes, SysUtils, md5, contnrs, math, DOM, UXmlHelper, UInterfaces,
UEnums; UEnums, URegions;
type type
@ -39,7 +39,7 @@ type
TAccount = class(TObject, ISerializable, IInvalidate) TAccount = class(TObject, ISerializable, IInvalidate)
constructor Create(AOwner: IInvalidate; AName, APasswordHash: string; constructor Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel); AAccessLevel: TAccessLevel; ARegions: TStringList);
constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement); constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
procedure Serialize(AElement: TDOMElement); procedure Serialize(AElement: TDOMElement);
protected protected
@ -48,6 +48,7 @@ type
FAccessLevel: TAccessLevel; FAccessLevel: TAccessLevel;
FPasswordHash: string; FPasswordHash: string;
FLastPos: TPoint; FLastPos: TPoint;
FRegions: TStringList;
procedure SetAccessLevel(const AValue: TAccessLevel); procedure SetAccessLevel(const AValue: TAccessLevel);
procedure SetPasswordHash(const AValue: string); procedure SetPasswordHash(const AValue: string);
procedure SetLastPos(const AValue: TPoint); procedure SetLastPos(const AValue: TPoint);
@ -56,6 +57,7 @@ type
property AccessLevel: TAccessLevel read FAccessLevel write SetAccessLevel; property AccessLevel: TAccessLevel read FAccessLevel write SetAccessLevel;
property PasswordHash: string read FPasswordHash write SetPasswordHash; property PasswordHash: string read FPasswordHash write SetPasswordHash;
property LastPos: TPoint read FLastPos write SetLastPos; property LastPos: TPoint read FLastPos write SetLastPos;
property Regions: TStringList read FRegions;
procedure Invalidate; procedure Invalidate;
end; end;
@ -82,16 +84,26 @@ uses
{ TAccount } { TAccount }
constructor TAccount.Create(AOwner: IInvalidate; AName, APasswordHash: string; constructor TAccount.Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel); AAccessLevel: TAccessLevel; ARegions: TStringList);
var
i : Integer;
begin begin
inherited Create; inherited Create;
FOwner := AOwner; FOwner := AOwner;
FName := AName; FName := AName;
FPasswordHash := APasswordHash; FPasswordHash := APasswordHash;
FAccessLevel := AAccessLevel; FAccessLevel := AAccessLevel;
if ARegions <> nil then
FRegions := ARegions
else
FRegions := TStringList.Create;
end; end;
constructor TAccount.Deserialize(AOwner: IInvalidate; AElement: TDOMElement); constructor TAccount.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
var
xmlElement, xmlRegion: TDOMElement;
nodelist: TDOMNodeList;
i: Integer;
begin begin
inherited Create; inherited Create;
FOwner := AOwner; FOwner := AOwner;
@ -100,6 +112,23 @@ begin
FPasswordHash := TXmlHelper.ReadString(AElement, 'PasswordHash', ''); FPasswordHash := TXmlHelper.ReadString(AElement, 'PasswordHash', '');
FLastPos := Point(0, 0); FLastPos := Point(0, 0);
TXmlHelper.ReadCoords(AElement, 'LastPos', FLastPos.X, FLastPos.Y); TXmlHelper.ReadCoords(AElement, 'LastPos', FLastPos.X, FLastPos.Y);
FRegions := TStringList.Create;
xmlElement := TDOMElement(AElement.FindNode('Regions'));
if xmlElement <> nil then
begin
nodeList := xmlElement.GetChildNodes;
for i := 0 to nodeList.Count - 1 do
begin
if nodeList.Item[i].NodeName = 'Region' then
begin
xmlRegion := TDOMElement(nodeList.Item[i]);
if assigned(xmlRegion.FirstChild) then
FRegions.Add(TDOMText(xmlRegion.FirstChild).Data);
end;
end;
nodeList.Free;
end;
end; end;
procedure TAccount.SetAccessLevel(const AValue: TAccessLevel); procedure TAccount.SetAccessLevel(const AValue: TAccessLevel);
@ -127,11 +156,18 @@ begin
end; end;
procedure TAccount.Serialize(AElement: TDOMElement); procedure TAccount.Serialize(AElement: TDOMElement);
var
i : Integer;
child : TDOMElement;
begin begin
TXmlHelper.WriteString(AElement, 'Name', FName); TXmlHelper.WriteString(AElement, 'Name', FName);
TXmlHelper.WriteString(AElement, 'PasswordHash', FPasswordHash); TXmlHelper.WriteString(AElement, 'PasswordHash', FPasswordHash);
TXmlHelper.WriteInteger(AElement, 'AccessLevel', Integer(FAccessLevel)); TXmlHelper.WriteInteger(AElement, 'AccessLevel', Integer(FAccessLevel));
TXmlHelper.WriteCoords(AElement, 'LastPos', FLastPos.X, FLastPos.Y); TXmlHelper.WriteCoords(AElement, 'LastPos', FLastPos.X, FLastPos.Y);
child := TXmlHelper.AssureElement(AElement, 'Regions');
for i := 0 to FRegions.Count -1 do
if Config.Regions.Find(FRegions[i]) <> nil then //Validate if the region (still) exists
TXmlHelper.WriteString(child, 'Region', FRegions[i]);
end; end;
{ TAccountList } { TAccountList }

View File

@ -30,8 +30,8 @@ unit UAdminHandling;
interface interface
uses uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState, Classes, SysUtils, math, UPacket, UPacketHandlers, UConfig, UAccount,
UEnhancedMemoryStream, UEnums, lNet; UNetState, UEnhancedMemoryStream, UEnums, URegions;
type type
@ -52,6 +52,24 @@ type
TUserListPacket = class(TPacket) TUserListPacket = class(TPacket)
constructor Create; constructor Create;
end; end;
{ TModifyRegionResponsePacket }
TModifyRegionResponsePacket = class(TPacket)
constructor Create(AStatus: TModifyRegionStatus; ARegion: TRegion);
end;
{ TDeleteRegionResponsePacket }
TDeleteRegionResponsePacket = class(TPacket)
constructor Create(AStatus: TDeleteRegionStatus; ARegionName: string);
end;
{ TUserRegionsPacket }
TRegionListPacket = class(TPacket)
constructor Create;
end;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnFlushPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
@ -59,6 +77,10 @@ procedure OnQuitPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnModifyUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnDeleteUserPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var var
AdminPacketHandlers: array[0..$FF] of TPacketHandler; AdminPacketHandlers: array[0..$FF] of TPacketHandler;
@ -68,7 +90,8 @@ implementation
uses uses
md5, UCEDServer, UPackets, UClientHandling; md5, UCEDServer, UPackets, UClientHandling;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var var
packetHandler: TPacketHandler; packetHandler: TPacketHandler;
begin begin
@ -96,15 +119,26 @@ var
username, password: string; username, password: string;
accessLevel: TAccessLevel; accessLevel: TAccessLevel;
netState: TNetState; netState: TNetState;
regions: TStringList;
i, regionCount: Integer;
begin begin
username := ABuffer.ReadStringNull; username := ABuffer.ReadStringNull;
password := ABuffer.ReadStringNull; password := ABuffer.ReadStringNull;
accessLevel := TAccessLevel(ABuffer.ReadByte); accessLevel := TAccessLevel(ABuffer.ReadByte);
regionCount := ABuffer.ReadByte;
account := Config.Accounts.Find(username); account := Config.Accounts.Find(username);
if account <> nil then if account <> nil then
begin begin
if password <> '' then if password <> '' then
account.PasswordHash := MD5Print(MD5String(password)); account.PasswordHash := MD5Print(MD5String(password));
account.Regions.Clear;
for i := 0 to regionCount - 1 do
account.Regions.Add(ABuffer.ReadStringNull);
account.Invalidate;
if account.AccessLevel <> accessLevel then if account.AccessLevel <> accessLevel then
begin begin
account.AccessLevel := accessLevel; account.AccessLevel := accessLevel;
@ -114,24 +148,34 @@ begin
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData); netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then if (netState <> nil) and (netState.Account = account) then
begin begin
CEDServerInstance.SendPacket(netState, TAccessLevelChangedPacket.Create(accessLevel)); CEDServerInstance.SendPacket(netState,
TAccessLevelChangedPacket.Create(accessLevel));
end; end;
end; end;
end; end;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muModified, account)); CEDServerInstance.SendPacket(ANetState,
TModifyUserResponsePacket.Create(muModified, account));
end else end else
begin begin
account := TAccount.Create(Config.Accounts, username, if username = '' then
MD5Print(MD5String(password)), accessLevel);
if (username = '') or (Pos('=', username) > 0) then
begin begin
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muInvalidUsername, account)); CEDServerInstance.SendPacket(ANetState,
account.Free; TModifyUserResponsePacket.Create(muInvalidUsername, account));
Exit; Exit;
end else
begin
regions := TStringList.Create;
for i := 0 to regionCount - 1 do
regions.Add(ABuffer.ReadStringNull);
account := TAccount.Create(Config.Accounts, username,
MD5Print(MD5String(password)), accessLevel, regions);
Config.Accounts.Add(account);
Config.Accounts.Invalidate;
CEDServerInstance.SendPacket(ANetState,
TModifyUserResponsePacket.Create(muAdded, account));
end; end;
Config.Accounts.Add(account);
Config.Invalidate;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muAdded, account));
end; end;
end; end;
@ -158,25 +202,112 @@ begin
end; end;
Config.Accounts.Remove(account); Config.Accounts.Remove(account);
Config.Invalidate; Config.Invalidate;
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duDeleted, username)); CEDServerInstance.SendPacket(ANetState,
TDeleteUserResponsePacket.Create(duDeleted, username));
end else end else
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duNotFound, username)); CEDServerInstance.SendPacket(ANetState,
TDeleteUserResponsePacket.Create(duNotFound, username));
end; end;
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
begin begin
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TUserListPacket.Create)); CEDServerInstance.SendPacket(ANetState,
TCompressedPacket.Create(TUserListPacket.Create));
end;
procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
regionName: string;
region: TRegion;
status: TModifyRegionStatus;
i, areaCount: Integer;
x1, y1, x2, y2: Word;
begin
regionName := ABuffer.ReadStringNull;
region := Config.Regions.Find(regionName);
if region = nil then
begin
region := TRegion.Create(Config.Regions, regionName);
Config.Regions.Add(region);
status := mrAdded;
end else
begin
region.Areas.Clear;
status := mrModified;
end;
areaCount := ABuffer.ReadByte;
for i := 0 to areaCount - 1 do
begin
x1 := ABuffer.ReadWord;
y1 := ABuffer.ReadWord;
x2 := ABuffer.ReadWord;
y2 := ABuffer.ReadWord;
region.Areas.Add(Min(x1, x2), Min(y1, y2),
Max(x1, x2), Max(y1, y2));
end;
CEDServerInstance.SendPacket(ANetState,
TModifyRegionResponsePacket.Create(status, region));
end;
procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
regionName: string;
regions: TRegionList;
i: Integer;
status: TDeleteRegionStatus;
begin
regionName := ABuffer.ReadStringNull;
i := 0;
status := drNotFound;
regions := Config.Regions;
while (i < regions.Count) and (status = drNotFound) do
begin
if TRegion(regions[i]).Name = regionName then
begin
regions.Delete(i);
status := drDeleted;
end else
inc(i);
end;
CEDServerInstance.SendPacket(ANetState,
TDeleteRegionResponsePacket.Create(status, regionName));
end;
procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
begin
CEDServerInstance.SendPacket(ANetState,
TCompressedPacket.Create(TRegionListPacket.Create));
end; end;
{ TModifyUserResponsePacket } { TModifyUserResponsePacket }
constructor TModifyUserResponsePacket.Create(AStatus: TModifyUserStatus; AAccount: TAccount); constructor TModifyUserResponsePacket.Create(AStatus: TModifyUserStatus;
AAccount: TAccount);
var
i: Integer;
begin begin
inherited Create($03, 0); inherited Create($03, 0);
FStream.WriteByte($05); FStream.WriteByte($05);
FStream.WriteByte(Byte(AStatus)); FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(AAccount.Name); FStream.WriteStringNull(AAccount.Name);
FStream.WriteByte(Byte(AAccount.AccessLevel)); if (AStatus = muAdded) or (AStatus = muModified) then
begin
FStream.WriteByte(Byte(AAccount.AccessLevel));
FStream.WriteByte(AAccount.Regions.Count);
if AAccount.Regions.Count > 0 then begin
for i := 0 to AAccount.Regions.Count - 1 do
FStream.WriteStringNull(AAccount.Regions[i]);
end;
end;
{TODO : check for client side modifications!}
end; end;
{ TDeleteUserResponsePacket } { TDeleteUserResponsePacket }
@ -193,7 +324,7 @@ end;
constructor TUserListPacket.Create; constructor TUserListPacket.Create;
var var
i: Integer; i, j: Integer;
account: TAccount; account: TAccount;
begin begin
inherited Create($03, 0); inherited Create($03, 0);
@ -204,6 +335,75 @@ begin
account := TAccount(Config.Accounts.Items[i]); account := TAccount(Config.Accounts.Items[i]);
FStream.WriteStringNull(account.Name); FStream.WriteStringNull(account.Name);
FStream.WriteByte(Byte(account.AccessLevel)); FStream.WriteByte(Byte(account.AccessLevel));
FStream.WriteByte(account.Regions.Count);
for j := 0 to account.Regions.Count - 1 do
FStream.WriteStringNull(account.Regions[j]);
end;
FStream.WriteWord(Config.Regions.Count);
for i := 0 to Config.Regions.Count - 1 do
FStream.WriteStringNull(TRegion(Config.Regions.Items[i]).Name);
end;
{ TModifyRegionResponsePacket }
constructor TModifyRegionResponsePacket.Create(AStatus: TModifyRegionStatus;
ARegion: TRegion);
var
i, areaCount: Integer;
begin
inherited Create($03, 0);
FStream.WriteByte($08);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(ARegion.Name);
if (AStatus = mrAdded) or (AStatus = mrModified) then
begin
areaCount := ARegion.Areas.Count;
FStream.WriteByte(areaCount);
for i := 0 to areaCount - 1 do
with ARegion.Areas.Rects[i] do
begin
FStream.WriteWord(Left);
FStream.WriteWord(Top);
FStream.WriteWord(Right);
FStream.WriteWord(Bottom);
end;
end;
end;
{ TDeleteRegionResponsePacket }
constructor TDeleteRegionResponsePacket.Create(AStatus: TDeleteRegionStatus;
ARegionName: string);
begin
inherited Create($03, 0);
FStream.WriteByte($09);
FStream.WriteByte(Byte(AStatus));
FStream.WriteStringNull(ARegionName);
end;
{ TRegionListPacket }
constructor TRegionListPacket.Create;
var
i, j: Integer;
region: TRegion;
begin
inherited Create($03, 0);
FStream.WriteByte($08);
FStream.WriteByte(Config.Regions.Count);
for i := 0 to Config.Regions.Count - 1 do
begin
region := TRegion(Config.Regions.Items[i]);
FStream.WriteStringNull(region.Name);
FStream.WriteByte(region.Areas.Count);
for j := 0 to region.Areas.Count - 1 do
with region.Areas.Rects[j] do
begin
FStream.WriteWord(Left);
FStream.WriteWord(Top);
FStream.WriteWord(Right);
FStream.WriteWord(Bottom);
end;
end; end;
end; end;
@ -219,6 +419,9 @@ initialization
AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserPacket); AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserPacket);
AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserPacket); AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserPacket);
AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket); AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket);
AdminPacketHandlers[$08] := TPacketHandler.Create(0, @OnModifyRegionPacket);
AdminPacketHandlers[$09] := TPacketHandler.Create(0, @OnDeleteRegionPacket);
AdminPacketHandlers[$0A] := TPacketHandler.Create(0, @OnListRegionsPacket);
finalization finalization
for i := 0 to $FF do for i := 0 to $FF do
if AdminPacketHandlers[i] <> nil then if AdminPacketHandlers[i] <> nil then

View File

@ -31,7 +31,7 @@ interface
uses uses
Classes, SysUtils, DOM, XMLRead, XMLWrite, md5, Keyboard, UAccount, Classes, SysUtils, DOM, XMLRead, XMLWrite, md5, Keyboard, UAccount,
UXmlHelper, UInterfaces, UEnums; UXmlHelper, UInterfaces, UEnums, URegions;
type type
@ -76,6 +76,7 @@ type
FMap: TMapInfo; FMap: TMapInfo;
FTiledata: string; FTiledata: string;
FRadarcol: string; FRadarcol: string;
FRegions: TRegionList;
FAccounts: TAccountList; FAccounts: TAccountList;
FChanged: Boolean; FChanged: Boolean;
procedure SetPort(const AValue: Integer); procedure SetPort(const AValue: Integer);
@ -86,6 +87,7 @@ type
property Map: TMapInfo read FMap; property Map: TMapInfo read FMap;
property Tiledata: string read FTiledata write SetTiledata; property Tiledata: string read FTiledata write SetTiledata;
property Radarcol: string read FRadarcol write SetRadarcol; property Radarcol: string read FRadarcol write SetRadarcol;
property Regions: TRegionList read FRegions;
property Accounts: TAccountList read FAccounts; property Accounts: TAccountList read FAccounts;
procedure Flush; procedure Flush;
procedure Invalidate; procedure Invalidate;
@ -214,11 +216,17 @@ begin
FTiledata := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Tiledata', 'tiledata.mul'); FTiledata := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Tiledata', 'tiledata.mul');
FRadarcol := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Radarcol', 'radarcol.mul'); FRadarcol := TXmlHelper.ReadString(xmlDoc.DocumentElement, 'Radarcol', 'radarcol.mul');
xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Regions'));
if assigned(xmlElement) then
FRegions := TRegionList.Deserialize(Self, xmlElement)
else
Fregions := TRegionList.Create(Self);
xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Accounts')); xmlElement := TDOMElement(xmlDoc.DocumentElement.FindNode('Accounts'));
if not assigned(xmlElement) then if not assigned(xmlElement) then
raise TInvalidConfigException.Create('Account information not found'); raise TInvalidConfigException.Create('Account information not found');
FAccounts := TAccountList.Deserialize(Self, xmlElement); FAccounts := TAccountList.Deserialize(Self, xmlElement);
xmlDoc.Free; xmlDoc.Free;
FChanged := False; FChanged := False;
@ -233,6 +241,7 @@ begin
FFilename := AFilename; FFilename := AFilename;
FMap := TMapInfo.Create(Self); FMap := TMapInfo.Create(Self);
FAccounts := TAccountList.Create(Self); FAccounts := TAccountList.Create(Self);
FRegions := TRegionList.Create(Self);
Writeln('Configuring Network'); Writeln('Configuring Network');
Writeln('==================='); Writeln('===================');
@ -282,7 +291,7 @@ begin
Write ('Password [hidden]: '); Write ('Password [hidden]: ');
password := QueryPassword; password := QueryPassword;
FAccounts.Add(TAccount.Create(FAccounts, stringValue, FAccounts.Add(TAccount.Create(FAccounts, stringValue,
MD5Print(MD5String(password)), alAdministrator)); MD5Print(MD5String(password)), alAdministrator, nil));
FChanged := True; FChanged := True;
end; end;
@ -291,6 +300,7 @@ destructor TConfig.Destroy;
begin begin
if Assigned(FMap) then FreeAndNil(FMap); if Assigned(FMap) then FreeAndNil(FMap);
if Assigned(FAccounts) then FreeAndNil(FAccounts); if Assigned(FAccounts) then FreeAndNil(FAccounts);
if Assigned(FRegions) then FreeAndNil(FRegions);
inherited Destroy; inherited Destroy;
end; end;
@ -301,6 +311,7 @@ begin
TXmlHelper.WriteString(AElement, 'Tiledata', FTiledata); TXmlHelper.WriteString(AElement, 'Tiledata', FTiledata);
TXmlHelper.WriteString(AElement, 'Radarcol', FRadarcol); TXmlHelper.WriteString(AElement, 'Radarcol', FRadarcol);
FAccounts.Serialize(TXmlHelper.AssureElement(AElement, 'Accounts')); FAccounts.Serialize(TXmlHelper.AssureElement(AElement, 'Accounts'));
FRegions.Serialize(TXmlHelper.AssureElement(AElement, 'Regions'));
end; end;
procedure TConfig.SetPort(const AValue: Integer); procedure TConfig.SetPort(const AValue: Integer);

View File

@ -539,9 +539,11 @@ var
item: PLinkedItem; item: PLinkedItem;
packet: TDrawMapPacket; packet: TDrawMapPacket;
begin begin
if not ValidateAccess(ANetState, alNormal) then Exit;
x := ABuffer.ReadWord; x := ABuffer.ReadWord;
y := ABuffer.ReadWord; y := ABuffer.ReadWord;
if not ValidateAccess(ANetState, alNormal, x, y) then Exit;
cell := GetMapCell(x, y); cell := GetMapCell(x, y);
if cell <> nil then if cell <> nil then
begin begin
@ -571,9 +573,11 @@ var
item: PLinkedItem; item: PLinkedItem;
packet: TInsertStaticPacket; packet: TInsertStaticPacket;
begin begin
if not ValidateAccess(ANetState, alNormal) then Exit;
x := ABuffer.ReadWord; x := ABuffer.ReadWord;
y := ABuffer.ReadWord; y := ABuffer.ReadWord;
if not ValidateAccess(ANetState, alNormal, x, y) then Exit;
block := GetStaticBlock(x div 8, y div 8); block := GetStaticBlock(x div 8, y div 8);
if block <> nil then if block <> nil then
begin begin
@ -611,8 +615,10 @@ var
item: PLinkedItem; item: PLinkedItem;
packet: TDeleteStaticPacket; packet: TDeleteStaticPacket;
begin begin
if not ValidateAccess(ANetState, alNormal) then Exit;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8); block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
if block <> nil then if block <> nil then
begin begin
@ -656,8 +662,10 @@ var
item: PLinkedItem; item: PLinkedItem;
packet: TElevateStaticPacket; packet: TElevateStaticPacket;
begin begin
if not ValidateAccess(ANetState, alNormal) then Exit;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8); block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
if block <> nil then if block <> nil then
begin begin
@ -705,11 +713,14 @@ var
deletePacket: TDeleteStaticPacket; deletePacket: TDeleteStaticPacket;
movePacket: TMoveStaticPacket; movePacket: TMoveStaticPacket;
begin begin
if not ValidateAccess(ANetState, alNormal) then Exit;
staticItem := nil; staticItem := nil;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
newX := EnsureRange(ABuffer.ReadWord, 0, FCellWidth - 1); newX := EnsureRange(ABuffer.ReadWord, 0, FCellWidth - 1);
newY := EnsureRange(ABuffer.ReadWord, 0, FCellHeight - 1); newY := EnsureRange(ABuffer.ReadWord, 0, FCellHeight - 1);
//Check, if both, source and target, are within a valid region
if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
if not ValidateAccess(ANetState, alNormal, newX, newY) then Exit;
if (staticInfo.X = newX) and (staticInfo.Y = newY) then Exit; if (staticInfo.X = newX) and (staticInfo.Y = newY) then Exit;
@ -798,8 +809,10 @@ var
item: PLinkedItem; item: PLinkedItem;
packet: THueStaticPacket; packet: THueStaticPacket;
begin begin
if not ValidateAccess(ANetState, alNormal) then Exit;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8); block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
if block <> nil then if block <> nil then
begin begin

View File

@ -1,189 +1,217 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2007 Andreas Schneider
*) *)
unit UPacketHandlers; unit UPacketHandlers;
interface interface
uses uses
SysUtils, dzlib, UConfig, UNetState, UEnhancedMemoryStream, UEnums, Classes, SysUtils, dzlib, math, UConfig, UNetState, UEnhancedMemoryStream, UEnums,
ULinkedList; ULinkedList, URegions;
type type
TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState) of object; TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState) of object;
{ TPacketHandler } { TPacketHandler }
TPacketHandler = class(TObject) TPacketHandler = class(TObject)
constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload; constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload;
constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload; constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload;
procedure Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); procedure Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
protected protected
FLength: Cardinal; FLength: Cardinal;
FPacketProcessor: TPacketProcessor; FPacketProcessor: TPacketProcessor;
FPacketProcessorMethod: TPacketProcessorMethod; FPacketProcessorMethod: TPacketProcessorMethod;
published published
property PacketLength: Cardinal read FLength; property PacketLength: Cardinal read FLength;
end; end;
var var
PacketHandlers: array[0..$FF] of TPacketHandler; PacketHandlers: array[0..$FF] of TPacketHandler;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean; function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean; overload;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler); function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean; overload;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
implementation
implementation
uses
UCEDServer, UPackets, UConnectionHandling, UAdminHandling, UClientHandling; uses
UCEDServer, UPackets, UConnectionHandling, UAdminHandling, UClientHandling;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean;
begin function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean;
Result := (ANetState.Account <> nil) and (ANetState.Account.AccessLevel >= ALevel); begin
end; Result := (ANetState.Account <> nil) and (ANetState.Account.AccessLevel >= ALevel);
end;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
begin function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean;
if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]); var
PacketHandlers[AID] := APacketHandler; i,j: Word;
end; region: TRegion;
rect: TRect;
{ TPacketHandler } begin
if not ValidateAccess(ANetState, ALevel) then Exit(False);
constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); if (ANetState.Account.Regions.Count = 0) or
begin (ANetState.Account.AccessLevel >= alAdministrator) then Exit(True); //no restrictions
inherited Create;
FLength := ALength; Result := False;
FPacketProcessor := APacketProcessor; for i := 0 to ANetState.Account.Regions.Count - 1 do
FPacketProcessorMethod := nil; begin
end; region := Config.Regions.Find(ANetState.Account.Regions[i]);
if region <> nil then
constructor TPacketHandler.Create(ALength: Cardinal; begin
APacketProcessorMethod: TPacketProcessorMethod); for j := 0 to region.Areas.Count - 1 do
begin begin
inherited Create; rect := region.Areas.Rects[j];
FLength := ALength; if InRange(AX, rect.Left, rect.Right) and
FPacketProcessor := nil; InRange(AY, rect.Top, rect.Bottom) then
FPacketProcessorMethod := APacketProcessorMethod; Exit(True);
end; end;
end;
procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); end;
begin end;
if Assigned(FPacketProcessor) then
FPacketProcessor(ABuffer, ANetState) procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
else if Assigned(FPacketProcessorMethod) then begin
FPacketProcessorMethod(ABuffer, ANetState); if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]);
end; PacketHandlers[AID] := APacketHandler;
end;
procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var { TPacketHandler }
uncompStream: TEnhancedMemoryStream;
uncompBuffer: TDecompressionStream; constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor);
targetSize: Cardinal; begin
packetID: Byte; inherited Create;
begin FLength := ALength;
targetSize := ABuffer.ReadCardinal; FPacketProcessor := APacketProcessor;
uncompBuffer := TDecompressionStream.Create(ABuffer); FPacketProcessorMethod := nil;
uncompStream := TEnhancedMemoryStream.Create; end;
try
uncompStream.CopyFrom(uncompBuffer, targetSize); constructor TPacketHandler.Create(ALength: Cardinal;
uncompStream.Position := 0; APacketProcessorMethod: TPacketProcessorMethod);
packetID := uncompStream.ReadByte; begin
if PacketHandlers[packetID] <> nil then inherited Create;
begin FLength := ALength;
if PacketHandlers[PacketID].PacketLength = 0 then FPacketProcessor := nil;
uncompStream.Position := uncompStream.Position + 4; FPacketProcessorMethod := APacketProcessorMethod;
uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position); end;
PacketHandlers[PacketID].Process(uncompStream, ANetState);
uncompStream.Unlock; procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
end else begin
begin if Assigned(FPacketProcessor) then
Writeln(TimeStamp, 'Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress); FPacketProcessor(ABuffer, ANetState)
ANetState.ReceiveQueue.Clear; else if Assigned(FPacketProcessorMethod) then
CEDServerInstance.Disconnect(ANetState.Socket); FPacketProcessorMethod(ABuffer, ANetState);
end; end;
finally
if uncompBuffer <> nil then uncompBuffer.Free; procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
if uncompStream <> nil then uncompStream.Free; var
end; uncompStream: TEnhancedMemoryStream;
end; uncompBuffer: TDecompressionStream;
targetSize: Cardinal;
procedure OnRequestBlocksPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); packetID: Byte;
var begin
coords: TBlockCoordsArray; targetSize := ABuffer.ReadCardinal;
i: Integer; uncompBuffer := TDecompressionStream.Create(ABuffer);
begin uncompStream := TEnhancedMemoryStream.Create;
if not ValidateAccess(ANetState, alView) then Exit; try
SetLength(coords, (ABuffer.Size - ABuffer.Position) div SizeOf(TBlockCoords)); uncompStream.CopyFrom(uncompBuffer, targetSize);
ABuffer.Read(coords[0], Length(coords) * SizeOf(TBlockCoords)); uncompStream.Position := 0;
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TBlockPacket.Create(coords, ANetState))); packetID := uncompStream.ReadByte;
end; if PacketHandlers[packetID] <> nil then
begin
procedure OnFreeBlockPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState); if PacketHandlers[PacketID].PacketLength = 0 then
var uncompStream.Position := uncompStream.Position + 4;
x, y: Word; uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position);
blockSubscriptions: TLinkedList; PacketHandlers[PacketID].Process(uncompStream, ANetState);
begin uncompStream.Unlock;
if not ValidateAccess(ANetState, alView) then Exit; end else
x := ABuffer.ReadWord; begin
y := ABuffer.ReadWord; Writeln(TimeStamp, 'Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);
blockSubscriptions := CEDServerInstance.Landscape.BlockSubscriptions[X, Y]; ANetState.ReceiveQueue.Clear;
if blockSubscriptions <> nil then CEDServerInstance.Disconnect(ANetState.Socket);
begin end;
blockSubscriptions.Delete(ANetState); finally
ANetState.Subscriptions.Remove(blockSubscriptions); if uncompBuffer <> nil then uncompBuffer.Free;
end; if uncompStream <> nil then uncompStream.Free;
end; end;
end;
procedure OnNoOpPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin procedure OnRequestBlocksPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
//no operation var
end; coords: TBlockCoordsArray;
i: Integer;
{$WARNINGS OFF} begin
var if not ValidateAccess(ANetState, alView) then Exit;
i: Integer; SetLength(coords, (ABuffer.Size - ABuffer.Position) div SizeOf(TBlockCoords));
ABuffer.Read(coords[0], Length(coords) * SizeOf(TBlockCoords));
initialization CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TBlockPacket.Create(coords, ANetState)));
for i := 0 to $FF do end;
PacketHandlers[i] := nil;
PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket); procedure OnFreeBlockPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlerPacket); var
PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket); x, y: Word;
PacketHandlers[$04] := TPacketHandler.Create(0, @OnRequestBlocksPacket); blockSubscriptions: TLinkedList;
PacketHandlers[$05] := TPacketHandler.Create(5, @OnFreeBlockPacket); begin
//$06-$0B handled by landscape if not ValidateAccess(ANetState, alView) then Exit;
PacketHandlers[$0C] := TPacketHandler.Create(0, @OnClientHandlerPacket); x := ABuffer.ReadWord;
//$0D handled by radarmap y := ABuffer.ReadWord;
//$0E handled by landscape blockSubscriptions := CEDServerInstance.Landscape.BlockSubscriptions[X, Y];
PacketHandlers[$FF] := TPacketHandler.Create(1, @OnNoOpPacket); if blockSubscriptions <> nil then
finalization begin
for i := 0 to $FF do blockSubscriptions.Delete(ANetState);
if PacketHandlers[i] <> nil then ANetState.Subscriptions.Remove(blockSubscriptions);
PacketHandlers[i].Free; end;
{$WARNINGS ON} 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.

View File

@ -34,7 +34,7 @@ uses
SysUtils, Classes, SysUtils, Classes,
lnetbase, lnetbase,
UConfig, UCEDServer, URadarMap, ULargeScaleOperations, UPackets, UConfig, UCEDServer, URadarMap, ULargeScaleOperations, UPackets,
UAdminHandling, UClientHandling, ULandscape, UPacketHandlers; UAdminHandling, UClientHandling, ULandscape, UPacketHandlers, URegions;
{$I version.inc} {$I version.inc}

View File

@ -1,70 +1,75 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2007 Andreas Schneider
*) *)
unit UEnums; unit UEnums;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
type type
TLoginState = (lsOK = 0, TLoginState = (lsOK = 0,
lsInvalidUser = 1, lsInvalidUser = 1,
lsInvalidPassword = 2, lsInvalidPassword = 2,
lsAlreadyLoggedIn = 3, lsAlreadyLoggedIn = 3,
lsNoAccess = 4); lsNoAccess = 4);
TServerState = (ssRunning = 0, TServerState = (ssRunning = 0,
ssFrozen = 1, ssFrozen = 1,
ssOther = 2); ssOther = 2);
TAccessLevel = (alNone = 0, TAccessLevel = (alNone = 0,
alView = 1, alView = 1,
alNormal = 2, alNormal = 2,
alAdministrator = 255); alAdministrator = 255);
TModifyUserStatus = (muInvalidUsername = 0, TModifyUserStatus = (muInvalidUsername = 0,
muAdded = 1, muAdded = 1,
muModified = 2); muModified = 2);
TDeleteUserStatus = (duNotFound = 0, TDeleteUserStatus = (duNotFound = 0,
duDeleted = 1); duDeleted = 1);
function GetAccessLevelString(AAccessLevel: TAccessLevel): string; TModifyRegionStatus = (mrAdded = 0,
mrModified = 1);
implementation TDeleteRegionStatus = (drNotFound = 0,
drDeleted = 1);
function GetAccessLevelString(AAccessLevel: TAccessLevel): string;
begin function GetAccessLevelString(AAccessLevel: TAccessLevel): string;
Result := '';
case AAccessLevel of implementation
alNone: Result := 'None';
alView: Result := 'Viewer'; function GetAccessLevelString(AAccessLevel: TAccessLevel): string;
alNormal: Result := 'Normal'; begin
alAdministrator: Result := 'Administrator'; Result := '';
end; case AAccessLevel of
end; alNone: Result := 'None';
alView: Result := 'Viewer';
end. alNormal: Result := 'Normal';
alAdministrator: Result := 'Administrator';
end;
end;
end.

100
URectList.pas Normal file
View File

@ -0,0 +1,100 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2008 Andreas Schneider
*)
unit URectList;
{$mode objfpc}{$H+}
interface
uses
SysUtils,Classes;
type
TRectList = class(TList)
protected
function GetRect(AIndex: Integer): TRect;
procedure SetRect(AIndex: Integer; ARect: TRect);
public
function Add(ALeft, ATop, ARight, ABottom: Integer): Integer;
procedure Clear; override;
procedure Delete(AIndex: Integer); reintroduce;
property Rects[Index: Integer]: TRect read GetRect write SetRect;
end;
PRect = ^TRect;
implementation
{ TRectList }
function TRectList.GetRect(AIndex: Integer): TRect;
begin
Result := PRect(Items[AIndex])^;
end;
procedure TRectList.SetRect(AIndex: Integer; ARect: TRect);
var
internalRect: PRect;
begin
internalRect := Items[AIndex];
System.Move(ARect, internalRect^, SizeOf(TRect));
end;
function TRectList.Add(ALeft, ATop, ARight, ABottom: Integer): Integer;
var
internalRect: PRect;
begin
new(internalRect);
internalRect^.Left := ALeft;
internalRect^.Top := ATop;
internalRect^.Right := ARight;
internalRect^.Bottom := ABottom;
Result := inherited Add(internalRect);
end;
procedure TRectList.Clear;
var
i: Integer;
internalRect: PRect;
begin
for i := 0 to Count - 1 do
begin
internalRect := Items[i];
dispose(internalRect);
end;
inherited;
end;
procedure TRectList.Delete(AIndex: Integer);
var
internalRect: PRect;
begin
internalRect := Items[AIndex];
dispose(internalRect);
inherited Delete(AIndex);
end;
end.

View File

@ -37,6 +37,7 @@ type
{ TXmlHelper } { TXmlHelper }
TXmlHelper = class(TObject) TXmlHelper = class(TObject)
class function FindChild(AParent: TDOMElement; AName: string): TDOMElement;
class function AssureElement(AParent: TDOMElement; AName: string): TDOMElement; class function AssureElement(AParent: TDOMElement; AName: string): TDOMElement;
class procedure WriteString(AParent: TDOMElement; AName, AValue: string); class procedure WriteString(AParent: TDOMElement; AName, AValue: string);
class function ReadString(AParent: TDOMElement; AName, ADefault: string): string; class function ReadString(AParent: TDOMElement; AName, ADefault: string): string;
@ -52,10 +53,30 @@ implementation
{ TXmlHelper } { TXmlHelper }
class function TXmlHelper.AssureElement(AParent: TDOMElement; AName: string): TDOMElement; class function TXmlHelper.FindChild(AParent: TDOMElement; AName: string): TDOMElement;
var
i: Integer;
nodeList: TDOMNodeList;
begin begin
Result := TDOMElement(AParent.FindNode(AName)); Result := nil;
if not assigned(Result) then nodeList := AParent.GetChildNodes;
i := 0;
while (Result = nil) and (i < nodeList.Count) do
begin
if nodeList.Item[i].NodeName = AName then
Result := TDOMElement(nodeList[i]);
inc(i);
end;
nodeList.Free;
end;
class function TXmlHelper.AssureElement(AParent: TDOMElement; AName: string): TDOMElement;
var
i: Integer;
nodeList: TDOMNodeList;
begin
Result := FindChild(AParent, AName);
if Result = nil then
begin begin
Result := AParent.OwnerDocument.CreateElement(AName); Result := AParent.OwnerDocument.CreateElement(AName);
AParent.AppendChild(Result); AParent.AppendChild(Result);
@ -77,7 +98,7 @@ class function TXmlHelper.ReadString(AParent: TDOMElement; AName, ADefault: stri
var var
element: TDOMElement; element: TDOMElement;
begin begin
element := TDOMElement(AParent.FindNode(AName)); element := FindChild(AParent, AName);
if assigned(element) and assigned(element.FirstChild) then if assigned(element) and assigned(element.FirstChild) then
Result := TDOMText(element.FirstChild).Data Result := TDOMText(element.FirstChild).Data
else else
@ -125,7 +146,7 @@ var
element: TDOMElement; element: TDOMElement;
tempX, tempY: Integer; tempX, tempY: Integer;
begin begin
element := TDOMElement(AParent.FindNode(AName)); element := FindChild(AParent, AName);
Result := assigned(element) and TryStrToInt(element.AttribStrings['x'], tempX) Result := assigned(element) and TryStrToInt(element.AttribStrings['x'], tempX)
and TryStrToInt(element.AttribStrings['y'], tempY); and TryStrToInt(element.AttribStrings['y'], tempY);

View File

@ -1,5 +1,5 @@
const const
ProductVersion = '0.3.6'; ProductVersion = '0.3.7';
ProtocolVersion = 5; ProtocolVersion = 6;
Revision = '41'; Revision = '41';
Copyright = '2008 Andreas Schneider'; Copyright = '2008 Andreas Schneider';