Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Перехват вызовов функций из динамических библиотек

Автор: Den is Com

В России запущенно производство принципиально новых программно-аппаратных средств для взлома систем под названием: "Plug & Fuck". Устройства и софт работают отлично.

// проверено и работает для WIN 9x и WinNT
// в юните на первый взгляд, есть структуры , описание которых уже есть в Дельфи , но к сожалению не
// всех и не во всех версиях Дельфи эти структуры присутствуют. Да уж, это не С

Проблема скорее для хакера, а не для программиста. Но существуют ситуации, когда это необходимо. Сложно предположить ситуацию, в которой это может понадобится, но например: можете перехватывать надоевшее окошко о необходимости купить компонент :) . Разумеется этот код предназначен для более широких целей и в более широком варианте позволяет контролировать работу внешней программы, производя "мягкий" взлом - изменения присходят только в памяти и не касаются исполняемого файла на диске. Разумеется можно использовать и для более светлых целей. При использовании данного исходника будьте осторожны: при компилировании пректа с динамическими пакетами перехватываемая функция может находится в пакете, а не в файле программы. Перед перехватом функции необходимо заменить её функцией-ловушкой. Например для MessageBox


type

TMyProc= function (hWnd: HWND; lpText, lpCaption: 
  PAnsiChar; uType: UINT): Integer; stdcall;
PTMyProc=^TMyProc;

function MyMessageBox(hWnd: HWND; lpText, lpCaption: 
  PAnsiChar; uType: UINT): Integer; stdcall;
begin
  ShowMessage('Message intercepted');
  result:=IDOK;
end;

и сам перехват происходит так


InterceptDllCall(hInstance,'user32.dll','MessageBoxA',
Pointer(@MyMessageBox),PPointer(@myProc),nil); 

теперь все вызовы MessageBox будут ссылаться на нашу функцию :) Надеюсь вы помните, что функции MessageBox в user32.dll нет - это только оболочка для MessageBoxА

и обратная операция - восстановление работоспособности старой функции


InterceptDllCall(hInstance,'user32.dll','MessageBoxA',
Pointer(myProc),nil,Pointer(@MyMessageBox)); 

Привожу полностью все файлы проекта:


// Intercep.pas

unit intercep;

