home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tspa / tp4 / tsunt45.tst < prev    next >
Encoding:
Text File  |  1992-01-01  |  2.2 KB  |  105 lines
  1. {$M 16384,0,655360}
  2.  
  3. (* This is a test program for the TSUNT45.TPU unit *)
  4.  
  5. uses Dos
  6.      {$IFDEF VER40}
  7.      ,TSUNT45
  8.      {$ENDIF}
  9.      ;
  10.  
  11. procedure LOGO;
  12. begin
  13.   writeln;
  14.   writeln ('TSUNT45 unit test by Prof. Timo Salmi, Wed 01-Jan-92');
  15.   writeln ('University of Vaasa, Finland, ts@chyde.uwasa.fi');
  16.   writeln;
  17. end;
  18.  
  19. (* Which Dos version *)
  20. procedure TEST1;
  21. begin
  22.   writeln ('Dos version ', Lo(DosVersion), '.', Hi(DosVersion));
  23. end;  (* test1 *)
  24.  
  25. (* Number of environment strings *)
  26. procedure TEST2;
  27. begin
  28.   write ('The number of environment strings is ');
  29.   writeln (EnvCount);
  30. end;  (* test2 *)
  31.  
  32. (* Display environment strings *)
  33. procedure TEST3;
  34. var i : integer;
  35. begin
  36.   for i := 1 to EnvCount do writeln (EnvStr(i));
  37. end;  (* test3 *)
  38.  
  39. (* Display a particular environment string *)
  40. procedure TEST4;
  41. var i : integer;
  42. begin
  43.   writeln ('Path is ', GetEnv('path'));
  44.   Flush (output);
  45. end;  (* test4 *)
  46.  
  47. (* The name of the current program *)
  48. procedure TEST5;
  49. begin
  50.   writeln (ParamStr0);
  51. end;  (* test5 *)
  52.  
  53. (* The expanded name of any program *)
  54. procedure TEST6;
  55. begin
  56.   writeln (FExpand('anyprog'));
  57. end;  (* test6 *)
  58.  
  59. (* Is the disk write verification on or off, cf MsDos verify command *)
  60. procedure TEST7;
  61. var yes : boolean;
  62. begin
  63.   GetVerify (yes);
  64.   if yes then
  65.     writeln ('System verify (read-after-write) flag is on')
  66.     else
  67.     writeln ('System verify (read-after-write) flag is off')
  68. end;  (* test7 *)
  69.  
  70. (* Set the MsDos disk write verify flag, c.f. the MsDos verify command *)
  71. procedure TEST8;
  72. begin
  73.   SetVerify (true);
  74.   TEST7;
  75.   SetVerify (false);
  76.   TEST7;
  77. end;  (* test8 *)
  78.  
  79. (* Return state of Ctr-Break checking in DOS *)
  80. procedure TEST9;
  81. var yes : boolean;
  82. begin
  83.   SetCBreak (false);
  84.   GetCBreak (yes);
  85.   if yes then writeln ('Crtl-Break checking is on')
  86.     else writeln ('Crtl-Break checking is off');
  87.   SetCBreak (true);
  88.   GetCBreak (yes);
  89.   if yes then writeln ('Crtl-Break checking is on')
  90.     else writeln ('Crtl-Break checking is off');
  91. end;  (* test9 *)
  92.  
  93. (* Main program: the tests *)
  94. begin
  95.   LOGO;
  96.   TEST1;
  97.   TEST2;
  98.   TEST3;
  99.   TEST4;
  100.   TEST5;
  101.   TEST6;
  102.   TEST8;
  103.   TEST9;
  104. end.  (* tsunt45.tst *)
  105.