- 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
Classes, SysUtils, md5, contnrs, math, DOM, UXmlHelper, UInterfaces,
UEnums;
UEnums, URegions;
type
@ -39,7 +39,7 @@ type
TAccount = class(TObject, ISerializable, IInvalidate)
constructor Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel);
AAccessLevel: TAccessLevel; ARegions: TStringList);
constructor Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
procedure Serialize(AElement: TDOMElement);
protected
@ -48,6 +48,7 @@ type
FAccessLevel: TAccessLevel;
FPasswordHash: string;
FLastPos: TPoint;
FRegions: TStringList;
procedure SetAccessLevel(const AValue: TAccessLevel);
procedure SetPasswordHash(const AValue: string);
procedure SetLastPos(const AValue: TPoint);
@ -56,6 +57,7 @@ type
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;
procedure Invalidate;
end;
@ -82,16 +84,26 @@ uses
{ TAccount }
constructor TAccount.Create(AOwner: IInvalidate; AName, APasswordHash: string;
AAccessLevel: TAccessLevel);
AAccessLevel: TAccessLevel; ARegions: TStringList);
var
i : Integer;
begin
inherited Create;
FOwner := AOwner;
FName := AName;
FPasswordHash := APasswordHash;
FAccessLevel := AAccessLevel;
if ARegions <> nil then
FRegions := ARegions
else
FRegions := TStringList.Create;
end;
constructor TAccount.Deserialize(AOwner: IInvalidate; AElement: TDOMElement);
var
xmlElement, xmlRegion: TDOMElement;
nodelist: TDOMNodeList;
i: Integer;
begin
inherited Create;
FOwner := AOwner;
@ -100,6 +112,23 @@ begin
FPasswordHash := TXmlHelper.ReadString(AElement, 'PasswordHash', '');
FLastPos := Point(0, 0);
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;
procedure TAccount.SetAccessLevel(const AValue: TAccessLevel);
@ -127,11 +156,18 @@ begin
end;
procedure TAccount.Serialize(AElement: TDOMElement);
var
i : Integer;
child : TDOMElement;
begin
TXmlHelper.WriteString(AElement, 'Name', FName);
TXmlHelper.WriteString(AElement, 'PasswordHash', FPasswordHash);
TXmlHelper.WriteInteger(AElement, 'AccessLevel', Integer(FAccessLevel));
TXmlHelper.WriteCoords(AElement, 'LastPos', FLastPos.X, FLastPos.Y);
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;
{ TAccountList }

View File

@ -30,8 +30,8 @@ unit UAdminHandling;
interface
uses
Classes, SysUtils, UPacket, UPacketHandlers, UConfig, UAccount, UNetState,
UEnhancedMemoryStream, UEnums, lNet;
Classes, SysUtils, math, UPacket, UPacketHandlers, UConfig, UAccount,
UNetState, UEnhancedMemoryStream, UEnums, URegions;
type
@ -53,12 +53,34 @@ type
constructor Create;
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 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);
procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
AdminPacketHandlers: array[0..$FF] of TPacketHandler;
@ -68,7 +90,8 @@ implementation
uses
md5, UCEDServer, UPackets, UClientHandling;
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
packetHandler: TPacketHandler;
begin
@ -96,15 +119,26 @@ var
username, password: string;
accessLevel: TAccessLevel;
netState: TNetState;
regions: TStringList;
i, regionCount: Integer;
begin
username := ABuffer.ReadStringNull;
password := ABuffer.ReadStringNull;
accessLevel := TAccessLevel(ABuffer.ReadByte);
regionCount := ABuffer.ReadByte;
account := Config.Accounts.Find(username);
if account <> nil then
begin
if password <> '' then
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
begin
account.AccessLevel := accessLevel;
@ -114,24 +148,34 @@ begin
netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
if (netState <> nil) and (netState.Account = account) then
begin
CEDServerInstance.SendPacket(netState, TAccessLevelChangedPacket.Create(accessLevel));
CEDServerInstance.SendPacket(netState,
TAccessLevelChangedPacket.Create(accessLevel));
end;
end;
end;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muModified, account));
CEDServerInstance.SendPacket(ANetState,
TModifyUserResponsePacket.Create(muModified, account));
end else
begin
account := TAccount.Create(Config.Accounts, username,
MD5Print(MD5String(password)), accessLevel);
if (username = '') or (Pos('=', username) > 0) then
if username = '' then
begin
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muInvalidUsername, account));
account.Free;
CEDServerInstance.SendPacket(ANetState,
TModifyUserResponsePacket.Create(muInvalidUsername, account));
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;
Config.Accounts.Add(account);
Config.Invalidate;
CEDServerInstance.SendPacket(ANetState, TModifyUserResponsePacket.Create(muAdded, account));
end;
end;
@ -158,25 +202,112 @@ begin
end;
Config.Accounts.Remove(account);
Config.Invalidate;
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duDeleted, username));
CEDServerInstance.SendPacket(ANetState,
TDeleteUserResponsePacket.Create(duDeleted, username));
end else
CEDServerInstance.SendPacket(ANetState, TDeleteUserResponsePacket.Create(duNotFound, username));
CEDServerInstance.SendPacket(ANetState,
TDeleteUserResponsePacket.Create(duNotFound, username));
end;
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
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;
{ TModifyUserResponsePacket }
constructor TModifyUserResponsePacket.Create(AStatus: TModifyUserStatus; AAccount: TAccount);
constructor TModifyUserResponsePacket.Create(AStatus: TModifyUserStatus;
AAccount: TAccount);
var
i: Integer;
begin
inherited Create($03, 0);
FStream.WriteByte($05);
FStream.WriteByte(Byte(AStatus));
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;
{ TDeleteUserResponsePacket }
@ -193,7 +324,7 @@ end;
constructor TUserListPacket.Create;
var
i: Integer;
i, j: Integer;
account: TAccount;
begin
inherited Create($03, 0);
@ -204,6 +335,75 @@ begin
account := TAccount(Config.Accounts.Items[i]);
FStream.WriteStringNull(account.Name);
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;
@ -219,6 +419,9 @@ initialization
AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserPacket);
AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserPacket);
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
for i := 0 to $FF do
if AdminPacketHandlers[i] <> nil then

