⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 uconnect.pas

📁 千年源代码,只缺少控件,可以做二次开发用,好不容易得来的
💻 PAS
📖 第 1 页 / 共 4 页
字号:
unit uConnect;

interface

uses
   Classes, SysUtils, uGConnect, uDBRecordDef, uBuffer, uAnsTick,
   Common, uKeyClass, DefType, aDefType, BSCommon, uLevelExp, AnsImg2;

const
   SHARE_XPOS     = 63;
   SHARE_YPOS     = 61;
   GRADE_FILENAME = '.\Setting\Grade.SDB';

type
   TWhereStatus = ( ws_none, ws_group, ws_grade, ws_room, ws_inroom );

   TWordComData = record
      Cnt : Word;
      Data : array [0..4096 - 1] of byte;
   end;
   PTWordComData = ^TWordComData;

   TConnector = class
   private
      GradeWindowButtonDownTick : integer;
      GateNo : Integer;

      StartTime : String;

      SaveTick : Integer;
      FboAllowDelete : Boolean;

      ShoutedTick : Integer;

      User : Pointer;
      BattleRoom : Pointer;
   public
      ConnectID : Integer;

      CharData : TDBRecord;

      LoginID : String;
      ServerName : String;
      CharName : String;
      Name : String;

      GroupTitle : String;

      IpAddr : String;
      VerNo : Byte;
      PaidType : Byte;

      SysopScope : Integer;

      // Points;
      Win : Integer;          // 铰
      Lose : Integer;         // 菩
      DisConnected : Integer; // 谗变芭
      BattleRecord : Integer; // 傈利
      Points : Integer;       // 痢荐
      Grade : Integer;        // 鉴困

      WhereStatus : TWhereStatus;
      WaitTick : Integer;
      WaitStartTick : Integer;

      ReceiveBuffer : TPacketBuffer;

      constructor Create (aServerName : String; aGateNo, aConnectID : Integer);
      destructor Destroy; override;

      procedure ExitBattleRoom;
      procedure ExitShareRoom;

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

      procedure MessageProcess (aComData : PTWordComData);
      procedure BattleDBMessageProcess (aPacket : PTPacketData);

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

      function  SearchExtremeMagic (aStr : String) : String;
      function  SearchGradeStrList (aServerName, aCharName : String) : Boolean;
      procedure SearchPositionbyServer (aServerName : String; var aXpos, aYpos : Integer);

      procedure SendBattleGroupList (aType : Byte);
      procedure SendBattleRoomList (aGroupTitle : String; aType : Byte);
      procedure SendGradeList (aWordStr : String);

      function  GetCharAge : Integer;
      procedure SendChatMessage (astr: string; aColor: byte);
      procedure SendMap (var aSenderInfo: TBasicData; amap, aobj, arof, atil, aSoundBase: string);
      procedure SendShowCenterMessage (aStr : String; aColor : Word);
      procedure SendShow (var aSenderinfo: TBasicData);      

      function  GetToken (aStr : String; aDivStr : Char; aTime : Integer) : String;

      property  boAllowDelete : Boolean read FboAllowDelete write FboAllowDelete;
   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);

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

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

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

      // procedure AddSaveData (aData : PChar; aSize : Integer);
      procedure BattleDBMessageProcess (aPacket : PTPacketData);

      procedure SendLatestList (aWhereStatus : TWhereStatus; aData : PChar; aSize : Integer);
      procedure SendLatestRoomList (aGroupTitle : String; aData : PChar; aSize : Integer);

      procedure WaitRoomMessage (aGroupTitle : String; aStr : String; aColor : Byte);
      procedure ShoutMessage (aStr : String; aColor : Byte);

      function GetSaveListCount : Integer;

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

var
   ConnectorList : TConnectorList;

   GradeStrList : TStringList;

implementation

uses
   svMain, uUser, svClass, AUtil32, uGroup, UserSDB, BasicObj;

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

   VerNo := 0;
   PaidType := 0;

   ServerName := aServerName;
   CharName := '';
   LoginID := '';
   IpAddr := '';
   Name := '';

   Win := 0;
   Lose := 0;
   DisConnected := 0;
   BattleRecord := 0;
   Points := 0;
   Grade := 0;

   WhereStatus := ws_none;

   FillChar (CharData, SizeOf (TDBRecord), 0);

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

   FboAllowDelete := false;

   User := nil;
   BattleRoom := nil;

   ReceiveBuffer := TPacketBuffer.Create (BufferSizeS2C);
   GradeWindowButtonDownTick := 0;

{
   RankData.rName := CharName;
   RankData.rServerName := ServerName;
   RankData.rAge := GetCharAge;

   if StrPas (@CharData.Sex) = '巢' then
      RankData.rSex := 0
   else RankData.rSex := 1;

   BattleDBSender.PutPacket (ConnectID, BSBD_GETRANKDATA, 0, @RankData, SizeOf (TGetRankData)); // sdb data 阂矾坷扁
}
end;

