[Помогите!] Кому не лень, помогите нубу!

[Shadrincev]

Приветствую всех!
Заморочился я квестом PQ3. Для копания баллист использовать бота PW Script Bot оказалось очень накладно, кушает очень много ресурсов. А т.к. поддержку Ресокопа временно прекратили, решил сделать что-то самостоятельно.
Что мне потребовалось:
1. Выбор окна пв в Combobox и переименование его под ник персонажа.
2. Начинать выкапывание баллист по нажатию кнопки Старт, пока не будет нажата кнопка стоп.
За основу взял исходники программы Бот для прокачки пета в 4-й комнате (спасибо большое автору за исходники). В результате я сделал 1-й пункт.
Вот код:

unit fMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, IniFiles, ExtCtrls, Mask, ComCtrls, Spin, DB,
DBGrids, DBClient, CheckLst;

const
GamerOffsetsCount = 5;

GamerName = 0;
GamerTargetID = 1;
PetNum = 2;
PetHP = 3;
PetHungry = 4;

ControlPetHungry = 70;
ControlPetHP = 90;

type
TGamerInfo = record
Name: array[0..10] of WideChar;
TargetID: DWORD;
PetNum: DWORD;
PetHP: SINGLE;
PetHungry: DWORD;
end;

TfrmMain = class(TForm)
Label1: TLabel;
obConnectToClient: TButton;
lbConnectStatus: TLabel;
Timer: TTimer;
eClientCaption: TComboBox;
cbAlwaysTop: TCheckBox;
cbRename: TCheckBox;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure obConnectToClientClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure cbAlwaysTopClick(Sender: TObject);
procedure cbRenameClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure SendKey(key: Word; const shift: TShiftState);
{ Private declarations }
public
base_addr: DWORD;
packet_addr: DWORD;
game_addr: DWORD;
gamer_addr: DWORD;
pet_addr: DWORD;
Unfreeze_addr: DWORD;

game_addr_offset: DWORD;
gamer_addr_offset: DWORD;
pet_addr_offset: DWORD;
GamerOffsets: array[0..GamerOffsetsCount - 1] of DWORD;

GamerInfo: TGamerInfo;
PetAttak: Boolean;

hW: THandle;
pidw, pid: DWORD;

unfreeze_flag: Byte;

function ConnectToClient: boolean;
function ConnectedToClient: boolean;
procedure DisconnectFromClient;
procedure GetGamerInfo;
procedure unfreeze;
{ Public declarations }
end;

var
frmMain: TfrmMain;
KlientWindow:HWND;
ProcessId:Integer;
hProcess:Integer;

implementation

uses StrUtils, uMemory;

{$R *.dfm}

function FileVersion(AFileName: string): string;
var
szName: array[0..255] of Char;
P: Pointer;
Value: Pointer;
Len: UINT;
GetTranslationString: string;
FFileName: PChar;
FValid: boolean;
FSize: DWORD;
FHandle: DWORD;
FBuffer: PChar;
begin
try
FFileName := StrPCopy(StrAlloc(Length(AFileName) + 1), AFileName);
FValid := False;
FSize := GetFileVersionInfoSize(FFileName, FHandle);
if FSize > 0 then
try
GetMem(FBuffer, FSize);
FValid := GetFileVersionInfo(FFileName, FHandle, FSize, FBuffer);
except
FValid := False;
raise;
end;
Result := '';
if FValid then
VerQueryValue(FBuffer, '\VarFileInfo\Translation', p, Len)
else
p := nil;
if P <> nil then
GetTranslationString := IntToHex(MakeLong(HiWord(Longint(P^)),
LoWord(Longint(P^))), 8);
if FValid then
begin
StrPCopy(szName, '\StringFileInfo\' + GetTranslationString +
'\FileVersion');
if VerQueryValue(FBuffer, szName, Value, Len) then
Result := StrPas(PChar(Value));
end;
finally
try
if FBuffer <> nil then
FreeMem(FBuffer, FSize);
except
end;
try
StrDispose(FFileName);
except
end;
end;
end;

function NumToKey(Num: Integer): string; // 0..8=1..9, 9..16=F1..F8
begin
if Num < 9 then
Result := IntToStr(Num + 1)
else
Result := 'F' + IntToStr(Num - 8);
end;

