home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TSPA3260.ZIP / TSUNTK.TST < prev    next >
Encoding:
Text File  |  1993-01-23  |  1.8 KB  |  81 lines
  1. (* This is a test program for the TSUNTK.TPU unit 23-Jan-93 *)
  2.  
  3. uses TSUNTK;
  4.  
  5. procedure LOGO;
  6. begin
  7.   writeln;
  8.   writeln ('TSUNTK unit test by Prof. Timo Salmi, 23-Jan-93');
  9.   writeln ('University of Vaasa, Finland, ts@uwasa.fi');
  10. {$IFDEF VER40}
  11.   writeln ('TP version 4.0');
  12. {$ENDIF}
  13. {$IFDEF VER50}
  14.   writeln ('TP version 5.0');
  15. {$ENDIF}
  16. {$IFDEF VER55}
  17.   writeln ('TP version 5.5');
  18. {$ENDIF}
  19. {$IFDEF VER60}
  20.   writeln ('TP version 6.0');
  21. {$ENDIF}
  22. {$IFDEF VER70}
  23.   writeln ('TP version 7.0');
  24. {$ENDIF}
  25.   writeln;
  26. end;  (* logo *)
  27.  
  28. (* Display the boot drive *)
  29. procedure TEST1;
  30. begin
  31.    writeln ('The boot drive was ', BOOTDRFN);
  32.    Flush (output);
  33. end;  (* test1 *)
  34.  
  35. (* Return the serial number of a disk *)
  36. procedure TEST2;
  37. var serial : string;
  38.     drive  : char;
  39.     path   : string;
  40. begin
  41.   drive := 'A';
  42.   serial := GETSERFN (drive);
  43.   writeln ('The serial number for ', UpCase(drive), ' is ', serial);
  44. end;  (* test2 *)
  45.  
  46. (* Get the volume label of a MsDos 4.+ disk *)
  47. procedure TEST3;
  48. var volume : string;
  49.     drive  : char;
  50. begin
  51.   drive := 'A';
  52.   volume := GETVOLFN (drive);
  53.   writeln ('The volume label for ', UpCase(drive), ' is ', volume);
  54. end;  (* test3 *)
  55.  
  56. (* Set the serial number of a floppy *)
  57. procedure TEST4;
  58. var serial : string;
  59.     drive  : char;
  60.     path   : string;
  61.     status : integer;
  62. begin
  63.   drive := 'A';
  64.   SETSER (drive, '1FAC-2B4D', status);
  65.   case status of
  66.     -1 : writeln ('Procedure not supported for MsDos versions prior 4.0');
  67.     -2 : writeln ('Unacceptable drive chosen');
  68.     -3 : writeln ('Error in the serial string XXXX-XXXX');
  69.     -4 : writeln ('An error was reported by the MsDos interrupt');
  70.   end; {case}
  71. end;  (* test4 *)
  72.  
  73. (* Main program *)
  74. begin
  75.   LOGO;
  76.   TEST1;
  77.   TEST2;
  78.   {}
  79.   write ('Press <-'' '); readln;
  80. end.  (* tsuntz.tst *)
  81.