home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 04 / tricks / tplabel.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-01-09  |  4.8 KB  |  175 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    TPLABEL.PAS                         *)
  3. (* Dieses Programm demonstriert den Umgang mit Disketten- *)
  4. (* und Festplatten-Labels. TPLabel hat den gleichen       *)
  5. (* Funktionsumfang wie MS-DOS Label; Labels können        *)
  6. (* angelegt, umbenannt und gelöscht werden.               *)
  7. (*            (c) 1991 Michael Plewe & TOOLBOX            *)
  8. (* ------------------------------------------------------ *)
  9. PROGRAM TPLabel;
  10.  
  11. USES Crt, Dos;
  12.  
  13. TYPE
  14.   str11 = STRING [11];
  15.  
  16. CONST
  17.   New     : BOOLEAN = FALSE;
  18.   Message : STRING  =
  19.     'TPLABEL Version 1.0  (c) 1991 Michael Plewe & TOOLBOX';
  20.   Drive   : STRING [1] = 'C';
  21.   FCB     : ARRAY [0..45] OF BYTE =
  22.                     ($FF, $00, $00, $00, $00, $00, $08, $03,
  23.                      $00, $00, $00, $00, $00, $00, $00, $00,
  24.                      $00, $00, $00, $00, $00, $00, $00, $00,
  25.                      $00, $00, $00, $00, $00, $00, $00, $00,
  26.                      $00, $00, $00, $00, $00, $00, $00, $00,
  27.                      $00, $00, $00, $00, $00, $00);
  28.  
  29.   NewVolumeID : str11 = '';
  30.   OldVolumeID : str11 = '';
  31.  
  32. VAR
  33.   Fehler : BYTE;
  34.  
  35.  
  36.   PROCEDURE Error(No : BYTE);
  37.   BEGIN
  38.     Write('FEHLER');
  39.     CASE No OF
  40.       1 : WriteLn(' bei Parameterübergabe!    ',
  41.                   ' Bsp.: TPLABEL C:');
  42.       2 : WriteLn('! Name des Datenträgers konnte ',
  43.                   'nicht geändert werden.');
  44.       3 : WriteLn('! Alter Name des Datenträgers konnte ',
  45.                   'nicht gefunden werden.');
  46.       4 : WriteLn('! Name des Datenträgers konnte nicht ',
  47.                   'eingetragen werden.');
  48.       5 : WriteLn('! Name des Datenträgers konnte nicht ',
  49.                   'gelöscht werden.');
  50.     END;
  51.     Halt(No);
  52.   END;
  53.  
  54.   PROCEDURE GetDrive;
  55.   BEGIN
  56.     IF ParamCount <> 1 THEN Error(1);
  57.     Drive  := ParamStr(1);
  58.     Drive  := UpCase(Drive[1]);
  59.     FCB[7] := Ord(Drive[1])-64;
  60.   END;
  61.  
  62.   PROCEDURE AdaptStr(VAR strg : str11);
  63.   VAR
  64.     b : BYTE;
  65.   BEGIN
  66.     IF strg <> '' THEN
  67.       FOR b := Length(strg) TO 11 DO strg := strg + #32;
  68.   END;
  69.  
  70.   PROCEDURE ReadLabel;
  71.   BEGIN
  72.     WriteLn('(Länge: 11 Zeichen / RETURN beendet)');
  73.     Write('Bitte geben Sie einen neuen Namen ein: ');
  74.     ReadLn(NewVolumeID);
  75.     AdaptStr(NewVolumeID);
  76.   END;
  77.  
  78.   PROCEDURE EraseLabel;
  79.   VAR
  80.     Regs : Registers;
  81.     c    : CHAR;
  82.     i    : BYTE;
  83.   BEGIN
  84.     Write('Soll Name des Datenträgers gelöscht ',
  85.           'werden? (J/N) ');
  86.     c := UpCase(ReadKey);
  87.     WriteLn(c);
  88.     IF c = 'J' THEN BEGIN
  89.       FOR i := 1 TO 11 DO FCB[7+i] := Ord(OldVolumeID[i]);
  90.       WITH Regs DO BEGIN
  91.         ah := $13;
  92.         ds := Seg(FCB);
  93.         dx := Ofs(FCB);
  94.         MsDos(Regs);
  95.         IF al <> 0 THEN Error(5);
  96.         WriteLn(^M^J'Name des Datenträgers wurde gelöscht');
  97.       END;
  98.     END ELSE
  99.       WriteLn(^M^J'Name des Datenträgers wurde nicht ',
  100.               'verändert');
  101.   END;
  102.  
  103.   PROCEDURE NewLabel;
  104.   VAR
  105.     Regs : Registers;
  106.     i    : BYTE;
  107.   BEGIN
  108.     WriteLn('Datenträger in Laufwerk ', Drive,
  109.             ': trägt keinen Namen.');
  110.     ReadLabel;
  111.     IF NewVolumeID = '' THEN BEGIN
  112.        WriteLn(^M^J'Es wurde kein Name eingetragen');
  113.        Exit;
  114.     END;
  115.     FOR i := 1 TO 11 DO FCB[7+i] := Ord(NewVolumeID[i]);
  116.     WITH Regs DO BEGIN
  117.       ah := $16;
  118.       ds := Seg(FCB);
  119.       dx := Ofs(FCB);
  120.       MsDos(Regs);
  121.       IF al <> 0 THEN Error(4);
  122.       WriteLn(^M^J'Name des Datenträgers wurde eingetragen')
  123.     END;
  124.   END;
  125.  
  126.   PROCEDURE RenameLabel;
  127.   VAR
  128.     Regs : Registers;
  129.     i    : BYTE;
  130.   BEGIN
  131.     WriteLn('Alter Name des Datenträgers in Laufwerk ',
  132.             Drive, ': lautet ',OldVolumeID,'.');
  133.     ReadLabel;
  134.     IF NewVolumeID = '' THEN BEGIN
  135.       EraseLabel;
  136.       Exit;
  137.     END;
  138.     FOR i := 1 TO 11 DO BEGIN
  139.       FCB[ 7+i] := Ord(OldVolumeID[i]);
  140.       FCB[23+i] := Ord(NewVolumeID[i]);
  141.     END;
  142.     WITH Regs DO BEGIN
  143.       ah := $17;
  144.       ds := Seg(FCB);
  145.       dx := Ofs(FCB);
  146.       MsDos(Regs);
  147.       IF al <> 0 THEN Error(2);
  148.       WriteLn(^M^J'Name des Datenträgers wurde geändert!');
  149.     END;
  150.   END;
  151.  
  152.   PROCEDURE SetLabel;
  153.   VAR
  154.     FileRec : SearchRec;
  155.   BEGIN
  156.     FileRec.Name := '';
  157.     FindFirst(Drive + ':\*.*', VolumeID, FileRec);
  158.     IF DosError <> 0 THEN IF DosError = 18 THEN New := TRUE
  159.                                            ELSE Error(3);
  160.     IF Pos('.', FileRec.Name) > 0 THEN
  161.       Delete(FileRec.Name, Pos('.', FileRec.Name), 1);
  162.     OldVolumeID := FileRec.Name;
  163.     AdaptStr(OldVolumeID);
  164.     IF New THEN NewLabel
  165.            ELSE RenameLabel;
  166.   END;
  167.  
  168. BEGIN
  169.   WriteLn(^M^J, Message, ^J);
  170.   GetDrive;
  171.   SetLabel;
  172. END.
  173. (* ------------------------------------------------------ *)
  174. (*                 Ende von TPLABEL.PAS                   *)
  175.