📄 unitstate.pas

📁 网络游戏神迹脱机外挂PASCAL源码
💻 PAS
字号:
unit UnitState;
{---------无影开发小组敬告：-------------------}
{        外挂研究无罪，开放源码有理！           }
{ 希望以此献给各位想研究外挂的朋友一窥外挂之容 }
{    本代码只供研究之用，不得用于非法用途      }
interface

uses Classes,Messages,SysUtils,Windows,Dialogs,PackStruct,GameCode;

type
//点坐标结构
  PosPoint=record
    X:word;
    Y:word;
  end;

type
//地图上怪物信息的结构
  TMapMstInfo=record
  MstId   : DWORD;
  MstPos  : PosPoint;
  MstName : array[0..20] of Char;
  end;

type
//地图上怪物信息管理
  TMapMstList=class(TOBject)
  Private
   MstList : TList ;
   MstCnt  : word  ;
  public
   constructor Create;
   destructor Destroy;override;
   procedure AddMst(PMstPack:Pointer);
   procedure DelMst(Index:Integer);
   function FindMstbyN(MstName:string):integer;
   function FindMstbyP(Point:PosPoint):integer;
   function FindMstbyId(MstID:DWORD)  :integer;
   function GetMstPos(Index:Integer)  :PosPoint;
   function GetMstId(Index:Integer)   :DWORD;
   function GetMstName(Index:Integer) :string;
   procedure EditMstPos(MstId:DWORD;MstNewPos:PosPoint);
   function GetCnt():Integer;
  end;


type
//管理道具的类
  TItemBox=class(TOBject)
  Private
   ItemList  :  TList ;
   ItemCnt   :  word  ;
  public
   constructor Create  ;
   destructor  Destroy ; override;

   procedure AddItem(pAddItem : pointer);
   //添加一个道具
   function RemoveItem(ItemId:dword):Integer;
   // 删除一个道具，参数为道具id
   // 返回1，删除成功，返回0未找到此id值道具
   function GetItem(Index:Integer;pItemBuf:pointer):Integer;
   //取得一个道具的全部信息,写入pItemBuf
   function FindItem(StringName:string):Integer;
   //寻找一个指定名道具，返回index值
   function GetItemCnt():Integer;
   //取得道具数量
   procedure PrintItem;
   //调试用函数 debug out 'Item:道具名'
  end;
//----------------------------------------------------------
var
CharId   : DWORD     ;   //人物的id
CharPos  : PosPoint  ;   //人物目前坐标
CharHP   : Integer   ;   //人物目前hp
CharHPMax: Integer   ;   //人物hp上限
CharMP   : Integer   ;   //人物目前mp
FailCnt  : Integer=0 ;   //连续返回FL包个数
HSignal  : THandle   ;   //信号变量
ItemBox1 : TItemBox  ;   //人物身上道具栏的物品
MstList1 : TMapMstList;  //地图上出现的怪物信息
//ChrList1 : TMapMstList;  //地图上出现人物的信息
//----------------------------------------------------------
procedure DisGorFPack(buf:PChar;var xvalue:word;var yvalue:word);
//解析+包，返回坐标值。
procedure DisItemPack(buf:PChar);
//解析登陆时候C900的物品包
procedure DisLngPosPack(buf:PChar);
//解析人物登陆时确定位置和id的包
procedure DisHpMpPack(buf:PChar);
//解析hp,Mp状态的包
procedure DisHpDownPack(buf:PChar);
//解析hp down的包
procedure DisLngHpPack(buf:PChar);
//解析登陆时候血量确定包
procedure DisItmGetPack(buf:PChar);
//解析得到物品包
procedure DisItmUsePack(buf:PChar);
//解析使用物品包，在send时候调用
procedure SetMName(buf:PChar);
//取得TMstPack结构中mstname里的怪物名字
procedure DisMstAprPack(buf:PChar);
//解析怪物出现的包
procedure DisMstDspPack(buf:PChar);
//解析怪物消失的包
procedure DisMstMovPack(buf:PChar);
//解析怪物移动的包 ,和LaDisPack1差不多，未写功能？
procedure DisMstDiePack(buf:PChar);
//解析怪物死了的包
function DisPriChatPack(buf:array of char):String;
//解析私聊频道聊天信息
function IsMst(Kind:word):Boolean;
//判断是否是怪物，未完全统计
//甲虫稻草人$12,土狼$11,鹿鸡$0B,蟒$0A,食人花$0D
procedure PressKey(KeyCode:byte;HW:HWND);
//按一个键
//----------------------------------------------------------

