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?