home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Pascal / HISOFTPASCAL2,0-2.DMS / in.adf / Demos / UtilUnit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-12-31  |  2.2 KB  |  116 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. {
  12.  
  13.         The Exist function shows how to use Assign as in Turbo Pascal.
  14. }
  15.         
  16. INTERFACE
  17.  
  18. Uses DOS,Crt;
  19.  
  20. Const
  21.         Version = 1.1;
  22. Var
  23.         StrIn   : Text;   { Read }
  24.         StrOut  : Text;   { Write }
  25.         StrData : String; { IO buffer for StrIn and StrOut }
  26.  
  27. Function Int2Str(Num : Integer) : String;
  28. Function Exist(Filename : PathStr) : Boolean;
  29. Procedure WaitToGo(KeyVal : Byte);
  30. Function NoSpaces(S : String) : String;
  31. Function UpperStr(S : String) : String;
  32. Procedure ClearStrInOut;
  33.  
  34. IMPLEMENTATION
  35.  
  36. Function Exist(Filename : PathStr) : Boolean;
  37. Var
  38.         Dummy : File;
  39.         IOres : Integer;
  40. Begin
  41.   Assign(Dummy,FileName);
  42.   {$I-} 
  43.   Reset(Dummy); 
  44.   {$I+}
  45.   IOres := IOresult;
  46.   If (IOres = 0) then
  47.     Close(Dummy);
  48.   Exist := IOres = 0;
  49. End;
  50.  
  51. Function Int2Str(Num : Integer) : String;
  52. Var
  53.         Res : String;
  54. Begin
  55.   Str(Num, Res); Int2Str := Res;
  56. End;
  57.  
  58. Procedure WaitToGo(KeyVal : Byte);
  59. Begin
  60.   Repeat Until (ReadKey = Chr(KeyVal));
  61. End;
  62.  
  63. Function NoSpaces(S : String) : String;
  64. Begin
  65.   While (Pos(#32,S) > 0) Do
  66.     Delete(S,Pos(#32,S),1);
  67.   NoSpaces := S;
  68. End;
  69.  
  70. Function UpperStr(S : String) : String;
  71. Var
  72.      X : Byte;
  73. Begin
  74.   For X := 1 To Length(S) Do
  75.     S[X] := UpCase(S[X]);
  76.   UpperStr := S;
  77. End;
  78.  
  79. Procedure ClearStrInOut;
  80. Begin
  81.   While Not(Eof(StrIn)) Do
  82.     ReadLn(StrIn);
  83. End;
  84.  
  85. Procedure StrInOutHandler(Var F : TextRec);
  86. Var
  87.         Tmp : String;
  88. Begin
  89.   With F Do
  90.     Begin
  91.       If fInpFlag then
  92.         Begin { read }
  93.           Move(StrData[1],fBufPtr^[0],Length(StrData));
  94.           fBufEnd := Length(StrData);
  95.           StrData := '';
  96.         End
  97.       Else
  98.         Begin { write }
  99.           Move(fBufPtr^[0],Tmp[1],fBufPos);
  100.           Tmp[0] := Chr(fBufPos);
  101.           Insert(Tmp,StrData,Length(StrData)+1);
  102.         End;
  103.       fBufPos := 0;
  104.     End;
  105. End;
  106.  
  107. Var     
  108.         DevBuf : TDevBuf;
  109. BEGIN
  110.   Device('StrInOut',@StrInOutHandler,DevBuf);
  111.   Assign(StrIn,'StrInOut');
  112.   Reset(StrIn);
  113.   Assign(StrOut,'StrInOut');
  114.   Rewrite(StrOut);
  115. END.
  116.