procedure TfrmMain.SendKey(key: Word; const shift: TShiftState);
Type
TBuffers = Array [0..1] of TKeyboardState;
Var
pKeyBuffers : ^TBuffers;
lparam: dword;
Begin
(* check if the target window exists *)
If IsWindow(hW) Then Begin
(* set local variables to default values *)
pKeyBuffers := Nil;
lparam := MakeLong(0, MapVirtualKey(key, 0));

(* allocate space for the key state buffers *)
New(pKeyBuffers);
try
(* Fill buffer 1 with current state so we can later restore it.
Null out buffer 0 to get a "no key pressed" state. *)
GetKeyboardState( pKeyBuffers^[1] );
FillChar(pKeyBuffers^[0], Sizeof(TKeyboardState), 0);

(* set the requested modifier keys to "down" state in the buffer *)
If ssShift In shift Then
pKeyBuffers^[0][VK_SHIFT] := $80;
If ssAlt In shift Then Begin
(* Alt needs special treatment since a bit in lparam needs also be set*)
pKeyBuffers^[0][VK_MENU] := $80;
lparam := lparam or $20000000;
End;
If ssCtrl In shift Then
pKeyBuffers^[0][VK_CONTROL] := $80;
If ssLeft In shift Then
pKeyBuffers^[0][VK_LBUTTON] := $80;
If ssRight In shift Then
pKeyBuffers^[0][VK_RBUTTON] := $80;
If ssMiddle In shift Then
pKeyBuffers^[0][VK_MBUTTON] := $80;

(* make out new key state array the active key state map *)
SetKeyboardState( pKeyBuffers^[0] );

(* post the key messages *)
If ssAlt In Shift Then Begin
SendMessage( hW, WM_SYSKEYDOWN, key, longint(lparam));
SendMessage( hW, WM_SYSKEYUP, key, longint(lparam or $C0000000));
End
Else Begin
SendMessage( hW, WM_KEYDOWN, key, longint(lparam));
SendMessage( hW, WM_KEYUP, key, longint(lparam or $C0000000));
End;
(* process the messages *)
Application.ProcessMessages;

(* restore the old key state map *)
SetKeyboardState( pKeyBuffers^[1] );
finally
(* free the memory for the key state buffers *)
If pKeyBuffers <> Nil Then
Dispose( pKeyBuffers );
End; { If }
End;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
ini: TIniFile;

function ReadAddr(Section, Ident: string; Default: DWORD): DWORD;
begin
Result := StrToInt64Def('$' + ini.ReadString(Section, Ident, IntToHex(Default, 8)), Default);
// запись на случай если значение не описано в файле
ini.WriteString(Section, Ident, IntToHex(Result, 8));
end;

begin
Caption := Caption + ' ' + FileVersion(Application.ExeName);

unfreeze_flag := 1;

ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));

base_addr := ReadAddr('Base', 'base_addr', $00B27A04);
packet_addr := ReadAddr('Base', 'packet_addr', $006737B0);
game_addr_offset := ReadAddr('Base', 'game_addr_offset', $0000001C);
gamer_addr_offset := ReadAddr('Base', 'gamer_addr_offset', $00000034);
pet_addr_offset := ReadAddr('Base', 'pet_addr_offset', $00001068);
unfreeze_addr := ReadAddr('Base', 'unfreeze_addr', $00B28534);

GamerOffsets[GamerTargetID] := ReadAddr('Gamer', 'TargetID', $00000B68);
GamerOffsets[GamerName] := ReadAddr('Gamer', 'GamerName', $00000638);
GamerOffsets[PetNum] := ReadAddr('Pet', 'PetNum', $8);
GamerOffsets[PetHP] := ReadAddr('Pet', 'PetHP', $1C);
GamerOffsets[PetHungry] := ReadAddr('Pet', 'PetHungry', $8);

Ini.ReadSection('Perfect World Captions', eClientCaption.Items);

cbAlwaysTop.Checked := ini.ReadBool('Common', 'AlwaysTop', True);
cbRename.Checked := ini.ReadBool('Common', 'Rename', True);

ini.Free;

if cbAlwaysTop.Checked then
FormStyle := fsStayOnTop
else
FormStyle := fsNormal;

PetAttak := False;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
var
i: integer;
Ini: TIniFile;
begin
DisconnectFromClient;

ini := TIniFile.Create(ChangeFileExt(Application.ExeName, '.ini'));

