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

- Added ability to edit regions for accounts 

- Added AccessChangedListener to allow several listeners to react on accesslevel changes
- Changed TModifyUserPacket to support the region lists
- Fixed a region list parsing bug in TfrmAccountControl.OnListUsersPacket (Unsigned vs. Signed Integer)
- Fixed the order of form creation in TdmNetwork to assure the functionality of the region and account control
- Added some glob entries to .hgignore
This commit is contained in:
Andreas Schneider 2008-08-25 17:33:38 +02:00
parent 85cc0c0066
commit 91af86a294
11 changed files with 691 additions and 503 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
.hgignore
View File

@ -1,2 +1,19 @@
syntax: regexp #syntax: regexp
#(?<!\.(pas|lfm|lpr|lpi))$ #(?<!\.(pas|lfm|lpr|lpi))$
syntax: glob
obj/*
bin/*
doc/*
pasdoc/*
Setup/*
*.lps
*.lrs
*.txt
*.log
*.png
*.ico
*.tga
*.gif
*.bmp
*.xpm
*.htm*

4
Client/CentrED.lpr
View File

@ -21,7 +21,7 @@
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2008 Andreas Schneider
*) *)
program CentrED; program CentrED;
@ -40,7 +40,7 @@ uses
UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo, UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets, UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets,
UPacketHandlers, UAdminHandling, UGameResources, ULandscape; UPacketHandlers, UAdminHandling, UGameResources, ULandscape;
{$IFDEF Windows} {$IFDEF Windows}
{$R *.res} {$R *.res}
{$ENDIF} {$ENDIF}

4
Client/UAdminHandling.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2008 Andreas Schneider
*) *)
unit UAdminHandling; unit UAdminHandling;
@ -30,7 +30,7 @@ unit UAdminHandling;
interface interface
uses uses
Classes, SysUtils, UPacket, UPacketHandlers, UEnhancedMemoryStream, UEnums; Classes, SysUtils, UPacket, UPacketHandlers, UEnhancedMemoryStream;
type type

728
Client/UdmNetwork.pas
View File

@ -1,364 +1,364 @@
(* (*
* 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 UdmNetwork; unit UdmNetwork;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet, Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet,
UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils; UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils;
type type
{ TdmNetwork } { TdmNetwork }
TdmNetwork = class(TDataModule) TdmNetwork = class(TDataModule)
TCPClient: TLTCPComponent; TCPClient: TLTCPComponent;
tmNoOp: TTimer; tmNoOp: TTimer;
procedure DataModuleCreate(Sender: TObject); procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject); procedure DataModuleDestroy(Sender: TObject);
procedure TCPClientConnect(aSocket: TLSocket); procedure TCPClientConnect(aSocket: TLSocket);
procedure TCPClientDisconnect(aSocket: TLSocket); procedure TCPClientDisconnect(aSocket: TLSocket);
procedure TCPClientError(const msg: string; aSocket: TLSocket); procedure TCPClientError(const msg: string; aSocket: TLSocket);
procedure TCPClientReceive(aSocket: TLSocket); procedure TCPClientReceive(aSocket: TLSocket);
procedure tmNoOpStartTimer(Sender: TObject); procedure tmNoOpStartTimer(Sender: TObject);
procedure tmNoOpTimer(Sender: TObject); procedure tmNoOpTimer(Sender: TObject);
protected protected
FSendQueue: TEnhancedMemoryStream; FSendQueue: TEnhancedMemoryStream;
FReceiveQueue: TEnhancedMemoryStream; FReceiveQueue: TEnhancedMemoryStream;
FUsername: string; FUsername: string;
FPassword: string; FPassword: string;
FAccessLevel: TAccessLevel; FAccessLevel: TAccessLevel;
FDataDir: string; FDataDir: string;
FLastPacket: TDateTime; FLastPacket: TDateTime;
procedure OnCanSend(ASocket: TLSocket); procedure OnCanSend(ASocket: TLSocket);
procedure OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream); procedure OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
procedure ProcessQueue; procedure ProcessQueue;
procedure DoLogin; procedure DoLogin;
public public
property Username: string read FUsername; property Username: string read FUsername;
property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel; property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel;
procedure Send(APacket: TPacket); procedure Send(APacket: TPacket);
procedure Disconnect; procedure Disconnect;
procedure CheckClose(ASender: TForm); procedure CheckClose(ASender: TForm);
end; end;
var var
dmNetwork: TdmNetwork; dmNetwork: TdmNetwork;
implementation implementation
uses uses
UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize, UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize,
UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings, UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings,
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings, UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand, UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand,
UfrmVirtualLayer, UfrmFilter, UfrmTileInfo, UfrmRegionControl; UfrmVirtualLayer, UfrmFilter, UfrmTileInfo, UfrmRegionControl;
{$I version.inc} {$I version.inc}
{ TdmNetwork } { TdmNetwork }
procedure TdmNetwork.DataModuleCreate(Sender: TObject); procedure TdmNetwork.DataModuleCreate(Sender: TObject);
begin begin
FSendQueue := TEnhancedMemoryStream.Create; FSendQueue := TEnhancedMemoryStream.Create;
FReceiveQueue := TEnhancedMemoryStream.Create; FReceiveQueue := TEnhancedMemoryStream.Create;
TCPClient.OnCanSend := @OnCanSend; TCPClient.OnCanSend := @OnCanSend;
PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlingPacket); PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlingPacket);
DoLogin; DoLogin;
end; end;
procedure TdmNetwork.DataModuleDestroy(Sender: TObject); procedure TdmNetwork.DataModuleDestroy(Sender: TObject);
begin begin
if FSendQueue <> nil then FreeAndNil(FSendQueue); if FSendQueue <> nil then FreeAndNil(FSendQueue);
if FReceiveQueue <> nil then FreeAndNil(FReceiveQueue); if FReceiveQueue <> nil then FreeAndNil(FReceiveQueue);
if PacketHandlers[$02] <> nil then FreeAndNil(PacketHandlers[$02]); if PacketHandlers[$02] <> nil then FreeAndNil(PacketHandlers[$02]);
end; end;
procedure TdmNetwork.TCPClientConnect(aSocket: TLSocket); procedure TdmNetwork.TCPClientConnect(aSocket: TLSocket);
begin begin
FSendQueue.Clear; FSendQueue.Clear;
FReceiveQueue.Clear; FReceiveQueue.Clear;
end; end;
procedure TdmNetwork.TCPClientDisconnect(aSocket: TLSocket); procedure TdmNetwork.TCPClientDisconnect(aSocket: TLSocket);
begin begin
FSendQueue.Clear; FSendQueue.Clear;
FReceiveQueue.Clear; FReceiveQueue.Clear;
DoLogin; DoLogin;
end; end;
procedure TdmNetwork.TCPClientError(const msg: string; aSocket: TLSocket); procedure TdmNetwork.TCPClientError(const msg: string; aSocket: TLSocket);
begin begin
MessageDlg('Connection error', msg, mtError, [mbOK], 0); MessageDlg('Connection error', msg, mtError, [mbOK], 0);
if not TCPClient.Connected then if not TCPClient.Connected then
TCPClientDisconnect(aSocket); TCPClientDisconnect(aSocket);
end; end;
procedure TdmNetwork.TCPClientReceive(aSocket: TLSocket); procedure TdmNetwork.TCPClientReceive(aSocket: TLSocket);
var var
buffer: array[0..4095] of byte; buffer: array[0..4095] of byte;
size: Integer; size: Integer;
begin begin
repeat repeat
size := TCPClient.Get(buffer, 4096); size := TCPClient.Get(buffer, 4096);
if size > 0 then if size > 0 then
FReceiveQueue.Enqueue(buffer, size); FReceiveQueue.Enqueue(buffer, size);
until size <= 0; until size <= 0;
ProcessQueue; ProcessQueue;
end; end;
procedure TdmNetwork.tmNoOpStartTimer(Sender: TObject); procedure TdmNetwork.tmNoOpStartTimer(Sender: TObject);
begin begin
FLastPacket := Now; FLastPacket := Now;
end; end;
procedure TdmNetwork.tmNoOpTimer(Sender: TObject); procedure TdmNetwork.tmNoOpTimer(Sender: TObject);
begin begin
if SecondsBetween(FLastPacket, Now) > 25 then if SecondsBetween(FLastPacket, Now) > 25 then
Send(TNoOpPacket.Create); Send(TNoOpPacket.Create);
end; end;
procedure TdmNetwork.OnCanSend(ASocket: TLSocket); procedure TdmNetwork.OnCanSend(ASocket: TLSocket);
var var
size: Integer; size: Integer;
begin begin
while FSendQueue.Size > 0 do while FSendQueue.Size > 0 do
begin begin
FLastPacket := Now; FLastPacket := Now;
size := TCPClient.Send(FSendQueue.Memory^, FSendQueue.Size); size := TCPClient.Send(FSendQueue.Memory^, FSendQueue.Size);
if size > 0 then if size > 0 then
FSendQueue.Dequeue(size) FSendQueue.Dequeue(size)
else else
Break; Break;
end; end;
end; end;
procedure TdmNetwork.OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream); procedure TdmNetwork.OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
var var
subID: Byte; subID: Byte;
loginState: TLoginState; loginState: TLoginState;
width, height: Word; width, height: Word;
serverState: TServerState; serverState: TServerState;
begin begin
subID := ABuffer.ReadByte; subID := ABuffer.ReadByte;
case subID of case subID of
$01: $01:
begin begin
if ABuffer.ReadCardinal = ProtocolVersion then if ABuffer.ReadCardinal = ProtocolVersion then
begin begin
frmInitialize.lblStatus.Caption := 'Authenticating'; frmInitialize.lblStatus.Caption := 'Authenticating';
Send(TLoginRequestPacket.Create(FUsername, FPassword)); Send(TLoginRequestPacket.Create(FUsername, FPassword));
end else end else
begin begin
MessageDlg('Error', 'Invalid protocol version. Maybe your client is outdated.', mtError, [mbOK], 0); MessageDlg('Error', 'Invalid protocol version. Maybe your client is outdated.', mtError, [mbOK], 0);
Disconnect; Disconnect;
end; end;
end; end;
$03: $03:
begin begin
loginState := TLoginState(ABuffer.ReadByte); loginState := TLoginState(ABuffer.ReadByte);
if loginState = lsOK then if loginState = lsOK then
begin begin
frmInitialize.lblStatus.Caption := 'Initializing'; frmInitialize.lblStatus.Caption := 'Initializing';
frmInitialize.Repaint; frmInitialize.Repaint;
frmInitialize.lblStatus.Repaint; frmInitialize.lblStatus.Repaint;
Application.ProcessMessages; Application.ProcessMessages;
FAccessLevel := TAccessLevel(ABuffer.ReadByte); FAccessLevel := TAccessLevel(ABuffer.ReadByte);
InitGameResourceManager(FDataDir); InitGameResourceManager(FDataDir);
width := ABuffer.ReadWord; width := ABuffer.ReadWord;
height := ABuffer.ReadWord; height := ABuffer.ReadWord;
ResMan.InitLandscape(width, height); ResMan.InitLandscape(width, height);
frmMain := TfrmMain.Create(dmNetwork); frmMain := TfrmMain.Create(dmNetwork);
frmAccountControl := TfrmAccountControl.Create(frmMain); frmRadarMap := TfrmRadarMap.Create(frmMain);
frmEditAccount := TfrmEditAccount.Create(frmAccountControl); frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain);
frmConfirmation := TfrmConfirmation.Create(frmMain); frmRegionControl := TfrmRegionControl.Create(frmMain);
frmDrawSettings := TfrmDrawSettings.Create(frmMain); frmAccountControl := TfrmAccountControl.Create(frmMain);
frmMoveSettings := TfrmMoveSettings.Create(frmMain); frmEditAccount := TfrmEditAccount.Create(frmAccountControl);
frmElevateSettings := TfrmElevateSettings.Create(frmMain); frmConfirmation := TfrmConfirmation.Create(frmMain);
frmHueSettings := TfrmHueSettings.Create(frmMain); frmDrawSettings := TfrmDrawSettings.Create(frmMain);
frmBoundaries := TfrmBoundaries.Create(frmMain); frmMoveSettings := TfrmMoveSettings.Create(frmMain);
frmFilter := TfrmFilter.Create(frmMain); frmElevateSettings := TfrmElevateSettings.Create(frmMain);
frmVirtualLayer := TfrmVirtualLayer.Create(frmMain); frmHueSettings := TfrmHueSettings.Create(frmMain);
frmAbout := TfrmAbout.Create(frmMain); frmBoundaries := TfrmBoundaries.Create(frmMain);
frmRadarMap := TfrmRadarMap.Create(frmMain); frmFilter := TfrmFilter.Create(frmMain);
frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain); frmVirtualLayer := TfrmVirtualLayer.Create(frmMain);
frmTileInfo := TfrmTileInfo.Create(frmMain); frmAbout := TfrmAbout.Create(frmMain);
frmRegionControl := TfrmRegionControl.Create(frmMain); frmTileInfo := TfrmTileInfo.Create(frmMain);
frmMain.Show; frmMain.Show;
frmInitialize.Hide; frmInitialize.Hide;
tmNoOp.Enabled := True; tmNoOp.Enabled := True;
end else end else
begin begin
if loginState = lsInvalidUser then if loginState = lsInvalidUser then
MessageDlg('Error', 'The username you specified is incorrect.', mtWarning, [mbOK], 0) MessageDlg('Error', 'The username you specified is incorrect.', mtWarning, [mbOK], 0)
else if loginState = lsInvalidPassword then else if loginState = lsInvalidPassword then
MessageDlg('Error', 'The password you specified is incorrect.', mtWarning, [mbOK], 0) MessageDlg('Error', 'The password you specified is incorrect.', mtWarning, [mbOK], 0)
else if loginState = lsAlreadyLoggedIn then else if loginState = lsAlreadyLoggedIn then
MessageDlg('Error', 'There is already a client logged in using that account.', mtWarning, [mbOK], 0) MessageDlg('Error', 'There is already a client logged in using that account.', mtWarning, [mbOK], 0)
else if loginState = lsNoAccess then else if loginState = lsNoAccess then
MessageDlg('Error', 'This account has no access.', mtWarning, [mbOK], 0); MessageDlg('Error', 'This account has no access.', mtWarning, [mbOK], 0);
end; end;
end; end;
$04: //Server state $04: //Server state
begin begin
serverState := TServerState(ABuffer.ReadByte); serverState := TServerState(ABuffer.ReadByte);
if serverState = ssRunning then if serverState = ssRunning then
begin begin
frmInitialize.UnsetModal; frmInitialize.UnsetModal;
frmInitialize.Hide; frmInitialize.Hide;
tmNoOp.Enabled := True; tmNoOp.Enabled := True;
end else end else
begin begin
case serverState of case serverState of
ssFrozen: frmInitialize.lblStatus.Caption := 'The server is currently paused.'; ssFrozen: frmInitialize.lblStatus.Caption := 'The server is currently paused.';
ssOther: frmInitialize.lblStatus.Caption := ABuffer.ReadStringNull ssOther: frmInitialize.lblStatus.Caption := ABuffer.ReadStringNull
end; end;
tmNoOp.Enabled := False; tmNoOp.Enabled := False;
frmInitialize.Show; frmInitialize.Show;
frmInitialize.SetModal; frmInitialize.SetModal;
end; end;
end; end;
end; end;
end; end;
procedure TdmNetwork.ProcessQueue; procedure TdmNetwork.ProcessQueue;
var var
packetHandler: TPacketHandler; packetHandler: TPacketHandler;
size: Cardinal; size: Cardinal;
begin begin
FReceiveQueue.Position := 0; FReceiveQueue.Position := 0;
while FReceiveQueue.Size >= 1 do while FReceiveQueue.Size >= 1 do
begin begin
packetHandler := PacketHandlers[FReceiveQueue.ReadByte]; packetHandler := PacketHandlers[FReceiveQueue.ReadByte];
if packetHandler <> nil then if packetHandler <> nil then
begin begin
size := packetHandler.PacketLength; size := packetHandler.PacketLength;
if size = 0 then if size = 0 then
begin begin
if FReceiveQueue.Size > 5 then if FReceiveQueue.Size > 5 then
size := FReceiveQueue.ReadCardinal size := FReceiveQueue.ReadCardinal
else else
Break; //wait for more data Break; //wait for more data
end; end;
if FReceiveQueue.Size >= size then if FReceiveQueue.Size >= size then
begin begin
FReceiveQueue.Lock(FReceiveQueue.Position, size - FReceiveQueue.Position); //prevent handler from reading too much FReceiveQueue.Lock(FReceiveQueue.Position, size - FReceiveQueue.Position); //prevent handler from reading too much
packetHandler.Process(FReceiveQueue); packetHandler.Process(FReceiveQueue);
FReceiveQueue.Unlock; FReceiveQueue.Unlock;
FReceiveQueue.Dequeue(size); FReceiveQueue.Dequeue(size);
end else end else
Break; //wait for more data Break; //wait for more data
end else end else
begin begin
{Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);} {Writeln('Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);}
Disconnect; Disconnect;
FReceiveQueue.Clear; FReceiveQueue.Clear;
end; end;
end; end;
end; end;
procedure TdmNetwork.DoLogin; procedure TdmNetwork.DoLogin;
begin begin
tmNoOp.Enabled := False; tmNoOp.Enabled := False;
frmLogin := TfrmLogin.Create(dmNetwork); frmLogin := TfrmLogin.Create(dmNetwork);
if frmInitialize = nil then frmInitialize := TfrmInitialize.Create(dmNetwork); if frmInitialize = nil then frmInitialize := TfrmInitialize.Create(dmNetwork);
if frmTileInfo <> nil then FreeAndNil(frmTileInfo); if frmTileInfo <> nil then FreeAndNil(frmTileInfo);
if frmLargeScaleCommand <> nil then FreeAndNil(frmLargeScaleCommand); if frmEditAccount <> nil then FreeAndNil(frmEditAccount);
if frmEditAccount <> nil then FreeAndNil(frmEditAccount); if frmAccountControl <> nil then FreeAndNil(frmAccountControl);
if frmAccountControl <> nil then FreeAndNil(frmAccountControl); if frmConfirmation <> nil then FreeAndNil(frmConfirmation);
if frmConfirmation <> nil then FreeAndNil(frmConfirmation); if frmDrawSettings <> nil then FreeAndNil(frmDrawSettings);
if frmDrawSettings <> nil then FreeAndNil(frmDrawSettings); if frmMoveSettings <> nil then FreeAndNil(frmMoveSettings);
if frmMoveSettings <> nil then FreeAndNil(frmMoveSettings); if frmElevateSettings <> nil then FreeAndNil(frmElevateSettings);
if frmElevateSettings <> nil then FreeAndNil(frmElevateSettings); if frmHueSettings <> nil then FreeAndNil(frmHueSettings);
if frmHueSettings <> nil then FreeAndNil(frmHueSettings); if frmBoundaries <> nil then FreeAndNil(frmBoundaries);
if frmBoundaries <> nil then FreeAndNil(frmBoundaries); if frmFilter <> nil then FreeAndNil(frmFilter);
if frmFilter <> nil then FreeAndNil(frmFilter); if frmVirtualLayer <> nil then FreeAndNil(frmVirtualLayer);
if frmVirtualLayer <> nil then FreeAndNil(frmVirtualLayer); if frmAbout <> nil then FreeAndNil(frmAbout);
if frmAbout <> nil then FreeAndNil(frmAbout); if frmRegionControl <> nil then FreeAndNil(frmRegionControl);
if frmRegionControl <> nil then FreeAndNil(frmRegionControl); if frmLargeScaleCommand <> nil then FreeAndNil(frmLargeScaleCommand);
if frmRadarMap <> nil then FreeAndNil(frmRadarMap); if frmRadarMap <> nil then FreeAndNil(frmRadarMap);
if frmMain <> nil then if frmMain <> nil then
begin begin
frmMain.ApplicationProperties1.OnIdle := nil; frmMain.ApplicationProperties1.OnIdle := nil;
FreeAndNil(frmMain); FreeAndNil(frmMain);
end; end;
if GameResourceManager <> nil then FreeAndNil(GameResourceManager); if GameResourceManager <> nil then FreeAndNil(GameResourceManager);
frmInitialize.Hide; frmInitialize.Hide;
while frmLogin.ShowModal = mrOK do while frmLogin.ShowModal = mrOK do
begin begin
if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then
begin begin
FUsername := frmLogin.edUsername.Text; FUsername := frmLogin.edUsername.Text;
FPassword := frmLogin.edPassword.Text; FPassword := frmLogin.edPassword.Text;
FDataDir := frmLogin.edData.Text; FDataDir := frmLogin.edData.Text;
frmInitialize.lblStatus.Caption := 'Connecting'; frmInitialize.lblStatus.Caption := 'Connecting';
frmInitialize.Show; frmInitialize.Show;
Break; Break;
end else end else
MessageDlg('Error', 'Cannot connect to the specified server.', mtError, [mbOK], 0); MessageDlg('Error', 'Cannot connect to the specified server.', mtError, [mbOK], 0);
end; end;
frmLogin.Close; frmLogin.Close;
FreeAndNil(frmLogin); FreeAndNil(frmLogin);
end; end;
procedure TdmNetwork.Send(APacket: TPacket); procedure TdmNetwork.Send(APacket: TPacket);
var var
source: TEnhancedMemoryStream; source: TEnhancedMemoryStream;
begin begin
if TCPClient.Connected then if TCPClient.Connected then
begin begin
FSendQueue.Seek(0, soFromEnd); FSendQueue.Seek(0, soFromEnd);
source := APacket.Stream; source := APacket.Stream;
FSendQueue.CopyFrom(source, 0); FSendQueue.CopyFrom(source, 0);
OnCanSend(nil); OnCanSend(nil);
end; end;
APacket.Free; APacket.Free;
end; end;
procedure TdmNetwork.Disconnect; procedure TdmNetwork.Disconnect;
begin begin
Send(TQuitPacket.Create); Send(TQuitPacket.Create);
end; end;
procedure TdmNetwork.CheckClose(ASender: TForm); procedure TdmNetwork.CheckClose(ASender: TForm);
begin begin
if ((frmLogin = nil) or (ASender = frmLogin)) and if ((frmLogin = nil) or (ASender = frmLogin)) and
((frmMain = nil) or (ASender = frmMain)) and ((frmMain = nil) or (ASender = frmMain)) and
((frmInitialize = nil) or (not frmInitialize.Visible)) then ((frmInitialize = nil) or (not frmInitialize.Visible)) then
begin begin
Application.Terminate; Application.Terminate;
end; end;
end; end;
initialization initialization
{$I UdmNetwork.lrs} {$I UdmNetwork.lrs}
end. end.

37
Client/UfrmAccountControl.pas
View File

@ -31,7 +31,7 @@ interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ComCtrls,
VirtualTrees, VTHeaderPopup, UEnhancedMemoryStream, UEnums; VirtualTrees, Math, UEnhancedMemoryStream, UEnums;
type type
@ -67,8 +67,6 @@ type
procedure OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream); procedure OnDeleteUserResponse(ABuffer: TEnhancedMemoryStream);
procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream); procedure OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
function FindNode(AUsername: string): PVirtualNode; function FindNode(AUsername: string): PVirtualNode;
public
{ public declarations }
end; end;
var var
@ -90,7 +88,8 @@ type
{ TModifyUserPacket } { TModifyUserPacket }
TModifyUserPacket = class(TPacket) TModifyUserPacket = class(TPacket)
constructor Create(AUsername, APassword: string; AAccessLevel: TAccessLevel); constructor Create(AUsername, APassword: string; AAccessLevel: TAccessLevel;
ARegions: TStrings);
end; end;
{ TDeleteUserPacket } { TDeleteUserPacket }
@ -108,13 +107,22 @@ type
{ TModifyUserPacket } { TModifyUserPacket }
constructor TModifyUserPacket.Create(AUsername, APassword: string; constructor TModifyUserPacket.Create(AUsername, APassword: string;
AAccessLevel: TAccessLevel); AAccessLevel: TAccessLevel; ARegions: TStrings);
var
regionCount: Byte;
i: Integer;
begin begin
inherited Create($03, 0); inherited Create($03, 0);
FStream.WriteByte($05); FStream.WriteByte($05);
FStream.WriteStringNull(AUsername); FStream.WriteStringNull(AUsername);
FStream.WriteStringNull(APassword); FStream.WriteStringNull(APassword);
FStream.WriteByte(Byte(AAccessLevel)); FStream.WriteByte(Byte(AAccessLevel));
regionCount := Min(ARegions.Count, 256);
FStream.WriteByte(regionCount);
for i := 0 to regionCount - 1 do
FStream.WriteStringNull(ARegions.Strings[i]);
end; end;
{ TDeleteUserPacket } { TDeleteUserPacket }
@ -155,6 +163,7 @@ procedure TfrmAccountControl.tbEditUserClick(Sender: TObject);
var var
selected: PVirtualNode; selected: PVirtualNode;
accountInfo: PAccountInfo; accountInfo: PAccountInfo;
regions: TStrings;
begin begin
selected := vstAccounts.GetFirstSelected; selected := vstAccounts.GetFirstSelected;
if selected <> nil then if selected <> nil then
@ -168,9 +177,14 @@ begin
edPassword.Text := ''; edPassword.Text := '';
lblPasswordHint.Visible := True; lblPasswordHint.Visible := True;
SetAccessLevel(accountInfo^.AccessLevel); SetAccessLevel(accountInfo^.AccessLevel);
SetRegions(accountInfo^.Regions);
if ShowModal = mrOK then if ShowModal = mrOK then
begin
regions := GetRegions;
dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text,
edPassword.Text, GetAccessLevel)); edPassword.Text, GetAccessLevel, regions));
regions.Free;
end;
end; end;
end; end;
end; end;
@ -188,6 +202,8 @@ begin
end; end;
procedure TfrmAccountControl.tbAddUserClick(Sender: TObject); procedure TfrmAccountControl.tbAddUserClick(Sender: TObject);
var
regions: TStrings;
begin begin
with frmEditAccount do with frmEditAccount do
begin begin
@ -197,9 +213,14 @@ begin
edPassword.Text := ''; edPassword.Text := '';
lblPasswordHint.Visible := False; lblPasswordHint.Visible := False;
cbAccessLevel.ItemIndex := 2; cbAccessLevel.ItemIndex := 2;
SetRegions(nil);
if ShowModal = mrOK then if ShowModal = mrOK then
begin
regions := GetRegions;
dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, edPassword.Text, dmNetwork.Send(TModifyUserPacket.Create(edUsername.Text, edPassword.Text,
GetAccessLevel)); GetAccessLevel, regions));
regions.Free;
end;
end; end;
end; end;
@ -348,7 +369,7 @@ procedure TfrmAccountControl.OnListUsersPacket(ABuffer: TEnhancedMemoryStream);
var var
node: PVirtualNode; node: PVirtualNode;
accountInfo: PAccountInfo; accountInfo: PAccountInfo;
i, j, count, regions: Word; i, j, count, regions: Integer;
begin begin
vstAccounts.BeginUpdate; vstAccounts.BeginUpdate;
vstAccounts.Clear; vstAccounts.Clear;

31
Client/UfrmEditAccount.lfm
View File

@ -10,6 +10,9 @@ object frmEditAccount: TfrmEditAccount
ClientHeight = 214 ClientHeight = 214
ClientWidth = 261 ClientWidth = 261
Font.Height = -11 Font.Height = -11
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
Position = poOwnerFormCenter Position = poOwnerFormCenter
LCLVersion = '0.9.25' LCLVersion = '0.9.25'
object PageControl1: TPageControl object PageControl1: TPageControl
@ -22,7 +25,7 @@ object frmEditAccount: TfrmEditAccount
TabOrder = 0 TabOrder = 0
object tsGeneral: TTabSheet object tsGeneral: TTabSheet
Caption = 'General' Caption = 'General'
ClientHeight = 142 ClientHeight = 144
ClientWidth = 257 ClientWidth = 257
ParentFont = True ParentFont = True
object lblPasswordHint: TLabel object lblPasswordHint: TLabel
@ -39,27 +42,27 @@ object frmEditAccount: TfrmEditAccount
end end
object lblUsername: TLabel object lblUsername: TLabel
Left = 6 Left = 6
Height = 13 Height = 14
Top = 12 Top = 12
Width = 64 Width = 58
Caption = 'Username:' Caption = 'Username:'
ParentColor = False ParentColor = False
ParentFont = True ParentFont = True
end end
object lblPassword: TLabel object lblPassword: TLabel
Left = 6 Left = 6
Height = 13 Height = 14
Top = 44 Top = 44
Width = 61 Width = 54
Caption = 'Password:' Caption = 'Password:'
ParentColor = False ParentColor = False
ParentFont = True ParentFont = True
end end
object lblAccessLevel: TLabel object lblAccessLevel: TLabel
Left = 6 Left = 6
Height = 13 Height = 14
Top = 108 Top = 108
Width = 71 Width = 63
Caption = 'Accesslevel:' Caption = 'Accesslevel:'
ParentColor = False ParentColor = False
ParentFont = True ParentFont = True
@ -86,7 +89,7 @@ object frmEditAccount: TfrmEditAccount
end end
object cbAccessLevel: TComboBox object cbAccessLevel: TComboBox
Left = 86 Left = 86
Height = 23 Height = 29
Top = 104 Top = 104
Width = 160 Width = 160
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending] AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]
@ -104,12 +107,12 @@ object frmEditAccount: TfrmEditAccount
end end
object tsRegions: TTabSheet object tsRegions: TTabSheet
Caption = 'Regions' Caption = 'Regions'
ClientHeight = 142 ClientHeight = 144
ClientWidth = 257 ClientWidth = 257
ParentFont = True ParentFont = True
object Label1: TLabel object Label1: TLabel
Left = 8 Left = 8
Height = 13 Height = 14
Top = 8 Top = 8
Width = 241 Width = 241
Align = alTop Align = alTop
@ -121,17 +124,17 @@ object frmEditAccount: TfrmEditAccount
ParentColor = False ParentColor = False
ParentFont = True ParentFont = True
end end
object CheckListBox1: TCheckListBox object cbRegions: TCheckListBox
Left = 8 Left = 8
Height = 109 Height = 110
Top = 25 Top = 26
Width = 241 Width = 241
Align = alClient Align = alClient
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
ItemHeight = 10 ItemHeight = 13
ParentFont = True ParentFont = True
TabOrder = 0 TabOrder = 0
TopIndex = -1 TopIndex = -1

235
Client/UfrmEditAccount.pas
View File

@ -1,47 +1,47 @@
(* (*
* 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 2008 Andreas Schneider
*) *)
unit UfrmEditAccount; unit UfrmEditAccount;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
UEnums, ComCtrls, ExtCtrls, CheckLst; UEnums, ComCtrls, ExtCtrls, CheckLst, UfrmRegionControl, VirtualTrees;
type type
{ TfrmEditAccount } { TfrmEditAccount }
TfrmEditAccount = class(TForm) TfrmEditAccount = class(TForm)
btnCancel: TButton; btnCancel: TButton;
btnOK: TButton; btnOK: TButton;
cbAccessLevel: TComboBox; cbAccessLevel: TComboBox;
CheckListBox1: TCheckListBox; cbRegions: TCheckListBox;
edPassword: TEdit; edPassword: TEdit;
edUsername: TEdit; edUsername: TEdit;
Label1: TLabel; Label1: TLabel;
@ -52,41 +52,120 @@ type
PageControl1: TPageControl; PageControl1: TPageControl;
Panel1: TPanel; Panel1: TPanel;
tsGeneral: TTabSheet; tsGeneral: TTabSheet;
tsRegions: TTabSheet; tsRegions: TTabSheet;
public procedure FormCreate(Sender: TObject);
function GetAccessLevel: TAccessLevel; procedure FormDestroy(Sender: TObject);
procedure SetAccessLevel(AAccessLevel: TAccessLevel); procedure FormShow(Sender: TObject);
end; public
function GetAccessLevel: TAccessLevel;
var function GetRegions: TStrings;
frmEditAccount: TfrmEditAccount; procedure SetAccessLevel(AAccessLevel: TAccessLevel);
procedure SetRegions(ARegions: TStrings);
implementation protected
procedure RegionModified(ARegion: TRegionInfo);
{ TfrmEditAccount } procedure RegionDeleted(ARegionName: string);
procedure RegionList;
function TfrmEditAccount.GetAccessLevel: TAccessLevel; end;
begin
case cbAccessLevel.ItemIndex of var
0: Result := alNone; frmEditAccount: TfrmEditAccount;
1: Result := alView;
2: Result := alNormal; implementation
3: Result := alAdministrator;
end; { TfrmEditAccount }
end;
procedure TfrmEditAccount.FormCreate(Sender: TObject);
procedure TfrmEditAccount.SetAccessLevel(AAccessLevel: TAccessLevel); begin
begin frmRegionControl.OnRegionModified := @RegionModified;
case AAccessLevel of frmRegionControl.OnRegionDeleted := @RegionDeleted;
alNone: cbAccessLevel.ItemIndex := 0; frmRegionControl.OnRegionList := @RegionList;
alView: cbAccessLevel.ItemIndex := 1; end;
alNormal: cbAccessLevel.ItemIndex := 2;
alAdministrator: cbAccessLevel.ItemIndex := 3; procedure TfrmEditAccount.FormDestroy(Sender: TObject);
end; begin
end; frmRegionControl.OnRegionModified := nil;
frmRegionControl.OnRegionDeleted := nil;
initialization frmRegionControl.OnRegionList := nil;
{$I UfrmEditAccount.lrs} end;
end. procedure TfrmEditAccount.FormShow(Sender: TObject);
begin
PageControl1.ActivePageIndex := 0;
end;
function TfrmEditAccount.GetAccessLevel: TAccessLevel;
begin
case cbAccessLevel.ItemIndex of
0: Result := alNone;
1: Result := alView;
2: Result := alNormal;
3: Result := alAdministrator;
end;
end;
function TfrmEditAccount.GetRegions: TStrings;
var
regions: TStringList;
i: Integer;
begin
regions := TStringList.Create;
for i := 0 to cbRegions.Items.Count - 1 do
begin
if cbRegions.Checked[i] then
regions.Add(cbRegions.Items[i]);
end;
Result := regions;
end;
procedure TfrmEditAccount.SetAccessLevel(AAccessLevel: TAccessLevel);
begin
case AAccessLevel of
alNone: cbAccessLevel.ItemIndex := 0;
alView: cbAccessLevel.ItemIndex := 1;
alNormal: cbAccessLevel.ItemIndex := 2;
alAdministrator: cbAccessLevel.ItemIndex := 3;
end;
end;
procedure TfrmEditAccount.SetRegions(ARegions: TStrings);
var
i: Integer;
begin
for i := 0 to cbRegions.Items.Count - 1 do
cbRegions.Checked[i] := (ARegions <> nil) and
(ARegions.IndexOf(cbRegions.Items.Strings[i]) > -1);
end;
procedure TfrmEditAccount.RegionModified(ARegion: TRegionInfo);
begin
if cbRegions.Items.IndexOf(ARegion.Name) = -1 then
cbRegions.Items.Add(ARegion.Name);
end;
procedure TfrmEditAccount.RegionDeleted(ARegionName: string);
begin
cbRegions.Items.Delete(cbRegions.Items.IndexOf(ARegionName));
end;
procedure TfrmEditAccount.RegionList;
var
regionNode: PVirtualNode;
regionInfo: PRegionInfo;
begin
cbRegions.Items.BeginUpdate;
cbRegions.Items.Clear;
regionNode := frmRegionControl.vstRegions.GetFirst;
while regionNode <> nil do
begin
regionInfo := frmRegionControl.vstRegions.GetNodeData(regionNode);
cbRegions.Items.Add(regionInfo^.Name);
regionNode := frmRegionControl.vstRegions.GetNext(regionNode);
end;
cbRegions.Items.EndUpdate;
end;
initialization
{$I UfrmEditAccount.lrs}
end.

30
Client/UfrmLogin.lfm
View File

@ -16,8 +16,8 @@ object frmLogin: TfrmLogin
ShowInTaskBar = stAlways ShowInTaskBar = stAlways
LCLVersion = '0.9.25' LCLVersion = '0.9.25'
object lblCopyright: TLabel object lblCopyright: TLabel
Height = 24 Height = 25
Top = 241 Top = 240
Width = 489 Width = 489
Align = alBottom Align = alBottom
Alignment = taCenter Alignment = taCenter
@ -30,33 +30,33 @@ object frmLogin: TfrmLogin
Top = 8 Top = 8
Width = 321 Width = 321
Caption = 'Connection' Caption = 'Connection'
ClientHeight = 111 ClientHeight = 113
ClientWidth = 317 ClientWidth = 317
ParentFont = True ParentFont = True
TabOrder = 0 TabOrder = 0
object lblHost: TLabel object lblHost: TLabel
Left = 30 Left = 30
Height = 13 Height = 14
Top = 9 Top = 9
Width = 31 Width = 28
Caption = 'Host:' Caption = 'Host:'
ParentColor = False ParentColor = False
ParentFont = True ParentFont = True
end end
object lblUsername: TLabel object lblUsername: TLabel
Left = 30 Left = 30
Height = 13 Height = 14
Top = 43 Top = 43
Width = 64 Width = 58
Caption = 'Username:' Caption = 'Username:'
ParentColor = False ParentColor = False
ParentFont = True ParentFont = True
end end
object lblPassword: TLabel object lblPassword: TLabel
Left = 30 Left = 30
Height = 13 Height = 14
Top = 77 Top = 77
Width = 61 Width = 54
Caption = 'Password:' Caption = 'Password:'
ParentColor = False ParentColor = False
ParentFont = True ParentFont = True
@ -368,7 +368,7 @@ object frmLogin: TfrmLogin
Height = 96 Height = 96
Top = 8 Top = 8
Width = 145 Width = 145
ClientHeight = 92 ClientHeight = 79
ClientWidth = 141 ClientWidth = 141
ParentFont = True ParentFont = True
TabOrder = 2 TabOrder = 2
@ -432,11 +432,11 @@ object frmLogin: TfrmLogin
end end
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
Left = 336 Left = 336
Height = 81 Height = 84
Top = 112 Top = 112
Width = 145 Width = 145
Caption = 'Profiles' Caption = 'Profiles'
ClientHeight = 64 ClientHeight = 69
ClientWidth = 141 ClientWidth = 141
ParentFont = True ParentFont = True
TabOrder = 3 TabOrder = 3
@ -444,7 +444,7 @@ object frmLogin: TfrmLogin
Left = 86 Left = 86
Height = 22 Height = 22
Hint = 'Save profile' Hint = 'Save profile'
Top = 32 Top = 40
Width = 23 Width = 23
Color = clBtnFace Color = clBtnFace
Glyph.Data = { Glyph.Data = {
@ -493,7 +493,7 @@ object frmLogin: TfrmLogin
Left = 111 Left = 111
Height = 22 Height = 22
Hint = 'Delete profile' Hint = 'Delete profile'
Top = 32 Top = 40
Width = 23 Width = 23
Color = clBtnFace Color = clBtnFace
Glyph.Data = { Glyph.Data = {
@ -540,7 +540,7 @@ object frmLogin: TfrmLogin
end end
object cbProfile: TComboBox object cbProfile: TComboBox
Left = 6 Left = 6
Height = 21 Height = 29
Top = 8 Top = 8
Width = 128 Width = 128
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending] AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]

49
Client/UfrmMain.pas
View File

@ -21,7 +21,7 @@
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2008 Andreas Schneider
*) *)
unit UfrmMain; unit UfrmMain;
@ -38,10 +38,11 @@ uses
type type
TVirtualTile = class(TStaticItem) TVirtualTile = class(TStaticItem);
end;
TVirtualTileArray = array of TVirtualTile; TVirtualTileArray = array of TVirtualTile;
TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
{ TfrmMain } { TfrmMain }
TfrmMain = class(TForm) TfrmMain = class(TForm)
@ -277,6 +278,7 @@ type
FLocationsFile: string; FLocationsFile: string;
FRandomPresetLocation: string; FRandomPresetLocation: string;
FLastDraw: TDateTime; FLastDraw: TDateTime;
FAccessChangedListeners: array of TAccessChangedListener;
procedure SetX(const AValue: Integer); procedure SetX(const AValue: Integer);
procedure SetY(const AValue: Integer); procedure SetY(const AValue: Integer);
procedure SetCurrentTile(const AValue: TWorldItem); procedure SetCurrentTile(const AValue: TWorldItem);
@ -306,6 +308,8 @@ type
property SelectedTile: TWorldItem read FSelectedTile write SetSelectedTile; property SelectedTile: TWorldItem read FSelectedTile write SetSelectedTile;
procedure SetPos(AX, AY: Word); procedure SetPos(AX, AY: Word);
procedure RegisterAccessChangedListener(AListener: TAccessChangedListener);
procedure UnregisterAccessChangedListener(AListener: TAccessChangedListener);
end; end;
var var
@ -1500,6 +1504,41 @@ begin
end; end;
end; end;
procedure TfrmMain.RegisterAccessChangedListener(
AListener: TAccessChangedListener);
var
i: Integer;
begin
for i := Low(FAccessChangedListeners) to High(FAccessChangedListeners) do
if FAccessChangedListeners[i] = AListener then
Exit; //Prevent duplicates
SetLength(FAccessChangedListeners, Length(FAccessChangedListeners) + 1);
FAccessChangedListeners[High(FAccessChangedListeners)] := AListener;
end;
procedure TfrmMain.UnregisterAccessChangedListener(
AListener: TAccessChangedListener);
var
i: Integer;
found: Boolean;
begin
i := Low(FAccessChangedListeners);
found := False;
while (i <= High(FAccessChangedListeners)) and (not found) do
begin
if FAccessChangedListeners[i] = AListener then
begin
if i < High(FAccessChangedListeners) then
Move(FAccessChangedListeners[i+1], FAccessChangedListeners[i],
(High(FAccessChangedListeners) - Low(FAccessChangedListeners) - i) *
SizeOf(TAccessChangedListener)); //move subsequent entries
SetLength(FAccessChangedListeners, Length(FAccessChangedListeners) - 1);
found := True;
end else
Inc(i);
end;
end;
procedure TfrmMain.SetCurrentTile(const AValue: TWorldItem); procedure TfrmMain.SetCurrentTile(const AValue: TWorldItem);
begin begin
if FCurrentTile <> nil then if FCurrentTile <> nil then
@ -2050,6 +2089,7 @@ end;
procedure TfrmMain.OnClientHandlingPacket(ABuffer: TEnhancedMemoryStream); procedure TfrmMain.OnClientHandlingPacket(ABuffer: TEnhancedMemoryStream);
var var
sender, msg: string; sender, msg: string;
i: Integer;
begin begin
case ABuffer.ReadByte of case ABuffer.ReadByte of
$01: //client connected $01: //client connected
@ -2096,6 +2136,9 @@ begin
ProcessAccessLevel; ProcessAccessLevel;
MessageDlg('AccessLevel change', Format('Your accesslevel has been changed to %s.', [GetAccessLevelString(dmNetwork.AccessLevel)]), mtWarning, [mbOK], 0); MessageDlg('AccessLevel change', Format('Your accesslevel has been changed to %s.', [GetAccessLevelString(dmNetwork.AccessLevel)]), mtWarning, [mbOK], 0);
end; end;
for i := Low(FAccessChangedListeners) to High(FAccessChangedListeners) do
FAccessChangedListeners[i](dmNetwork.AccessLevel);
end; end;
end; end;
end; end;

55
Client/UfrmRegionControl.pas
View File

@ -32,12 +32,22 @@ interface
uses uses
Classes, SysUtils, math, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, math, LResources, Forms, Controls, Graphics, Dialogs,
VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf, VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf,
UEnhancedMemoryStream, Menus, URectList; UEnhancedMemoryStream, Menus, URectList, UEnums;
type type
TAreaMoveType = (amLeft, amTop, amRight, amBottom); TAreaMoveType = (amLeft, amTop, amRight, amBottom);
TAreaMove = set of TAreaMoveType; TAreaMove = set of TAreaMoveType;
PRegionInfo = ^TRegionInfo;
TRegionInfo = record
Name: string;
Areas: TRectList;
end;
TRegionModifiedEvent = procedure(ARegionInfo: TRegionInfo) of object;
TRegionDeletedEvent = procedure(ARegionName: string) of object;
TRegionListEvent = procedure of object;
{ TfrmRegionControl } { TfrmRegionControl }
TfrmRegionControl = class(TForm) TfrmRegionControl = class(TForm)
@ -91,16 +101,20 @@ type
FLastX: Integer; FLastX: Integer;
FLastY: Integer; FLastY: Integer;
FAreaMove: TAreaMove; FAreaMove: TAreaMove;
FOnRegionModified: TRegionModifiedEvent;
FOnRegionDeleted: TRegionDeletedEvent;
FOnRegionList: TRegionListEvent;
function FindRegion(AName: string): PVirtualNode; function FindRegion(AName: string): PVirtualNode;
procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream); procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream);
procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream); procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream);
procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream); procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
private procedure OnAccessChanged(AAccessLevel: TAccessLevel);
{ private declarations }
public public
{ public declarations } property OnRegionModified: TRegionModifiedEvent read FOnRegionModified write FOnRegionModified;
end; property OnRegionDeleted: TRegionDeletedEvent read FOnRegionDeleted write FOnRegionDeleted;
property OnRegionList: TRegionListEvent read FOnRegionList write FOnRegionList;
end;
var var
frmRegionControl: TfrmRegionControl; frmRegionControl: TfrmRegionControl;
@ -108,16 +122,9 @@ implementation
uses uses
UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UGUIPlatformUtils, UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UGUIPlatformUtils,
UAdminHandling, UPacketHandlers; UAdminHandling, UPacketHandlers, UConsts;
type type
PRegionInfo = ^TRegionInfo;
TRegionInfo = record
Name: string;
Areas: TRectList;
end;
{ TModifyRegionPacket } { TModifyRegionPacket }
TModifyRegionPacket = class(TPacket) TModifyRegionPacket = class(TPacket)
@ -191,10 +198,13 @@ begin
vstRegions.NodeDataSize := SizeOf(TRegionInfo); vstRegions.NodeDataSize := SizeOf(TRegionInfo);
frmRadarMap.Dependencies.Add(pbArea); frmRadarMap.Dependencies.Add(pbArea);
frmMain.RegisterAccessChangedListener(@OnAccessChanged);
AssignAdminPacketHandler($08, TPacketHandler.Create(0, @OnModifyRegionPacket)); AssignAdminPacketHandler($08, TPacketHandler.Create(0, @OnModifyRegionPacket));
AssignAdminPacketHandler($09, TPacketHandler.Create(0, @OnDeleteRegionPacket)); AssignAdminPacketHandler($09, TPacketHandler.Create(0, @OnDeleteRegionPacket));
AssignAdminPacketHandler($0A, TPacketHandler.Create(0, @OnListRegionsPacket)); AssignAdminPacketHandler($0A, TPacketHandler.Create(0, @OnListRegionsPacket));
dmNetwork.Send(TRequestRegionListPacket.Create);
end; end;
procedure TfrmRegionControl.FormDestroy(Sender: TObject); procedure TfrmRegionControl.FormDestroy(Sender: TObject);
@ -209,7 +219,6 @@ procedure TfrmRegionControl.FormShow(Sender: TObject);
begin begin
SetWindowParent(Handle, frmMain.Handle); SetWindowParent(Handle, frmMain.Handle);
btnSave.Enabled := False; //no changes yet btnSave.Enabled := False; //no changes yet
dmNetwork.Send(TRequestRegionListPacket.Create);
end; end;
procedure TfrmRegionControl.btnSaveClick(Sender: TObject); procedure TfrmRegionControl.btnSaveClick(Sender: TObject);
@ -532,6 +541,7 @@ var
regionInfo: PRegionInfo; regionInfo: PRegionInfo;
begin begin
regionInfo := Sender.GetNodeData(Node); regionInfo := Sender.GetNodeData(Node);
regionInfo^.Name := '';
if regionInfo^.Areas <> nil then FreeAndNil(regionInfo^.Areas); if regionInfo^.Areas <> nil then FreeAndNil(regionInfo^.Areas);
end; end;
@ -604,6 +614,9 @@ begin
btnSave.Enabled := False; btnSave.Enabled := False;
vstRegionsChange(vstRegions, regionNode); vstRegionsChange(vstRegions, regionNode);
end; end;
if Assigned(FOnRegionModified) then
FOnRegionModified(regionInfo^);
end; end;
procedure TfrmRegionControl.OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream); procedure TfrmRegionControl.OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream);
@ -619,6 +632,9 @@ begin
if regionNode <> nil then if regionNode <> nil then
vstRegions.DeleteNode(regionNode); vstRegions.DeleteNode(regionNode);
if Assigned(FOnRegionDeleted) then
FOnRegionDeleted(regionName);
end; end;
procedure TfrmRegionControl.OnListRegionsPacket(ABuffer: TEnhancedMemoryStream); procedure TfrmRegionControl.OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
@ -648,6 +664,15 @@ begin
end; end;
end; end;
vstRegions.EndUpdate; vstRegions.EndUpdate;
if Assigned(FOnRegionList) then
FOnRegionList;
end;
procedure TfrmRegionControl.OnAccessChanged(AAccessLevel: TAccessLevel);
begin
if AAccessLevel >= alAdministrator then
dmNetwork.Send(TRequestRegionListPacket.Create);
end; end;
initialization initialization

2
Server/UAdminHandling.pas
View File

@ -352,7 +352,7 @@ begin
FStream.WriteByte(Byte(account.AccessLevel)); FStream.WriteByte(Byte(account.AccessLevel));
FStream.WriteByte(account.Regions.Count); FStream.WriteByte(account.Regions.Count);
for j := 0 to account.Regions.Count - 1 do for j := 0 to account.Regions.Count - 1 do
FStream.WriteStringNull(account.Regions[j]); FStream.WriteStringNull(account.Regions.Strings[j]);
end; end;
end; end;