ANTICHAT — форум по информационной безопасности, OSINT и технологиям

unit WaitThread;

interface

uses Classes, Windows;

type
TWaitThread = class(TThread)
   WaitUntil: TDateTime;
   procedure Execute; override;
end;

implementation

uses SysUtils;

procedure TWaitThread.Execute;
var
Timer: THandle;
SystemTime: TSystemTime;
FileTime, LocalFileTime: TFileTime;
begin
Timer := CreateWaitableTimer(NIL, FALSE, NIL);
try
   DateTimeToSystemTime(WaitUntil, SystemTime);
   SystemTimeToFileTime(SystemTime, LocalFileTime);
   LocalFileTimeToFileTime(LocalFileTime, FileTime);
   SetWaitableTimer(Timer, TLargeInteger(FileTime), 0, 
     NIL, NIL, FALSE);
   WaitForSingleObject(Timer, INFINITE);
finally
   CloseHandle(Timer);
end;
end;

end.

type
TForm1 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
private
   procedure TimerFired(Sender: TObject);
end;

//.....

implementation

uses WaitThread;

procedure TForm1.Button1Click(Sender: TObject);
var
T: TDateTime;
begin
with TWaitThread.Create(TRUE) do
begin
   OnTerminate := TimerFired;
   FreeOnTerminate := TRUE;
   // Срок ожидания закончится через 5 секунд
   WaitUntil := Now + 1 / 24 / 60 / 60 * 5;
   Resume;
end;
end;

procedure TForm1.TimerFired(Sender: TObject);
begin
	ShowMessage('Timer fired !');
end;

procedure TForm1.sButton1Click(Sender: TObject);
begin
  sButton1.Enabled:=false;
  for i:=1 to 50 do
    NewThread:=TNewThread.Create(true);
    NewThread.FreeOnTerminate:=true;
    NewThread.Priority:=tpLOWER;
    NewThread.Resume;
  end;
end;