uconnector.pas

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

unit uConnector;

interface

uses
   Windows, Classes, SysUtils, ScktComp, mmSystem, uBuffer, uLGRecordDef,
   uDBRecordDef, uKeyClass, uPackets, AnsStringCls, DefType, AUtil32;

type
   TClientWindow = ( cw_none, cw_login, cw_createlogin, cw_selectchar, cw_main, cw_agree );
   TGameStatus = ( gs_none, gs_login, gs_agree, gs_selectchar, gs_gotogame, gs_playing, gs_createchar, gs_deletechar, gs_createlogin, gs_changepass );

   TConnectData = record
      SocketInt : Integer;
   end;
   PTConnectData = ^TConnectData;

   TConnector = class
   private
      ConnectID : Integer;

      SocketInt : Integer;
      Socket : TCustomWinSocket;

      PacketSender : TPacketSender;
      PacketReceiver : TPacketReceiver;

      FGameStatus : TGameStatus;
      FClientWindow : TClientWindow;

      FLastMessage : Byte;
      RequestTime : Integer;

      CreateTime : Integer;

      LoginData : TLGRecord;

      VerNo : Byte;
      PaidType : TPaidType;
      Code : Byte;
      LoginID, LoginPW : String;
      PlayChar, UseChar, UseLand : String;
      IpAddr : String;

      // PaidResult : Integer;
      // boTimePay : Boolean;

      procedure ShowWindow (aKey : TClientWindow; boShow : Boolean);
      procedure SendStatusMessage (aKey: Byte; aStr : String);
      function GetCharInfo : String;
   protected
   public
      constructor Create (aSocket : TCustomWinSocket; aConnectID : Integer);
      destructor Destroy; override;

      function Update (CurTick : Integer) : Boolean;
      function MessageProcess (aComData : PTWordComData) : Boolean;

      procedure AddReceiveData (aData : PChar; aCount : Integer);
      procedure AddSendData (aData : PChar; aCount : Integer);
      procedure AddSendDataDirect (aData : PChar; aCount : Integer);
      procedure AddSendDataNoTouch (aData : PChar; aCount : Integer);

      procedure GameMessageProcess (aPacket : PTPacketData);
      procedure DBMessageProcess (aPacket : PTPacketData);
      procedure LoginMessageProcess (aPacket : PTPacketData);
      procedure PaidMessageProcess (aPacket : PTPacketData);

      procedure SetWriteAllow;

      property GameStatus : TGameStatus read FGameStatus;
      property PlayCharName : String read PlayChar;
   end;

   TConnectorList = class
   private
      UniqueID : Integer;
      UniqueValue : Integer;

      FPlayingUserCount : Integer;
      FLogingUserCount : Integer;

      SocketKey, ConnectIDKey : TIntegerKeyClass;
      
      DataList : TList;
      DeleteList : TList;

      CurProcessPos, ProcessCount : Word;

      function GetCount : Integer;
   protected
   public
      constructor Create;
      destructor Destroy; override;

      procedure Clear;

      function Update (CurTick : Integer) : Boolean;

      function CreateConnect (aSocket : TCustomWinSocket) : Boolean;
      function DeleteConnect (aSocket : TCustomWinSocket) : String;

      procedure AddReceiveData (aSocket : TCustomWinSocket; aData : PChar; aCount : Integer);

      procedure GameMessageProcess (aPacket : PTPacketData);
      procedure DBMessageProcess (aPacket : PTPacketData);
      procedure LoginMessageProcess (aPacket : PTPacketData);
      procedure PaidMessageProcess (aPacket : PTPacketData);

      procedure SetWriteAllow (aSocket : TCustomWinSocket);

      procedure ReCalc;

      property Count : Integer read GetCount;

      property PlayingUserCount : Integer read FPlayingUserCount write FPlayingUserCount;
      property LogingUserCount : Integer read FLogingUserCount write FLogingUserCount;
      property AutoConnectID : Integer read UniqueID;
      property GateUniqueValue : Integer read UniqueValue write UniqueValue;
   end;

var
   ConnectorList : TConnectorList;

implementation

uses
   FMain, uUtil, uGramerID;

// TConnector
constructor TConnector.Create (aSocket : TCustomWinSocket; aConnectID : Integer);
begin
   ConnectID := aConnectID;

   SocketInt := Integer (aSocket);
   
   Socket := aSocket;

   PacketSender := TPacketSender.Create ('Sender', 65535, aSocket);
   PacketReceiver := TPacketReceiver.Create ('Receiver', 65535);

   FGameStatus := gs_none;
   FClientWindow := cw_none;

   FLastMessage := 0;
   RequestTime := 0;
   CreateTime := timeGetTime;

   FillChar (LoginData, SizeOf (TLGRecord), 0);

   LoginID := '';
   LoginPW := '';
   PlayChar := '';
   UseChar := '';
   UseLand := '';
   IpAddr := aSocket.RemoteAddress;
   VerNo := 0;
   PaidType := pt_none;
   Code := 0;
