NtDelayExecution(
  IN BOOLEAN              Alertable,
  IN PLARGE_INTEGER       DelayInterval );

function cyclepermks(pau_dur:Int64):Int64;
var tstsc,tetsc,p:Int64;
begin
 p:=-10*pau_dur;
 tstsc:=tsc;
 NtDelayExecution(false,@p);
 tetsc:=tsc-tstsc;
 cyclepermks:=(tetsc-calibrate_runtime) *1000 div pau_dur;
end;

procedure NtDelayExecution(Alertable:boolean;Interval:PInt64); stdcall; external 'ntdll.dll';

var test_result,temp_result:string; n:Int64; i:byte; aver,t_res:Int64; res:TextFile;
begin
 WriteLn('The program will generate a file containing the table of results of measurements of quantity of cycles of the processor in a mikrosecond. Time of measurement is chosen'+' miscellaneous, intervals: 1, 10, 100, 1000, 10000, 100000, 1000000, 10000000 mks. You will see distinctions of measurements. If an interval of measurement longer - results will be more exact.');
 WriteLn;
 Writeln('Expected time of check - 1 minute. Press any key for start of the test...');
 temp_result:='Delay :'+#9+'Test 1:'+#9+'Test 2:'+#9+'Test 3:'+#9+'Test 4:'+#9+'Test 5:'+#9+'Average:';
 n:=1;
 test_result:=temp_result;
 WriteLn(test_result);
 while n<=10000000 do
  begin
   temp_result:='10^'+IntToStr(length(IntToStr(n))-1)+'mks'+#9;
   aver:=0;
   for i:=1 to 5 do
    begin
     t_res:=cyclepermks(n);
     aver:=aver+t_res;
     temp_result:=temp_result+IntToStr(t_res)+#9;
    end;
   WriteLn(temp_result+IntToStr(aver div 5));
   test_result:=test_result+#13+#10+temp_result+IntToStr(aver div 5);
   n:=n*10;
  end;
 WriteLn;
 AssignFile(res,'TCC_NTAPI.xls');
 ReWrite(res);
 Write(res,test_result);
 CloseFile(res);
 WriteLn('The test is completed. The data are saved in a file TCC_NTAPI.xls.');
 Writeln('Press any key for an exit...');
 ReadLn;
end.

function cyclepermks(pau_dur:Int64):Int64;
var tstsc,tetsc,p:Int64; tmr:cardinal;
begin
 tmr:=CreateWaitableTimer(nil, false, nil);
 p:=-10*pau_dur;
 tstsc:=tsc;
 SetWaitableTimer(tmr, p, 0, nil, nil, false);
 WaitForSingleObjectEx(tmr, infinite, true);
 CloseHandle(tmr);
 tetsc:=tsc-tstsc;
 cyclepermks:=(tetsc-calibrate_runtime2) *1000 div pau_dur;
end;

function calibrate_runtime2:Int64;
var i:byte; tstsc,tetsc,crtm, p:Int64; tmr:cardinal;
begin
 tstsc:=tsc;
 crtm:=tsc-tstsc;
 for i:=0 to 9 do
  begin
   tmr:=CreateWaitableTimer(nil, false, nil);
   p:=0;
   tstsc:=tsc;
   SetWaitableTimer(tmr, p, 0, nil, nil, false);
   CloseHandle(tmr);
   crtm:=tsc-tstsc;
   if tetsc<crtm then crtm:=tetsc;
  end;
 calibrate_runtime2:=crtm;
end;