Форум: "Основная";
Текущий архив: 2004.12.19;
Скачать: [xml.tar.bz2];
ВнизКак отловить 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;
Скачать: [xml.tar.bz2];
Память: 0.46 MB
Время: 0.034 c