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.