uuser.pas

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

unit UUser;

interface

uses
  Windows, SysUtils, Classes, ScktComp, WinSock, aDefType, svclass, deftype,
  aUtil32, basicobj, fieldmsg, AnsImg2, mapunit, subutil, uanstick, uSendcls,
  uUserSub, aiunit, uLetter, uGroup, AnsStringCls, uConnect, uBuffer, uKeyClass;

const
   InputStringState_None          = 0;
   InputStringState_AddExchange   = 1;
   InputStringState_Search        = 2;

   RefusedMailLimit               = 5; // 芭何等 率瘤狼 弥措荐 (率瘤扁瓷阑 荤侩且 荐 绝霸凳)
   MailSenderLimit                = 5; // 焊辰 荤恩阑 扁撅窍绰 弥措摹

type
{
   TMouseEventData = record
     rtick : Integer;
     revent: array [0..10-1] of integer;
   end;
   PTMouseEventData = ^TMouseEventData;

   // 概农肺 眉农甫 淬淬窍绰 努贰胶
   TMacroChecker = class
   private
      nSaveCount : Integer; // 付快胶捞亥飘 单捞鸥 焊包 肮荐
      DataList : TList;

      nReceivedCount : Integer; // 眠啊等 付快胶 捞亥飘 单捞鸥狼 墨款飘

      function CheckNone : Boolean; // 沥富肺 酒公老档 窍瘤 臼绰 荤恩
      function CheckCase1 : Boolean; // MouseMove父 0 < x < 20 牢 荤恩
      function CheckCase2 : Boolean; // 30盒悼救 荐摹啊 +-10%捞郴牢 荤恩
      function CheckCase3 : Boolean; // 呈公 磊林 焊郴绰 荤恩

      procedure SaveMacroCase(aName : String; nCase : Integer);

   public
      constructor Create(anSaveCount : Integer);
      destructor Destroy; override;

      procedure Clear;

      procedure AddMouseEvent(pMouseEvent : PTCMouseEvent; anTick : Integer);
      function Check(aName : String) : Boolean;
   end;
}


   TUserObject = class (TBasicObject)
   private
     Connector : TConnector;

//     boFalseVersion : Boolean;
     boShiftAttack : Boolean;
     TargetId : integer;
     PrevTargetID : Integer;
     LifeObjectState : TLifeObjectState;

     RopeTarget : integer;
     RopeTick : integer;
     RopeOldX, RopeOldy : word;

     ShootBowCount : integer;

     FreezeTick : integer;
     DiedTick : integer;
     HitedTick : integer;
     LifeData : TLifeData;

     function   AllowCommand (CurTick: integer): Boolean;
   protected
     LastGainExp : integer;

     DisplayValue : Word;
     DisplayTick : Integer;

//     AttribClass : TAttribClass;
     WearItemClass : TWearItemClass;
     HaveItemClass : THaveItemClass;
     HaveMagicClass : THaveMagicClass;

     function  FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer; override;
     procedure Initial (aName: string);
     procedure StartProcessByDir (aDir : Integer); override;
     procedure StartProcess; override;
     procedure EndProcess; override;
   public
     AttribClass : TAttribClass;

     Name, IP : String;
     GuildServerID : Integer;
     GuildName : String;
     GuildGrade : String;
     SendClass : TSendClass;
     SayTick : Integer;
     SearchTick : Integer;

     constructor Create;
     destructor Destroy; override;
     procedure SetTargetId (aid: integer);
     procedure CommandChangeCharState (aFeatureState: TFeatureState; boSend: Boolean);
     procedure ShowEffect (aEffectNumber : Word; aEffectKind : TLightEffectKind);
     function  CommandHited (aattacker: integer; aHitData: THitData; apercent: integer): integer;
     function  CommandHit (CurTick: integer; boSend: Boolean): Boolean;
     procedure CommandBowing (CurTick: integer; atid: integer; atx, aty: word; boSend: Boolean);
     procedure CommandTurn (adir: word; boSend: Boolean);
     procedure Update (CurTick: integer); override;

     function GetLifeObjectState : TLifeObjectState;
     function AddMagic  (aMagicData: PTMagicData): Boolean;
     function FindHaveMagicByName (aMagicName : String) : Integer;
     function DeleteItem (aItemData: PTItemData): Boolean;
     function FindItem (aItemData : PTItemData): Boolean;

     procedure SetLifeData;
   public
     function GetAge : Integer;
   end;


   TUser = class (TUserObject)
   private
     boNewServer : Boolean;
     boTv : Boolean;

     boException : Boolean;

     boCanSay, boCanMove, boCanAttack, boCanHit : Boolean;

     InputStringState : integer;
     CountWindowState : integer;

     CM_MessageTick : array [0..255] of integer;
     PrisonTick : Integer;
     SaveTick : integer;
     FalseTick : integer;
     PosMoveX, PosMoveY: integer;
     SysopScope : integer;

     MailBox : TList;
     MailTick : Integer;
     RefuseReceiver : TStringList;
     MailSender : TStringList;
     boLetterCheck : Boolean;

     UseSkillKind : Integer;
     SkillUsedTick : Integer;
     SkillUsedMaxTick  : Integer;

     SpecialWindowSt : TSpecialWindowSt;