implementation


//----------------------------------------------------------
constructor TItemBox.Create;
begin
inherited Create;
ItemList:=TList.Create;
ItemCnt:=0;
end;

destructor TItemBox.Destroy;
var
i : Integer;
p : ^THPMPInfo;
begin
inherited Destroy;
for i:=0 to ItemList.Count-1 do
  begin
  p:=ItemList.Items[i];
  Dispose(p);
  end;
ItemList.Free;
end;

procedure TItemBox.AddItem(pAddItem : pointer);
var
pBoxItem : ^THPMPInfo;
pAdd     : ^THPMPInfo;
begin
pAdd:=pAddItem;
  try
    new(pBoxItem);
  except on EOutOfMemory do
    begin
    DBGOut('TItemBox.AddItem:EOutOfMemory',[]);
    exit;
    end;
  end;
Move(pAdd^,pBoxItem^,sizeof(THPMPInfo));
//DBGOut('pAdd=%s,pBoxItem=%s',[padd.Name,pBoxItem.Name]);
ItemList.Add(pBoxItem);
ItemCnt:=ItemList.Count;
end;

procedure TItemBox.PrintItem;
var
i : Integer;
p : ^THPMPInfo;
begin
for i:=0 to ItemCnt-1 do
  begin
  //OutputDebugString('123');
  p:=ItemList.Items[i];
  DBGOut('Item:%s',[p.Name]);
  end;
end;

function TItemBox.RemoveItem(ItemId:dword):Integer;
var
ItemIndex : Integer;
pItem     : ^THPMPInfo;
begin
RemoveItem:=0;
for ItemIndex:=0 to ItemCnt-1 do
  begin
  pItem:=ItemList.Items[ItemIndex];
  if pItem.ID=ItemId then
    begin
    Dispose(pItem);
    ItemList.Delete(ItemIndex);
    RemoveItem:=1;
    break;
    end;
  end;
ItemCnt:=ItemList.Count;
end;

function TItemBox.GetItem(Index:Integer;pItemBuf:pointer):Integer;
var
pIBuf : ^THPMPInfo;
pItem : ^THPMPInfo;
begin
pIBuf:=pItemBuf;
if (Index>=ItemList.Count) or (Index<0) then
  begin
  ShowMessage('TItemBox.GetItem:wrong index');
  GetItem:=0;
  exit;
  end;
pItem:=ItemList.Items[Index];

Move(pItem^,pIBuf^,sizeof(THPMPInfo));
GetItem:=1;
end;

function TItemBox.FindItem(StringName:string):Integer;
var
pItem : ^THPMPInfo;
i     : Integer;
begin
FindItem:=-1;
for i:=0 to ItemCnt-1 do
  begin
  pItem:=ItemList.Items[i];
  if StrComp(PChar(@pItem.Name[0]),
             PChar(StringName))=0 then
    begin
    findItem:=i;
    exit;
    end;
  end;
end;

function TItemBox.GetItemCnt():Integer;
begin
GetItemCnt:=ItemCnt;
end;
//----------------------------------------------------------
constructor TMapMstList.Create;
begin
inherited Create;
MstList:=TList.Create;
end;

destructor TMapMstList.Destroy;
var
i : Integer;
p : ^TMapMstInfo;
begin
inherited Destroy;
for i:=0 to MstList.Count-1 do
  begin
  p:=MstList.Items[i];
  Dispose(p);
  end;
MstList.Free;
end;

