Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Delphi Новый топик    Ответить
Топик располагается на нескольких страницах: [1] 2   вперед  Ctrl      все
 message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
shonli95
Member

Откуда:
Сообщений: 85
Можно ли как то заставить 1 обработчик глотать два сообщения ?
30 апр 19, 17:08    [21875771]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
Мимопроходящий
Member

Откуда: бурятский тундрюк, эсквайр
Сообщений: 30037

зай чем? (С)

Posted via ActualForum NNTP Server 1.5

30 апр 19, 17:19    [21875779]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
shonli95
Member

Откуда:
Сообщений: 85
Мимопроходящий,

На сколько я понимаю, он создаёт в классе селектор с меткой WM_*, и при вызове определённого сообщения достаёт его из своих недалёких vmt мест. Можно Думаю динамически отредактировать его, и задать к примеру на создание формы. Это стоит проверить, что бы на один и тот же обработчик ссылались разные сообщения
30 апр 19, 17:39    [21875801]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
Мимопроходящий
Member

Откуда: бурятский тундрюк, эсквайр
Сообщений: 30037

30.04.2019 17:39, shonli95 пишет:
> На сколько я понимаю, он создаёт в классе селектор с меткой WM_*

кито?! (С)

Posted via ActualForum NNTP Server 1.5

30 апр 19, 17:46    [21875805]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
shonli95
Member

Откуда:
Сообщений: 85
Кто нибудь знает как писать в защищённую память? Считать то я могу, я вижу сколько методов с WM_* Я знаю их адреса.

Стоит только попробовать что то поменять, сразу в AV падает

procedure AddMethod(&Class: Pointer; Selector: SmallInt; MethodAddress: Pointer);
type
  PArrayMethod = ^TArrayMethod;
  TArrayMethod = array of SmallInt;

  TDynaMethodTable = record
    Count: Word;
    Selectors: array [0 .. 9999999] of SmallInt;
  end;

  PDynaMethodTable = ^TDynaMethodTable;
var
  Tabl: PDynaMethodTable;
  Addrs: PPointer;
  OldCount: Word;
  T: PArrayMethod;
begin
  Tabl := PPointer(PByte(PPointer(&Class^)^) + VmtDynamicTable)^;
  if Tabl <> nil then
  begin
    OldCount := Tabl.Count;
    Tabl.Count := Tabl.Count + 1;
    // inc(Tabl.Count);

    T := @Tabl.Selectors;
    SetLength(T^, Tabl.Count);

    Addrs := PPointer(PByte(T) + OldCount * SizeOf(Tabl.Selectors[0]));
    PPointer(PByte(Addrs) + OldCount * SizeOf(Pointer))^ := MethodAddress;
  end;
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  AddMethod(@Self, WM_SYSCOMMAND, Self.MethodAddress('SysCommand'));
end;
30 апр 19, 18:13    [21875843]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
Мимопроходящий
Member

Откуда: бурятский тундрюк, эсквайр
Сообщений: 30037

30.04.2019 18:13, shonli95 пишет:
> Кто нибудь знает как писать в защищённую память?

а поцчему вы спrашиваите? (С)

Posted via ActualForum NNTP Server 1.5

30 апр 19, 18:18    [21875847]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
shonli95
Member

Откуда:
Сообщений: 85
Всё получилось, динамически ставить эти обработчики

  AddMethod(@Self, WM_SYSCOMMAND, Self.MethodAddress('SysCommand'));
  AddMethod(@Self, WM_CONTEXTMENU, Self.MethodAddress('SysCommand2'));



Весь код
+
unit Unit4;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.AppEvnts, Vcl.StdCtrls;

type
  TForm4 = class(TForm)
    procedure SysCommand(var Message: TMessage); // message WM_SYSCOMMAND;
    procedure SysCommand2(var Message: TMessage);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

type
  TMethodTest = procedure of object;

implementation

{$R *.dfm}

procedure AddMethod(&Class: Pointer; Selector: SmallInt; MethodAddress: Pointer);
{$POINTERMATH ON}
label NewStart, EndStep;
type
  ArrPointer = array of Pointer;

  TArrayMethod = array of SmallInt;

  TDynaMethodTable = record
    Count: Word;
    Selectors: array [0 .. 9999999] of SmallInt;
  end;

  PDynaMethodTable = ^TDynaMethodTable;
var
  Tabl: PDynaMethodTable;
  Addrs1, Addrs2, Ptr: PPointer;
  OldCount, I: Word;
  OldProtect: Cardinal;

  Addres, BytePtr: PByte;
  MNewStart: Boolean;
