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

    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.

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