procedure TMapMstList.AddMst(PMstPack:Pointer);
var
PMstP    : ^TMstPack;
PChrP    : ^TChrPack;
PMstInfo : ^TMapMstInfo;
begin
PMstP:=PMstPack;
if PMstP.MstK<>0 then
  begin
  DBGOut('Add a Mst to List',[]);
  try
    new(PMstInfo);
  except on EOutOfMemory do
    begin
    DBGOut('TMapMstList.AddMst:EOutOfMemory',[]);
    exit;
    end;
    end;
  PMstInfo.MstId:=PMstP.Header.dwFlag;
  PMstInfo.MstPos.X:=PMstP.Header.w1;
  PMstInfo.MstPos.Y:=PMstP.Header.w2;
  StrLCopy(PChar(@PMstInfo.MstName[0]),PChar(@PMstP.MstName),20);
  SetMName(PChar(@PMstInfo.MstName[0]));
  if PMstInfo.MstName<>'' then
    MstList.Add(PMstInfo)
  else
    dispose(PMstInfo);
  MstCnt:=MstList.Count;
  end
else
  begin
  PChrP:=PMstPack;
  DBGOut('Add a Chr to List',[]);
  try
    new(PmstInfo);
  except on  EOutOfMemory do
    begin
    DBGOut('TMapMstList.AddMst:EOutOfMemory',[]);
    exit;
    end;
    end;
  PMstInfo.MstId:=PChrP.Header.dwFlag;
  PMstInfo.MstPos.X:=PChrP.Header.w1;
  PMstInfo.MstPos.Y:=PChrP.Header.w2;
  StrLCopy(PChar(@PMstInfo.MstName[0]),PChar(@PChrP.ChrName),20);
  SetMName(PChar(@PMstInfo.MstName[0]));
  if PMstInfo.MstName<>'' then
    MstList.Add(PMstInfo)
  else
    dispose(PMstInfo);
  MstCnt:=MstList.Count;
  end;

end;

function TMapMstList.FindMstbyN(MstName:String):integer;
var
PMstInfo : ^TMapMstInfo;
i, Index : Integer;
begin
Index:=-1;//未找到时候返回值
for i:=0 to MstCnt-1 do
  begin
  PMstInfo:=MstList.Items[i];
  if MstName=PMstInfo.MstName then
    begin
    Index:=i;
    break;
    end;
  end;
FindMstbyN:=Index;
end;

function TMapMstList.FindMstbyP(Point:PosPoint):Integer;
var
PMstInfo : ^TMapMstInfo;
i, Index : Integer;
begin
Index:=-1;
for i:=0 to MstCnt-1 do
  begin
  PMstInfo:=MstList.Items[i];
  if (PMstInfo.MstPos.X=Point.X) and
   (PMstInfo.MstPos.Y=Point.Y) then
    begin
    Index:=i;
    break;
    end;
  end;
FindMstbyP:=Index;
end;

function TMapMstList.FindMstbyId(MstId:DWORD):Integer;
var
PMstInfo : ^TMapMstInfo;
i, Index : Integer;
begin
Index:=-1;
for i:=0 to MstCnt-1 do
  begin
  PMstInfo:=MstList.Items[i];
  if MstId=PMstInfo.MstId then
    begin
    Index:=i;
    break;
    end;
  end;
FindMstbyId:=Index;
end;

procedure TMapMstList.DelMst(Index:Integer);
begin
if (Index>(MstCnt-1)) or (Index<0) then
  begin
  DBGOut('TMapMstList.DelMst:Wrong Index',[]);
  exit;
  end;
Dispose(MstList.Items[Index]);
MstList.Delete(Index);
MstCnt:=MstList.Count;
end;

function TMapMstList.GetMstId(Index:Integer):dword;
var
PMstInfo : ^TMapMstInfo;
begin
if (Index>(MstCnt-1)) or (Index<0) then
  begin
  DBGOut('TMapMstList.GetMstId:Wrong Index',[]);
  GetMstId:=0;
  exit;
  end;
PMstInfo:=MstList.Items[Index];
GetMstId:=PMstInfo.MstId;
end;

function TMapMstList.GetMstPos(Index:Integer):PosPoint;
var
PMstInfo : ^TMapMstInfo;
begin
if (Index>(MstCnt-1)) or (Index<0) then
  begin
  DBGOut('TMapMstList.GetMstPos:Wrong Index',[]);
  exit;
  end;
