429 lines
16 KiB
Plaintext
429 lines
16 KiB
Plaintext
(*
|
||
* 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 2009 Andreas Schneider
|
||
*)
|
||
unit UdmNetwork;
|
||
|
||
{$mode objfpc}{$H+}
|
||
|
||
interface
|
||
|
||
uses
|
||
Classes, SysUtils, LResources, Forms, Controls, Dialogs, lNetComponents, lNet,
|
||
UEnhancedMemoryStream, UPacket, UEnums, ExtCtrls, dateutils, LConvEncoding;
|
||
|
||
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;
|
||
FProfile: string;
|
||
FUsername: string;
|
||
FPassword: string;
|
||
FAccessLevel: TAccessLevel;
|
||
FServerStart: TDateTime;
|
||
FDataDir: string;
|
||
FLastPacket: TDateTime;
|
||
procedure OnCanSend(ASocket: TLSocket);
|
||
procedure OnConnectionHandlingPacket(ABuffer: TEnhancedMemoryStream);
|
||
procedure ProcessQueue;
|
||
procedure DoLogin;
|
||
public
|
||
property Profile: string read FProfile;
|
||
property Username: string read FUsername;
|
||
property AccessLevel: TAccessLevel read FAccessLevel write FAccessLevel;
|
||
property ServerStart: TDateTime read FServerStart;
|
||
procedure Send(APacket: TPacket);
|
||
procedure Disconnect;
|
||
procedure CheckClose(ASender: TForm);
|
||
public
|
||
ErrorCaption: string;
|
||
WrongServer: string;
|
||
WrongAccount: string;
|
||
WrongPassword: string;
|
||
NoAccess: string;
|
||
AlreadyLogined: string;
|
||
TCPErrorCaption: string;
|
||
UnsuportedVersion: string;
|
||
end;
|
||
|
||
var
|
||
dmNetwork: TdmNetwork;
|
||
|
||
implementation
|
||
|
||
uses
|
||
UPacketHandlers, UPackets, UfrmMain, UfrmLogin, UfrmInitialize,
|
||
UGameResources, UfrmAccountControl, UfrmEditAccount, UfrmDrawSettings,
|
||
UfrmBoundaries, UfrmElevateSettings, UfrmConfirmation, UfrmMoveSettings,
|
||
UfrmAbout, UfrmHueSettings, UfrmRadar, UfrmLargeScaleCommand, UfrmFillSettings,
|
||
UfrmVirtualLayer, UfrmFilter, UfrmRegionControl, UfrmLightlevel, UfrmSelectionSettings,
|
||
UfrmSurfElevateSettings, UfrmSurfStretchSettings, UfrmSurfSmoothSettings,
|
||
Logging, Language;
|
||
|
||
{$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
|
||
FreeAndNil(FSendQueue);
|
||
FreeAndNil(FReceiveQueue);
|
||
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);
|
||
var
|
||
rumsg : string;
|
||
begin
|
||
rumsg := CP1251ToUTF8(msg);
|
||
MessageDlg(TCPErrorCaption, rumsg, 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;
|
||
flags: Cardinal;
|
||
serverState: TServerState;
|
||
date, time: TDateTime;
|
||
begin
|
||
subID := ABuffer.ReadByte;
|
||
case subID of
|
||
$01:
|
||
begin
|
||
if (ABuffer.ReadCardinal - $1000) = ProtocolVersion then
|
||
begin
|
||
frmInitialize.lblStatus.Caption := frmInitialize.SplashAuthorization;
|
||
Send(TLoginRequestPacket.Create(FUsername, FPassword));
|
||
end else
|
||
begin // sLineBreak
|
||
MessageDlg(ErrorCaption, UnsuportedVersion, mtError, [mbOK], 0);
|
||
Disconnect;
|
||
end;
|
||
Logger.Send([lcClient, lcInfo], 'Текущая версия протокола подтверждена');
|
||
end;
|
||
$03:
|
||
begin
|
||
loginState := TLoginState(ABuffer.ReadByte);
|
||
if loginState = lsOK then
|
||
begin
|
||
frmInitialize.SetStatusLabel(frmInitialize.SplashInicialization);
|
||
|
||
Application.ProcessMessages;
|
||
FAccessLevel := TAccessLevel(ABuffer.ReadByte);
|
||
FServerStart := IncSecond(Now, - ABuffer.ReadDWord);
|
||
width := ABuffer.ReadWord;
|
||
height := ABuffer.ReadWord;
|
||
flags := ABuffer.ReadCardinal;
|
||
|
||
// Для совместимости с сервером 0.7.0 (ранее тут слалось число преметов)
|
||
if (flags and $FF000000) = 0 then // GameResourceManager.Tiledata.StaticCount
|
||
if flags < $C000 then flags := $F0000000 else flags := $F0000008;
|
||
|
||
if not InitGameResourceManager(FDataDir, Flags) then begin
|
||
Logger.Send([lcClient, lcInfo], 'CentrED+ загрузка отменена, не та версия *.mul файлов.');
|
||
Disconnect; exit;
|
||
end;
|
||
|
||
ResMan.InitLandscape(width, height);
|
||
|
||
// Проверка обновлений
|
||
frmInitialize.SetStatusLabel(frmInitialize.SplashUpdates);
|
||
|
||
|
||
Logger.Send([lcClient, lcInfo], 'Начало загрузки CentrED+');
|
||
frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['OpenGL Device']));
|
||
ResMan.Landscape.UpdateWriteMap(ABuffer); Logger.Send([lcClient, lcInfo], 'ResMan.Landscape.UpdateWriteMap(ABuffer);');
|
||
|
||
frmMain := TfrmMain.Create(dmNetwork); Logger.Send([lcClient, lcInfo], 'frmMain := TfrmMain.Create(dmNetwork);');
|
||
|
||
frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['Windows Forms']));
|
||
frmRadarMap := TfrmRadarMap.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmRadarMap := TfrmRadarMap.Create(frmMain);');
|
||
frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmLargeScaleCommand := TfrmLargeScaleCommand.Create(frmMain);');
|
||
frmRegionControl := TfrmRegionControl.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmRegionControl := TfrmRegionControl.Create(frmMain);');
|
||
frmAccountControl := TfrmAccountControl.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmAccountControl := TfrmAccountControl.Create(frmMain);');
|
||
frmEditAccount := TfrmEditAccount.Create(frmAccountControl); Logger.Send([lcClient, lcInfo], 'frmEditAccount := TfrmEditAccount.Create(frmAccountControl);');
|
||
frmConfirmation := TfrmConfirmation.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmConfirmation := TfrmConfirmation.Create(frmMain);');
|
||
frmSelectionSettings := TfrmSelectionSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmSelectionSettings := TfrmSelectionSettings.Create(frmMain);');
|
||
frmMoveSettings := TfrmMoveSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmMoveSettings := TfrmMoveSettings.Create(frmMain);');
|
||
frmElevateSettings := TfrmElevateSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmElevateSettings := TfrmElevateSettings.Create(frmMain);');
|
||
frmSurfElevateSettings := TfrmSurfElevateSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmSurfElevateSettings := TfrmSurfElevateSettings.Create(frmMain);');
|
||
frmSurfStretchSettings := TfrmSurfStretchSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmSurfStretchSettings := TfrmSurfStretchSettings.Create(frmMain);');
|
||
frmSurfSmoothSettings := TfrmSurfSmoothSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmSurfSmoothSettings := TfrmSurfSmoothSettings.Create(frmMain);');
|
||
frmDrawSettings := TfrmDrawSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmDrawSettings := TfrmDrawSettings.Create(frmMain);');
|
||
frmHueSettings := TfrmHueSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmHueSettings := TfrmHueSettings.Create(frmMain);');
|
||
frmFillSettings := TfrmFillSettings.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmFillSettings := TfrmFillSettings.Create(frmMain);');
|
||
frmVirtualLayer := TfrmVirtualLayer.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmVirtualLayer := TfrmVirtualLayer.Create(frmMain)');
|
||
frmBoundaries := TfrmBoundaries.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmBoundaries := TfrmBoundaries.Create(frmMain);');
|
||
frmFilter := TfrmFilter.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmFilter := TfrmFilter.Create(frmMain);');
|
||
frmLightlevel := TfrmLightlevel.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmLightlevel := TfrmLightlevel.Create(frmMain);');
|
||
frmAbout := TfrmAbout.Create(frmMain); Logger.Send([lcClient, lcInfo], 'frmAbout := TfrmAbout.Create(frmMain);');
|
||
frmMain.mnuTileListViewClick(nil);
|
||
frmMain.Show; Logger.Send([lcClient, lcInfo], 'frmMain.Show;');
|
||
frmInitialize.Hide; Logger.Send([lcClient, lcInfo], 'frmInitialize.Hide;');
|
||
tmNoOp.Enabled := True; Logger.Send([lcClient, lcInfo], 'tmNoOp.Enabled := True;');
|
||
frmInitialize.SetStatusLabel(Format(frmInitialize.SplashLoading, ['Done']));
|
||
end else
|
||
begin
|
||
if loginState = lsInvalidUser then
|
||
MessageDlg(ErrorCaption, WrongAccount, mtWarning, [mbOK], 0)
|
||
else if loginState = lsInvalidPassword then
|
||
MessageDlg(ErrorCaption, WrongPassword, mtWarning, [mbOK], 0)
|
||
else if loginState = lsAlreadyLoggedIn then
|
||
MessageDlg(ErrorCaption, AlreadyLogined, mtWarning, [mbOK], 0)
|
||
else if loginState = lsNoAccess then
|
||
MessageDlg(ErrorCaption, NoAccess, mtWarning, [mbOK], 0);
|
||
end;
|
||
Logger.Send([lcClient, lcInfo], 'CentrED+ запущен.');
|
||
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 := frmInitialize.SplashSuspend;
|
||
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);
|
||
|
||
FreeAndNil(frmEditAccount);
|
||
FreeAndNil(frmAccountControl);
|
||
FreeAndNil(frmConfirmation);
|
||
FreeAndNil(frmSelectionSettings);
|
||
FreeAndNil(frmMoveSettings);
|
||
FreeAndNil(frmElevateSettings);
|
||
FreeAndNil(frmSurfElevateSettings);
|
||
FreeAndNil(frmSurfStretchSettings);
|
||
FreeAndNil(frmSurfSmoothSettings);
|
||
FreeAndNil(frmDrawSettings);
|
||
FreeAndNil(frmHueSettings);
|
||
FreeAndNil(frmFillSettings);
|
||
FreeAndNil(frmVirtualLayer);
|
||
FreeAndNil(frmBoundaries);
|
||
FreeAndNil(frmFilter);
|
||
FreeAndNil(frmLightlevel);
|
||
FreeAndNil(frmAbout);
|
||
FreeAndNil(frmRegionControl);
|
||
FreeAndNil(frmLargeScaleCommand);
|
||
FreeAndNil(frmRadarMap);
|
||
|
||
if frmMain <> nil then
|
||
begin
|
||
frmMain.ApplicationProperties1.OnIdle := nil;
|
||
FreeAndNil(frmMain);
|
||
end;
|
||
|
||
FreeAndNil(GameResourceManager);
|
||
|
||
frmInitialize.Hide;
|
||
while frmLogin.ShowModal = mrOK do
|
||
begin
|
||
LanguageTranslate(frmInitialize, self, nil);
|
||
if TCPClient.Connect(frmLogin.edHost.Text, frmLogin.edPort.Value) then
|
||
begin
|
||
if frmLogin.cbProfile.ItemIndex > -1
|
||
then FProfile := frmLogin.cbProfile.Text
|
||
else FProfile := '---';
|
||
FUsername := frmLogin.edUsername.Text;
|
||
FPassword := frmLogin.edPassword.Text;
|
||
FDataDir := UTF8ToCP1251(frmLogin.edData.Text);
|
||
frmInitialize.lblStatus.Caption := frmInitialize.SplashConnection;
|
||
frmInitialize.Show;
|
||
Break;
|
||
end else
|
||
MessageDlg(ErrorCaption, WrongServer, 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.
|
||
|