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))$
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
*
*
* Portions Copyright 2007 Andreas Schneider
* Portions Copyright 2008 Andreas Schneider
*)
program CentrED;
@ -40,7 +40,7 @@ uses
UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets,
UPacketHandlers, UAdminHandling, UGameResources, ULandscape;
{$IFDEF Windows}
{$R *.res}
{$ENDIF}

4
Client/UAdminHandling.pas
View File

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

728
Client/UdmNetwork.pas
View File

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

37
Client/UfrmAccountControl.pas
View File

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

31
Client/UfrmEditAccount.lfm
View File

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

235
Client/UfrmEditAccount.pas
View File

@ -1,47 +1,47 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2007 Andreas Schneider
*)
unit UfrmEditAccount;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
UEnums, ComCtrls, ExtCtrls, CheckLst;
type
{ TfrmEditAccount }
(*
* 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 UfrmEditAccount;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
UEnums, ComCtrls, ExtCtrls, CheckLst, UfrmRegionControl, VirtualTrees;
type
{ TfrmEditAccount }
TfrmEditAccount = class(TForm)
btnCancel: TButton;
btnOK: TButton;
cbAccessLevel: TComboBox;
CheckListBox1: TCheckListBox;
cbRegions: TCheckListBox;
edPassword: TEdit;
edUsername: TEdit;
Label1: TLabel;
@ -52,41 +52,120 @@ type
PageControl1: TPageControl;
Panel1: TPanel;
tsGeneral: TTabSheet;
tsRegions: TTabSheet;
public
function GetAccessLevel: TAccessLevel;
procedure SetAccessLevel(AAccessLevel: TAccessLevel);
end;
var
frmEditAccount: TfrmEditAccount;
implementation
{ TfrmEditAccount }
function TfrmEditAccount.GetAccessLevel: TAccessLevel;
begin
case cbAccessLevel.ItemIndex of
0: Result := alNone;
1: Result := alView;
2: Result := alNormal;
3: Result := alAdministrator;
end;
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;
initialization
{$I UfrmEditAccount.lrs}
end.
tsRegions: TTabSheet;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
public
function GetAccessLevel: TAccessLevel;
function GetRegions: TStrings;
procedure SetAccessLevel(AAccessLevel: TAccessLevel);
procedure SetRegions(ARegions: TStrings);
protected
procedure RegionModified(ARegion: TRegionInfo);
procedure RegionDeleted(ARegionName: string);
procedure RegionList;
end;
var
frmEditAccount: TfrmEditAccount;
implementation
{ TfrmEditAccount }
procedure TfrmEditAccount.FormCreate(Sender: TObject);
begin
frmRegionControl.OnRegionModified := @RegionModified;
frmRegionControl.OnRegionDeleted := @RegionDeleted;
frmRegionControl.OnRegionList := @RegionList;
end;
procedure TfrmEditAccount.FormDestroy(Sender: TObject);
begin
frmRegionControl.OnRegionModified := nil;
frmRegionControl.OnRegionDeleted := nil;
frmRegionControl.OnRegionList := nil;
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
LCLVersion = '0.9.25'
object lblCopyright: TLabel
Height = 24
Top = 241
Height = 25
Top = 240
Width = 489
Align = alBottom
Alignment = taCenter
@ -30,33 +30,33 @@ object frmLogin: TfrmLogin
Top = 8
Width = 321
Caption = 'Connection'
ClientHeight = 111
ClientHeight = 113
ClientWidth = 317
ParentFont = True
TabOrder = 0
object lblHost: TLabel
Left = 30
Height = 13
Height = 14
Top = 9
Width = 31
Width = 28
Caption = 'Host:'
ParentColor = False
ParentFont = True
end
object lblUsername: TLabel
Left = 30
Height = 13
Height = 14
Top = 43
Width = 64
Width = 58
Caption = 'Username:'
ParentColor = False
ParentFont = True
end
object lblPassword: TLabel
Left = 30
Height = 13
Height = 14
Top = 77
Width = 61
Width = 54
Caption = 'Password:'
ParentColor = False
ParentFont = True
@ -368,7 +368,7 @@ object frmLogin: TfrmLogin
Height = 96
Top = 8
Width = 145
ClientHeight = 92
ClientHeight = 79
ClientWidth = 141
ParentFont = True
TabOrder = 2
@ -432,11 +432,11 @@ object frmLogin: TfrmLogin
end
object GroupBox1: TGroupBox
Left = 336
Height = 81
Height = 84
Top = 112
Width = 145
Caption = 'Profiles'
ClientHeight = 64
ClientHeight = 69
ClientWidth = 141
ParentFont = True
TabOrder = 3
@ -444,7 +444,7 @@ object frmLogin: TfrmLogin
Left = 86
Height = 22
Hint = 'Save profile'
Top = 32
Top = 40
Width = 23
Color = clBtnFace
Glyph.Data = {
@ -493,7 +493,7 @@ object frmLogin: TfrmLogin
Left = 111
Height = 22
Hint = 'Delete profile'
Top = 32
Top = 40
Width = 23
Color = clBtnFace
Glyph.Data = {
@ -540,7 +540,7 @@ object frmLogin: TfrmLogin
end
object cbProfile: TComboBox
Left = 6
Height = 21
Height = 29
Top = 8
Width = 128
AutoCompleteText = [cbactEndOfLineComplete, cbactSearchAscending]

49
Client/UfrmMain.pas
View File

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

55
Client/UfrmRegionControl.pas
View File

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

2
Server/UAdminHandling.pas
View File

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