end;

destructor TConnector.Destroy;
var
   buffer : array[0..20 - 1] of byte;
begin
   if GameStatus = gs_playing then begin
      FillChar (buffer, SizeOf (buffer), 0);
      StrPCopy (@buffer, PlayChar);
      if GameSender <> nil then begin
         GameSender.PutPacket (ConnectID, GM_DISCONNECT, 0, @buffer, SizeOf (buffer));
      end;
      if DBSender <> nil then begin
         DBSender.PutPacket (ConnectID, DB_UNLOCK, 0, @buffer, SizeOf (buffer));
      end;
   end;

   PacketReceiver.Free;
   PacketSender.Free;

   inherited Destroy;
end;

procedure TConnector.SetWriteAllow;
begin
   PacketSender.WriteAllow := true;
end;

procedure TConnector.AddReceiveData (aData : PChar; aCount : Integer);
begin
   PacketReceiver.PutData (aData, aCount);
end;

procedure TConnector.AddSendData (aData : PChar; aCount : Integer);
var
   ComData : TWordComData;
begin
   ComData.Size := aCount;
   Move (aData^, ComData.Data, aCount);
   PacketSender.PutPacket (0, 0, 0, @ComData, ComData.Size + SizeOf (Word));
end;

procedure TConnector.AddSendDataDirect (aData : PChar; aCount : Integer);
begin
   PacketSender.PutPacket (0, 0, 0, aData, aCount);
end;

procedure TConnector.AddSendDataNoTouch (aData : PChar; aCount : Integer);
begin
   PacketSender.PutPacket (0, 0, 0, aData, aCount);
end;

procedure TConnector.SendStatusMessage (aKey: Byte; aStr : String);
var
   cnt : Integer;
   sMessage : TSMessage;
begin
   sMessage.rmsg := SM_MESSAGE;
   sMessage.rkey := aKey;
   SetWordString (sMessage.rWordString, aStr);
   cnt := Sizeof(sMessage) - Sizeof(TWordString) + sizeofwordstring(sMessage.rWordString);
   
   AddSendData (@sMessage, cnt);
end;

procedure TConnector.ShowWindow (aKey : TClientWindow; boShow : Boolean);
var
   sWindow : TSWindow;
begin
   if boShow = true then begin
      FClientWindow := aKey;
   end;
   sWindow.rmsg := SM_WINDOW;
   sWindow.rwindow := Byte (aKey);
   sWindow.rboShow := boShow;
   AddSendData (@sWindow, sizeof(sWindow));
end;

function TConnector.Update (CurTick : Integer) : Boolean;
var
   PacketData : TPacketData;
   ComData : TWordComData;
   nSize : Integer;
begin
   PacketSender.Update;
   PacketReceiver.Update;
   while PacketReceiver.Count > 0 do begin
      if PacketReceiver.GetPacket (@PacketData) = false then break;
      nSize := PacketData.PacketSize - SizeOf (Word) - SizeOf (Integer) - SizeOf (Byte) - SizeOf (Byte);
      Move (PacketData.Data, ComData, nSize);
      if FGameStatus = gs_playing then begin
         if GameSender <> nil then begin
            GameSender.PutPacket (ConnectID, GM_SENDGAMEDATA, 0, @ComData.Data, ComData.Size);
         end;
      end else begin
         MessageProcess (@ComData);
      end;
   end;

   if (FGameStatus <> gs_none) and (FGameStatus <> gs_playing) then begin
      if RequestTime + 60000 <= CurTick then begin
         RequestTime := 0;
         FGameStatus := gs_none;
         Case FClientWindow of
            cw_login :
               begin
                  SendStatusMessage (MESSAGE_LOGIN, '[TIMEOUT] 促矫 矫档秦 林技夸');
               end;
            cw_selectchar :
               begin
                  SendStatusMessage (MESSAGE_SELCHAR, '[TIMEOUT] 促矫 矫档秦 林技夸');
               end;
            cw_createlogin :
               begin
                  ShowWindow (cw_createlogin, false);
                  ShowWindow (cw_login, true);
                  SendStatusMessage (MESSAGE_LOGIN, '[TIMEOUT] 促矫 矫档秦 林技夸');
               end;
         end;
      end;
   end;

   if FGameStatus <> gs_playing then begin
      if CreateTime + 1000 * 60 * 10 <= CurTick then begin
         ConnectorList.DeleteConnect (Socket);
      end;
   end;

   Result := true;