interface
uses windows, dialogs, SysUtils;
type

  PImageDosHeader = ^TImageDosHeader;
  {EXTERNALSYM _IMAGE_DOS_HEADER}
  _IMAGE_DOS_HEADER = packed record { DOS .EXE header                  }
    e_magic: Word; { Magic number                     }
    e_cblp: Word; { Bytes on last page of file       }
    e_cp: Word; { Pages in file                    }
    e_crlc: Word; { Relocations                      }
    e_cparhdr: Word; { Size of header in paragraphs     }
    e_minalloc: Word; { Minimum extra paragraphs needed  }
    e_maxalloc: Word; { Maximum extra paragraphs needed  }
    e_ss: Word; { Initial (relative) SS value      }
    e_sp: Word; { Initial SP value                 }
    e_csum: Word; { Checksum                         }
    e_ip: Word; { Initial IP value                 }
    e_cs: Word; { Initial (relative) CS value      }
    e_lfarlc: Word; { File address of relocation table }
    e_ovno: Word; { Overlay number                   }
    e_res: array[0..3] of Word; { Reserved words                   }
    e_oemid: Word; { OEM identifier (for e_oeminfo)   }
    e_oeminfo: Word; { OEM information; e_oemid specific}
    e_res2: array[0..9] of Word; { Reserved words                   }
    e_lfanew: LongInt; { File address of new exe header   }
  end;
  TImageDosHeader = _IMAGE_DOS_HEADER;
  //  {$EXTERNALSYM IMAGE_DOS_HEADER}

  IMAGE_DOS_HEADER = _IMAGE_DOS_HEADER;

  //***************************************
  PImageDataDirectory = ^TImageDataDirectory;
  _IMAGE_DATA_DIRECTORY = record
    VirtualAddress: DWORD;
    Size: DWORD;
  end;
  //  {$EXTERNALSYM _IMAGE_DATA_DIRECTORY}
  TImageDataDirectory = _IMAGE_DATA_DIRECTORY;
  IMAGE_DATA_DIRECTORY = _IMAGE_DATA_DIRECTORY;
  //  {$EXTERNALSYM IMAGE_DATA_DIRECTORY}

  //*************
  PImageOptionalHeader = ^TImageOptionalHeader;
  _IMAGE_OPTIONAL_HEADER = packed record
    { Standard fields. }
    Magic: Word;
    MajorLinkerVersion: Byte;
    MinorLinkerVersion: Byte;
    SizeOfCode: DWORD;
    SizeOfInitializedData: DWORD;
    SizeOfUninitializedData: DWORD;
    AddressOfEntryPoint: DWORD;
    BaseOfCode: DWORD;
    BaseOfData: DWORD;
    { NT additional fields. }
    ImageBase: DWORD;
    SectionAlignment: DWORD;
    FileAlignment: DWORD;
    MajorOperatingSystemVersion: Word;
    MinorOperatingSystemVersion: Word;
    MajorImageVersion: Word;
    MinorImageVersion: Word;
    MajorSubsystemVersion: Word;
    MinorSubsystemVersion: Word;
    Win32VersionValue: DWORD;
    SizeOfImage: DWORD;
    SizeOfHeaders: DWORD;
    CheckSum: DWORD;
    Subsystem: Word;
    DllCharacteristics: Word;
    SizeOfStackReserve: DWORD;
    SizeOfStackCommit: DWORD;
    SizeOfHeapReserve: DWORD;
    SizeOfHeapCommit: DWORD;
    LoaderFlags: DWORD;
    NumberOfRvaAndSizes: DWORD;
    DataDirectory: packed array[0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1] of
      TImageDataDirectory;
  end;
  // {$EXTERNALSYM _IMAGE_OPTIONAL_HEADER}
  TImageOptionalHeader = _IMAGE_OPTIONAL_HEADER;
  IMAGE_OPTIONAL_HEADER = _IMAGE_OPTIONAL_HEADER;
  // {$EXTERNALSYM IMAGE_OPTIONAL_HEADER}

  PImageNtHeaders = ^TImageNtHeaders;
  _IMAGE_NT_HEADERS = packed record
    Signature: DWORD;
    FileHeader: TImageFileHeader;
    OptionalHeader: TImageOptionalHeader;
  end;
  // {$EXTERNALSYM _IMAGE_NT_HEADERS}
  TImageNtHeaders = _IMAGE_NT_HEADERS;
  IMAGE_NT_HEADERS = _IMAGE_NT_HEADERS;
  // {$EXTERNALSYM IMAGE_NT_HEADERS}

  PImage_import_by_name = ^TImage_import_by_mame;
  _IMAGE_IMPORT_BY_NAME = packed record

    Hint: Word;
    Name: Byte;
  end;
  TImage_import_by_mame = _IMAGE_IMPORT_BY_NAME;

  _u1 = packed record
    case Integer of

      0: (ForwarderString: PByte);
      1: (Functionn: PDWORD);
      2: (Ordinal: DWORD);
      3: (AddressOfData: PImage_import_by_name);
  end;
  PImageThunkData = ^TImageThunkData;
  _IMAGE_THUNK_DATA = packed record

    u1: _u1;
  end;
  TImageThunkData = _IMAGE_THUNK_DATA;
  IMAGE_THUNK_DATA = _IMAGE_THUNK_DATA;

  _temp_charcteristics = record
    case Integer of
      0: (Characteristics: DWORD); // 0 for terminating null import descriptor
      1: (OriginalFirstThunk: PImageThunkData); // RVA to original unbound IAT
  end;

  PImageImportDescriptor = ^TImageImportDescriptor;
  _IMAGE_IMPORT_DESCRIPTOR = packed record

    t: _temp_charcteristics;
    TimeDateStamp: DWord; // 0 if not bound,
    // -1 if bound, and real date\time stamp
    //     in IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT (new BIND)
    // O.W. date/time stamp of DLL bound to (Old BIND)

    ForwarderChain: DWORD; // -1 if no forwarders
    Name: DWORD;
    FirstThunk: PImageThunkData;
      // RVA to IAT (if bound this IAT has actual addresses)
  end;
  TImageImportDescriptor = _IMAGE_IMPORT_DESCRIPTOR;
  IMAGE_IMPORT_DESCRIPTOR = _IMAGE_IMPORT_DESCRIPTOR;
  PPointer = ^Pointer;
function InterceptDllCall(

  hLocalModule: HModule;
  c_szDllName: Pchar;
  c_szApiName: PChar;
  pApiNew: Pointer;
  p_pApiOrg: PPointer;
  pApiToChange: Pointer): Boolean;
implementation

function MakePtr(base: Dword; Offset: DWORD): Pointer;
begin
  Result := Pointer(Base + Offset);
end;

function InterceptDllCall(

  hLocalModule: HModule;
  c_szDllName: Pchar;
  c_szApiName: PChar;
  pApiNew: Pointer;
  p_pApiOrg: PPointer;
  pApiToChange: Pointer): Boolean;

