Contributor: SWAG SUPPORT TEAM
UNIT FCBLabel;
{Turbo Pascal unit for manipulating volume labels}
INTERFACE
USES
DOS;
TYPE
DriveType = String[1];
DiskIDType = String[11];
FUNCTION GetDiskID(Drive:DriveType): DiskIDType;
FUNCTION SetDiskID(Drive:DriveType;
DiskID:DiskIDType): Boolean;
FUNCTION ReNameDiskID(Drive:DriveType;
OldDiskID:DiskIDType;
NewDiskID:DiskIDType): Boolean;
FUNCTION DeleteDiskID(Drive:DriveType): Boolean;
IMPLEMENTATION
TYPE
ExtendedFCBRecord = RECORD
ExtFCB : Byte;
Res1 : ARRAY[1..5] OF Byte;
Attr : Byte;
Drive : Byte;
Name1 : ARRAY[1..11] OF Char;
Unused1: ARRAY[1..5] OF Char;
Name2 : ARRAY[1..11] OF Char;
Unused2: ARRAY[1..9] OF Byte;
END;
FUNCTION GetDiskID(Drive:DriveType): DiskIDType;
VAR
DirInfo : SearchRec;
DirDiskID : String[12];
I,PosPeriod : Byte;
BEGIN
FindFirst(Drive+':\'+'*.*',VolumeID,DirInfo);
IF DosError = 0 THEN
BEGIN
DirDiskID := DirInfo.Name;
PosPeriod := POS('.',DirDiskID);
IF PosPeriod> 0 THEN
Delete(DirDiskID,PosPeriod,1);
GetDiskID := DirDiskID
END
ELSE
GetDiskID := ''
END;
{Use MsDos service 16H to SET a volume label }
FUNCTION SetDiskID(Drive:DriveType;
DiskID:DiskIDType): Boolean;
VAR
FCB : ExtendedFCBRecord;
Regs : Registers;
Temp : String[1];
I : Integer;
BEGIN
Temp := Drive;
WITH FCB DO
BEGIN
ExtFCB := $FF;
Attr := 8ドル;
Drive := Ord(UpCase(Temp[1])) - 64;
FOR I := 1 TO Length(DiskID) DO
Name1[I] := DiskID[I];
IF Length(DiskID) < 11 THEN FOR I := (Length(DiskID) + 1) TO 11 DO Name1[I] := ' ' END; Regs.ah := 16ドル; Regs.ds := Seg(FCB); Regs.dx := Ofs(FCB); MsDos(Regs); IF Regs.AL = 0 THEN SetDiskID := TRUE ELSE SetDiskID := FALSE END; {use MsDOS service 17H to RENAME a volume label } FUNCTION ReNameDiskID(Drive:DriveType; OldDiskID:DiskIDType ; NewDiskID:DiskIDType): Boolean; VAR FCB : ExtendedFCBRecord; Regs : Registers; Temp : String[1]; I : Integer; BEGIN Temp := Drive; WITH FCB DO BEGIN ExtFCB := $FF; Attr := 8ドル; Drive := Ord(UpCase(Temp[1])) - 64; {Set old disk id} FOR I := 1 TO Length(OldDiskID) DO Name1[I] := OldDiskID[I]; FOR I := (Length(OldDiskID) + 1) TO 11 DO Name1[I] := ' '; {Set new disk id} FOR I := 1 TO Length(NewDiskID) DO Name2[I] := NewDiskID[I]; FOR I := (Length(NewDiskID) + 1) TO 11 DO Name2[I] := ' ' END; Regs.ah := 17ドル; Regs.ds := Seg(FCB); Regs.dx := Ofs(FCB); MsDos(Regs); IF Regs.AL = 0 THEN ReNameDiskID := TRUE ELSE ReNameDiskID := FALSE END; {Use MsDos service 13H DELETE a volume label } FUNCTION DeleteDiskID(Drive:DriveType): Boolean; VAR FCB : ExtendedFCBRecord; Regs : Registers; Temp : String[1]; I : Integer; BEGIN Temp := Drive; WITH FCB DO BEGIN ExtFCB := $FF; Attr := 8ドル; Drive := Ord(UpCase(Temp[1])) - 64; Name1[1] := '*'; Name1[2] := '.'; Name1[3] := '*'; FOR I := 4 TO 11 DO Name1[I] := ' ' END; Regs.ah := 13ドル; Regs.ds := Seg(FCB); Regs.dx := Ofs(FCB); MsDos(Regs); IF Regs.AL = 0 THEN DeleteDiskID := TRUE ELSE DeleteDiskID := FALSE END; END. { --------------- TEST PROGRAM -------------------} PROGRAM TestFCB; { test FCBLabel UNIT} USES CRT,FCBLabel; VAR Choice : Byte; Drive : DriveType; DiskID : DiskIDType; NewDiskID : DiskIDType; BEGIN REPEAT {Endless loop - select option 5 to Exit} ClrScr; GotoXY(25,1); WriteLn('Volume Functions'); GotoXY(25,9); WriteLn('1) SET LABEL'); GotoXY(25,10); WriteLn('2) DELETE LABEL'); GotoXY(25,11); WriteLn('3) RENAME LABEL'); GotoXY(25,12); WriteLn('4) GET LABEL'); GotoXY(25,13); WriteLn('5) Exit'); GotoXY(20,15); Write('Type number and press Enter> ');
ReadLn(Choice); WriteLn;
Drive := 'C'; { use drive C: as test drive }
CASE Choice OF
1: BEGIN {Set volume LABEL}
DiskID := GetDiskID(Drive);
IF DiskID '' THEN
BEGIN
WriteLn('Label not null: ',DiskID);
WriteLn('Use RENAME instead');
WriteLn('Press Enter to continue');
ReadLn
END
ELSE
BEGIN
Write('Enter new label> ');
ReadLn(DiskID);
IF NOT SetDiskID(Drive,DiskID) THEN
BEGIN
WriteLn('System Error');
WriteLn
('Press Enter to continue');
ReadLn
END
END
END;
2: BEGIN {Delete Volume LABEL}
IF DeleteDiskID(Drive) THEN
WriteLn('Volume label deleted')
ELSE
WriteLn('System Error');
WriteLn('Press Enter to continue');
ReadLn
END;
3: BEGIN {Rename Volume LABEL}
DiskID := GetDiskID(Drive);
IF DiskID = '' THEN
BEGIN
WriteLn('Current label is null:');
WriteLn('Use SET option instead');
WriteLn('Press Enter to continue');
ReadLn
END
ELSE
BEGIN
Write('Enter new name of label> ');
ReadLn(NewDiskID);
IF NOT ReNameDiskID
(Drive,DiskID,NewDiskID) THEN
BEGIN
WriteLn('System Error');
WriteLn
('Press Enter to continue');
ReadLn
END
END
END;
4: BEGIN {Get Volume LABEL}
DiskID := GetDiskID(Drive);
Write('The current label is ');
IF DiskID = '' THEN
WriteLn('null')
ELSE
WriteLn(DiskID);
WriteLn('Press Enter to continue');
ReadLn
END;
5: Halt;
ELSE { continue }
END { case }
UNTIL FALSE
END.