Problem z wysyłaniem pakietów

0

Witam.

Mam problem z kodem, który miałby za zadanie wysyłać pakiety wstępnie do gierki bf2.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, tlhelp32, StdCtrls, Vcl.ExtCtrls, IdIPWatch, IdBaseComponent,
  IdComponent, IdIPMCastBase, IdIPMCastClient, Vcl.Samples.Spin;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    SpinEdit1: TSpinEdit;
    procedure Timer1Timer(Sender: TObject);
  private
	{ Private declarations }
  public
	{ Public declarations }
  end;

var
  Form1: TForm1;

  PidHandle: integer;
  PidID : integer;
  byteArr : Array of byte;

  Written: Size_T;
  ProcessID :Int64;
  Proc_ID: Int64;
  IDProcess : Int64;

Const
  ProgramName = 'BF2.exe';

implementation

{$R *.dfm}



//Write an Array of bytes to memory
procedure SendPacket(Address: Int64; Data: Array of Byte);
var
ProcID:Integer;
Thandle:HWND;
begin
THandle := OpenProcess(PROCESS_ALL_ACCESS, False, ProcID);
GetWindowThreadProcessId(FindWindow('Battlefield2',Nil), @ProcessID);
WriteProcessMemory(THandle, Ptr(Address), @Data, SizeOf(Data), Written);
end;



procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;

  begin
  If GetWindowThreadProcessId(FindWindow('Battlefield2',Nil), @ProcessID) = 0
  then

  begin
  timer1.enabled := false;
  MessageDlg('Start BF2 First.', mtwarning, [mbOK],0);

  end
  else
  begin


	SetLength(byteArr, 4);
	byteArr[0] := $00;
	byteArr[1] := $00;
	byteArr[2] := $00;
	byteArr[3] := $00;
  SendPacket(PIDHandle, byteArr);




  SpinEdit1.Value := SpinEdit1.Value+1;

  if SpinEdit1.Value = 255 then
  begin
  timer1.Enabled := false;
  showmessage('255 packets should be sent');
  end;
 end;

 closehandle(PidHandle);
 end;



end.

Kod znajduje mi gierkę i jej okno, niby wysyła pakiety, ale one do gry nie dochodzą. Sprawdzałem pakiety za pomocą programu WPE PRO i niestety ten program to potwierdza :/

Czy ktoś wie w czym jest problem?

0

Na sam początek: gdzie ustawiasz wartość zmiennej PIDHandle?

1

Tak na oko na początek:

procedure SendPacket(Address: Int64; Data: array of Byte);
var
  ProcID: Integer;
  hProc: THandle;
  NumBytesWritten: SIZE_T;
begin
  GetWindowThreadProcessId(FindWindow('Battlefield2', nil), @ProcID);//zdobądz ID procesu (mam nadzieje że nazwa klasy okna gry to Battlefield2)
  hProc:= OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_WRITE, False, ProcID); //PROCESS_VM_OPERATION, PROCESS_VM_WRITE dla WriteProcessMemory (ew. dla VirtualProtectEx)
  WriteProcessMemory(hProc, Ptr(Address), @Data, SizeOf(Data), NumBytesWritten); //zapisz do pamieci procesu (jak nie dzila to wczesniej wywolaj VirtualProtectEx)
  CloseHandle(hProc); //zamknij uchwyt
end;

Programowanie metodą "kopiuj / wklej" zazwyczaj nie działa.

0
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, tlhelp32, StdCtrls, Vcl.ExtCtrls, IdIPWatch, IdBaseComponent,
  IdComponent, IdIPMCastBase, IdIPMCastClient, Vcl.Samples.Spin;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Button1: TButton;
    SpinEdit1: TSpinEdit;
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
	{ Private declarations }
  public
	{ Public declarations }
  end;

var
  Form1: TForm1;

  PidHandle: integer;
  byteArr : Array of byte;


  Written: Size_T;
  ProcessID :Integer;
  IDProcess : Cardinal;
  ProcID: Integer;
  HProc:Thandle;


Const
  ProgramName = Testowy.exe';

implementation

{$R *.dfm}



//Write an Array of bytes to memory
procedure SendPacket(Address: Int64; Data: Array of Byte);
var
  NumBytesWritten: SIZE_T;
begin
  GetWindowThreadProcessId(FindWindow('Testowy', nil), @ProcID);//zdobądz ID procesu (mam nadzieje że nazwa klasy okna gry to Battlefield2)
  hProc:= OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_WRITE, False, ProcID); //PROCESS_VM_OPERATION, PROCESS_VM_WRITE dla WriteProcessMemory (ew. dla VirtualProtectEx)
  WriteProcessMemory(hProc, Ptr(Address), @Data, SizeOf(Data), NumBytesWritten); //zapisz do pamieci procesu (jak nie dzila to wczesniej wywolaj VirtualProtectEx)
  CloseHandle(hProc); //zamknij uchwyt
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
spinedit1.Value := 0;
timer1.Enabled:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
i:integer;
  begin
  If GetWindowThreadProcessId(FindWindow('Testowy',Nil), @ProcessID) = 0
  then

  begin
  timer1.enabled := false;
  MessageDlg('Start BF2 First.', mtwarning, [mbOK],0);

  end
  else
  begin


	SetLength(byteArr, 4);
	byteArr[0] := $00;
	byteArr[1] := $01;
	byteArr[2] := $02;
	byteArr[3] := $03;
  SendPacket(hProc, byteArr);




  SpinEdit1.Value := SpinEdit1.Value+1;

  if SpinEdit1.Value = 255 then
  begin
  timer1.Enabled := false;
  showmessage('255 packets should be sent');
  end;
 end;

 closehandle(hProc);
 end;



end.

Nadal nie działą :/

2

Przekopiowałeś ten kod z internetu bez zrozumienia sposobu jego działania, prawda?

SendPacket(hProc, byteArr); // <- ten hProc jest wewnątrz SendPacket() parametrem `Address`, czyli efektywnie robisz `WriteProcessMemory(hProc, Ptr(hProc), ...)` - w jaki sposób miałoby to działać poprawnie?

1 użytkowników online, w tym zalogowanych: 0, gości: 1