home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / dos / label.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-13  |  2.1 KB  |  73 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-,M 16384,0,655360}
  2. (*===================================================================*)
  3. (*                              LABEL.PAS                            *)
  4. (*                    (C) 1993 te-wi Verlag, München                 *)
  5. (*  Demonstration für die Funktionen GetLabel und SetLabel der Unit  *)
  6. (*                             DOSUTIL.PAS                           *)
  7. (*===================================================================*)
  8.  
  9. PROGRAM DosLabel;
  10.  
  11. USES
  12.   Dos, Upper, Dosutil;
  13.  
  14. VAR
  15.   Drive      : BYTE;
  16.   Parameter,
  17.   OldVol,
  18.   Dir        : STRING;
  19.   result, i  : INTEGER;
  20.  
  21. BEGIN
  22.   GetDir(0, Dir);
  23.   Drive := Ord(Dir[1]) - 64;
  24.   IF ParamCount = 0 THEN
  25.   BEGIN
  26.     WriteLn('Bitte das neue Label auf der Kommandozeile angeben!');
  27.     Halt;
  28.   END;
  29.   Parameter := '';
  30.   IF ParamCount > 0 THEN
  31.   BEGIN
  32.     FOR i := 1 TO ParamCount DO
  33.       Parameter := Parameter + ParamStr(i) + ' ';
  34.   END;
  35.   Parameter := UpString(Parameter);
  36.   Parameter[0] := Pred(Parameter[0]);
  37.   Dir := Parameter;
  38.   IF Pos(':', Dir) > 0 THEN
  39.   BEGIN
  40.     Drive := Ord(Dir[1]) - 64;
  41.     Delete(Dir, 1, 2);
  42.   END;
  43.   IF Dir[1] = '\' THEN Delete(Dir, 1, 1);
  44.   OldVol := GetLabel(Drive);
  45.   IF DosError = 18 (* »No more files« ist kein Fehler *) THEN
  46.     DosError := 0;
  47.   IF DosError <> 0 THEN WriteLn('Fehler Nummer: ', DosError);
  48.   IF OldVol <> '' THEN
  49.     WriteLn('Volumelabel in Laufwerk ', Chr(Drive + 64) ,
  50.             ' ist ' , OldVol)
  51.   ELSE
  52.     WriteLn('Datenträger in ', Chr(Drive + 64) ,
  53.             ' hat keinen Namen');
  54.   IF Dir <> '' THEN
  55.   BEGIN
  56.     result := SetLabel(Drive, Dir);
  57.     IF result = 0 THEN
  58.       WriteLn('Volumelabel in Laufwerk ', Chr(Drive + 64) ,
  59.               ' auf ' , GetLabel(Drive), ' geändert.')
  60.     ELSE
  61.      WriteLn('Falsche Eingabe!');
  62.    END
  63.    ELSE
  64.    BEGIN
  65.      IF SetLabel(Drive, '') = 0 THEN
  66.         Write('Datenträgernamen gelöscht')
  67.      ELSE
  68.        Write('Fehler beim Löschen des Volume-Namens');
  69.    END;
  70. END.
  71.  
  72. (*===================================================================*)
  73.