Текущий архив: 2004.12.19;
Скачать: CL | DM;

Вниз

Как отловить MesssageBox?   Найти похожие ветки 

← →
ShotGuN ©   (2004-12-02 10:07) [0]

Есть ли такой Message, который срабатывает при вылетании MessageBox?

---

← →
Rouse_ ©   (2004-12-02 11:30) [1]

////////////////////////////////////////////////////////////////////////////////
//
//  Демонстрационная программа перехвата вызова API функций
//  Автор: Джеффри РИХТЕР
//  Адаптация для Delphi: Александр (Rouse_) Багель
//

unit Unit1;

interface

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

type

 TMessageBox = function(hWnd: HWND; lpText, lpCaption:
   PChar; uType: UINT): Integer; stdcall;

 PFARPROC = ^FARPROC;

 TIIDUnion = record
   case Integer of
     0: (Characteristics: DWORD);
     1: (OriginalFirstThunk: DWORD);
 end;

 PImageImportDescriptor = ^TImageImportDescriptor;
 TImageImportDescriptor = record
   Union: TIIDUnion;
   TimeDateStamp: DWORD;
   ForwarderChain: DWORD;
   Name: DWORD;
   FirstThunk: DWORD;
 end;

 PImageThunkData = ^TImageThunkData32;
 TImageThunkData32 = packed record
   _function : PDWORD;
 end;

 TForm1 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   procedure ReplaceIATEntryInOneMod(const OldProc, NewProc: FARPROC);
   procedure SetAPIHook;
   procedure ResetAPIHook;
 end;

 {$EXTERNALSYM ImageDirectoryEntryToData}
 function ImageDirectoryEntryToData(Base: Pointer; MappedAsImage: ByteBool;
   DirectoryEntry: Word; var Size: ULONG): Pointer; stdcall; external "imagehlp.dll";

 {$EXTERNALSYM HookMessageBox}
 function HookMessageBox(hWnd: HWND; lpText, lpCaption: PChar;
   uType: UINT): Integer; stdcall;

var
 Form1: TForm1;

var
 OldMessageBox: FARPROC = nil;
 CurrentMessageBox: FARPROC;

implementation

{$R *.dfm}

// Перехват API посредством подмены в таблице импорта
procedure TForm1.ReplaceIATEntryInOneMod(const OldProc,
 NewProc: FARPROC);
var
 Size: DWORD;
 ImportEntry: PImageImportDescriptor;
 Thunk: PImageThunkData;
 Protect, newProtect: DWORD;
 DOSHeader: PImageDosHeader;
 NTHeader: PImageNtHeaders;
begin
 if OldProc = nil then Exit;
 if NewProc = nil then Exit;

  // Можно искать вот так
 ImportEntry := ImageDirectoryEntryToData(Pointer(hInstance), BOOL(1),
   IMAGE_DIRECTORY_ENTRY_IMPORT, Size);

 // Или вот так
 {DOSHeader := PImageDosHeader(hInstance);
 if IsBadReadPtr(Pointer(hInstance), SizeOf(TImageNtHeaders)) then Exit;
 if (DOSHeader^.e_magic <> IMAGE_DOS_SIGNATURE) then Exit;
 NTHeader := PImageNtHeaders(DWORD(DOSHeader) + DWORD(DOSHeader^._lfanew));
 if NTHeader^.Signature <> IMAGE_NT_SIGNATURE then Exit;
 ImportEntry := PImageImportDescriptor(DWORD(hInstance) +
     DWORD(NTHeader^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress));
 if DWORD(ImportEntry) = DWORD(NTHeader) then Exit;  }

 if ImportEntry <> nil then
 begin
   while ImportEntry^.Name <> 0 do
   begin
       Thunk := PImageThunkData(DWORD(hInstance) +
         DWORD(ImportEntry^.FirstThunk));
       while Thunk^._function <> nil do
       begin
         if (Thunk^._function = OldProc) then
         begin
           if not IsBadWritePtr(@Thunk^._function, sizeof(DWORD)) then
             Thunk^._function := NewProc
           else
           begin

             if VirtualProtect(@Thunk^._function, SizeOf(DWORD),
               PAGE_EXECUTE_READWRITE, Protect) then
             begin
               Thunk^._function := NewProc;
               newProtect := Protect;
               VirtualProtect(@Thunk^._function, SizeOf(DWORD),
                 newProtect, Protect);
             end;
           end;
           //Exit;
         end
         else
           Inc(PChar(Thunk), SizeOf(TImageThunkData32));
       end;
     ImportEntry := Pointer(Integer(ImportEntry) + SizeOf(TImageImportDescriptor));
   end;
 end;
end;

function HookMessageBox(hWnd: HWND; lpText, lpCaption: PChar; uType: UINT): Integer; stdcall;
begin
 Result := TMessageBox(OldMessageBox)(hWnd,
   PChar(Format("Перехвачен текст: "%s"", [lpText])),
   PChar(Format("Перехвачен текст: "%s"", [lpCaption])), uType);
end;

// Снятие хука
procedure TForm1.ResetAPIHook;
begin
 ReplaceIATEntryInOneMod(CurrentMessageBox, OldMessageBox);
end;

// Установка хука
procedure TForm1.SetAPIHook;
begin
 OldMessageBox :=
   GetProcAddress(GetModuleHandle("User32.dll"), "MessageBoxA");
 CurrentMessageBox := @HookMessageBox;
 ReplaceIATEntryInOneMod(OldMessageBox, CurrentMessageBox);
end;

////////////////////////////////////////////////////////////////////////////////

procedure TForm1.Button1Click(Sender: TObject);
begin
 MessageBox(0, "Текст сообщения", "Заголовок", 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 SetAPIHook;
 MessageBox(0, "Текст сообщения", "Заголовок", 0);
 ResetAPIHook;
end;

end.

---

← →
NAlexey ©   (2004-12-02 11:44) [2]

WM_CANCELMODE

---

Страницы: 1 вся ветка

Текущий архив: 2004.12.19;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.023 c