home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / VOL.ZIP / VOLTEST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-01-19  |  3.5 KB  |  153 lines
  1. program VOLTEST;
  2. uses
  3.    CRT,DOS,VOL;
  4.  
  5.  (* Type VolumeName declared in VOL as String[11] *)
  6.  (* Type Drive      declared in VOL as Byte *)
  7.  
  8. var
  9.    sel : Byte;
  10.  
  11. procedure PressKey;
  12. var
  13.    ch : Char;
  14. Begin
  15.    Write ('Press any key ...');
  16.    ch:= ReadKey;
  17.    If ch = #0 Then ch:= ReadKey;
  18.    Writeln
  19. End;
  20.  
  21. function GetKey (max : Byte) : Byte;
  22. var
  23.    ch : Char;
  24. Begin
  25.    Repeat
  26.       ch:= UpCase (ReadKey);
  27.       If ch = #27 Then
  28.       Begin
  29.          GetKey:= 0;
  30.          Exit
  31.       End
  32.    Until (ch >= 'A') OR (ch <= Chr (max+64));
  33.    Write (ch);
  34.    GetKey:= Ord (ch) - 64
  35. End;
  36.  
  37. procedure Get_Choice (var sel:byte);
  38. begin
  39.    Writeln ('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
  40.    Writeln ('    A. Add Volume Name');
  41.    Writeln ('    B. Change Volume Name');
  42.    Writeln ('    C. Delete Volume Name');
  43.    Writeln ('    D. Get Volume Name');
  44.    Writeln ('    E. (or Esc) = QUIT');
  45.    Writeln;
  46.    Writeln ('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
  47.    Writeln;
  48.    Write ('Press the Proper Letter => ');
  49.    sel:= GetKey (5)
  50. end;
  51.  
  52.  (*********************************************************************)
  53.  (*********************************************************************)
  54.  
  55. procedure AV (dr:Drive);
  56. var
  57.    so,
  58.    st  : VolumeName;
  59. Begin
  60.    Write ('New Volume Label (11 Characters Max) => ');
  61.    Readln (st);
  62.    If Length (st) = 0 Then Exit;
  63.    Writeln;
  64.    If ADDVOL (dr,st) Then
  65.       Writeln ('New Volume Label Added.')
  66.    Else
  67.       Writeln ('ERROR in Adding New Volume Label.');
  68.    Writeln;
  69.    PressKey
  70. End;
  71.  
  72. procedure CV (dr:Drive);
  73. var
  74.    so,
  75.    st  : VolumeName;
  76. Begin
  77.    Writeln;
  78.    so:= GetVol (dr);
  79.    If Length (so) = 0 Then
  80.       Begin
  81.          Writeln ('ERROR in Reading Volume Label or no Volume Label found.');
  82.          Writeln;
  83.          PressKey
  84.       End
  85.    else
  86.       begin
  87.          writeln ('Old Volume Label is ',so);
  88.          write ('New Volume Label (11 Characters Max) => ');
  89.          readln (st);
  90.          if Length (st) > 0 Then
  91.             begin
  92.                writeln;
  93.                if ChgVol (dr,st) Then
  94.                   Writeln ('Volume Label Changed.')
  95.                else
  96.                   Writeln ('ERROR in Changing Volume Label.');
  97.                writeln;
  98.                pressKey
  99.             end
  100.       end
  101. end;
  102.  
  103. procedure DV (dr:Drive);
  104. Begin
  105.    If DELVOL (dr) Then
  106.       Writeln ('Volume Label Deleted.')
  107.    Else
  108.       Writeln ('ERROR in Deleting Volume Label.');
  109.    Writeln;
  110.    PressKey
  111. End;
  112.  
  113. procedure GV (dr:Drive);
  114. var
  115.    st  : VolumeName;
  116. Begin
  117.    st:= GetVol (dr);
  118.    If Length (st) > 0 Then
  119.       Writeln ('Current Label is ',st)
  120.    Else
  121.       Writeln ('ERROR in Reading Volume Label or no Volume Label found.');
  122.    Writeln;
  123.    PressKey
  124. End;
  125.  
  126.  (*********************************************************************)
  127.  (*                          MAIN PROGRAM                             *)
  128.  (*********************************************************************)
  129. var dr:Drive;
  130. Begin
  131.    Repeat
  132.       ClrScr;
  133.       Get_Choice (sel);
  134.       if sel in [1..4] then
  135.          begin
  136.             Writeln;
  137.             Writeln;
  138.             Write ('Drive Letter ( or Esc ) => ');
  139.             dr:= GetKey (26);
  140.             If dr >  0 Then
  141.                begin
  142.                   Writeln (':');
  143.                   Case sel of
  144.                      1 : AV (dr);
  145.                      2 : CV (dr);
  146.                      3 : DV (dr);
  147.                      4 : GV (dr)
  148.                   End
  149.                end
  150.          end
  151.    Until (sel = 5) OR (sel = 0)
  152. End.
  153.