找传奇、传世资源到传世资源站!

packethack抓包程序

8.5玩家评分(1人评分)
下载后可评
介绍 评论 失效链接反馈

【例子介绍】PacketHack1.1使用说明书 

PacketHack1.1使用说明书

1.选择目标进程

当弹出Processlist,选择你要的进程双击,将返回到主界面,并开始截取数据,如果注入成功,开始按钮将不可用,暂停和停止按钮可用

2.将要发送的数据包加入Sent列表:
双击Packet列表中的数据包(或者右键菜单),将弹出Add to sent窗口,取个名字,还有要发送这个包前的延时,第一个要发送的包就写0(单位:ms)
3.编辑Sent列表

你可以删除有焦点的数据,使用上下移修改发包顺序,将要发送的包打上钩,右键可以全部打钩和取消全部打钩,双击可以修改数据

4.发送数据
点击发送按钮,将开始发送,到此整个过程已经ok了,此程序附带源代码,为了方便大家制定自己的需求

注:要是大家要跟踪调试,需要DebugView

【相关图片】packethack抓包程序 Delphi数据库编程-第1张

【源码结构】

{*******************************************************}
{       版权所有 (C) 2008 Dstorm                        }
{                                                       }
{ 工程名称:  PacketHack                                 }
{ 单元名称:                                             }
{                                                       }
{ 功能概要说明:                                         }
{    Core.dll demo                                      }
{                                                       }
{*******************************************************}

//---------------------------------------
//operate with lv2 ,must careful
//importent for Delete
//---------------------------------------

unit UntMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ToolWin, ImgList, StdCtrls, ExtCtrls, UntProcList,
  UPublic, UntSent;

