fgate.pas

千年源代码,只缺少控件,可以做二次开发用,好不容易得来的

unit FGate;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, StdCtrls, ExtCtrls, ComCtrls, uPackets, AUtil32, BSCommon,
  AnsStringCls, BasicObj, DefType;

type
  TfrmGate = class(TForm)
    sckGateAccept: TServerSocket;
    PageControl1: TPageControl;
    tsGate1: TTabSheet;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    lblSendByte1: TLabel;
    Label6: TLabel;
    lblRecvByte1: TLabel;
    Label8: TLabel;
    lblWBCount1: TLabel;
    shpWBSign1: TShape;
    Label10: TLabel;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    lblSendByte3: TLabel;
    Label3: TLabel;
    lblRecvByte3: TLabel;
    Label12: TLabel;
    lblWBCount3: TLabel;
    shpWBSign3: TShape;
    Label14: TLabel;
    GroupBox3: TGroupBox;
    Label15: TLabel;
    lblSendByte2: TLabel;
    Label17: TLabel;
    lblRecvByte2: TLabel;
    Label19: TLabel;
    lblWBCount2: TLabel;
    shpWBSign2: TShape;
    Label21: TLabel;
    GroupBox4: TGroupBox;
    Label22: TLabel;
    lblSendByte4: TLabel;
    Label24: TLabel;
    lblRecvByte4: TLabel;
    Label26: TLabel;
    lblWBCount4: TLabel;
    shpWBSign4: TShape;
    Label28: TLabel;
    timerDisplay: TTimer;
    sckDBConnect: TClientSocket;
    timerProcess: TTimer;
    Label2: TLabel;
    Label5: TLabel;
    Shape1: TShape;
    Label7: TLabel;
    Label9: TLabel;
    GroupBox5: TGroupBox;
    Label11: TLabel;
    lblDBSendBytes: TLabel;
    Label16: TLabel;
    lblDBReceiveBytes: TLabel;
    Label20: TLabel;
    lblDBWBCount: TLabel;
    shpDBWBSign: TShape;
    Label25: TLabel;
    TabSheet1: TTabSheet;
    Label13: TLabel;
    lblNameKeyCount: TLabel;
    Label18: TLabel;
    lblUniqueKeyCount: TLabel;
    Label27: TLabel;
    lblSaveListCount: TLabel;
    Label23: TLabel;
    lblConnectListCount: TLabel;
    sckBattleConnect: TClientSocket;
    GroupBox6: TGroupBox;
    Label29: TLabel;
    lblBattleSendBytes: TLabel;
    Label31: TLabel;
    lblBattleReceiveBytes: TLabel;
    Label33: TLabel;
    lblBattleWBCount: TLabel;
    shpBattleWBSign: TShape;
    Label35: TLabel;
    txtLog: TMemo;
    procedure sckGateAcceptAccept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckGateAcceptClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckGateAcceptClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckGateAcceptClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure sckGateAcceptClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckGateAcceptClientWrite(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure timerDisplayTimer(Sender: TObject);
    procedure sckDBConnectConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckDBConnectDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckDBConnectError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure sckDBConnectRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure sckDBConnectWrite(Sender: TObject; Socket: TCustomWinSocket);
    procedure timerProcessTimer(Sender: TObject);
    procedure sckBattleConnectConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckBattleConnectDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckBattleConnectError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure sckBattleConnectRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sckBattleConnectWrite(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
    procedure DBMessageProcess (aPacket : PTPacketData);
    procedure BattleMessageProcess (aPacket : PTPacketData);
  public
    { Public declarations }

    procedure AddLog (aStr : String);
    function AddSendDBServerData (aMsg : Byte; aData : PChar; aCount : Integer) : Boolean;
    function AddSendBattleData (aID : Integer; aMsg : Byte; aRetCode : Byte; aData : PChar; aCount : Integer) : Boolean;
  end;

var
  frmGate: TfrmGate;

  DBServerIPAddress : String;
  DBServerPort : Integer;
  BattleServerIPAddress : String;
  BattleServerPort : Integer;

  DBSender : TPacketSender = nil;
  BattleSender : TPacketSender = nil;
  DBReceiver : TPacketReceiver = nil;
  BattleReceiver : TPacketReceiver = nil;

implementation

uses
   SVMain, uGConnect, uConnect, uItemLog;

{$R *.DFM}

procedure TfrmGate.AddLog (aStr : String);
begin
   if txtLog.Lines.Count >= 30 then begin
      txtLog.Lines.Delete (0);
   end;
   txtLog.Lines.Add (aStr);
end;

procedure TfrmGate.sckGateAcceptAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   GateConnectorList.CreateConnect (Socket);
   AddLog (format ('Gate Server Accepted %s', [Socket.RemoteAddress]));
end;

procedure TfrmGate.sckGateAcceptClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   //
end;

procedure TfrmGate.sckGateAcceptClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   if Socket.Connected = true then begin
      GateConnectorList.DeleteConnect (Socket);
      AddLog (format ('Gate Server Disconnected %s', [Socket.RemoteAddress]));
   end;
end;

procedure TfrmGate.sckGateAcceptClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
   AddLog (format ('Gate Accept Socket Error (%d, %s)', [ErrorCode, Socket.RemoteAddress]));
   ErrorCode := 0;
end;

procedure TfrmGate.sckGateAcceptClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
   nRead, nTotalBytes : Integer;
   buffer : array[0..8192 - 1] of byte;
begin
   nTotalBytes := Socket.ReceiveLength;

   // while nTotalBytes > 0 do begin
      nRead := nTotalBytes;
      if nRead > 8192 then nRead := 8192;
      nRead := Socket.ReceiveBuf (buffer, nRead);
      if nRead > 0 then begin
         nTotalBytes := nTotalBytes - nRead;
         GateConnectorList.AddReceiveData (Socket, @buffer, nRead);
      // end else begin
      //    break;
      end;
   // end;
end;

procedure TfrmGate.sckGateAcceptClientWrite(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   GateConnectorList.SetWriteAllow (Socket);
end;

procedure TfrmGate.FormCreate(Sender: TObject);
begin
   DBSender := nil;
   DBReceiver := nil;

   BattleSender := nil;
   BattleReceiver := nil;

   GateList.SetBSGateActive (false);

   sckDBConnect.Address := DBServerIPAddress;
   sckDBConnect.Port := DBServerPort;
   sckDBConnect.Active := true;

   sckBattleConnect.Address := BattleServerIPAddress;
   sckBattleConnect.Port := BattleServerPort;
   sckBattleConnect.Active := true;

   sckGateAccept.Port := 3052;
   sckGateAccept.Active := true;

   timerDisplay.Interval := 1000;
   timerDisplay.Enabled := true;

   timerProcess.Interval := 10;
   timerProcess.Enabled := true;
end;

procedure TfrmGate.FormDestroy(Sender: TObject);
begin
   timerDisplay.Enabled := false;
   timerProcess.Enabled := false;
   
   if DBSender <> nil then begin
      DBSender.Free;
      DBSender := nil;
   end;
   if DBReceiver <> nil then begin
      DBReceiver.Free;
      DBReceiver := nil;
   end;

   if BattleSender <> nil then begin
      BattleSender.Free;
      BattleSender := nil;
   end;
   if BattleReceiver <> nil then begin
      BattleReceiver.Free;
      BattleReceiver := nil;
   end;

   if sckGateAccept.Active = true then begin
      sckGateAccept.Socket.Close;
   end;
   if sckGateAccept.Active = true then begin
      sckDBConnect.Socket.Close;
   end;
end;

procedure TfrmGate.timerDisplayTimer(Sender: TObject);
var
   i : Integer;
   GateConnector : TGateConnector;
begin
   if sckDBConnect.Active = false then begin
      sckDBConnect.Socket.Close;
      sckDBConnect.Active := true;
   end else begin
   end;

   if sckBattleConnect.Active = false then begin
      sckBattleConnect.Socket.Close;
      sckBattleConnect.Active := true;
   end else begin
   end;

   // Gate 1-1
   if GateConnectorList.Count > 0 then begin
      GateConnector := GateConnectorList.Items [0];
      with GateConnector do begin
         lblSendByte1.Caption := IntToStr (SendBytesPerSec) + 'K';
         lblRecvByte1.Caption := IntToStr (ReceiveBytesPerSec) + 'K';
         lblWBCount1.Caption := IntToStr (WBCount);

         if WriteAllow = true then begin
            shpWBSign1.Brush.Color := clLime;
         end else begin
            shpWBSign1.Brush.Color := clRed;
         end;
      end;
   end;
   // Gate 1-2
   if GateConnectorList.Count > 1 then begin
      GateConnector := GateConnectorList.Items [1];
      with GateConnector do begin
         lblSendByte2.Caption := IntToStr (SendBytesPerSec) + 'K';
         lblRecvByte2.Caption := IntToStr (ReceiveBytesPerSec) + 'K';
         lblWBCount2.Caption := IntToStr (WBCount);

         if WriteAllow = true then begin
            shpWBSign2.Brush.Color := clLime;
         end else begin
            shpWBSign2.Brush.Color := clRed;