[Back to DRIVES SWAG index] [Back to Main SWAG index] [Original]

    {
    >I am having difficulty changing a disk volume Label using Turbo Pascal.
    >Does anyone know how to acComplish this?
    }
    Uses
      Dos;

    Type fcbType = Record
                     drive   : Byte;
                     name    : Array[1..8] of Char;
                     ext     : Array[1..3] of Char;
                     fpos    : Word;
                     recsize : Word;
                     fsize   : LongInt;
                     fdate   : Word;
                     ftime   : Word;
                     reserv  : Array[1..8] of Byte;
                     currec  : Byte;
                     relrec  : LongInt;
                   end;
         extfcb =  Record
                     flag    : Byte;                  { must be $ff! }
                     reserv  : Array[1..5] of Byte;
                     attrib  : Byte;
                     fcb     : fcbType;
                   end;

    Function GetVolLabel(drive:Char):String;
    Var sr : SearchRec;
    begin
      findfirst(drive+':\*.*',VolumeID,sr);
      if Doserror=0 then GetVolLabel:=sr.name
      else GetVolLabel:='';
    end;

    Procedure setfcbname(Var fcb:fcbType; name:String);
    Var p : Byte;
    begin
      p:=pos('.',name);
      if p=0 then begin
        p:=length(name)+1;
        name:=name+'.';
        end;
      fillChar(fcb.name,11,' ');
      move(name[1],fcb.name,p-1);
      move(name[p+1],fcb.ext,length(name)-p);
    end;

    Procedure SetVolLabel(drive:Char; vLabel:String);
    Var fcb  : extfcb;
        vl   : PathStr;
        regs : Registers;
        f    : File;
    begin
      vl:=GetVolLabel(drive);
      fcb.flag:=$ff;
      fcb.attrib:=VolumeID;
      if vl<>'' then begin
        setfcbname(fcb.fcb,vl);
        fcb.fcb.drive:=ord(UpCase(drive))-64;
        regs.ah:=$13;                { Delete File }
        regs.ds:=seg(fcb);
        regs.dx:=ofs(fcb);
        msDos(regs);
        end;
      if vLabel<>'' then begin
        fcb.fcb.drive:=ord(UpCase(drive))-64;
        setfcbname(fcb.fcb,vLabel);
        With regs do begin
          ah:=$16;                  { Create File }
          ds:=seg(fcb);
          dx:=ofs(fcb);
          msDos(regs);
          ah:=$10;                  { Close File }
          ds:=seg(fcb);
          dx:=ofs(fcb);
          msDos(regs);
          end;
        end;
    end;

[Back to DRIVES SWAG index] [Back to Main SWAG index] [Original]