try
for I := 0 to eClientCaption.Items.Count - 1 do
Ini.WriteString('Perfect World Captions', eClientCaption.Items[i], '');
except
end;

ini.WriteBool('Common', 'AlwaysTop', cbAlwaysTop.Checked);
ini.WriteBool('Common', 'Rename', cbRename.Checked);

ini.Free;
end;

function TfrmMain.ConnectToClient: boolean;
var
addr: DWORD;
BytesCountOfRead: DWORD;
begin
try
DisconnectFromClient;
hw := FindWindow(nil, pChar(eClientCaption.text));
pidw := GetWindowThreadProcessId(hw, pid);
hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, pid);
Result := hProcess <> 0;
if result then
begin
ReadProcessMemory(hProcess, ptr(base_addr), @addr, sizeof(addr), BytesCountOfRead);
game_addr := addr + game_addr_offset;
end;
except
Result := False;
end;
end;

procedure TfrmMain.DisconnectFromClient;
begin
if ConnectedToClient then
CloseHandle(hProcess);
hProcess := 0;
end;

function TfrmMain.ConnectedToClient: boolean;
begin
Result := hProcess <> 0;
end;

procedure TfrmMain.obConnectToClientClick(Sender: TObject);
begin
// Устанавливаем связь с клиентом
if not Timer.Enabled then
begin
lbConnectStatus.Color := clRed;
if ConnectToClient then
lbConnectStatus.Caption := 'Связь установлена'
else
lbConnectStatus.Caption := 'Нет связи';
lbConnectStatus.Update;
Sleep(500);
lbConnectStatus.Color := clBtnFace;
lbConnectStatus.Update;
if ConnectedToClient then
begin
if eClientCaption.Items.IndexOf(eClientCaption.Text) < 0 then
eClientCaption.Items.Add(eClientCaption.Text);
GetGamerInfo;
if cbRename.Checked then
cbRenameClick(cbRename);
obConnectToClient.Caption := 'Разорвать';
Timer.Enabled := True;
end;
end
else
begin
Timer.Enabled := False;
DisconnectFromClient;
obConnectToClient.Caption := 'Связаться';
end;
end;

procedure TfrmMain.GetGamerInfo;
var
BytesCountOfRead: DWORD;
addr, pet: DWORD;
i: integer;
ch: WideChar;
st: string;
begin
ZeroMemory(@GamerInfo, SizeOf(GamerInfo));
if ConnectedToClient then
begin
try
ReadProcessMemory(hProcess, ptr(game_addr), @addr, sizeof(addr), BytesCountOfRead);
ReadProcessMemory(hProcess, ptr(addr + gamer_addr_offset), @gamer_addr, sizeof(gamer_addr), BytesCountOfRead);
ReadProcessMemory(hProcess, ptr(gamer_addr + pet_addr_offset), @pet_addr, sizeof(pet_addr), BytesCountOfRead);

ReadProcessMemory(hProcess, ptr(gamer_addr + GamerOffsets[GamerTargetID]), @GamerInfo.TargetID, sizeof(GamerInfo.TargetID), BytesCountOfRead);
ReadProcessMemory(hProcess, ptr(gamer_addr + GamerOffsets[GamerName]), @addr, sizeof(addr), BytesCountOfRead);
ReadProcessMemory(hProcess, ptr(pet_addr + GamerOffsets[PetNum]), @GamerInfo.PetNum, sizeof(GamerInfo.PetNum), BytesCountOfRead);
if GamerInfo.PetNum <> $FFFFFFFF then
begin
ReadProcessMemory(hProcess, ptr(pet_addr + GamerInfo.PetNum * 4 + $10), @Pet, sizeof(Pet), BytesCountOfRead);
ReadProcessMemory(hProcess, ptr(pet + GamerOffsets[PetHP]), @GamerInfo.PetHP, sizeof(GamerInfo.PetHP), BytesCountOfRead);
ReadProcessMemory(hProcess, ptr(pet + GamerOffsets[PetHungry]), @GamerInfo.PetHungry, sizeof(GamerInfo.PetHungry), BytesCountOfRead);
end
else
begin
GamerInfo.PetHP := 100;
GamerInfo.PetHungry := $FFFFFFFF;
end;

except
end;

