(*[72457,2131]
LABEL.PAS                 10-Oct-85 8020               197

    Keywords: MSDOS PCDOS DISK LABEL VOLUME

    This program reads, adds or modifies a disk volume label under MSDOS. It
    works for Turbo 2 or 3, and for DOS 2 or 3.
*)

PROGRAM vlabel(Input, Output);
    {display, add or modify volume labels}

  CONST
    toklen = 63;              {max length of a token}
    maxtok = 10;              {max number of tokens on command line}
  TYPE
    token = STRING[toklen];
    argarray = ARRAY[1..maxtok] OF token;
    message = STRING[79];
  VAR
    argc : Integer;           {argument count (number of tokens)}
    argv : argarray;          {elements are the tokens found on the command line}
    errmess : message;        {error message, if any, returned from getcom}
    i : Integer;
    drive : Byte;
    drivelet : STRING[1];
    labl : STRING[11];
    inter, gotlabel : Boolean;

  FUNCTION getcom(VAR errstring : message) : Boolean;
      {parse command line passed from DOS to Turbo Pascal}
      {return false if error encountered}
      {errstring will contain a text error message if getcom is false}
    CONST
      delim : SET OF Char = [' ', ^I];
      comm = $80;             {offset of command tail in program segment prefix}
    VAR
      bufpos : Byte;          {position in command line buffer}
      tokpos : Byte;          {position in current token}
      nchars : Byte;          {one more than the characters in the command tail}
      c : Char;
      m1, m2 : message;

    FUNCTION comchar : Char;
        {return the command character at current buffer position}
      BEGIN
        comchar := Chr(Mem[CSeg : (comm+bufpos)]);
        bufpos := bufpos+1;
      END;                    {comchar}

    BEGIN                     {getcom}
      getcom := True;
      bufpos := 0;
      nchars := 1+Ord(comchar); {define buffer stopping point}
      argc := 0;
      IF nchars > 1 THEN BEGIN
        c := comchar;
        WHILE (c IN delim) DO c := comchar; {skip leading blanks}
        WHILE bufpos <= nchars DO BEGIN
          IF argc < maxtok THEN BEGIN {get the next argument}
            argc := argc+1;
            tokpos := 0;
            WHILE ((bufpos <= nchars) AND (NOT(c IN delim))) DO BEGIN
              IF tokpos < toklen THEN BEGIN {read the argument}
                tokpos := tokpos+1;
                argv[argc][tokpos] := c;
                c := comchar;
              END ELSE BEGIN  {set error and skip the rest}
                getcom := False;
                Str(argc, m1);
                Str(toklen, m2);
                errstring := 'ERROR: argument# '+m1+' truncated to '+m2+' characters';
                WHILE (NOT(c IN delim)) DO c := comchar;
              END;
            END;
            argv[argc][0] := Chr(tokpos); {store the arg length}
            WHILE (c IN delim) DO c := comchar; {skip blanks}
          END ELSE BEGIN
            getcom := False;
            Str(maxtok, m1);
            errstring := 'ERROR: number of arguments truncated to '+m1;
            bufpos := nchars+1;
          END;
        END;
      END;
    END;                      {getcom}

  PROCEDURE volume(drive : Byte);
      {DOS calls to access volume labels}
    TYPE
      regpack = RECORD
                  ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer;
                END;
      extendfcb = ARRAY[0..43] OF Char;
    VAR

      drivenam : STRING[3];
      i : Integer;
      reg : regpack;
      c : Char;
      haslabel : Boolean;
      dta, xfcb, sfcb : extendfcb;

    PROCEDURE initfcb(VAR x : extendfcb; namechar : Char);
        {initialize an extended fcb}
      VAR
        i : Integer;
      BEGIN
        x[0] := Chr(255);     {flag for extended FCB}
        FOR i := 1 TO 5 DO x[i] := Chr(0);
        x[6] := Chr(8);       {specifies that we want volume label}
        x[7] := Chr(0);       {where drive number goes}
        FOR i := 8 TO 18 DO x[i] := namechar;
        FOR i := 19 TO 43 DO x[i] := Chr(0);
      END;                    {initfcb}

    BEGIN
      initfcb(sfcb, '?');     {initialize buffers}
      initfcb(xfcb, ' ');

      IF drive = 0 THEN BEGIN {GET DRIVE NUMBER}
        reg.ax := $19 SHL 8;
        MsDos(reg);
        Mem[Seg(drive) : Ofs(drive)] := Lo(reg.ax)+1;
      END;
      sfcb[7] := Chr(drive);
      xfcb[7] := Chr(drive);
      CASE drive OF
        1 : drivenam := 'A: ';
        2 : drivenam := 'B: ';
        3 : drivenam := 'C: ';
        4 : drivenam := 'D: ';
        5 : drivenam := 'E: ';
        6 : drivenam := 'F: ';
        7 : drivenam := 'G: ';
        8 : drivenam := 'H: ';
      END;

      reg.ax := $1a SHL 8; reg.ds := Seg(dta[0]); reg.dx := Ofs(dta[0]);
      MsDos(reg);             {SET UP DISK TRANSFER AREA FOR FILENAMES}


      reg.dx := Ofs(sfcb[0]); reg.ax := $11 SHL 8;
      MsDos(reg);             {search for volume entry}

      IF Lo(reg.ax) = $FF THEN BEGIN
        haslabel := False;
        IF NOT(gotlabel) THEN
          WriteLn('volume in drive ', drivenam, ' has no label')
      END ELSE BEGIN
        haslabel := True;
        IF NOT(gotlabel) THEN BEGIN
          Write('volume in drive ', drivenam, ' is ');
          FOR i := 1 TO 11 DO Write(dta[7+i]);
          WriteLn;
        END;
      END;

      {go on to change the label}
      IF inter THEN BEGIN
        Write('enter new volume label (<cr> for no change): ');
        ReadLn(labl);
      END;
      IF Length(labl) > 0 THEN BEGIN
        FOR i := 1 TO Length(labl) DO xfcb[7+i] := labl[i]; {insert label into xfcb}
        IF haslabel THEN BEGIN
          FOR i := 1 TO 11 DO dta[23+i] := xfcb[7+i]; {modify dta}
          reg.ds := Seg(dta[0]); reg.dx := Ofs(dta[0]); reg.ax := $17 SHL 8;
          MsDos(reg);
        END ELSE BEGIN
          reg.ds := Seg(xfcb[0]); reg.dx := Ofs(xfcb[0]); reg.ax := $16 SHL 8;
          MsDos(reg);
        END;
        IF Lo(reg.ax) = $FF THEN
          WriteLn('error in modifying label')
        ELSE BEGIN
          Write('new volume label in drive ', drivenam, ' is ');
          FOR i := 1 TO 11 DO BEGIN
            c := xfcb[7+i];
            Write(UpCase(c));
          END;
          WriteLn;
        END;
      END;
    END;                      {volume}

  BEGIN
    writeln;
    IF getcom(errmess) THEN BEGIN
      gotlabel := False;
      drive := 0; labl:='';
      IF argc > 0 THEN BEGIN
        inter:=false;
        i := 1;
        WHILE i <= argc DO BEGIN
          IF (Length(argv[i]) = 2) AND (argv[i][2] = ':') THEN BEGIN
            {a drive letter}
            drivelet := argv[i];
            CASE UpCase(drivelet[1]) OF
              'A' : drive := 1;
              'B' : drive := 2;
              'C' : drive := 3;
              'D' : drive := 4;
              'E' : drive := 5;
              'F' : drive := 6;
              'G' : drive := 7;
              'H' : drive := 8;
            ELSE
              WriteLn('unknown drive designator');
              Halt;
            END;
          END ELSE BEGIN
            {a new volume label}
            gotlabel := True;
            labl := argv[i];
          END;
          i := i+1;
        END;
        volume(drive);
      END ELSE BEGIN
        inter:=true;
        WHILE True DO BEGIN
          WriteLn;
          Write('enter drive (<cr> for default, Q to quit): ');
          drivelet := '';
          ReadLn(drivelet);
          IF UpCase(drivelet[1]) = 'Q' THEN Halt;
          IF Length(drivelet) = 0 THEN
            drive := 0
          ELSE BEGIN
            CASE UpCase(drivelet[1]) OF
              'A' : drive := 1;
              'B' : drive := 2;
              'C' : drive := 3;
              'D' : drive := 4;
              'E' : drive := 5;
              'F' : drive := 6;
              'G' : drive := 7;
              'H' : drive := 8;
            ELSE
              WriteLn('unknown drive designator');
              Halt;
            END;
          END;
          volume(drive);
        END;
      END;
    END ELSE BEGIN
      WriteLn(errmess);
    END;
  END.