const
  SELFCAPTION = 'PacketHack';
  WChar: set of char = [#0];

type

  TForm1 = class(TForm)
    tlb: TToolBar;
    btn1: TToolButton;
    btn2: TToolButton;
    btn3: TToolButton;
    il: TImageList;
    pnl1: TPanel;
    pnl2: TPanel;
    lbl1: TLabel;
    lbl2: TLabel;
    lbl3: TLabel;
    btn5: TToolButton;
    Label1: TLabel;
    Label2: TLabel;
    lv1: TListView;
    spl1: TSplitter;
    pnl3: TPanel;
    tlb1: TToolBar;
    btn7: TToolButton;
    btn8: TToolButton;
    btn11: TToolButton;
    btn10: TToolButton;
    lbl4: TLabel;
    btn12: TToolButton;
    btn13: TToolButton;
    lv2: TListView;
    Panel1: TPanel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    btn4: TToolButton;
    btn15: TToolButton;
    pm1: TPopupMenu;
    Clear1: TMenuItem;
    AddtoSend1: TMenuItem;
    pm2: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    Clear2: TMenuItem;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    stat1: TStatusBar;
    AddalltoSent1: TMenuItem;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn15Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lv1DblClick(Sender: TObject);
    procedure lv1Deletion(Sender: TObject; Item: TListItem);
    procedure btn10Click(Sender: TObject);
    procedure lv2SelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure lv2Deletion(Sender: TObject; Item: TListItem);
    procedure btn8Click(Sender: TObject);
    procedure btn7Click(Sender: TObject);
    procedure pm1Popup(Sender: TObject);
    procedure AddtoSend1Click(Sender: TObject);
    procedure Clear1Click(Sender: TObject);
    procedure lv2DblClick(Sender: TObject);
    procedure btn12Click(Sender: TObject);
    procedure btn13Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure pm2Popup(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure lv2InfoTip(Sender: TObject; Item: TListItem;
      var InfoTip: String);
    procedure lv1InfoTip(Sender: TObject; Item: TListItem;
      var InfoTip: String);
    procedure Clear2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure stat1DblClick(Sender: TObject);
    procedure stat1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
      const Rect: TRect);
    procedure AddalltoSent1Click(Sender: TObject);
    procedure stat1Click(Sender: TObject);
  private
    { Private declarations }
    ModuleHandle: THandle;
    FPause: Boolean;
    FStart: Boolean;
    FSendCount: Integer;
    FSendtoCount: integer;
    FWSASendCount: Integer;
    FWSASendtoCount: integer;
    FBitmap, FbitTop: TBitmap;

    FSentThread: TSentThread;
    FMStart: boolean;
    FMSentError: Integer;
    FMSentCount: Integer;
    procedure StopHackProc;
    procedure StartHackProc(ExeName, Helpstr: PChar);
    function  StopHack: Boolean;
    procedure PuaseHackProc;
    procedure RestartHackProc;
    procedure AddHackData(idx: Integer);

    procedure StartSendProc;
    procedure StopSendProc;

    procedure OnCMTDATA(var message: TMessage); message WM_CMTDATA;
    procedure OnDESTGONE(var message: TMessage); message WM_DESTGONE;
    procedure OnSentError(var message: TMessage); message WM_SENTERROR;
    procedure OnUpdateSent(var message: TMessage); message WM_UPDATESENT; 

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses UntSetSent, UntOption;

{$R *.dfm}

function TForm1.StopHack: Boolean;
begin
  Result := False;
  if Application.MessageBox('你要停止当前过程吗?', '警告',
                            MB_YESNO MB_ICONWARNING) = IDYES then
  begin
    if FMStart then
    begin
      StopSendProc();
    end;
    btn7.Enabled := False; //???  

    StopHackProc();
    Result := true;
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  if Form2.ShowModal = mrok then
  begin
    if ((FPause or FStart) and StopHack)
          or (not FPause) or (not FStart)then
    begin
      StartHackProc(PChar(Form2.ProcessName), PChar(form2.HelpStr));
    end;
  end;
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  RestartHackProc()
end;

procedure TForm1.StartHackProc(ExeName, Helpstr: PChar);
begin
  if InstallCore(Self.Handle, ExeName, Helpstr) then
  begin
    btn2.Enabled := False;
    btn3.Enabled := True;
    btn15.Enabled := True;

    FSendCount := 0;
    FSendtoCount := 0;
    FWSASendCount := 0;
    FWSASendtoCount := 0;
    
    FStart := True;
    Self.Caption := SELFCAPTION '[' ExeName ']';
  end;
end;

procedure TForm1.StopHackProc;
begin
  Self.Enabled := False;

  UnInstallCore();

  FStart := False;
  FPause := False;

  btn2.Enabled := False;
  btn3.Enabled := False;
  btn15.Enabled := False;

  lbl3.Caption := '0';
  Label2.Caption := '0';

  Self.Caption := SELFCAPTION '[???]';

  lv1.Clear;
  lv2.Clear;
    
  Self.Enabled := True;
end;

procedure TForm1.PuaseHackProc;
var
  CMTDATA: TCMTDATA;
begin
  CMTDATA.ftt := FtNone;
  CMTDATA.Pause := True;
  SetCoreData(@CMTDATA);

  btn3.Enabled := False;
  btn2.Enabled := True;
  btn15.Enabled := True;

  FPause := True;
  FStart := False;
end;

procedure TForm1.RestartHackProc;
var
  CMTDATA: TCMTDATA;
begin
  CMTDATA.ftt := FtNone;
  CMTDATA.Pause := False;
  SetCoreData(@CMTDATA);
  
  btn2.Enabled := False;
  btn3.Enabled := True;
  btn15.Enabled := True;

  FPause := False;
  FStart := true;
end;

procedure TForm1.btn3Click(Sender: TObject);
begin
  PuaseHackProc();
end;

procedure TForm1.btn15Click(Sender: TObject);
begin
  StopHack();
end;

procedure TForm1.OnCMTDATA(var message: TMessage);
var
  pData: PCMTDATA;
  itm: TListItem;
  tempstr: string;
begin
//  if not FStart then Exit;  //?? 
  
  New(pData);
  GetCoreData(pData);

  itm := lv1.Items.Add;
  tempstr := pData^.srcIp ':'   IntToStr(pData^.srcPort);
  itm.SubItems.Add(tempstr);
  
  tempstr := pData^.DestIp ':' IntToStr(pData^.DestPort);
  itm.SubItems.Add(tempstr);

  if pData^.ftt = ftSend then
  begin
    itm.SubItems.Add(IntToStr(pData.Len));
    itm.SubItems.Add('Send:' pData^.Buf);
    inc(FSendCount);
    lbl3.Caption := IntToStr(FSendCount);    
  end else
  if pData^.ftt = ftSendto Then
  begin
    itm.SubItems.Add(IntToStr(pData.Len));
    itm.SubItems.Add('Sendto:' pData^.Buf);
    inc(FSendtoCount);
    Label2.Caption := IntToStr(FSendtoCount);
  end else
  if pData^.ftt = ftWSASend Then
  begin
    itm.SubItems.Add(IntToStr(pData^.lpBuffers.len));
    itm.SubItems.Add('WSASend:' pData^.lpBuffers.buf);
    inc(FWSASendCount);
    Label5.Caption := IntToStr(FWSASendCount);
  end else
  if pData^.ftt = ftWSASendto Then
  begin
    itm.SubItems.Add(IntToStr(pData^.lpBuffers.len));
    itm.SubItems.Add('WSASendto:' pData^.lpBuffers.buf);
    inc(FWSASendtoCount);
    Label2.Caption := IntToStr(FWSASendtoCount);
  end;

  itm.Data := pData;
  itm.Caption := IntToStr(FSendCount FSendtoCount FWSASendCount FWSASendtoCount);
  
  lv1.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
end;

procedure TForm1.OnDESTGONE(var message: TMessage);
begin
  //FStart := False;  //??  
  if FMStart then
  begin
    StopSendProc(); //停止发送
  end;
  btn7.Enabled := False; //??

  if FStart or FPause then
    StopHackProc();   //目标进程Over了
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FBitmap := TBitmap.Create;
  il.GetBitmap(9, FBitmap);

  FbitTop := TBitmap.Create;
  il.GetBitmap(10, FbitTop);

  ModuleHandle := 0;
  ModuleHandle := LoadLibrary('Core.dll');
  if ModuleHandle = 0 then
  begin
    Application.MessageBox('加载Core.dll失败!', '错误', MB_OK MB_ICONWARNING);
    Exit;
  end;

  @UnInstallCore := GetProcAddress(ModuleHandle, 'UnInstallCore');
  @InstallCore := GetProcAddress(ModuleHandle, 'InstallCore');
  @SetCoreData := GetProcAddress(ModuleHandle, 'SetCoreData');
  @GetCoreExist := GetProcAddress(ModuleHandle, 'GetCoreExist');
  @GetCoreData := GetProcAddress(ModuleHandle, 'GetCoreData');
  
  btn1.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if ModuleHandle >0 then
  begin
    //UnInstallCore();
    FreeLibrary(ModuleHandle);
  end;

  FreeAndNil(FBitmap);
  FreeAndNil(FBitTop);
end;

procedure TForm1.lv1DblClick(Sender: TObject);
var
  itm: TListItem;
begin
  if lv1.Selected <> nil then
  begin
    AddHackData(lv1.Selected.Index);
  end;
end;

procedure TForm1.AddHackData(idx: Integer);
var
  i: Integer;
  pData, pDatat: PCMTDATA;
  itm: TListItem;
begin
  for i := 0 to lv2.Items.Count - 1 do
  begin
    if lv1.Items[idx].Caption =
        lv2.Items[i].SubItems[0] then
      Exit;
  end;
  
  Form3.Name := 'New Name';
  Form3.dt := '500';
  if Form3.ShowModal = mrok then
  begin
    if lv2.Items.Count = 0 then
    begin
      btn7.Enabled := True;
    end;    

    pData := PCMTDATA(lv1.Items[idx].Data);
    if pData <> nil then
    begin
      New(pdatat);
      CopyMemory(pdatat, pData, SizeOf(TCMTDATA));
    
      itm := Lv2.Items.Add;
      itm.Caption := Form3.Name;
      itm.SubItems.Add(lv1.Items[idx].Caption);
      itm.SubItems.Add(Form3.dt);
      itm.SubItems.Add(pData^.Buf);
      itm.Data := pdatat;
    end;

  end;
end;

procedure TForm1.lv1Deletion(Sender: TObject; Item: TListItem);
begin
  if Item.Data <> nil then
  begin
    Dispose(PCMTDATA(Item.Data));
    Item.Data := nil;
  end;
end;

procedure TForm1.OnSentError(var message: TMessage);
begin
  //if not FMStart then Exit;     //if Is PostMessge
  
  Inc(FMSentError);
  Label11.Caption := IntToStr(FMSentError);
end;

procedure Delay(MSecs: Longint);
var
  FirstTickCount, Now: Longint;
begin
  FirstTickCount := GetTickCount();
  repeat
    Application.ProcessMessages;
    Now := GetTickCount();
  until (Now - FirstTickCount >= MSecs) or (Now < FirstTickCount);
end;

procedure TForm1.StartSendProc;
begin
  if not Assigned(FSentThread) then
  begin
    FSentThread := TSentThread.Create;
    FSentThread.lv := lv2;
    FSentThread.PH := Self.Handle;
    FSentThread.Resume;
  end;

  FMStart := True;
  btn7.Enabled := False;
  btn10.Enabled := False;
  btn12.Enabled := False;
  btn13.Enabled := False;
  btn8.Enabled := True;
  lv2.Enabled := False;

  FMSentError := 0;
  FMSentCount := 0;
end;

procedure TForm1.StopSendProc;
begin
  Self.Enabled := False;

  if Assigned(FSentThread) then
  begin
    FSentThread.MStop := True; //haha, myff
    FSentThread.Terminate;
    FSentThread.WaitFor;
    FreeAndNil(FSentThread);
  end;

  FMStart := False;
  FMStart := False;
  
  Label9.Caption := '0';
  Label11.Caption := '0';

  btn7.Enabled := True;
  btn8.Enabled := False;
  lv2.Enabled := True;

  if lv2.Selected <> nil then
  begin
    btn10.Enabled := True;
    btn12.Enabled := True;
    btn13.Enabled := True;
  end;

  Self.Enabled := True;
end;

procedure TForm1.btn10Click(Sender: TObject);
begin
  if lv2.Selected <> nil then
  begin
    lv2.Selected.Delete;
    btn10.Enabled := False;
    btn12.Enabled := False;
    btn13.Enabled := False;

    if lv2.Items.Count <= 0 then
      btn7.Enabled := False;   
  end;
end;

procedure TForm1.lv2SelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
begin
  if not FMStart then
  begin
    if Selected then
    begin
      btn10.Enabled := True;
      btn12.Enabled := True;
      btn13.Enabled := True;
    end else
    begin
      btn10.Enabled := False;
      btn12.Enabled := False;
      btn13.Enabled := False;
    end;
  end;
end;

procedure TForm1.lv2Deletion(Sender: TObject; Item: TListItem);
begin
  if Item.Data <> nil then
  begin
    Dispose(PCMTDATA(Item.Data));
    Item.Data := nil;
  end;
end;

procedure TForm1.btn8Click(Sender: TObject);
begin
  StopSendProc();
end;

procedure TForm1.btn7Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to lv2.Items.Count -  1 do
  begin
    if lv2.Items[i].Checked then
    begin
      StartSendProc();
      break;
    end;
  end;
end;

procedure TForm1.pm1Popup(Sender: TObject);
begin
  if lv1.Selected <> nil then
  begin
    AddtoSend1.Enabled := True;
  end else
    AddtoSend1.Enabled := False;

  if lv1.Items.Count >0 then
  begin
    if FPause then
      AddalltoSent1.Enabled  := True
    else
      AddalltoSent1.Enabled  := false;
    Clear1.Enabled := True;
  end else
  begin
    AddalltoSent1.Enabled  := false;
    Clear1.Enabled := False;
  end;
end;

procedure TForm1.AddtoSend1Click(Sender: TObject);
begin
  AddHackData(lv1.Selected.Index);
end;

procedure TForm1.Clear1Click(Sender: TObject);
begin
  if lv1.Items.Count > 0 then
    lv1.Clear;

{  FSendCount := 0;
  FSendtoCount := 0;

  lbl3.Caption := '0';
  Label2.Caption := '0';
}
end;

procedure TForm1.lv2DblClick(Sender: TObject);
begin
  if (not FMStart) and (lv2.Selected <> nil) then
  begin
    Form3.Name := lv2.Selected.Caption;
    Form3.dt := lv2.Selected.SubItems[1];
    if Form3.ShowModal = mrok then
    begin
      lv2.Selected.Caption := Form3.Name;
      lv2.Selected.SubItems[1] := Form3.dt;
    end;
  end;
end;

procedure TForm1.btn12Click(Sender: TObject);
var
  pData: PCMTDATA;
  DestItem, SelItem: TListItem;
begin
  //lv2.Items.BeginUpdate;
  SelItem := lv2.Selected;

  if  SelItem.Index > 0 then
  begin
    New(pData);
    CopyMemory(pData, SelItem.Data, SizeOf(TCMTDATA));

    DestItem := lv2.Items.Insert(SelItem.Index - 1);
    DestItem.Assign(SelItem);
    DestItem.Data :=  pData;
    lv2.Selected := DestItem;
    SelItem.Delete;
  end;
  //lv2.Items.EndUpdate;
end;

procedure TForm1.btn13Click(Sender: TObject);
var
  pData: PCMTDATA;
  DestItem, SelItem: TListItem;
begin
  //lv2.Items.BeginUpdate;
  SelItem := lv2.Selected;

  if SelItem.Index < lv2.Items.Count - 1 then
  begin
    New(pData);
    CopyMemory(pData, SelItem.Data, SizeOf(TCMTDATA));

    DestItem := lv2.Items.Insert(SelItem.Index 2);
    DestItem.Assign(SelItem);
    DestItem.Data :=  pData;
    lv2.Selected := DestItem;
    SelItem.Delete;
  end;
end;

procedure TForm1.N1Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to lv2.Items.Count -  1 do
  begin
    lv2.Items[i].Checked := True;
  end;
end;

procedure TForm1.pm2Popup(Sender: TObject);
begin
  if {(not FMStart) and }(lv2.Items.Count > 0) then
  begin
    n1.Enabled := True;
    n2.Enabled := True;
    Clear2.Enabled := True
  end else
  begin
    n1.Enabled := False;
    n2.Enabled := False;
    Clear2.Enabled := False;
  end;
end;

procedure TForm1.N2Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to lv2.Items.Count -  1 do
  begin
    lv2.Items[i].Checked := False;
  end;

end;

procedure TForm1.lv2InfoTip(Sender: TObject; Item: TListItem;
  var InfoTip: String);
var
  i: Integer;
  tempStr: string;
begin
  InfoTip := '';
  for I := 0 to PCMTDATA(Item.Data).Len - 1 do
  begin
    if PCMTDATA(Item.Data)^.Buf[i] in WChar then
    begin
      InfoTip := InfoTip '.';
    end else
      InfoTip := InfoTip PCMTDATA(Item.Data)^.Buf[i];
  end;

end;

procedure TForm1.lv1InfoTip(Sender: TObject; Item: TListItem;
  var InfoTip: String);
var
  i: Integer;
  tempStr: string;
begin
  InfoTip := '';
  for I := 0 to PCMTDATA(Item.Data).Len - 1 do
  begin
    if PCMTDATA(Item.Data)^.Buf[i] in WChar then
    begin
      InfoTip := InfoTip '.';
    end else
      InfoTip := InfoTip PCMTDATA(Item.Data)^.Buf[i];
  end;
end;

procedure TForm1.Clear2Click(Sender: TObject);
begin
  if not FMStart then
  begin
    if lv2.Items.Count > 0 then
      lv2.Clear;

    btn7.Enabled := False;
    btn8.Enabled := false;
    btn10.Enabled := false;
    btn12.Enabled := False;
    btn13.Enabled := False;
  end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if FMStart then
  begin
    StopSendProc(); //停止发送
  end;
  if FStart or FPause then
  begin
    StopHackProc();   //目标进程Over了
  end;
end;

procedure TForm1.OnUpdateSent(var message: TMessage);
begin
  //if  not FMStart then Exit; // if not SendMessage;
  Inc(FMSentCount);
  Label9.Caption := IntToStr(FMSentCount);
end;

procedure TForm1.stat1DblClick(Sender: TObject);
var
  rt : TRect;
  pt: TPoint;
begin
  GetCursorPos(pt);
  pt := ScreenToClient(pt);
  rt := Classes.Rect(stat1.Panels[0].Width, stat1.Top 2,
        stat1.Panels[0].Width 16, stat1.Top 2 16);

  if PtInRect(rt, pt) then
  begin
    if Form4.ShowModal = mrok then
    begin
      //SetCoreData();//Do not Used;Just Demo
    end;
  end;
end;

procedure TForm1.stat1Click(Sender: TObject);
var
  rt : TRect;
  pt: TPoint;
begin
  GetCursorPos(pt);
  pt := ScreenToClient(pt);
  rt := Classes.Rect(stat1.Panels[0].Width stat1.Panels[1].Width, stat1.Top 2,
        stat1.Panels[0].Width stat1.Panels[1].Width 16, stat1.Top 2 16);

  if PtInRect(rt, pt) then
  begin
    if Self.FormStyle = fsStayOnTop then
    begin
      self.FormStyle := fsNormal;
    end else
      self.FormStyle := fsStayOnTop;
  end;
end;

procedure TForm1.stat1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
  const Rect: TRect);
