home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / hacking / phreak_utils_pc / optimer.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-01  |  2.0 KB  |  111 lines

  1. unit OpTimer;
  2.  
  3. interface
  4.  
  5. procedure InitializeTimer;
  6. procedure RestoreTimer;
  7. function ReadTimer : LongInt;
  8. function ElapsedTime(Start, Stop : LongInt) : Real;
  9. procedure delayms(len: longint);
  10.  
  11. implementation
  12.  
  13. const
  14.   TimerResolution = 1193181.667;
  15. var
  16.   Delta : LongInt;
  17.  
  18. function Cardinal(L : LongInt) : Real;
  19. begin
  20.   if L < 0 then Cardinal := 4294967296.0+L
  21.   else Cardinal := L;
  22. end;
  23.  
  24. function ElapsedTime(Start, Stop : LongInt) : Real;
  25. begin
  26.   ElapsedTime := 1000.0*Cardinal(Stop-(Start+Delta))/TimerResolution;
  27. end;
  28.  
  29. procedure InitializeTimer;
  30. begin
  31.   Port[$43] := $34;
  32.   inline($EB/$00);
  33.   Port[$40] := $00;
  34.   inline($EB/$00);
  35.   Port[$40] := $00;
  36. end;
  37.  
  38. procedure RestoreTimer;
  39. begin
  40.   Port[$43] := $36;
  41.   inline($EB/$00);
  42.   Port[$40] := $00;
  43.   inline($EB/$00);
  44.   Port[$40] := $00;
  45. end;
  46.  
  47. function ReadTimer : LongInt;
  48. begin
  49. asm
  50.   cli
  51.   mov  al,0Ah
  52.   out  20h,al
  53.   xor  al,al
  54.   out  43h,al
  55.   in   al,20h
  56.   mov  di,ax
  57.   in   al,40h
  58.   mov  bl,al
  59.   in   al,40h
  60.   mov  bh,al
  61.   not  bx
  62.   in   al,21h
  63.   mov  si,ax
  64.   mov  al,0FFh
  65.   out  21h,al
  66.   mov  ax,40h
  67.   mov  es,ax
  68.   mov  dx,es:[6Ch]
  69.   mov  ax,si
  70.   out  21h,al
  71.   sti
  72.   mov  ax,di
  73.   test al,1
  74.   jz   @done
  75.   cmp  bx,0FFh
  76.   ja   @done
  77.   inc  dx
  78.   @done:
  79.   mov [bp-4],bx
  80.   mov [bp-2],dx
  81. end;
  82. end;
  83.  
  84. procedure Calibrate;
  85. var
  86.   I : Word;
  87.   L1, L2, Diff : LongInt;
  88. begin
  89.   Delta := MaxInt;
  90.   for I := 1 to 1000 do begin
  91.     L1 := ReadTimer;
  92.     L2 := ReadTimer;
  93.     Diff := L2-L1;
  94.     if Diff < Delta then
  95.       Delta := Diff;
  96.   end;
  97. end;
  98.  
  99. procedure delayms(len: longint);
  100. var start : longint;                           {* Merker fuer Startticks     *}
  101. begin
  102.   start := readtimer;                        {* Merker laden               *}
  103.   repeat                                     {* Solange warten bis...      *}
  104.   until elapsedtime(Start,Readtimer) >= len; {* Zeit vertrichen ist        *}
  105. end;
  106.  
  107. begin
  108.   InitializeTimer;
  109.   Calibrate;
  110. end.
  111.