Перехват API

← →
Иван (2002-08-09 13:42) [0]

Я нашел статью http://delphi.mastak.ru/articles/Dapi/index.html посвященную перехвату, но исходник там неполный, а при попытке зайти на сайт автора оказывается, что он продается.
У кого-нибудь есть полный исходник ? Киньте на мыло,please!
Или ссылки на подобную тему (только для Delphi, а не для Си)

← →
Ученик (2002-08-09 14:02) [1]

Для своего приложения.

program Project2;

uses
SysUtils, Windows;

type
TImageImportDescriptor = packed record
OriginalFirstThunk : DWORD;
TimeDateStamp : DWORD;
ForwarderChain : DWORD;
Name : DWORD;
FirstThunk : DWORD;
end;
PImageImportDescriptor = ^TImageImportDescriptor;

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

type
PPointer = ^Pointer;

function InterceptDllCall(
hLocalModule : HMODULE;
c_szDllName : PChar;
c_szApiName : PChar;
pApiNew : Pointer;
p_pApiOrg : PPointer;
pApiToChange : Pointer) : Bool;
var
pDOSHeader : PImageDosHeader;
pNTHeader : PImageNtHeaders;
pImportDesc : PImageImportDescriptor;
dwProtect : DWORD;
bSuccess : BOOL;
pThunk : PImageThunkData;
dwNewProtect : DWORD;
dwAddressToIntercept : DWORD;
begin
Result := False;
pDOSHeader := PImageDosHeader(hLocalModule);
bSuccess := FALSE;

if (pApiToChange <> nil) then
dwAddressToIntercept := DWORD(pApiToChange)
else
dwAddressToIntercept := DWORD(GetProcAddress(GetModuleHandle(c_szDllName), c_szApiName));

if IsBadReadPtr(Pointer(hLocalModule), sizeof(TImageNtHeaders)) then
Exit;
if (pDOSHeader^.e_magic <> IMAGE_DOS_SIGNATURE) then
Exit;
pNTHeader := PImageNtHeaders(DWORD(pDOSHeader) + DWORD(pDOSHeader^._lfanew));
if pNTHeader^.Signature <> IMAGE_NT_SIGNATURE then
Exit;

pImportDesc := PImageImportDescriptor(DWORD(hLocalModule) +
DWORD(pNTHeader^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress));

if DWORD(pImportDesc) = DWORD(pNTHeader) then
Exit;

while (pImportDesc^.Name <> 0) do begin
pThunk := PImageThunkData(DWORD(hLocalModule) + DWORD(pImportDesc^.FirstThunk));
while (pThunk^._function <> nil) do begin
if (DWORD(pThunk^._function) = dwAddressToIntercept) then begin
if not IsBadWritePtr(@pThunk^._function, sizeof(DWORD)) then begin
if (p_pApiOrg <> nil) then
p_pApiOrg^ := pThunk^._function;
pThunk^._function := pApiNew;
bSuccess := TRUE;
end else begin
if VirtualProtect(@pThunk^._function, sizeof(DWORD),
PAGE_EXECUTE_READWRITE, dwProtect) then begin
if (p_pApiOrg <> nil) then
p_pApiOrg^ := pThunk^._function;
pThunk^._function := pApiNew;
bSuccess := TRUE;
dwNewProtect := dwProtect;
VirtualProtect(@pThunk^._function, sizeof(DWORD), dwNewProtect, dwProtect)
end
end;
end;
Inc(PChar(pThunk), SizeOf(TImageThunkData32));
end;
Inc(PChar(pImportDesc), SizeOf(TImageImportDescriptor));
end;
Result := bSuccess;
end;

type
TMessageBox = function (Wnd : HWND;
lpText : PChar;
lpCaption : PChar;
uType : UINT) : Integer; stdcall;

var
p_fnMessageBoxOrg : Pointer = nil;

function MyMessageBox(Wnd : HWND;
lpText : PChar;
lpCaption : PChar;
uType : UINT) : Integer; stdcall;
begin
if (p_fnMessageBoxOrg = nil) then
Result := 0
else
Result := TMessageBox(p_fnMessageBoxOrg)(Wnd, lpCaption, lpText, uType)
end;

var
c_szTitle : PChar;
uStyle : UINT;
begin
c_szTitle := "Перехват функций API";
uStyle := MB_OK or MB_ICONHAND or MB_SYSTEMMODAL;
MessageBox(0, "Нормальный текст", c_szTitle, uStyle);
InterceptDllCall(hInstance, "user32.dll", "MessageBoxA",
@MyMessageBox, @p_fnMessageBoxOrg, nil);
MessageBox(0, "Текст и заголовок поменялись", c_szTitle, uStyle);
InterceptDllCall(hInstance, "user32.dll", "MessageBoxA",
p_fnMessageBoxOrg, nil, @MyMessageBox);
MessageBox(0, "Снова нормальный текст", c_szTitle, uStyle);
end.

Перехват API Найти похожие ветки