[Помогите!] Delphi отправка пакетов

[~ГайвеР~]

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

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
Type
  PParams = ^TParams;
  TParams = packed record
    Packet: array [0..100] of byte;
    Param1,Param2,Param3: DWord;
    Param4: array [1..100] of widechar;
  end;

function dwValueToString(Value: DWORD): String;
  var
    St: string;
  begin
    St := IntToHex(Value, 8);
    result := st[7]+st[8]+' '+
              st[5]+st[6]+' '+
              st[3]+st[4]+' '+
              st[1]+st[2];
  end;

  function wValueToString(Value: WORD): String;
  var
    St: string;
  begin
    St := IntToHex(Value, 4);
    result := st[3]+st[4]+' '+
              st[1]+st[2];
  end;

procedure PacketCall(aPParams: PParams); stdcall;
 var
    CallAddress,pPacket:pointer;
    BaseAddresses: DWord;
    Len:DWord;
  begin
    CallAddress:=Pointer(aPParams^.Param1);
    BaseAddresses:=aPParams^.Param2;
    Len:=aPParams^.Param3;
    pPacket:=@aPParams^.Packet;
    asm
      pushad
      mov ecx, BaseAddresses
      mov ecx, dword ptr [ecx]
      mov ecx, dword ptr [ecx+$20]
      push Len
      push pPacket
      call CallAddress
      popad
    end;
  end;
   procedure StrToByte(Packet:string; var aParams:TParams);
  var
    i, n, len: integer;
    vSt: string;
  begin
    len := length(Packet);
    i := 1;
    n := 0;
    vSt := '';
    while i <= len do
    begin
      if Packet[i] in ['0'..'9', 'A'..'F'] then
        vSt := vSt + Packet[i];
      if not (Packet[i] in ['0'..'9', 'A'..'F']) or (i = len) then
      begin
        aParams.Packet[n]:=strtoint('$'+vSt);
        inc(n);
        vSt := '';
      end;
      inc(i);
    end;
    aParams.Param3 := n;
  end;

  procedure InjectFunc(ProcessID: Cardinal; Func, aParams: Pointer; aParamsSize: DWord);
  var
    hThread: THandle;
    lpNumberOfBytes: DWord;
    ThreadAddr, ParamAddr: Pointer;
  begin
    if ProcessID <> 0 then
    begin

      ThreadAddr := VirtualAllocEx(ProcessID, nil, 256, MEM_COMMIT, PAGE_READWRITE);
      WriteProcessMemory(ProcessID, ThreadAddr, Func, 256, lpNumberOfBytes);

      ParamAddr := VirtualAllocEx(ProcessID, nil, aParamsSize, MEM_COMMIT, PAGE_READWRITE);
      WriteProcessMemory(ProcessID, ParamAddr, aParams, aParamsSize, lpNumberOfBytes);

      hThread := CreateRemoteThread(ProcessID, nil, 0, ThreadAddr, ParamAddr, 0, lpNumberOfBytes);

      WaitForSingleObject(hThread, INFINITE);

      CloseHandle(hThread);
      VirtualFreeEx(ProcessID, ParamAddr, 0, MEM_RELEASE);
      VirtualFreeEx(ProcessID, ThreadAddr, 0, MEM_RELEASE);
    end
  end;

  procedure Packet(Packet: string);
  var
    aParams: TParams;
  begin
    aParams.Param1 := $00668490;  \\вроде как BaseAdress
    StrToByte(Packet, aParams);
    aParams.Param2 := $00B27A04;  \\ UseSkill

  end;

  procedure Use(UseID: DWORD);
begin
Packet('28 00 00 01 00 00 50 6B 00 00  '+dwValueToString(UseID)); // перехваченный мною пакет открытия 
end;


end.

[VeTaL_UA]

1.Аццкий бред
2.Оффсеты не верные.

[krukovis]

Цитата: Сообщение от ~ГайвеР~ вот и склеил программу из найденных в инетах исходников

А чем не устраивает функция:

procedure PacketCall(aPParams:PParams); stdcall;
var
  CallAddress,pPacket:pointer;
  Len:DWord;
begin
  CallAddress:=Pointer($0060E310);  // Старый адрес - $005D7C30
  Len:=aPParams^.Param1;
  pPacket:=@aPParams^.Packet;
  asm
    pushad
    mov ecx, dword ptr [PW_BASE_ADDRESS]
    mov ecx, dword ptr [ecx+$20]
    push Len
    push pPacket
    call CallAddress
    popad
  end;
end;

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

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

Адрес теперь тут:
PackCall=006737B0 - на руофе.
Взял тут: http://zhyk.ru/forum/showpost.php?p=719249&postcount=1 - там же базовый набор пакетов есть. Остальные сможешь сам найти с помощью программы Packet Listener - лежит тут http://zhyk.ru/forum/showthread.php?t=276220

[VeTaL_UA]

Цитата: Сообщение от krukovis А чем не устраивает функция

Меня не устраивает этим:

Цитата: Сообщение от krukovis mov ecx, dword ptr [ecx+$20$34]

А так же тем, что

Цитата: Сообщение от krukovis PW_BASE_ADDRESS

