home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HISPEED2.LZH / UNITS / UTILUNIT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-26  |  3KB  |  130 lines
  1. {$D+}
  2. UNIT UtilUnit;
  3.  
  4. { Filename: UtilUnit.pas      }
  5. { Coder   : Jacob V. Pedersen }
  6. { Coded   : 06-02-1991        }
  7. { Purpose : Example           }
  8.  
  9. { This unit contains some routines that might come in handy. }
  10.  
  11. { Changes in version 1.1:    
  12.  
  13.         For an example of how to use the new Inline Assembler,
  14.         take a look at the HZ200 function.
  15.  
  16.         The Exist function shows how to use Assign as in Turbo Pascal.
  17. }
  18.         
  19. INTERFACE
  20.  
  21. Uses DOS;
  22.  
  23. Const
  24.         Version = 1.1;
  25. Var
  26.         StrIn   : Text;   { Read }
  27.         StrOut  : Text;   { Write }
  28.         StrData : String; { IO buffer for StrIn and StrOut }
  29.  
  30. Function Int2Str(Num : Integer) : String;
  31. Function Exist(Filename : PathStr) : Boolean;
  32. Procedure WaitToGo(KeyVal : Byte);
  33. Function NoSpaces(S : String) : String;
  34. Function UpperStr(S : String) : String;
  35. Procedure ClearStrInOut;
  36. Function HZ200 : LongInt;
  37.  
  38. IMPLEMENTATION
  39.  
  40. Function HZ200 : LongInt; ASSEMBLER;
  41. ASM
  42.         CLR.L   -(SP)           { Enter SuperVisor mode }
  43.         MOVE.W  #$20,-(SP)      
  44.         TRAP    #1              
  45.         MOVE.L  $4BA,@result    { Get long-word containing HZ200 counter }         MOVE.L  D0,2(SP) 
  46.         MOVE.L  D0,2(SP)        { Exit SuperVisor mode }
  47.         TRAP    #1
  48.         ADDQ.W  #6,SP           { Cleanup stack }                     
  49. END;
  50.  
  51. Function Exist(Filename : PathStr) : Boolean;
  52. Var
  53.         Dummy : File;
  54.         IOres : Integer;
  55. Begin
  56.   Assign(Dummy,FileName);
  57.   {$I-} 
  58.   Reset(Dummy); 
  59.   {$I+}
  60.   IOres := IOresult;
  61.   If (IOres = 0) then
  62.     Close(Dummy);
  63.   Exist := IOres = 0;
  64. End;
  65.  
  66. Function Int2Str(Num : Integer) : String;
  67. Var
  68.         Res : String;
  69. Begin
  70.   Str(Num, Res); Int2Str := Res;
  71. End;
  72.  
  73. Procedure WaitToGo(KeyVal : Byte);
  74. Begin
  75.   Repeat Until (ReadKey = Chr(KeyVal));
  76. End;
  77.  
  78. Function NoSpaces(S : String) : String;
  79. Begin
  80.   While (Pos(#32,S) > 0) Do
  81.     Delete(S,Pos(#32,S),1);
  82.   NoSpaces := S;
  83. End;
  84.  
  85. Function UpperStr(S : String) : String;
  86. Var
  87.      X : Byte;
  88. Begin
  89.   For X := 1 To Length(S) Do
  90.     S[X] := UpCase(S[X]);
  91.   UpperStr := S;
  92. End;
  93.  
  94. Procedure ClearStrInOut;
  95. Begin
  96.   While Not(Eof(StrIn)) Do
  97.     ReadLn(StrIn);
  98. End;
  99.  
  100. Procedure StrInOutHandler(Var F : TextRec);
  101. Var
  102.         Tmp : String;
  103. Begin
  104.   With F Do
  105.     Begin
  106.       If fInpFlag then
  107.         Begin { read }
  108.           Move(StrData[1],fBufPtr^[0],Length(StrData));
  109.           fBufEnd := Length(StrData);
  110.           StrData := '';
  111.         End
  112.       Else
  113.         Begin { write }
  114.           Move(fBufPtr^[0],Tmp[1],fBufPos);
  115.           Tmp[0] := Chr(fBufPos);
  116.           Insert(Tmp,StrData,Length(StrData)+1);
  117.         End;
  118.       fBufPos := 0;
  119.     End;
  120. End;
  121.  
  122. Var     
  123.         DevBuf : TDevBuf;
  124. BEGIN
  125.   Device('StrInOut',@StrInOutHandler,DevBuf);
  126.   Assign(StrIn,'StrInOut');
  127.   Reset(StrIn);
  128.   Assign(StrOut,'StrInOut');
  129.   Rewrite(StrOut);
  130. END.