GamerInfo.Name[0] := #0;
i := 0;
try
repeat
ReadProcessMemory(hProcess, ptr(addr), @ch, 2, BytesCountOfRead);
GamerInfo.Name[i] := ch;
addr := addr + 2;
inc(i);
until (ord(ch) = 0) or (i >= 10);
except
end;
if i <= 1 then
begin
St := IntToStr(Random(MaxInt));
StringToWideChar(St, GamerInfo.Name, 11);
end
else
GamerInfo.Name[i] := #0;
end;
end;

procedure TfrmMain.TimerTimer(Sender: TObject);
var
KeyCode: WORD;
begin
if ConnectedToClient then
begin
//читаем информацию об игроке
GetGamerInfo;
if (GamerInfo.PetNum <> $FFFFFFFF) then
begin
end;
end;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
begin
KlientWindow := FindWindow(nil, PChar('Perfect World')); //Находим Handle окна
GetWindowThreadProcessId(KlientWindow,@ProcessId); //Получаем Ид.П.
hProcess := OpenProcess(PROCESS_ALL_ACCESS,False,ProcessId); //Открываем процесс с полным доступом
Timer.Enabled := True;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
begin
Timer.Enabled := False;
end;

procedure TfrmMain.cbAlwaysTopClick(Sender: TObject);
begin
if cbAlwaysTop.Checked then
FormStyle := fsStayOnTop
else
FormStyle := fsNormal;
end;

procedure TfrmMain.cbRenameClick(Sender: TObject);
var
St: string;
begin
if cbRename.Checked and ConnectedToClient then
begin
St := WideCharToString(GamerInfo.Name);
SetWindowText(hW, PChar(St));
eClientCaption.Text := St;
if eClientCaption.Items.IndexOf(eClientCaption.Text) < 0 then
eClientCaption.Items.Add(eClientCaption.Text);
end;
end;

procedure TfrmMain.unfreeze;
var
BytesCountOfWrite: DWORD;
begin
unfreeze_flag := 1;
WriteProcessMemory(hProcess, ptr(unfreeze_addr), @unfreeze_flag, 1, BytesCountOfWrite); // unfreeze
// SetForegroundWindow(hw);
end;

end.

Но как реализовать 2-й пункт я не нашел примеров. Если кого-то не затруднит, подскажите, где искать или напишите пример с использованиям таймера или еще как. Использую Embarcadero RAD Studio XE.

[Sirioga]

Посмотри прекрасную тему от Dinmaite.

[VeTaL_UA]

Цитата: Сообщение от Shadrincev 1-й пункт.

Что-то ты весь код кинул
Вот мой вариант:
Глобальные переменные:

var
  FID: array[0..10] of THandle;

Вспомогательные функции:
ReadPlayerName

function ReadPlayerName(hProcess,data:DWord): string;
var
i,rw:DWord;
ch:WideChar;
wch:array[0..255] of WideChar;
str:string;
begin
i:=0;
 repeat
 ReadProcessMemory(hProcess,ptr(data),@ch,2,rw);
 data:=data+2;
 wch[i]:=ch;
 inc(i);
 until
 (ord(ch)=0) or (i>=255);
i:=0;
str:='';
 repeat
 str:=str+wch[i];
 inc(i);
 until
 wch[i]='';
result:=str;
end;

Загрузка всех запущенных окон в ComboBox с переименованием их по нику персонажа:
Код

procedure TForm1.FormCreate(Sender: TObject);
var
Wnd:THandle;
Nick,Res:String;
Hndl:array[0..255] of Char;
buf,ibuf,BC:DWord;
hProcess,PID,PID1:DWord;
i:Integer;
const
BA=$00B27A04;
begin
Wnd:=FindWindow('ElementClient Window',nil);
GetWindowThreadProcessId(Wnd,@PID);
hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,PID);
i:=0;
 while (hProcess<>0) and (PID<>PID1) do
  begin
  GetWindowText(Wnd,Hndl,SizeOf(Hndl));
  ReadProcessMemory(hProcess,ptr(BA),@ibuf,sizeof(ibuf),BC);
  ReadProcessMemory(hProcess,ptr(ibuf+$1C),@ibuf,sizeof(ibuf),BC);
  ReadProcessMemory(hProcess,ptr(ibuf+$34),@ibuf,sizeof(ibuf),BC);
  ReadProcessMemory(hProcess,ptr(ibuf+$638),@buf,sizeof(buf),BC);
  Nick:=ReadPlayerName(hProcess,buf);
  Res:='Handle: '+Hndl+' '+'Nickname: '+Nick;
  SetWindowText(Wnd,PChar(Nick));
  ComboBox1.Items.Add(Res);
  FID[i]:=Wnd;
  PID:=PID1;
  inc(i);
  end;
