uconnect.pas

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

unit uConnect;

interface

uses
   Classes, SysUtils, uGConnect, uDBRecordDef, uBuffer, uAnsTick,
   uKeyClass, DefType, aDefType, BSCommon, uPackets, AnsStringCls;

type
   TBattleConnectState = ( bcs_none, bcs_gotobattle, bcs_inbattle );

   TConnector = class
   private
      GateNo : Integer;
      ConnectID : Integer;

      CharName : String;
      StartTime : String;

      SaveTick : Integer;

      BattleConnectState : TBattleConnectState;
   public
      CharData : TDBRecord;
      NTData : TNoticeData;

      LoginID : String;
      IpAddr : String;
      VerNo : Byte;
      PaidType : TPaidType;
      PaidCode : Byte;

      ReceiveBuffer : TPacketBuffer;
   public
      constructor Create (aGateNo, aConnectID : Integer);
      destructor Destroy; override;

      function StartLayer (aData : PChar) : Boolean;
      procedure EndLayer;
      procedure ReStartLayer;
      
      procedure Update (CurTick : Integer);

      procedure MessageProcess (aComData : PTWordComData);

      procedure AddReceiveData (aData : PChar; aSize : Integer);
      procedure AddSendData (aData : PChar; aSize : Integer);

      property BattleState : TBattleConnectState read BattleConnectState write BattleConnectState;
   end;
   
   TConnectorList = class
   private
      UniqueKey : TIntegerKeyClass;
      NameKey : TStringKeyClass;
      
      DataList : TList;

      SaveBuffer : TPacketBuffer;

      CreateTick : Integer;
      DeleteTick : Integer;
      SaveTick : Integer;

      ConnectorProcessCount : Integer;
      CurProcessPos : Integer;
      
      function GetCount : Integer;
      function GetNameKeyCount : Integer;
      function GetUniqueKeyCount : Integer;
   public
      constructor Create;
      destructor Destroy; override;

      procedure Clear;

      procedure Update (CurTick : Integer);

      procedure CreateConnect (aGateNo : Integer; aPacket : PTPacketData);
      procedure DeleteConnect (aGateNo, aConnectID : Integer);

      procedure ReStartChar (aConnectID : Integer);

      procedure CloseAllConnect;
      procedure CloseConnectByCharName (aName : String);
      procedure CloseConnectByGateNo (aGateNo : Integer);

      procedure AddReceiveData (aGateNo : Integer; aPacket : PTPacketData);
      procedure AddSendData (aPacket : PTPacketData);

      procedure AddSaveData (aData : PChar; aSize : Integer);

      function GetSaveListCount : Integer;

      procedure ProcessNoticeServerMessage (aPacketData : PTPacketData);
      procedure SendConnectInfo (aInfoStr: String);

      property Count : Integer read GetCount;
      property NameKeyCount : Integer read GetNameKeyCount;
      property UniqueKeyCount : Integer read GetUniqueKeyCount;
   end;

var
   ConnectorList : TConnectorList;

implementation

uses
   svMain, FGate, uUser, svClass, FSockets, AUtil32;

constructor TConnector.Create (aGateNo, aConnectID : Integer);
begin
   GateNo := aGateNo;
   ConnectID := aConnectID;

   VerNo := 0;
   PaidType := pt_none;
   PaidCode := 0;
   CharName := '';
   LoginID := '';
   IpAddr := '';

   BattleConnectState := bcs_none;
   
   FillChar (CharData, SizeOf (TDBRecord), 0);

   StartTime := DateToStr (Date) + ' ' + TimeToStr (Time);
   SaveTick := mmAnsTick;

   ReceiveBuffer := TPacketBuffer.Create (BufferSizeS2C);
end;

destructor TConnector.Destroy;
var
   Str : String;
begin
   NTData.rMsg := GNM_OUTUSER;
   FrmSockets.AddDataToNotice (@NTData, SizeOf (TNoticeData));

   frmGate.AddLog ('close ' + CharName);

   if BattleConnectState <> bcs_none then begin
      frmGate.AddSendBattleData (ConnectID, GB_USERDISCONNECT, 0, nil, 0);
   end;
   
   if CharName <> '' then begin
      if BattleConnectState = bcs_none then EndLayer;
      ConnectorList.AddSaveData (@CharData, SizeOf (TDBRecord));
   end;

   Str := StrPas (@CharData.MasterName) + ',' + CharName + ',' + IpAddr + ',' + StartTime + ',' + DateToStr (Date) + ' ' + TimeToStr (Time);  
   ConnectorList.SendConnectInfo (Str);

   ReceiveBuffer.Free;

   inherited Destroy;