begin
  Addres := PByte(PPointer(&Class^)^);
NewStart: MNewStart := False;
  Ptr := PPointer(Addres + VmtDynamicTable);
  BytePtr := PByte(Ptr);
  if VirtualProtect(BytePtr, SizeOf(BytePtr^), PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    try
      Tabl := Ptr^;
      if Tabl = nil then
        goto EndStep;

      OldCount := Tabl.Count;

      Addrs2 := PPointer(PByte(@Tabl.Selectors) + Tabl.Count * SizeOf(Tabl.Selectors[0]));

      Tabl.Count := Tabl.Count + 1;

      Addrs1 := PPointer(PByte(@Tabl.Selectors) + Tabl.Count * SizeOf(Tabl.Selectors[0]));

      I := OldCount;
      while I > 0 do
      begin
        Dec(I);
        ArrPointer(Addrs1)[I] := ArrPointer(Addrs2)[I];
      end;

      ArrPointer(Addrs1)[OldCount] := MethodAddress;

      Tabl.Selectors[OldCount] := Selector;

    EndStep:

      if Tabl = nil then
      begin
        GetMem(PPointer(Addres + VmtDynamicTable)^, Sizeof(TDynaMethodTable));
        MNewStart := True;
      end;

    finally
      VirtualProtect(BytePtr, SizeOf(BytePtr^), OldProtect, OldProtect);
      FlushInstructionCache(GetCurrentProcess, BytePtr, SizeOf(BytePtr^));
    end;
    if MNewStart then
      goto NewStart;
  end;

end;

procedure TForm4.SysCommand2(var Message: TMessage);
begin
  Message.Result := 0;
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  AddMethod(@Self, WM_SYSCOMMAND, Self.MethodAddress('SysCommand'));
  AddMethod(@Self, WM_CONTEXTMENU, Self.MethodAddress('SysCommand2'));
end;

procedure TForm4.SysCommand(var Message: TMessage);
begin
  Form4.Caption := Message.WParam.ToString;
end;

end.
30 апр 19, 23:17    [21876034]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
shonli95
Member

Откуда:
Сообщений: 85
Вот для чего это делалось
+
unit FormHookEX;

interface

uses
  Winapi.Windows, Vcl.Forms, Winapi.Messages;

type
  ThookMessage = class(TForm)
    procedure CallMessage(var Message: TMessage);
  end;

 procedure FormSetHookMessage(Form: TForm);  // Могу запретить любой форме делать всё, что укажу 

procedure AddMethod(&Class: Pointer; Selector: SmallInt; MethodAddress: Pointer);

implementation

 procedure ThookMessage.CallMessage(var Message: TMessage); 
 begin 
   if Message.Msg = 123 then 
     Message.Result := 0 
   else 
     case Message.WParam of 
       61441, 61443, 61444, 61445, 61447, 61456, 61458, 61472, 61488, 61490, 61536, 61539, 61587, 
         61696, 61730: Message.Result := 0 
     else DefWindowProc(Handle, Message.Msg, Message.WParam, Message.LParam) 
     end; 
 end; 

procedure FormSetHookMessage(Form: TForm);
begin
  AddMethod(@Form, WM_SYSCOMMAND, @ThookMessage.CallMessage);
  AddMethod(@Form, WM_CONTEXTMENU, @ThookMessage.CallMessage);
end;

procedure AddMethod(&Class: Pointer; Selector: SmallInt; MethodAddress: Pointer);
label NewStart, EndStep;
type
  ArrPointer = array of Pointer;

  TArrayMethod = array of SmallInt;

  TDynaMethodTable = record
    Count: Word;
    Selectors: array [0 .. 9999999] of SmallInt;
  end;

  PDynaMethodTable = ^TDynaMethodTable;
var
  Tabl: PDynaMethodTable;
  Addrs1, Addrs2, Ptr: PPointer;
  OldCount, I: Word;
  OldProtect: Cardinal;

  Addres, BytePtr: PByte;
  MNewStart: Boolean;
begin
  Addres := PByte(PPointer(&Class^)^);
NewStart: MNewStart := False;
  Ptr := PPointer(Addres + VmtDynamicTable);
  BytePtr := PByte(Ptr);
  if VirtualProtect(BytePtr, SizeOf(BytePtr^), PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    try
      Tabl := Ptr^;
      if Tabl = nil then
        goto EndStep;

      OldCount := Tabl.Count;

      Addrs2 := PPointer(PByte(@Tabl.Selectors) + Tabl.Count * SizeOf(Tabl.Selectors[0]));

      Tabl.Count := Tabl.Count + 1;

      Addrs1 := PPointer(PByte(@Tabl.Selectors) + Tabl.Count * SizeOf(Tabl.Selectors[0]));

      I := OldCount;
      while I > 0 do
      begin
        Dec(I);
        ArrPointer(Addrs1)[I] := ArrPointer(Addrs2)[I];
      end;

      ArrPointer(Addrs1)[OldCount] := MethodAddress;

      Tabl.Selectors[OldCount] := Selector;

    EndStep:

      if Tabl = nil then
      begin
        GetMem(PPointer(Addres + VmtDynamicTable)^, Sizeof(TDynaMethodTable));
        MNewStart := True;
      end;

    finally
      VirtualProtect(BytePtr, SizeOf(BytePtr^), OldProtect, OldProtect);
      FlushInstructionCache(GetCurrentProcess, BytePtr, SizeOf(BytePtr^));
    end;
    if MNewStart then
      goto NewStart;
  end;

end;

initialization

finalization

end.
1 май 19, 02:01    [21876090]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
alekcvp
Member

Откуда:
Сообщений: 1412
shonli95
Вот для чего это делалось

Но... зачем?..
1 май 19, 23:21    [21876607]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
alekcvp
Member

Откуда:
Сообщений: 1412
Точнее вот это.
1 май 19, 23:26    [21876609]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
shonli95
Member

Откуда:
Сообщений: 85
alekcvp,

Почему никто раньше не мог подсказать? Я то показался в проперти формы, и не нашел ничего такого

+
unit FormHookEX;

interface

uses
  Vcl.Forms, Vcl.Controls, Winapi.Messages;

type
  ThookMessage = class(TForm)
    procedure CallMessage(var Message: TMessage);
    function GetFormHookEXWndProc(): TWndMethod;
  end;

procedure FormSetHookMessage(Form: TForm);

procedure FormRemoveHookMessage(Form: TForm);

implementation

function ThookMessage.GetFormHookEXWndProc(): TWndMethod;
begin
  Result := WndProc;
end;

procedure ThookMessage.CallMessage(var Message: TMessage);
begin
  if Message.Msg = 123 then
    Message.Result := 0
  else
    case Message.WParam of
      61441, 61443, 61444, 61445, 61447, 61456, 61458, 61472, 61488, 61490, 61536, 61539, 61587,
        61696, 61730: Message.Result := 0
    else WndProc(Message);
    end;
end;

procedure FormSetHookMessage(Form: TForm);
var
  T: TWndMethod;
begin
  TMethod(T).Data := Form;
  TMethod(T).Code := @ThookMessage.CallMessage;
  TControl(Form).WindowProc := T;
end;

procedure FormRemoveHookMessage(Form: TForm);
var
  T, T2: TMethod;
  V: function: TWndMethod of object;
begin
  T := TMethod(TControl(Form).WindowProc);
  if T.Code = @ThookMessage.CallMessage then
  begin
    TMethod(V).Data := Form;
    TMethod(V).Code := @ThookMessage.GetFormHookEXWndProc;

    TControl(Form).WindowProc := V();
  end;
end;

initialization

finalization

end.
2 май 19, 13:21    [21876903]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
alekcvp
Member

Откуда:
Сообщений: 1412
shonli95
alekcvp, Почему никто раньше не мог подсказать?


Возможно вот поэтому.
2 май 19, 16:56    [21877031]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
alekcvp
Member

Откуда:
Сообщений: 1412
+ Вторую ссылку не читали, да? :)
type
  TFormHook = class helper for TForm
    procedure CallMessage(var Message: TMessage);
    procedure HookForm;
    procedure UnhookForm;
  end;

...

procedure TFormHook.CallMessage(var Message: TMessage);
begin
  if Message.Msg = 123 then
    Message.Result := 0
  else
    case Message.WParam of
      61441, 61443, 61444, 61445, 61447, 61456, 61458, 61472, 61488, 61490, 61536, 61539, 61587,
        61696, 61730: Message.Result := 0
    else 
       WndProc(Message);
    end;
end;

procedure TFormHook.HookForm;
begin
   WindowProc := CallMessage;
end;

procedure TFormHook.UnhookForm;
begin
   WindowProc := nil;
end;
2 май 19, 17:04    [21877036]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
alekcvp
Member

Откуда:
Сообщений: 1412
Ошибся:
WindowProc := nilWndProc;
2 май 19, 17:06    [21877037]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
shonli95
Member

Откуда:
Сообщений: 85
alekcvp
shonli95
alekcvp, Почему никто раньше не мог подсказать?


Возможно вот поэтому.


Нет. Это не профессионализм со стороны форума. Я вижу ответ таким -

автор
Невозможно установить один message на два фронта, но это возможно сделать с помощью WindowProc,настроив коллбэк в ручную, на данные сообщения



... А не

Мимопроходящий
зай чем? (С)


Мимопроходящий

кито?! (С)



Это просто лишь бы посмеяться и посмотреть, что же мозг ТС изобретёт в конечном итоге.

Конечно не нужно исключать того, что Мимопроходящий и сам не знал как это сделать
2 май 19, 18:27    [21877048]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
Vlad F
Member

Откуда:
Сообщений: 815
shonli95,

Тут прибежали санитары и зафиксировали нас. (с)
2 май 19, 19:22    [21877062]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
shonli95
Member

Откуда:
Сообщений: 85
Vlad F,

Ой - Наркоши. Наркоши, цветные геймороши (С)
2 май 19, 20:32    [21877086]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
Vlad F
Member

Откуда:
Сообщений: 815
shonli95,
Какая у кого классика, такие и заботы/алгоритмы, очевидно.
2 май 19, 21:05    [21877090]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
alekcvp
Member

Откуда:
Сообщений: 1412
shonli95
Это просто лишь бы посмеяться и посмотреть, что же мозг ТС изобретёт в конечном итоге.


Справка - для слабаков, исходники - для дураков, правда? :)
2 май 19, 22:23    [21877117]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
shonli95
Member