CloseHandle(hProcess);
end;

Работать с окном, которое выбрано в ComboBox'е довольно просто, так как индекс ComboBox'а совпадает с индексом массива

Цитата: Сообщение от Shadrincev 2. Начинать выкапывание баллист по нажатию кнопки Старт, пока не будет нажата кнопка стоп.

Сделать инжект на копание, следуя этой теме.
Дальше сделать вечный цикл:

while not Terminated do

В отдельном потоке.

[Shadrincev]

По вашему примеру получает вот так в отображении ComboBox:
Handle: Perfect World Nickname: 123
Хотя окно игры переименовывается.
Буду дальше читать.
Точно также получается и когда я первый раз взял за основу ваш код, поэтому взял исходник указанный выше.

[VeTaL_UA]

Shadrincev, какая у тебя версия делфи?

[Shadrincev]

Цитата: Сообщение от VeTaL_UA Shadrincev, какая у тебя версия делфи?

стоят Delphi 7 и Embarcadero RAD Studio XE. И там, и там также.
Может из-за того, что код в цитате?

[VeTaL_UA]

Цитата: Сообщение от Shadrincev стоят Delphi 7 и Embarcadero RAD Studio XE. И там, и там также.

Компилятор - Delphi 7.
Исходник - [Ссылки могут видеть только зарегистрированные пользователи. ] .
Результат - [Ссылки могут видеть только зарегистрированные пользователи. ] .
Ещё вопросы?

[Shadrincev]

Цитата: Сообщение от VeTaL_UA Компилятор - Delphi 7. Исходник - [Ссылки могут видеть только зарегистрированные пользователи. ] . Результат - [Ссылки могут видеть только зарегистрированные пользователи. ] . Ещё вопросы?

Взял с исходника: Handle: 123 Nickname: 123
Тогда возникает вопрос, как скрыть отображение Handle: и Nickname:, а отображать только допустим ник 123.
Да и при повторном обращении к ComboBox или в вашем примере кнопке, выводимые Handle: 123 Nickname ввыводимом списке удваиваются, при еще одном обращении утраиваются и т.д. Хотя окно игры открыто одно.

[VeTaL_UA(1)]

Цитата: Сообщение от Shadrincev Тогда возникает вопрос, как скрыть отображение Handle: и Nickname:, а отображать только допустим ник 123.

ComboBox1.Items.Add(Nick);

Цитата: Сообщение от Shadrincev Да и при повторном обращении к ComboBox или в вашем примере кнопке, выводимые Handle: 123 Nickname ввыводимом списке удваиваются, при еще одном обращении утраиваются и т.д. Хотя окно игры открыто одно.

Кнопка была взята, как пример. Если вы не заметили, в своём примере я использую этот код в процедуре создания формы:

Цитата: Сообщение от VeTaL_UA procedure TForm1.FormCreate(Sender: TObject)

Если вы не можете подстроить элементарный код "под себя", то вам не стоит начинать с написания программ такой сложности. Начните с изучения основ языка.

[Shadrincev]

Цитата: Сообщение от VeTaL_UA(1) Кнопка была взята, как пример. Если вы не заметили, в своём примере я использую этот код в процедуре создания формы:

Прошу прощения, сутки мозгового штурма дают о себе знать, туплю. Все ок, нашел где накосячил.

Цитата: Сообщение от VeTaL_UA(1) Если вы не можете подстроить элементарный код "под себя", то вам не стоит начинать с написания программ такой сложности. Начните с изучения основ языка.

И так занимаюсь.

Добавлено через 1 час 4 минуты
Пытался использовать передачу пакета:
код:

procedure PacketCall(aPParams:PParams); stdcall;
var
CallAddress,pPacketointer;
LenWord;
begin
CallAddress:=Pointer($00B280C4); //005D7C30 было
Len:=aPParams^.Param1;
pPacket:=@aPParams^.Packet;
asm
pushad
mov ecx, dword ptr [PW_BASE_ADDRESS]
mov ecx, dword ptr [ecx+$34] //20 было
push Len
push pPacket
call CallAddress
popad
end;
end;