end;

function TConnector.GetCharInfo : String;
var
   i : Integer;
   str : String;
begin
   str := '';
   for i := 0 to 5 - 1 do begin
{
      if LoginData.CharInfo[i].CharName[0] <> 0 then begin
         str := str + StrPas (@LoginData.CharInfo[i].CharName);
         str := str + ':';
         str := str + StrPas (@LoginData.CharInfo[i].ServerName);
      end;
}
      if LoginData.CharInfo[i].CharName <> '' then begin
         Str := Str + LoginData.CharInfo [i].CharName;
         str := str + ':';
         Str := Str + LoginData.CharInfo [i].ServerName;
      end;

      if i < 5 - 1 then str := str + ',';
      // str := str + ',';
   end;

   Result := str;
end;

procedure TConnector.PaidMessageProcess (aPacket : PTPacketData);
var
   pPaidData : PTPaidData;
begin
   Case aPacket^.RequestMsg of
      PM_CHECKPAID :
         begin
            if aPacket^.ResultCode = 0 then begin
               PaidType := pt_validate;
               FGameStatus := gs_none;
               exit;
            end;

            pPaidData := PTPaidData (@aPacket^.Data);
            if pPaidData^.rLoginId <> LoginID then begin
               SendStatusMessage (MESSAGE_LOGIN, '蜡丰沥焊 坷幅涝聪促');
               FGameStatus := gs_none;
               exit;
            end;
            
            PaidType := pPaidData^.rPaidType;
            Code := pPaidData^.rCode;
            
            Case PaidType of
               pt_invalidate :
                  SendStatusMessage (MESSAGE_SELCHAR, '公丰 荤侩栏肺 立加登菌嚼聪促');
               pt_validate :
                  SendStatusMessage (MESSAGE_SELCHAR, '立加登菌嚼聪促');
               pt_test :
                  SendStatusMessage (MESSAGE_SELCHAR, '眉氰扁埃 荤侩磊肺 立加沁嚼聪促');
               pt_timepay :
                  SendStatusMessage (MESSAGE_SELCHAR, '辆樊力 荤侩磊肺 立加沁嚼聪促');
               Else
                  SendStatusMessage (MESSAGE_SELCHAR, format ('荤侩扁埃捞 %d老 巢疽嚼聪促', [pPaidData^.rRemainDay]));
            end;

            FGameStatus := gs_none;
         end;
   end;
end;

procedure TConnector.GameMessageProcess (aPacket : PTPacketData);
var
   iCnt : Integer;
   pDBRecord : PTDBRecord;
   buffer : array [0..20 - 1] of byte;
begin
   Case aPacket^.RequestMsg of
      GM_CONNECT :
         begin
            FGameStatus := gs_playing;
            ShowWindow (cw_selectchar, FALSE);
            ShowWindow (cw_main, TRUE);

            StrPCopy (@buffer, PlayChar);
            if DBSender <> nil then begin
               DBSender.PutPacket (ConnectID, DB_LOCK, 0, @buffer, SizeOf (buffer));
            end;
         end;
      GM_DISCONNECT :
         begin
            frmMain.AddLog ('立加秦力 : ' + PlayChar);
            Socket.Close;
         end;
      GM_SENDUSERDATA :
         begin
            pDBRecord := @aPacket^.Data;
            if DBSender <> nil then begin
               DBSender.PutPacket (ConnectID, DB_UPDATE, 0, @aPacket.Data, SizeOf (TDBRecord));
            end;
         end;
      GM_SENDGAMEDATA :
         begin
            iCnt := aPacket^.PacketSize - (SizeOf (Word) + SizeOf (Integer) + SizeOf (Byte) * 2);
            AddSendDataDirect (@aPacket^.Data, iCnt);
         end;
      GM_DUPLICATE :
      	begin
            SendStatusMessage (MESSAGE_SELCHAR, '立加秦力 登菌嚼聪促');
            PlayChar := ''; UseChar := ''; UseLand := '';
            FGameStatus := gs_none;
         end;
      GM_SENDALL :
      	begin
         	if FGameStatus = gs_playing then begin
               iCnt := aPacket^.PacketSize - (SizeOf (Word) + SizeOf (Integer) + SizeOf (Byte) * 2);
               AddSendDataNoTouch (@aPacket^.Data, iCnt);