From 91af86a29459f75b2391fe1d7112f2d0a2535bff Mon Sep 17 00:00:00 2001 From: Andreas Schneider Date: Mon, 25 Aug 2008 17:33:38 +0200 Subject: [PATCH] - 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 --- .hgignore | 19 +- Client/CentrED.lpr | 4 +- Client/UAdminHandling.pas | 4 +- Client/UdmNetwork.pas | 728 +++++++++++++++++----------------- Client/UfrmAccountControl.pas | 37 +- Client/UfrmEditAccount.lfm | 31 +- Client/UfrmEditAccount.pas | 235 +++++++---- Client/UfrmLogin.lfm | 30 +- Client/UfrmMain.pas | 49 ++- Client/UfrmRegionControl.pas | 55 ++- Server/UAdminHandling.pas | 2 +- 11 files changed, 691 insertions(+), 503 deletions(-) diff --git a/.hgignore b/.hgignore index ef1816f..fa201b8 100644 --- a/.hgignore +++ b/.hgignore @@ -1,2 +1,19 @@ -syntax: regexp +#syntax: regexp #(? 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. + diff --git a/Client/UfrmAccountControl.pas b/Client/UfrmAccountControl.pas index bd3cf53..f4700de 100644 --- a/Client/UfrmAccountControl.pas +++ b/Client/UfrmAccountControl.pas @@ -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; diff --git a/Client/UfrmEditAccount.lfm b/Client/UfrmEditAccount.lfm index eaef55f..62f9959 100644 --- a/Client/UfrmEditAccount.lfm +++ b/Client/UfrmEditAccount.lfm @@ -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 diff --git a/Client/UfrmEditAccount.pas b/Client/UfrmEditAccount.pas index 08ac44c..8684916 100644 --- a/Client/UfrmEditAccount.pas +++ b/Client/UfrmEditAccount.pas @@ -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. + diff --git a/Client/UfrmLogin.lfm b/Client/UfrmLogin.lfm index 78115d3..a693161 100644 --- a/Client/UfrmLogin.lfm +++ b/Client/UfrmLogin.lfm @@ -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] diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas index 391993a..1b1a19a 100644 --- a/Client/UfrmMain.pas +++ b/Client/UfrmMain.pas @@ -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; diff --git a/Client/UfrmRegionControl.pas b/Client/UfrmRegionControl.pas index a01fa08..39d72cc 100644 --- a/Client/UfrmRegionControl.pas +++ b/Client/UfrmRegionControl.pas @@ -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 diff --git a/Server/UAdminHandling.pas b/Server/UAdminHandling.pas index 8624db4..72682a4 100644 --- a/Server/UAdminHandling.pas +++ b/Server/UAdminHandling.pas @@ -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;