var
  rt, rt2: TRect;
begin
  if Panel.Index = 1 then
  begin
    rt := Rect;
    rt.Right := rt.Left 16;;
    rt.Bottom := rt.Top 16;
    rt2 := Classes.Rect(0, 0, 16, 16);
    StatusBar.Canvas.BrushCopy(rt, FBitmap, rt2, clWhite);
    StatusBar.Canvas.TextOut(rt.Right 5 , rt.Top 1, 'Option');
  end;
  if Panel.Index = 2 then
  begin
    rt := Rect;
    rt.Right := rt.Left 16;;
    rt.Bottom := rt.Top 16;
    rt2 := Classes.Rect(0, 0, 16, 16);
    StatusBar.Canvas.BrushCopy(rt, FbitTop, rt2, clWhite);
    StatusBar.Canvas.TextOut(rt.Right 5 , rt.Top 1, 'Set Window Style');
  end;
end;

procedure TForm1.AddalltoSent1Click(Sender: TObject);
var
  i: Integer;
begin
//只对暂停的时候有效
//  if FPause then
//  begin
    for I := 0 to lv1.Items.Count - 1 do
    begin
      AddHackData(i);
    end;
//  end;
end;

end.

评论

发表评论必须先登陆, 您可以 登陆 或者 注册新账号 !


在线咨询: 问题反馈
客服QQ:174666394

有问题请留言,看到后及时答复