procedure StrToByte(Packet:string; var aParams:TParams);
var
i:integer;
begin
i:=(length(Packet) div 2)-1;
aParams.Param1:=i+1;
for i:=0 to i do
aParams.Packet[i]:=strtoint('$'+Packet[i*2+1]+Packet[i*2+2]);
end;

procedure Packet(Packet: string);
var
aParams: TParams
begin
StrToByte(Packet,aParams);
InjectFunc(ProcessID,@PacketCall,@aParams,sizeof(a Params));
end;

procedure TForm1.btnTownPortalClick(Sender: TObject);
var
aParams : TParams;
begin
Packet('$2900A7000000000100000000'); //пример пакета
end;

end.

В этом месте возникает ошибка:

Цитата: procedure Packet(Packet: string); var aParams: TParams begin StrToByte(Packet,aParams); InjectFunc(ProcessID,@PacketCall,@aParams,sizeof(a Params)); end;

Ругается на begin и ProcessID. Не пойму причину, есть идеи у кого?

[semoder]

aParams: TParams;
Опиши переменную ProcessID, и получи её)

[VeTaL_UA]

Цитата: Сообщение от Shadrincev ProcessID

procedure Packet(Packet: string);
var
aParams: TParams;
Wnd: Thandle;
PID,hProcess: DWord;
begin
Wnd:=FID[ComboBox1.ItemIndex]; //Работаем с окном, которое выбрано в ComboBox'е
GetWindowThreadProcessId(Wnd,@PID);
hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,PID);
StrToByte(Packet,aParams);
InjectFunc(hProcess,@PacketCall,@aParams,sizeof(aParams));
end;

[Shadrincev]

Надоел я вам уже наверное.

Цитата: Сообщение от VeTaL_UA procedure Packet(Packet: string); var aParams: TParams; Wnd: Thandle; PID,hProcess: DWord; begin Wnd:=FID[ComboBox1.ItemIndex]; //Работаем с окном, которое выбрано в ComboBox'е GetWindowThreadProcessId(Wnd,@PID); hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,PID ); StrToByte(Packet,aParams); InjectFunc(hProcess,@PacketCall,@aParams,sizeof(aP arams)); end;

При таком варианте возмущается на ComboBox1.ItemIndex
Ставил на кнопку

Цитата: procedure TForm1.btnTownPortalClick(Sender: TObject); var aParams : TParams; Wnd: Thandle; PID,hProcess: DWord; begin Wnd:=FID[ComboBox1.ItemIndex]; //Работаем с окном, которое выбрано в ComboBox'е GetWindowThreadProcessId(Wnd,@PID); hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,PID ); Packet('$030001'); end;

Возмущаться перестает, но дальше при тесте выдает ошибку:

Цитата: "$$0" is not a valid integer value

Да как я понимаю за место ProcessID в InjectFunc ставим hProcess?
InjectFunc

procedure InjectFunc(hProcess: Cardinal; Func: Pointer; aParams: Pointer; aParamsSize: DWORD); //ProcessID
var
hThread: THandle;
lpNumberOfBytes: DWORD;
ThreadAddr, ParamAddr: Pointer;
begin
if hProcess<>0 then //ProcessID
begin
// ---- Выделим место в памяти процесса и запишем туда нашу функцию
ThreadAddr := VirtualAllocEx(hProcess, 0, 256, MEM_COMMIT, PAGE_READWRITE); //ProcessID
WriteProcessMemory(hProcess, ThreadAddr, Func, 256, lpNumberOfBytes); //ProcessID

// ---- Также запишем параметры к ней
ParamAddr := VirtualAllocEx(hProcess, 0, aParamsSize, MEM_COMMIT, PAGE_READWRITE);
WriteProcessMemory(hProcess, ParamAddr, aParams, aParamsSize, lpNumberOfBytes); //ProcessID

// ---- Создадим поток, в котором это всё будет выполняться
hThread := CreateRemoteThread(hProcess, 0, 0, ThreadAddr, ParamAddr, 0, lpNumberOfBytes); //ProcessID

// ---- Ожидаем, пока функция отработает
WaitForSingleObject(hThread, INFINITE);