PMstInfo:=MstList.Items[Index];
GetMstPos:=PMstInfo.MstPos;
end;

function TMapMstList.GetMstName(Index:Integer):string;
var
PMstInfo : ^TMapMstInfo;
begin
if (Index>(MstCnt-1)) or (Index<0) then
  begin
  DBGOut('TMapMstList.GetMstName:Wrong Index',[]);
  exit;
  end;
PMstInfo:=MstList.Items[Index];
GetMstName:=PMstInfo.MstName;
end;

procedure TMapMstList.EditMstPos(MstId:DWORD;MstNewPos:PosPoint);
var
MstIndex : Integer;
PMstInfo : ^TMapMstInfo;
begin
MstIndex:=FindMstbyId(MstId);
if MstIndex=-1 then
  begin
  DBGOut('TMapMstList.EditMstPos:Wrong MstIndex',[]);
  exit;
  end;
PMstInfo:=MstList.Items[MstIndex];
PMstInfo.MstPos:=MstNewPos;
end;

function TMapMstList.GetCnt():Integer;
begin
GetCnt:=MstCnt;
end;

//----------------------------------------------------------
procedure DisGorFPack(buf:PChar;var xvalue:word;var yvalue:word);
var
        i:integer;
xptr,yptr:PChar;
xstr,ystr:string;
begin
//DBGOut('return a GorF Pack',[]);
i:=0;
xstr:='';
ystr:='';
if buf[2]='L' then
  exit;

//判断是否为+包
if buf[1]<>'+' then
  exit;
//+包的G类的处理
if buf[2]='G' then
  begin
  PulseEvent(HSignal);//触发信号
  FailCnt:=0;
  Xptr:=@buf[4];
  while Xptr[i]<>'/' do
    begin
    xstr:=xstr+xptr[i];
    inc(i);
    end;
  Yptr:=@Xptr[i+1];
  i:=0;
  while Yptr[i]<>'!' do
    begin
    ystr:=ystr+Yptr[i];
    inc(i);
    end;
  end
//+包F类的处理
else
  begin
  Inc(FailCnt);
  PulseEvent(HSignal);//触发信号
  Xptr:=@buf[5];
  while Xptr[i]<>'/' do
    begin
    xstr:=xstr+xptr[i];
    inc(i);
    end;
  Yptr:=@Xptr[i+1];
  i:=0;
  while Yptr[i]<>'!' do
    begin
    ystr:=ystr+Yptr[i];
    inc(i);
    end;
  end;
xvalue:=StrToInt(xstr);
yvalue:=StrToInt(ystr);
end;
//---------------------------------------------------------
procedure DisLngHpPack(buf:PChar);
var
pHeader : ^PackHeaderA;
begin
pHeader:=@buf[0];
CharHP:=pHeader.w1;
CharHPMax:=pHeader.w3;
DBGOut('CharHP=%d,CharHPMax=%d',[CharHP,CharHPMax]);
end;

procedure DisHpMpPack(buf:PChar);
var
pHeader : ^PackHeaderA;
begin
pHeader:=@buf[0];
if pHeader.dwFlag<>CharId then
  exit;
CharHP:=pHeader.w1;
CharMp:=pHeader.w2;
CharHPMax:=pHeader.w3;
//DBGOut('CharHP=%d,CharHPMax=%d',[CharHP,CharHPMax]);
end;

procedure DisHpDownPack(buf:PChar);
var
pHeader : ^PackHeaderA;
begin
pHeader:=@buf[0];
if pHeader.dwFlag<>CharId then
  exit;
CharHP:=pHeader.w1;
CharHpMax:=pHeader.w2;
end;

procedure DisLngPosPack(buf:PChar);
var
pHeader : ^PackHeaderA;
begin
pHeader:=@buf[0];
CharId:=pHeader.dwFlag;
CharPos.X:=pHeader.w1;
CharPos.Y:=pHeader.w2;
//DBGOut('LngX=%d,LngY=%d',[CharPos.X,CharPos.Y]);
//DBGOut('CharId=%d',[CharId]);
end;