View File

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

View File

@ -539,9 +539,11 @@ var
item: PLinkedItem;
packet: TDrawMapPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
x := ABuffer.ReadWord;
y := ABuffer.ReadWord;
if not ValidateAccess(ANetState, alNormal, x, y) then Exit;
cell := GetMapCell(x, y);
if cell <> nil then
begin
@ -571,9 +573,11 @@ var
item: PLinkedItem;
packet: TInsertStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
x := ABuffer.ReadWord;
y := ABuffer.ReadWord;
if not ValidateAccess(ANetState, alNormal, x, y) then Exit;
block := GetStaticBlock(x div 8, y div 8);
if block <> nil then
begin
@ -611,8 +615,10 @@ var
item: PLinkedItem;
packet: TDeleteStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
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);
if block <> nil then
begin
@ -656,8 +662,10 @@ var
item: PLinkedItem;
packet: TElevateStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
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);
if block <> nil then
begin
@ -705,12 +713,15 @@ var
deletePacket: TDeleteStaticPacket;
movePacket: TMoveStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
staticItem := nil;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
newX := EnsureRange(ABuffer.ReadWord, 0, FCellWidth - 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 ((abs(staticInfo.X - newX) > 8) or (abs(staticInfo.Y - newY) > 8)) and
@ -798,8 +809,10 @@ var
item: PLinkedItem;
packet: THueStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
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);
if block <> nil then
begin

View File

@ -28,8 +28,8 @@ unit UPacketHandlers;
interface
uses
SysUtils, dzlib, UConfig, UNetState, UEnhancedMemoryStream, UEnums,
ULinkedList;
Classes, SysUtils, dzlib, math, UConfig, UNetState, UEnhancedMemoryStream, UEnums,
ULinkedList, URegions;
type
TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
@ -52,7 +52,8 @@ type
var
PacketHandlers: array[0..$FF] of TPacketHandler;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean; overload;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean; overload;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
implementation
@ -65,6 +66,33 @@ begin
Result := (ANetState.Account <> nil) and (ANetState.Account.AccessLevel >= ALevel);
end;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean;
var
i,j: Word;
region: TRegion;
rect: TRect;
begin
if not ValidateAccess(ANetState, ALevel) then Exit(False);
if (ANetState.Account.Regions.Count = 0) or
(ANetState.Account.AccessLevel >= alAdministrator) then Exit(True); //no restrictions
Result := False;
for i := 0 to ANetState.Account.Regions.Count - 1 do
begin
region := Config.Regions.Find(ANetState.Account.Regions[i]);
if region <> nil then
begin
for j := 0 to region.Areas.Count - 1 do
begin
rect := region.Areas.Rects[j];
if InRange(AX, rect.Left, rect.Right) and
InRange(AY, rect.Top, rect.Bottom) then
Exit(True);
end;
end;
end;
end;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
begin
if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]);

View File

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

View File

@ -52,6 +52,11 @@ type
TDeleteUserStatus = (duNotFound = 0,
duDeleted = 1);
TModifyRegionStatus = (mrAdded = 0,
mrModified = 1);
TDeleteRegionStatus = (drNotFound = 0,
drDeleted = 1);
function GetAccessLevelString(AAccessLevel: TAccessLevel): string;
implementation

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 = class(TObject)
class function FindChild(AParent: TDOMElement; AName: string): TDOMElement;
class function AssureElement(AParent: TDOMElement; AName: string): TDOMElement;
class procedure WriteString(AParent: TDOMElement; AName, AValue: string);
class function ReadString(AParent: TDOMElement; AName, ADefault: string): string;
@ -52,10 +53,30 @@ implementation
{ 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
Result := TDOMElement(AParent.FindNode(AName));
if not assigned(Result) then
Result := nil;
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
Result := AParent.OwnerDocument.CreateElement(AName);
AParent.AppendChild(Result);
@ -77,7 +98,7 @@ class function TXmlHelper.ReadString(AParent: TDOMElement; AName, ADefault: stri
var
element: TDOMElement;
begin
element := TDOMElement(AParent.FindNode(AName));
element := FindChild(AParent, AName);
if assigned(element) and assigned(element.FirstChild) then
Result := TDOMText(element.FirstChild).Data
else
@ -125,7 +146,7 @@ var
element: TDOMElement;
tempX, tempY: Integer;
begin
element := TDOMElement(AParent.FindNode(AName));
element := FindChild(AParent, AName);
Result := assigned(element) and TryStrToInt(element.AttribStrings['x'], tempX)
and TryStrToInt(element.AttribStrings['y'], tempY);

View File

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