//     ItemLogData : array [0..4 - 1] of TItemLogRecord;

     CopyHaveItem : THaveItemClass;
//     MacroChecker : TMacroChecker;

     // procedure SendData (cnt:integer; pb:pbyte);

     procedure LoadUserDataByPosition (aName: string; aXpos, aYpos : Integer);

     procedure LoadUserData (aName: string);
     procedure SaveUserData (aName: string);

     procedure UserSay (astr: string);
     procedure DragProcess (var code: TWordComData);
     procedure InputStringProcess (var code: TWordComData);
     procedure SelectCount (var Code : TWordComData);
     procedure ClickExChange (awin:byte; aclickedid:longInt; akey:word);
     function  AddableExChangeData (pex : PTExChangedata): Boolean;
     procedure AddExChangeData (var aSenderInfo : TBasicData; pex : PTExChangedata; aSenderIP : String);
     procedure DelExChangeData (pex : PTExChangedata);
   protected
     function  FieldProc (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer; override;
   public
     SysopObj, UserObj : TBasicObject;

     ExChangeData : TExChangeData;
     procedure ExChangeStart (aId : Integer);
     function isCheckExChangeData: Boolean;

     constructor Create;
     destructor Destroy; override;

     procedure MessageProcess (var code: TWordComData);

     function  InitialLayer (aName, aCharName : String) : Boolean;
     procedure FinalLayer;

     procedure InitialByPosition (aName : String; aXpos, aYpos : Integer);
     procedure Initial (aName: string);
     procedure StartProcessByDir (aDir : Integer); override;
     procedure StartProcess; override;
     procedure StartUser;
     procedure EndProcess; override;
     procedure EndUser;        
     procedure Update (CurTick: integer); override;

     function  FieldProc2 (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer;

     procedure AddRefusedUser (aName : String);
     procedure DelRefusedUser (aName : String);
     procedure AddMailSender (aName : String);
     function CheckSenderList (aName : String) : Boolean;

     procedure SetPosition (x, y : Integer);

//     function ShowItemLogWindow : String;
     function MovingStatus : Boolean;
//     procedure UdpSendMouseEvent (aInfoStr: String);

     procedure SetSpecialWindowSt (aWindow : Byte; aType : Byte; aSenderID : Integer);
     function isSpecialWindow : Boolean;

     procedure SendMapForViewer (aConnector : TConnector);
     procedure SendRefillMessage (hfu: Longint; var SenderInfo: TBasicData);
     procedure MoveConnector;

     procedure SetActionState (aState : TActionState);
     function  GetActionState : TActionState; 

     property LetterCheck : Boolean read boLetterCheck;
     property Exception : Boolean read boException write boException;
     property CanAttack : Boolean read boCanAttack write boCanAttack;
     property CanHit : Boolean read boCanHit write boCanHit;
   end;

   TUserList = class
   private
     ExceptCount : integer;
     CurProcessPos : integer;
     UserProcessCount : Integer;
     
     // AnsList : TAnsList;
     NameKey : TStringKeyClass;
     DataList : TList;

     TvList : TList;

//     function  AllocFunction: pointer;
//     procedure FreeFunction (item: pointer);
     function  GetCount: integer;
     function  Get (aIndex : Integer) : Pointer;
   public
     constructor Create (cnt: integer);
     destructor  Destroy; override;

     function  InitialLayerByPosition (aName, aCharName: string; aConnector : TConnector; aRoom : TBattleRoom; aXpos, aYpos : Integer) : TUser;

     function  InitialLayer (aName, aCharName: string; aConnector : TConnector; aRoom : TBattleRoom) : TUser;
     procedure FinalLayer (aConnector : TConnector);
     procedure StartChar (aName: string; aDir : Integer);

     function  GetUserPointer (aCharName: string): TUser;
     function  GetUserPointerById (aId: LongInt): TUser;

     procedure GuildSay (aGuildName, astr: string);
     function  GetGuildUserInfo (aGuildName: string): string;

     procedure SayByServerID (aServerID : Integer; aStr: String);

     procedure SendNoticeMessage (aStr: String; aColor : Integer);
     // procedure   SendGradeShoutMessage (astr: string; aColor: integer);
     function  GetUserList: string;
     procedure SendRaining (aRain : TSRainning);

     function  FieldProc2 (hfu: Longint; Msg: word; var SenderInfo: TBasicData; var aSubData: TSubData): Integer;

     procedure SaveUserInfo (aFileName : String);

     procedure Update (CurTick: integer);
     property  Count : integer read GetCount;
     property  Items [aIndex : Integer] : Pointer read Get;
   end;

var
  UserList : TUserList;

implementation

uses
   SvMain, uGConnect;

{
////////////////////////////////////////////////////
//
//             ===  TMacroChecker  ===
//
////////////////////////////////////////////////////

constructor TMacroChecker.Create(anSaveCount : Integer);
var
   i : Integer;
   pMouseEvent : PTMouseEventData;
begin
   nSaveCount := anSaveCount;
   DataList := TList.Create;

   for i := 0 to nSaveCount - 1 do begin
      New(pMouseEvent);
      if pMouseEvent <> nil then begin
         FillChar(pMouseEvent^, sizeof(TMouseEventData), 0);
         DataList.Add(pMouseEvent);
      end;
   end;

   nReceivedCount := 0;
end;

destructor TMacroChecker.Destroy;
var
   i : Integer;
   pMouseEvent : PTMouseEventData;
begin
   for i := 0 to DataList.Count - 1 do begin
      pMouseEvent := DataList.Items[i];
      if pMouseEvent <> nil then Dispose(pMouseEvent);
   end;
   DataList.Clear;
   DataList.Free;
end;

procedure TMacroChecker.Clear;
begin
   nReceivedCount := 0;
end;

function TMacroChecker.CheckNone : Boolean; // 沥富肺 酒公 老档 救窍绰 荤恩
var
   i, j : integer;
   pMouseEventData : PTMouseEventData;
begin
   Result := false;

   if nReceivedCount = nSaveCount then begin
      for i := 0 to nReceivedCount - 1 do begin
         pMouseEventData := DataList.Items[i];
         if pMouseEventData = nil then break;
         for j := 0 to 10 - 1 do begin
            if pMouseEventData^.revent[j] <> 0 then exit;
         end;
      end;
   end;

   Result := true;
end;

function TMacroChecker.CheckCase1: Boolean; // MouseMove父 0 < x < 20 牢 荤恩
var
   i, j : integer;
   pMouseEventData : PTMouseEventData;
begin
   Result := false;

   for i := 0 to nReceivedCount - 1 do begin
      pMouseEventData := DataList.Items[i];
      if pMouseEventData = nil then exit;
      for j := 1 to 10 - 1 do begin
         if pMouseEventData^.revent[j] <> 0 then exit;
      end;
      if (pMouseEventData^.revent[0] <= 0) or (pMouseEventData^.revent[0] >= 20) then exit;
   end;

   Result := true;
end;

function TMacroChecker.CheckCase2: Boolean; // 30盒悼救 荐摹啊 +-10%捞郴牢 荤恩
var
   i, j : integer;
   pMouseEventData : PTMouseEventData;
   AverageData, LimitData : TMouseEventData;
begin
   Result := false;

   FillChar(AverageData, sizeof(TMouseEventData), 0);
   for i := 0 to nReceivedCount - 1 do begin
      pMouseEventData := DataList.Items[i];
      if pMouseEventData = nil then exit;
      for j := 0 to 10 - 1 do begin
         AverageData.revent[j] := AverageData.revent[j] + pMouseEventData^.revent[j];
      end;
   end;
   for i := 0 to 10 - 1 do begin
      AverageData.revent[i] := Integer(AverageData.revent[i] div nReceivedCount);
      LimitData.revent[i] := Integer(AverageData.revent[i] div 10);
   end;