Откуда:
Сообщений: 85
alekcvp,

Так убедительно сказал, что теперь надо удалить форум. А до удаления, надо скидывать ссылку на твоё сообщение, когда кто - то создаст новый топик.

А то чё, не исходников не справки нет??? Для слабаков ? Ко, ко петушкам таким, которые не могут нагуглить нужное, а в справке так просто по "windows message", "winapi message" не найдёшь
2 май 19, 22:38    [21877124]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
alekcvp
Member

Откуда:
Сообщений: 1412
shonli95,

Форум нужен когда в справке чего-то нет или что-то непонятно.
А когда люди приходят спрашивать "как сделать чтобы в TLabel текст был красненьким" или "как запретить пользователю нажимать на кнопку в программе" - это смешно, да.

Или по этой теме: тебе надо было запретить форме реагировать на некоторые сообщения, но ты зачем-то стал спрашивать как реализовать какую-то ересь...

P.S: Я никогда не использовал ни метод WndProc, ни свойство WindowProc в своих программах, но узнал об их существовании из гугла за 5 минут.
3 май 19, 16:02    [21877379]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
shonli95
Member

Откуда:
Сообщений: 85
alekcvp,

Кээээп, мой случай : Что-то непонятно. Понятно???)))) Непонятно было как установить message в два положения на один обработчик


