Contributor: SWAG SUPPORT TEAM
{>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;