home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 9 / CD_ASCQ_09_1193.iso / news / 558 / tspa40 / tsunt45.tst < prev    next >
Text File  |  1993-01-22  |  3KB  |  120 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, Sat 23-Jan-1993');
  15.   writeln ('University of Vaasa, Finland, ts@uwasa.fi');
  16. {$IFDEF VER40}
  17.   writeln ('TP version 4.0');
  18. {$ENDIF}
  19. {$IFDEF VER50}
  20.   writeln ('TP version 5.0');
  21. {$ENDIF}
  22. {$IFDEF VER55}
  23.   writeln ('TP version 5.5');
  24. {$ENDIF}
  25. {$IFDEF VER60}
  26.   writeln ('TP version 6.0');
  27. {$ENDIF}
  28. {$IFDEF VER70}
  29.   writeln ('TP version 7.0');
  30. {$ENDIF}
  31.   writeln;
  32. end;
  33.  
  34. (* Which Dos version *)
  35. procedure TEST1;
  36. begin
  37.   writeln ('Dos version ', Lo(DosVersion), '.', Hi(DosVersion));
  38. end;  (* test1 *)
  39.  
  40. (* Number of environment strings *)
  41. procedure TEST2;
  42. begin
  43.   write ('The number of environment strings is ');
  44.   writeln (EnvCount);
  45. end;  (* test2 *)
  46.  
  47. (* Display environment strings *)
  48. procedure TEST3;
  49. var i : integer;
  50. begin
  51.   for i := 1 to EnvCount do writeln (EnvStr(i));
  52. end;  (* test3 *)
  53.  
  54. (* Display a particular environment string *)
  55. procedure TEST4;
  56. var i : integer;
  57. begin
  58.   writeln ('Path is ', GetEnv('path'));
  59.   Flush (output);
  60. end;  (* test4 *)
  61.  
  62. (* The name of the current program *)
  63. procedure TEST5;
  64. begin
  65.   writeln (ParamStr0);
  66. end;  (* test5 *)
  67.  
  68. (* The expanded name of any program *)
  69. procedure TEST6;
  70. begin
  71.   writeln (FExpand('anyprog'));
  72. end;  (* test6 *)
  73.  
  74. (* Is the disk write verification on or off, cf MsDos verify command *)
  75. procedure TEST7;
  76. var yes : boolean;
  77. begin
  78.   GetVerify (yes);
  79.   if yes then
  80.     writeln ('System verify (read-after-write) flag is on')
  81.     else
  82.     writeln ('System verify (read-after-write) flag is off')
  83. end;  (* test7 *)
  84.  
  85. (* Set the MsDos disk write verify flag, c.f. the MsDos verify command *)
  86. procedure TEST8;
  87. begin
  88.   SetVerify (true);
  89.   TEST7;
  90.   SetVerify (false);
  91.   TEST7;
  92. end;  (* test8 *)
  93.  
  94. (* Return state of Ctr-Break checking in DOS *)
  95. procedure TEST9;
  96. var yes : boolean;
  97. begin
  98.   SetCBreak (false);
  99.   GetCBreak (yes);
  100.   if yes then writeln ('Crtl-Break checking is on')
  101.     else writeln ('Crtl-Break checking is off');
  102.   SetCBreak (true);
  103.   GetCBreak (yes);
  104.   if yes then writeln ('Crtl-Break checking is on')
  105.     else writeln ('Crtl-Break checking is off');
  106. end;  (* test9 *)
  107.  
  108. (* Main program: the tests *)
  109. begin
  110.   LOGO;
  111.   TEST1;
  112.   TEST2;
  113.   TEST3;
  114.   TEST4;
  115.   TEST5;
  116.   TEST6;
  117.   TEST8;
  118.   TEST9;
  119. end.  (* tsunt45.tst *)
  120.