не лежит в константах:

const
PW_BASE_ADDRESS=$00B27A04;

Добавлено через 2 минуты
А так же этим:

Цитата: Сообщение от krukovis i:=(length(bytecodePacket) div 2)-1;

[Dinmaite]

Цитата: Сообщение от VeTaL_UA не лежит в константах:

Что правда?

Цитата: Сообщение от Dinmaite type PParams = ^TParams; TParams = packed record Packet: array [0..100] of byte; Param1,Param2,Param3: DWord; Param4: array [1..100] of widechar; end; const PW_BASE_ADDRESS = $009C0E6C; PW_GAMERUN_ADDR = $009C1514;

Ну а очепятки есть, то да.

[VeTaL_UA]

Цитата: Сообщение от Dinmaite Что правда?

Дин, эта часть кода не была здесь показана

И вообще, я не сразу вьехал, что код твой

[Mars']

кот немного с опечатками, поправь, и не используй PW_BASE_ADDRESS=$00B27A04 это опечтка тоже

[krukovis]

Цитата: Сообщение от Dinmaite Ну а очепятки есть, то да.

Поправь в своей теме пожалуйста. Дабы не вводить в заблуждение.

[Kitsune]

Цитата: Сообщение от VeTaL_UA кода не была здесь выкладена

аццко режет глаза

[~ГайвеР~]

Исправил свой код по вашим постам

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
Type
  PParams = ^TParams;
  TParams = packed record
    Packet: array [0..100] of byte;
    Param1,Param2,Param3: DWord;
    Param4: array [1..100] of widechar;
  end;
  const 
  PW_BASE_ADDRESS = $00B27A04;
  PW_GAMERUN_ADDR = $009C1514; \\ что эт за адрес?, и актуален ли он для руофа (аксовского клиента с рыбами)?

function dwValueToString(Value: DWORD): String;
  var
    St: string;
  begin
    St := IntToHex(Value, 8);
    result := st[7]+st[8]+' '+
              st[5]+st[6]+' '+
              st[3]+st[4]+' '+
              st[1]+st[2];
  end;

  function wValueToString(Value: WORD): String;
  var
    St: string;
  begin
    St := IntToHex(Value, 4);
    result := st[3]+st[4]+' '+
              st[1]+st[2];
  end;

procedure PacketCall(aPParams:PParams); stdcall;
var
  CallAddress,pPacket:pointer;
  Len:DWord;
begin
  CallAddress:=Pointer($006737B0);
  Len:=aPParams^.Param1;
  pPacket:=@aPParams^.Packet;
  asm
    pushad
    mov ecx, dword ptr [PW_BASE_ADDRESS]
    mov ecx, dword ptr [ecx+$34]
    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(aParams)); \\ на эту строку делфи ругается при запуске ([Error] Unit1.pas(88): Undeclared identifier: 'InjectFunc'), а если уберу то запуск идет нормально

end;
end

Кстати, не увидел где сама функция отправления пакетов в моем случае это активирование итема в инвентаре, 28 00 00 01 00 00 50 6B 00 00.
З.Ы. А может ли делфи выковыривать принятые пакеты, просто нужно зациклить отправку, только чтобы она происходила только после получения пакетов получения дропа с сундука (простите за тавтологию)
Как привязать зацикливание и остановку отправки пакетов к клавише?

[Dinmaite]

Цитата: Сообщение от Mars' кот немного с опечатками, поправь, и не используй PW_BASE_ADDRESS=$00B27A04 это опечтка тоже

Правда? Не может быть.

Цитата: Сообщение от krukovis Поправь в своей теме пожалуйста. Дабы не вводить в заблуждение.

Опечатки поправлю.

Цитата: Сообщение от ~ГайвеР~ Кстати, не увидел где сама функция отправления пакетов

Цитата: Сообщение от ~ГайвеР~ procedure PacketCall(aPParams:PParams); stdcall; var CallAddress,pPacketointer; LenWord; begin CallAddress:=Pointer($006737B0); Len:=aPParams^.Param1; pPacket:=@aPParams^.Packet; asm pushad mov ecx, dword ptr [PW_BASE_ADDRESS] mov ecx, dword ptr [ecx+$34] push Len push pPacket call CallAddress popad end; end;

Вот она

Цитата: Сообщение от ~ГайвеР~ А может ли делфи выковыривать принятые пакеты

Может

Цитата: Сообщение от ~ГайвеР~ Как привязать зацикливание и остановку отправки пакетов к клавише?

Учите язык.

[~ГайвеР~]

Так и не понял, куда именно вписать нужный мне пакет для отправки

[Shadrincev]

[Ссылки могут видеть только зарегистрированные пользователи. ]

Цитата: procedure TForm1.btnTownPortalClick(Sender: TObject); var aParams : TParams; begin Packet('$2900A7000000000100000000'); mInfo.Lines.Add('Teleport injected.'); //это думаю лишнее end;

[VeTaL_UA]

Цитата: Сообщение от TBX1n аццко режет глаза

[Morkanus]

пытаюсь отправить пакет но у меня ничего не происходит.
Подскажите...
....
всё справился...