Еми .. тва е.... максимума който успях да направя след всички бози дето написах
стигнах точност 0.00001 сек

ако някой може да помогне за поне още един разряд( ако е възможно) ще съм му very благодарен :)))))

или поне как да прескоча драйверите на LPT-то....
//==================================

procedure TForm1.Button1Click(Sender: TObject);
const b8 = 8;
var
PriorityClass : Integer;
Priority : Integer;
//
i,mi : Int64 ;
bg : TDateTime ;
P : Pointer ;
l : BYTE ;
Pd : ^comp ;
// b : BYTE ;
TimeStamp: record case byte of
1: (Whole: comp);
2: (Lo, Hi: cardinal);
end;
begin
if ( Assigned(str) ) then str.Free; // str : TMemoryStream ; //global
str := Nil;
str := TMemoryStream.Create;
str.SetSize(sz); // const sz = 10

Caption := 'Starting...';
i := 0;
mi := SpE.Value; // SpinEdit default value = 1000000
bg := Now;

l := SizeOf(comp);
P := @l;
New(Pd);

// bOK := QueryPerformanceFrequency(Res); // Res = 3579545 // 1.6GHz CPU

if not SmallPort1.Opened then SmallPort1.Opened := true; // http://www.qsl.net/om3cph/dds/lpt.html download smport

PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
Sleep(10);
//
repeat
{ asm
MOV DX, 379H
IN AL,DX
MOV b, AL
end;
if ( b and b8=0 ) then }

if ( SmallPort1.Port[$379] and b8 = 0) then
begin
// Pd^ := RDTSC; // function move next for optimal speed
asm
db $0F; db $31;
mov [TimeStamp.Lo], eax
mov [TimeStamp.Hi], edx
end;
Pd^ := TimeStamp.Whole;

str.Write(Pd^,l);
repeat
{ asm
MOV DX, 379H
IN AL,DX
MOV b, AL
end
until b and b8 = b8;}
until (SmallPort1.Port[$379] and b8 = b8 );
end;
Inc(i);
until i > mi;
l := 0;
str.Write(P^,SizeOf(BYTE));
//
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Caption := 'Stoped ' + FormatDateTime('hh:nn:ss:zzz',Now - bg);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i : Byte ;
// ns,lns : TLargeInteger ;
ns,lns : comp ;
L : TStringList ;
begin
L := TStringList.Create ;
Str.Position := 0;
lns := 0;
i := SizeOf(comp);
repeat
Str.Read(ns,i);
L.Add(FormatFloat('0.000000000',ns - lns));
lns := ns;
until Str.Position >=Str.Size;
Mlog.Lines.Text := L.Text;
end;


====
резултат при CPU 1.13GHz (1133MHz)

tick interval / CPU sek

564807412 1133000000 0,498506101
564803166 1133000000 0,498502353
564805390 1133000000 0,498504316
564807063 1133000000 0,498505793
564805605 1133000000 0,498504506
564805721 1133000000 0,498504608
564804308 1133000000 0,498503361
564806852 1133000000 0,498505606
564805650 1133000000 0,498504545
564804713 1133000000 0,498503718
564803857 1133000000 0,498502963
564806709 1133000000 0,49850548
564802713 1133000000 0,498501953
564807849 1133000000 0,498506486
564806977 1133000000 0,498505717
564805400 1133000000 0,498504325