Е толкова мога засега.. тава можах да измъдря...
(единствената оптимизация която се сещам че още може да направя е:
да пиша в стрийма само стоностите на таймера без дължината отпред щото данните ми са еднотипни... преди това имаше друга идея и затова съм сложил байт за дължина)

//=========================================================
procedure TForm1.Button1Click(Sender: TObject);
const b8 = 8;
var
PriorityClass : Integer;
Priority : Integer;
//
i,mi : Int64 ;
bg : TDateTime ;
P : Pointer ;
l : BYTE ;
Pd : ^TDateTime ;
lv : BYTE ;
v : Integer ;
tbg : TLargeInteger ;
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(TLargeInteger);
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
lv := SmallPort1.Port[$379];
if ( lv and b8 = b8) then
begin
QueryPerformanceCounter(tbg);
Pd^ := tbg;
str.Write(P^,SizeOf(BYTE));
str.Write(Pd^,l);
while ( SmallPort1.Port[$379] and v8 = v8 ) do
begin
Inc(i);
if i > mi then Break;
end;
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 ;
L : TStringList ;
begin
L := TStringList.Create ;
Str.Position := 0;
lns := 0;
repeat
Str.Read(i,SizeOf(Byte));
if ( i > 0 ) then
begin
Str.Read(ns,i);
L.Add(FormatFloat('0',(ns - lns)));
lns := ns;
end;
until i < 1;
Mlog.Lines.Text := L.Text;
end;

(* tova e rezultata pri mi = 10 000 000 ~ 00:00:39:682(time)
4,77354417733907E18
117304983552
117305573376
117306228736
117305704448
117305769984
117305507840
117306359808
117305704448
117305507840
117305376768
117305835520
117306163200
117305376768
117305966592
117305638912
117305573376
117306294272
117305245696
117305769984
117306032128
117305901056
117305114624
117306294272
117305442304
117305638912
117306294272
117305180160
117305704448
117306163200
117305835520
117305769984
117305638912
117305769984
117305507840
117305638912
117305966592
117305507840
117306032128
117305573376
117306032128
117305442304
117305769984
117305704448
117306097664
117305573376
117305573376
117305966592
117305704448
117306097664
117305049088
117306556416
117305049088
117305901056
117306228736
117305769984
117305311232
117305966592
117305573376
117305507840
117305769984
117306294272
117305507840
117306032128
117305638912
117305245696
117306359808
117305507840
117305704448
117305835520
117305376768
117306294272
117305638912
117306163200
117305311232
117305638912
117305376768
117306490880
117305245696
117305507840
*)