var
  pDosHeader: PImageDosHeader;

  pNtHeader: PImageNtHeaders;
  PImportDesc: PImageImportDescriptor;
  dwProtect: DWORD;
  dwNewProtect: DWORD;
  dwAddressToInterCept: DWORD;
  pThunk: PImageThunkData;
begin
  pDosHeader := PImageDosHeader(hLocalModule);
  Result := False;
  if (pApiToChange <> nil) then
    dwAddressToIntercept := DWORD(pApiToChange)
  else
    dwAddressToIntercept := Dword(GetProcAddress(GetModuleHandle(c_szDllName),
      c_szApiName));

  if IsBadReadPtr(Pointer(hLocalModule), sizeof(PImageNtHeaders)) then
    Exit;

  if pDosHeader.e_magic <> IMAGE_DOS_SIGNATURE then
    exit;
  pNtHeader := PImageNtHeaders(MakePtr(DWord(pDOSHeader),
    DWord(pDOSHeader.e_lfanew)));
  if pNTHeader.signature <> IMAGE_NT_SIGNATURE then
    exit;
  pImportDesc := PImageImportDescriptor(

    MakePtr(hLocalModule,
    pNtHeader.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress));

  if (PImportDesc = PImageImportDescriptor(pNtHeader)) then
    exit;

  while (pImportDesc.Name > 0) do
  begin

    pThunk := PImageThunkData(MakePtr(DWord(hLocalModule),
      Dword(pImportDesc.FirstThunk)));
    while (pThunk.u1.Functionn <> nil) do
    begin
      if DWord(pThunk.u1.Functionn) = dwAddressToIntercept then
      begin
        if not IsBadWritePtr(Pointer(@pThunk.u1.Functionn), sizeof(DWORD)) then
        begin
          if (p_pApiOrg <> nil) then
            p_pApiOrg^ := Pointer(pThunk.u1.Functionn);
          pThunk.u1.Functionn := pApiNew;
          Result := True;
        end
        else
        begin
          if VirtualProtect(Pointer(@pThunk.u1.Functionn), sizeof(DWORD),
            PAGE_EXECUTE_READWRITE, @dwProtect) then
          begin
            if (p_pApiOrg <> nil) then
              p_pApiOrg^ := Pointer(pThunk.u1.Functionn);
            pThunk.u1.Functionn := PDWORD(pApiNew);
            Result := True;
            dwNewProtect := dwProtect;
            VirtualProtect(Pointer(@pThunk.u1.Functionn), sizeof(DWORD),
              dwNewProtect, @dwProtect);
          end;
        end;
      end;
      Inc(PThunk);
    end;
    Inc(pImportDEsc);
  end;
end;

end.

// Project1.dpr

program Project1;

uses
  Forms,
  Unit1 in '..\..\Work\Temp\4\Unit1.pas' {Form1};

{$R *.RES}

begin

  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

// Unit1.dfm

object Form1: TForm1

  Left = 192
    Top = 107
    Width = 435
    Height = 300
    Caption = 'Form1'
    Color = clBtnFace
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    OldCreateOrder = False
    PixelsPerInch = 96
    TextHeight = 13
    object Button1: TButton
    Left = 72
      Top = 176
      Width = 273
      Height = 65
      Caption = 'Begin'
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -24
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      ParentFont = False
      TabOrder = 0
      OnClick = Button1Click
  end
  object Button2: TButton
    Left = 304
      Top = 16
      Width = 105
      Height = 49
      Caption = 'MessageBox'
      TabOrder = 1
      OnClick = Button2Click
  end
end

// Unit1.pas

unit Unit1;

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, intercep;

type

  TMyProc = function(hWnd: HWND; lpText, lpCaption: PAnsiChar; uType: UINT):
    Integer; stdcall;
  PTMyProc = ^TMyProc;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var

  Form1: TForm1;
  myProc: PTMyProc;
implementation

function MyMessageBox(hWnd: HWND; lpText, lpCaption: PAnsiChar; uType: UINT):
  Integer; stdcall;
begin
  ShowMessage('Message intercepted');

  result := IDOK;
end;
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

begin
  myProc := nil;
  MessageBox(0, 'Hello', 'Message 1', MB_OK);
  InterceptDllCall(hInstance, 'user32.dll', 'MessageBoxA',
    Pointer(@MyMessageBox), PPointer(@myProc), nil); //then ShowMessage('Ok');
  MessageBox(0, 'Hello', 'Message 2', MB_OK);
  InterceptDllCall(hInstance, 'user32.dll', 'MessageBoxA',
    Pointer(myProc), nil, Pointer(@MyMessageBox));
  MessageBox(0, 'Hello', 'Message 3 ', MB_OK);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  MessageBox(0, 'Hello', 'Message 4 ', MB_OK);
end;

end.

Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay