fgate.pas

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

unit FGate;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, StdCtrls, ExtCtrls, ComCtrls, uPackets, Common, AUtil32;

type
  TfrmGate = class(TForm)
    sckGateAccept: TServerSocket;
    txtLog: TMemo;
    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;
    Label2: TLabel;
    Label5: TLabel;
    Shape1: TShape;
    Label7: TLabel;
    Label9: TLabel;
    TabSheet1: TTabSheet;
    Label13: TLabel;
    lblNameKeyCount: TLabel;
    Label18: TLabel;
    lblUniqueKeyCount: TLabel;
    Label27: TLabel;
    lblSaveListCount: TLabel;
    Label23: TLabel;
    lblConnectListCount: TLabel;
    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);
  private
    { Private declarations }
//    procedure DBMessageProcess (aPacket : PTPacketData);
  public
    { Public declarations }

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

var
  frmGate: TfrmGate;

//  DBServerIPAddress : String;
//  DBServerPort : Integer;

//  DBSender : TPacketSender;
//  DBReceiver : TPacketReceiver;

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;

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

   sckGateAccept.Port := 3040;   // server 罐酒甸捞绰 port
   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 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;

   // 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;