// ---- Подчищаем за собой
CloseHandle(hThread);
VirtualFreeEx(hProcess, ParamAddr, 0, MEM_RELEASE); //ProcessID
VirtualFreeEx(hProcess, ThreadAddr, 0, MEM_RELEASE); //ProcessID
end
end;

Так же меня интересует, что баллист у нас 5, для каждой идет свой пакет, различие в :

Цитата: 361710C 391710C 371710C 381710C 3A1710C

Их как-то можно объединить на выполнение, чтобы программа сама решала, что рядом или проще ввести 5 кнопок для каждой баллисты отдельно?

[VeTaL_UA]

Цитата: Сообщение от Shadrincev При таком варианте возмущается на ComboBox1.ItemIndex

procedure Packet(Packet: string);
var
aParams: TParams;
Wnd: Thandle;
PID,hProcess: DWord;
begin
Wnd:=FID[Form1.ComboBox1.ItemIndex]; //Работаем с окном, которое выбрано в ComboBox'е
GetWindowThreadProcessId(Wnd,@PID);
hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,PID );
StrToByte(Packet,aParams);
InjectFunc(hProcess,@PacketCall,@aParams,sizeof(aP arams));
end;

Цитата: Сообщение от Shadrincev Да как я понимаю за место ProcessID в InjectFunc ставим hProcess?

Цитата: Сообщение от Shadrincev При таком варианте возмущается на ComboBox1.ItemIndex

procedure Packet(Packet: string);
var
aParams: TParams;
Wnd: Thandle;
PID,hProcess: DWord;
begin
Wnd:=FID[Form1.ComboBox1.ItemIndex]; //Работаем с окном, которое выбрано в ComboBox'е
GetWindowThreadProcessId(Wnd,@PID);
hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,PID );
StrToByte(Packet,aParams);
InjectFunc(hProcess,@PacketCall,@aParams,sizeof(aP arams));
end;

Примечание: Читай код

Цитата: Сообщение от Shadrincev Их как-то можно объединить на выполнение, чтобы программа сама решала

Найти оффсет расстояния и сравнивать, что ближе.

Цитата: Сообщение от Shadrincev или проще ввести 5 кнопок для каждой баллисты отдельно?

Проще, но с этим убирается весь смысл программы, как таковой. Программа должна сама всё делать, без вмешательства юзера, иначе зачем эта программа вовсе?

[Shadrincev]

Код

Цитата: procedure PacketCall(aPParams:PParams); stdcall; var CallAddress,pPacketointer; LenWord; begin CallAddress:=Pointer($459D60); Len:=aPParams^.Param1; pPacket:=@aPParams^.Packet; asm pushad mov ecx, dword ptr [PW_BASE_ADDRESS] mov ecx, dword ptr [ecx+$34] //20 push Len push pPacket call CallAddress popad end; end; procedure StrToByte(Packet:string; var aParams:TParams); var i:integer; begin i:=(length(Packet) div 2)-1; aParams.Param1:=i+1; for i:=0 to i do aParams.Packet[i]:=strtoint('$'+Packet[i*2+1]+Packet[i*2+2]); end; procedure Packet(Packet: string); var aParams: TParams; Wnd: Thandle; PID,hProcess: DWord; begin Wnd:=FID[Form1.ComboBox1.ItemIndex]; //Работаем с окном, которое выбрано в ComboBox'е GetWindowThreadProcessId(Wnd,@PID); hProcess:=OpenProcess(PROCESS_ALL_ACCESS,False,PID ); StrToByte(Packet,aParams); InjectFunc(hProcess,@PacketCall,@aParams,sizeof(aP arams)); end; procedure TForm1.Button1Click(Sender: TObject); var Packet:String; aParams : TParams; begin Packet:='030001'; end; end.

При такой постановке кода клиент игры прекращает работу. Ткните носом где, что ни так.
Затем VeTaL_UA, при определении окна игры, в Combobox добавляется только 1-но окно игры и то которое только что использовалось. Остальные в упор не видятся.

Цитата: Сообщение от VeTaL_UA Найти оффсет расстояния и сравнивать, что ближе. Проще, но с этим убирается весь смысл программы, как таковой. Программа должна сама всё делать, без вмешательства юзера, иначе зачем эта программа вовсе?

Не думаю что справлюсь. Поэтому для моих нубских целей пока пойдет.