Infinite loop “anti dll injection” stops software execution

[flashcoder]

I found a code that blocks a action of code injection in my software that is coming of another program that is running on computers of my clients, and works fine in Console Mode. Already if I past for VCL Form Mode using TThread, my software stops the execution.

PS: The goal this "dll injector" program, is prevent screen capture.

Following I will show as I'm using in VCL Form Mode:

Code: Select all


type

ThreadClass = Class(TThread)
Protected
Procedure Execute; OverRide;
End;

type
  TForm2 = class(TForm)
    tmr1: TTimer;
    procedure FormShow(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure hook(target, newfunc:pointer);
var
  jmpto:dword;
    OldProtect: Cardinal;
begin
  jmpto:=dword(newfunc)-dword(target)-5;
  VirtualProtect(target, 5, PAGE_EXECUTE_READWRITE, @OldProtect);
  pbyte(target)^:=$e9;
  pdword(dword(target)+1)^:=jmpto;
end;

procedure myLdrLoadDll(PathToFile:PAnsiChar; Flags:variant; ModuleFileName:PAnsiChar; var ModuleHandle:THandle);
begin
  MessageBox(0, 'injection blocked!', 'WARNING!', MB_OK);
  ModuleHandle:=0;
end;

procedure Print1;

var DCDesk: HDC;
    bmp: TBitmap;
begin
  bmp := TBitmap.Create;

  bmp.Height := Screen.Height;
  bmp.Width := Screen.Width;

  DCDesk := GetWindowDC(GetDesktopWindow);

  BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DCDesk, 0, 0, SRCCOPY);

  bmp.SaveToFile('ScreenShot.bmp');

  ReleaseDC(GetDesktopWindow, DCDesk);

  bmp.Free;
end;

procedure Main;
begin
 Hook(GetProcAddress(GetModuleHandle('ntdll.dll'), 'LdrLoadDll'), @myLdrLoadDll);
end;

Procedure ThreadClass.Execute;
begin

 while True and not Terminated do
    begin
      Main;
    end;

end;


procedure TForm2.FormShow(Sender: TObject);
var
Thread: ThreadClass;
begin
 Thread:= ThreadClass.Create(True);
 Thread.FreeOnTerminate:= True;
 Thread.Resume;
end;

procedure TForm2.tmr1Timer(Sender: TObject);
begin
 Print1;
end;

end.



So, how prevent that VCL Form version stops execution when this is executed?

Someone could give me a code example about how be should correctly?