destructor TConnector.Destroy;
begin
   frmMain.AddLog ('close ' + Name);
   frmMain.DelUser (Name);
   {
   if CharName <> '' then begin
      EndLayer;
   end;
   }

   if BattleRoom <> nil then begin
      TBattleRoom (BattleRoom).RemoveConnector (Self);
   end else begin
      ExitShareRoom;
      MirrorList.DelViewer (Self);
   end;

   ReceiveBuffer.Free;

   inherited Destroy;
end;

procedure TConnector.ExitBattleRoom;
begin
   if BattleRoom = nil then exit;

   User := nil;
   BattleRoom := nil;

   WhereStatus := ws_room;
   if GroupTitle <> '' then begin
      SendBattleRoomList (GroupTitle, 0);
   end else begin
      SendBattleGroupList (0);
   end;
end;

procedure TConnector.ExitShareRoom;
begin
   if User <> nil then begin
      TUserList (ShareRoom.UserList).FinalLayer (Self);
      User := nil;
      ShareRoom.RemoveJoinConnector (Self);
   end;
end;

function TConnector.StartLayer (aData : PChar) : Boolean;
var
   Str, rdStr : String;
   RankData : TGetRankData;
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 := _StrToInt (rdStr);

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

   Name := CharName + ' (' + ServerName + ')';

   // 苞楷 瞪鳖唱? ;;;; 铝.
   RankData.rName := CharName;
   RankData.rServerName := ServerName;
   RankData.rAge := GetCharAge;

   if StrPas (@CharData.Sex) = '巢' then
      RankData.rSex := 0
   else RankData.rSex := 1;

   if BattleDBSender <> nil then begin
      BattleDBSender.PutPacket (ConnectID, BSBD_GETRANKDATA, 0, @RankData, SizeOf (TGetRankData)); // sdb data 阂矾坷扁
   end;

   SysopScope := SysopClass.GetSysopScope (CharName);
end;

procedure TConnector.EndLayer;
begin
   if User <> nil then begin
      TUserList (TUser (User).Manager.UserList).FinalLayer (Self);
   end;
end;

procedure TConnector.Update (CurTick : Integer);
var
   ComData : TWordComData;
begin
{
   if CurTick >= SaveTick + 2000 then begin
      GameServerConnectorList.AddSendServerData (GateNo, ConnectID, BG_USERCLOSE, nil, 0);
      FboAllowDelete := true;
      exit;
   end;
}
   if WaitTick > 0 then begin
      WaitTick := WaitTick - (CurTick - WaitStartTick);
      WaitStartTick := CurTick;
      if WaitTick <= 0 then begin
         WaitTick := 0;
         WaitStartTick := 0;
      end;
   end;
   
   if ReceiveBuffer.Count > 0 then begin
      while true do begin
         if ReceiveBuffer.Get (@ComData) = false then break;
         MessageProcess (@ComData);
      end;
   end;
end;

procedure TConnector.MessageProcess (aComData : PTWordComData);
var
   i, CurTick, SXpos, SYpos : integer;
   sColor : Byte;
   pcKey : PTCKey;
   pcSay : PTCSay;
   pcConfirm : PTCWindowConfirm;
   ComData : TWordComData;
   MainMagic : String;
   RoomTitle, Str, RetStr, MagicStr : String;
   Strs : array [0..15] of string;
   LimitStr : String;


   Room : TBattleRoom;
   tmpUser : TUser;
   prd : PTSShowListWindow;
   pHideWindow : PTSHideSpecialWindow;

   RankPart : TGetRankPart;
   MainMagicData : TMainMagicData;
   MainMagicRank : TGetMainMagicRank;
begin
   CurTick := mmAnsTick;

   pckey := @aComData^.Data;
   Case pckey^.rmsg of
      CM_WINDOWCONFIRM :
         begin
            pcConfirm := @aComData^.Data;
            Case pcConfirm^.rWindow of
               WINDOW_GROUPWINDOW :
                  begin
                     if WhereStatus <> ws_group then begin
//                        frmMain.WriteLogInfo ('Invalid Message Received (GroupWindow)');
                        exit;
                     end;

                     Case pcConfirm^.rButton of
                        BATTLEBUTTON_SELECT :
                           begin
                              GroupTitle := GetToken (pcConfirm^.rText, ':', 0);
                              if GroupTitle = '' then begin
                                 SendBattleGroupList (0);
                                 exit;
                              end;
                              WhereStatus := ws_room;
                              if GroupTitle <> '' then
                                 SendBattleRoomList (GroupTitle, 0);
                              ConnectorList.WaitRoomMessage (GroupTitle, format ('%s丛捞 甸绢坷继嚼聪促', [CharName]), SAY_COLOR_GRADE5);
                           end;
                        BATTLEBUTTON_GRADE :

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -