Отправлено Perforator 16 октября 2003 г. 12:53 В ответ на: Вопрос в том, что надо измерять время с точностью до 1mS, а программист утверждает, что под Win через API это невозможно в принципе. отправлено КБ 16 октября 2003 г. 12:23

Function GlobalTime:Cardinal;
var l:TLargeInteger;
c:Array [1..2] Of Cardinal absolute L;
begin
QueryPerformanceCounter(l);
GlobalTime:=c[1];
end;

Function GetLoTick:Cardinal; assembler;
asm
DW $310F // rdtsc
end;

Function GetHiTick:Cardinal; assembler;
asm
DW $310F
MOV EAX,EDX
end;

Procedure Stop_Windows; assembler;
begin
SetPriorityClass(GetCurrentProcess, RealTime_PRIORITY_CLASS);
If Win32Platform<>VER_PLATFORM_WIN32_NT then
asm
cli
end;
end;

Procedure Start_Windows; assembler;
begin
SetPriorityClass(GetCurrentProcess, Normal_PRIORITY_CLASS);
If Win32Platform<>VER_PLATFORM_WIN32_NT then
asm
sti
end;
// Application.ProcessMessages;
end;

А вот тут - пример использования :

procedure TMainForm.FormCreate(Sender: TObject);
var i,j:word;
l:TLargeInteger;
c:Array [1..2] of Cardinal absolute l;
l1,l2,t1,t2:TLargeInteger;
_11:Array [1..2] of Cardinal absolute l1;
_22:Array [1..2] of Cardinal absolute l2;
begin
QueryPerformanceFrequency(l);
Stop_Windows;
t1:=GlobalTime;
_11[2]:=GetHiTick;
_11[1]:=GetLoTick;
If GetHiTick<>_11[2] then
begin
_11[1]:=GetLoTick;
_11[2]:=_11[2]+1;
end;
Sleep(1000);
t2:=GlobalTime;
_22[2]:=GetHiTick;
_22[1]:=GetLoTick;
If GetHiTick<>_22[2] then
begin
_22[1]:=GetLoTick;
_22[2]:=_22[2]+1;
end;
Start_Windows;
Freq:=Round((l2-l1)/(t2-t1)*c[1]);
Tics_Mcs:=Round(Freq*0.000001);
...

И подпрограммка задержки на единицы микросекунд ...

Procedure Delay(n_mcs:word);
var max_time:longint;
st_time,cur_time:TLargeInteger;
st_arr:Array[1..2] of Cardinal absolute st_time;
cur_arr:Array [1..2] of Cardinal absolute cur_time;
begin
st_arr[2]:=GetHiTick;
st_arr[1]:=GetLoTick;
If GetHiTick<>st_arr[2] then
begin
st_arr[1]:=GetLoTick;
st_arr[2]:=st_arr[2]+1;
end;
max_time:=Tics_Mcs*n_mcs;
cur_arr[2]:=GetHiTick;
cur_arr[1]:=GetLoTick;
If GetHiTick<>cur_arr[2] then
begin
cur_arr[2]:=cur_arr[2]+1;
cur_arr[1]:=GetLoTick;
end;
While (cur_time-st_time) begin
cur_arr[2]:=GetHiTick;
cur_arr[1]:=GetLoTick;
If GetHiTick<>cur_arr[2] then
begin
cur_arr[2]:=cur_arr[2]+1;
cur_arr[1]:=GetLoTick;
end;
end;
end;

• это точно, как перфоратором зубы рвать — DASM   (16.10.2003 15:13, пустое)