home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / dossys / vollabel / volume.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1993-05-22  |  2.8 KB  |  123 lines
  1. PROGRAM Volume;
  2. USES {$IFDEF DPMI} Crt, {$ELSE} WinProcs,WinCRT, {$ENDIF}  VolFuncs;
  3. VAR
  4.   DriveNum    : Byte;
  5.   DriveLet, C : Char;
  6.   V           : VolString;
  7.   HasLabel    : Boolean;
  8.  
  9. {$IFNDEF WINDOWS}
  10.   PROCEDURE Beep;
  11.   BEGIN
  12.     Sound(2000); Delay(100);
  13.     Sound(1000); Delay(200);
  14.     NoSound;
  15.   END;
  16.   {$ELSE}
  17.   Procedure Beep;
  18.   begin
  19.      MessageBeep(0);
  20.   end;
  21.   {$ENDIF}
  22.  
  23.   PROCEDURE SyntaxOut;
  24.   BEGIN
  25.     Beep;
  26.     WriteLn('Syntax: "VOLUME [d:]"   ',
  27.             '(d: is a drive letter)');
  28.     Halt;
  29.   END;
  30.  
  31.   PROCEDURE GetParameters;
  32.   BEGIN
  33.     CASE ParamCount OF
  34.       0 : DriveNum := 0;
  35.       1 : BEGIN
  36.             V := ParamStr(1);
  37.             DriveLet := UpCase(V[1]);
  38.             DriveNum := Ord(DriveLet) - Ord('@');
  39.             IF (DriveNum < 1) OR (DriveNum > 26) THEN
  40.               SyntaxOut;
  41.           END;
  42.       ELSE SyntaxOut;
  43.     END;
  44.   END;
  45.  
  46.   PROCEDURE GetExistingLabel;
  47.   BEGIN
  48.     V := '';
  49.     Write('Volume in drive ',DriveLet,' ...');
  50.     IF GetLabel(DriveNum, V) THEN
  51.       BEGIN
  52.         WriteLn(#8#8#8'is ',V);
  53.         HasLabel := TRUE;
  54.       END
  55.     ELSE
  56.       BEGIN
  57.         WriteLn(#8#8#8'has no label');
  58.         HasLabel := FALSE;
  59.       END;
  60.   END;
  61.  
  62.   PROCEDURE GetNewLabel;
  63.   VAR C : Char;
  64.   BEGIN
  65.     Write('Volume label (11 characters, ',
  66.           'ENTER for none)?');
  67.     V := '';
  68.     REPEAT
  69.       C := UpCase(ReadKey);
  70.       CASE C OF
  71.         #0 : C := UpCase(ReadKey); {read extended key}
  72.         #8 : IF length(V) > 0 THEN
  73.                BEGIN
  74.                  Dec(V[0]);
  75.                  Write(#8,' ',#8);
  76.                END
  77.              ELSE Beep;
  78.         #13 : ; {ok}
  79.         #0..#31 : Beep;
  80.         ELSE
  81.           IF length(V) < 11 THEN
  82.             BEGIN
  83.               Inc(V[0]);
  84.               Write(C);
  85.               V[length(V)] := C;
  86.             END
  87.           ELSE Beep;
  88.       END;
  89.     UNTIL C = #13;
  90.     WriteLn;
  91.   END;
  92.  
  93. BEGIN
  94.   GetParameters;
  95.   GetExistingLabel;
  96.   GetNewLabel;
  97.   IF V = '' THEN
  98.     BEGIN
  99.       Write('Delete current volume label (Y/N)? ');
  100.       REPEAT
  101.         C := UpCase(ReadKey);
  102.       UNTIL (C = 'Y') OR (C = 'N');
  103.       WriteLn(C);
  104.       Write('Label of volume in drive ',
  105.              DriveLet,' ...');
  106.       IF C = 'Y' THEN
  107.         IF DelLabel(DriveNum) THEN
  108.           WriteLn(#8#8#8'successfully deleted.')
  109.         ELSE WriteLn(#8#8#8'was not deleted.')
  110.       ELSE WriteLn(#8#8#8,'will not be deleted.');
  111.     END
  112.   ELSE
  113.     BEGIN
  114.       Write('Label of volume in drive ',
  115.              DriveLet,' ...');
  116.       IF (NOT HasLabel) OR DelLabel(DriveNum) THEN
  117.         IF SetLabel(DriveNum, V) THEN
  118.           WriteLn(#8#8#8'changed to ',V,'.')
  119.         ELSE WriteLn(#8#8#8'was not changed.')
  120.       ELSE WriteLn(#8#8#8,'could not be replaced.');
  121.     END;
  122. END.
  123.