Ответ должен был быть что это невозможно. А не крики умирающей птицы, что этот вопрос есть

Так как я хз как это гуглилось, и в справке искалось, опять по второй случай попадает - непонятно. Понятно?
3 май 19, 22:46    [21877550]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
alekcvp
Member

Откуда:
Сообщений: 1412
shonli95
alekcvp,
Ответ должен был быть что это невозможно. А не крики умирающей птицы, что этот вопрос есть


Почему невозможно? Возможно, через то самое место, как ты это сам сделал :)
Но вот зачем это было нужно, если твоя задача решалась парой строк кода совсем другим методом?..
4 май 19, 00:07    [21877571]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
shonli95
Member

Откуда:
Сообщений: 85
alekcvp,

=_= Такое чувства что я переписываюсь с ан....


Во первых, невозможно через конструкцию языка message.

Во вторых, это сделано было потому, что нагуглить другое решение невозможно было с моими значениями как это сделать

По этому я полез смотреть в исходники как работает message и понял как это переписать (Конечно же после поиска такого волшебного метода как WindowProc)


.... Так что.
4 май 19, 10:14    [21877651]     Ответить | Цитировать Сообщить модератору
 Re: message WM_SYSCOMMAND or WM_CONTEXTMENU  [new]
alekcvp
Member

Откуда:
Сообщений: 1412
shonli95
alekcvp,
Так как я хз как это гуглилось, и в справке искалось, опять по второй случай попадает - непонятно. Понятно?

(если не открывает)
Картинка с другого сайта.
4 май 19, 14:30    [21877725]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: [1] 2   вперед  Ctrl      все
Все форумы / Delphi Ответить