procedure DisItemPack(buf:PChar);
var
pHeader : ^PackHeaderA;
pItem   : ^THPMPInfo;
ItemCnt : word;
i       : Integer;
begin
ItemBox1:=TItemBox.Create;
pHeader:=@buf[0];
ItemCnt:=pHeader.w3;
//DBGOut('ItemCnt=%d',[ItemCnt]);
for i:=0 to ItemCnt-1 do
  begin
  pItem:=@buf[12+i*52];
  //OutputDebugString(PChar(@pItem.Name[0]));
  ItemBox1.AddItem(Pointer(pItem));
  end;
//ItemBox1.PrintItem;
end;

procedure DisItmGetPack(buf:PChar);
var
pHeader : ^PackHeaderA;
ItemCnt :  Integer;
pItem   : ^THPMPInfo;
i       :  Integer;
begin
pHeader:=@buf[0];
ItemCnt:=pHeader^.w3;
for i:=0 to ItemCnt-1 do
  begin
  pItem:=@buf[12+i*52];
  ItemBox1.AddItem(pItem);
  end;
end;

procedure DisItmUsePack(buf:PChar);
var
pHeader : ^PackHeaderA;
begin
pHeader:=@buf[0];
ItemBox1.RemoveItem(pHeader.dwFlag);
end;

procedure DisMstAprPack(buf:PChar);
begin
//pMstPack:=@buf[0];
MstList1.AddMst(buf);
end;

procedure DisMstDspPack(buf:PChar);
var
pMstPack : ^PackHeaderA;
Index    : Integer;
begin
pMstPack:=@buf[0];
index:=MstList1.FindMstbyId(pMstPack.dwFlag);
if Index=-1 then
  begin
  DBGOut('DisMstDspPack, No this ID',[]);
  exit;
  end
else
  MstList1.DelMst(index);
end;

procedure DisMstMovPack(buf:PChar);
begin
end;

procedure DisMstDiePack(buf:PChar);
var
ptrp:^PackHeaderA;
n   : Integer;
begin
ptrp:=@buf[0];
n:=MstList1.FindMstbyId(ptrp.dwFlag);
DBGOut('n=%d,ptrp.dwFlag=%d',[n,ptrp.dwFlag]);
if n<>-1 then
  begin
  MstList1.DelMst(n);
  end;
end;

function DisPriChatPack(buf:array of char):String;
Const
Flag1='=';
Flag2='>';
var
  i,j:integer;
  PlayerName:array[0..26]of char;
begin
  i:=12;
  j:=0;
  Repeat//取得对你私聊的玩家名字
  PlayerName[j]:=buf[i];
  inc(i);
  inc(j);
  if j>26 then
DBGOut('人物的名字过长',[]);
  Until (buf[i]=Flag1) And (buf[i+1]=Flag2);//遇到 => 跳出
  PlayerName[j]:=#0;
  //DBGOut(PlayerName,[]);
  DisPriChatPack:=PlayerName;
end;
//-----------------------------------------------------------
procedure SetMName(buf:PChar);
var
Len:Integer;
RStr:string;
begin
Len:=0;
while Len<20 do
  begin
  if buf[Len]=#$2f then
    begin
    buf[Len]:=#0;
    exit;
    end
  else
    begin
    Rstr:=Rstr+buf[Len];
    end;
  Inc(Len);
  end;
buf[Len]:=#0;
end;

function IsMst(Kind:word):Boolean;
//甲虫稻草人$12,土狼$11,鹿鸡$0B,蟒$0A,食人花$0D,熊$0C
begin
case Kind of
  10,11,12,13,17,18:
    IsMst:=true;
  else
    IsMst:=false;
  end;
end;

procedure PressKey(KeyCode:byte;HW:HWND);
begin
PostMessage(HW,WM_KEYDOWN,WPARAM(KeyCode),0);
end;
//-----------------------------------------------------------
end.
💿 文件大小 174 K
👤 上传用户 Numb_pqc
📂 所属分类 Delphi控件源码
🏷️ 相关标签

#PASCAL #网络游戏 #源码 #脱机
⌨️ 快捷键说明

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