end;

function TConnector.StartLayer (aData : PChar) : Boolean;
var
   Str, rdStr : String;
begin
   Result := true;

   Move (aData^, CharData, SizeOf (TDBRecord));
   CharName := StrPas (@CharData.PrimaryKey);
   LoginID := StrPas (@CharData.MasterName);
   Str := StrPas (@CharData.Dummy);

   Str := GetValidStr3 (Str, rdStr, ',');
   IpAddr := rdStr;
   Str := GetValidStr3 (Str, rdStr, ',');
   VerNo := _StrToInt (rdStr);
   Str := GetValidStr3 (Str, rdStr, ',');
   PaidType := TPaidType (_StrToInt (rdStr));
   Str := GetValidStr3 (Str, rdStr, ',');
   PaidCode := _StrToInt (rdStr);

   FillChar (CharData.Dummy, SizeOf (CharData.Dummy), 0);

   if UserList.InitialLayer (CharName, Self) = false then begin
      Result := false;
      exit;
   end;
   UserList.StartChar (CharName);

   FillChar (NTData, SizeOf(TNoticeData), 0);
   NTData.rMsg := GNM_INUSER;
   NTData.rLoginId := LoginID;
   NTData.rCharName := CharName;
   NTData.rIpAddr := IpAddr;
   NTData.rPaidType := TPaidType (PaidType);
   NTData.rCode := PaidCode;

   FrmSockets.AddDataToNotice (@NTData, SizeOf(TNoticeData));
end;

procedure TConnector.EndLayer;
begin
   UserList.FinalLayer (Self);
end;

procedure TConnector.ReStartLayer;
begin
   if UserList.InitialLayer (CharName, Self) = false then begin
      exit;
   end;
   UserList.StartChar (CharName);
   BattleConnectState := bcs_none;
end;

procedure TConnector.Update (CurTick : Integer);
var
   ComData : TWordComData;
   iCnt : Word;
begin
   if frmMain.chkSaveUserData.Checked = true then begin
      if SaveTick + 60 * 10 * 100 < CurTick then begin
         ConnectorList.AddSaveData (@CharData, SizeOf (TDBRecord));
         SaveTick := CurTick;
      end;
   end;

   if BattleConnectState = bcs_gotobattle then begin
      UserList.FinalLayer (Self);

      frmGate.AddSendBattleData (ConnectID, GB_USERCONNECT, 0, @CharData, SizeOf (TDBRecord));

      BattleConnectState := bcs_inbattle;
   end else if BattleConnectState = bcs_inbattle then begin
      if ReceiveBuffer.Count > 0 then begin
         while true do begin
            if ReceiveBuffer.Get (@ComData) = false then break;
            frmGate.AddSendBattleData (ConnectID, GB_GAMEDATA, 0, @ComData, ComData.Size + SizeOf (Word));
         end;
      end;
   end;
end;

procedure TConnector.MessageProcess (aComData : PTWordComData);
begin
end;

procedure TConnector.AddReceiveData (aData : PChar; aSize : Integer);
begin
   if ReceiveBuffer.Put (aData, aSize) = false then begin
      frmMain.WriteLogInfo ('TConnector.AddReceiveData() failed');
   end;
end;

procedure TConnector.AddSendData (aData : PChar; aSize : Integer);
begin
   GateConnectorList.AddSendData (GateNo, ConnectID, aData, aSize);
end;

// TConnectorList
constructor TConnectorList.Create;
begin
   CurProcessPos := 0;
   ConnectorProcessCount := 0;

   CreateTick := 0;
   DeleteTick := 0;
   SaveTick := 0;

   UniqueKey := TIntegerKeyClass.Create;
   NameKey := TStringKeyClass.Create;
   
   DataList := TList.Create;

   SaveBuffer := TPacketBuffer.Create (1024 * 1024 * 4);
end;

destructor TConnectorList.Destroy;
begin
   Clear;
   UniqueKey.Free;
   NameKey.Free;
   DataList.Free;

   SaveBuffer.Free;