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

    {
    > I need a way to find the  volume Label of a drive.  Any  suggestions or
    > source code?
    }
    {$S-,R-,V-,I-,N-,B-,F-}

    Unit Volume;

    Interface

    Uses
      Dos;

    Type

      Drive       = Byte;
      VolumeName  = String [11];

      VolFCB      = Record
        FCB_Flag : Byte;
        Reserved : Array [1..5] of Byte;
        FileAttr : Byte;
        Drive_ID : Byte;
        FileName : Array [1..8] of Byte;
        File_Ext : Array [1..3] of Byte;
        Unused_A : Array [1..5] of Byte;
        File_New : Array [1..8] of Byte;
        fExt_New : Array [1..3] of Byte;
        Unused_B : Array [1..9] of Byte
      end;

    Function DelVol (D : Byte) : Boolean;
    Function AddVol (D : Byte; V : VolumeName) : Boolean;
    Function ChgVol (D : Byte; V : VolumeName) : Boolean;
    Function GetVol (D : Byte) : VolumeName;

    Implementation

    Procedure Pad_Name (Var V : VolumeName);
    begin
      While LENGTH (V) <> 11 DO
        V := V + ' '
    end;

    Function Fix_Ext_Sym (Var V : VolumeName) : Byte;
    Var
      I : Byte;
    begin
      I := POS ('.', V);
      if I > 0 then
        DELETE (V, I, 1);
      Fix_Ext_Sym := I
    end;

    Function Extract_Name (S : SearchRec) : VolumeName;
    Var
      H, I : Byte;
    begin
      I := Fix_Ext_Sym (S.Name);
      if (I > 0) and (I < 9) then
        For H := 1 to (9 - I) DO
          INSERT (' ', S.Name, I);
      Extract_Name := S.Name
    end;

    Procedure Fix_Name (Var V : VolumeName);
    Var
      I : Byte;
    begin
      Pad_Name (V);
      For I := 1 to 11
        do V [I] := UPCASE (V [I])
    end;

    Function Valid_Drive_Num (D : Byte) : Boolean;
    begin
      Valid_Drive_Num := (D >= 1) and (D <= 26)
    end;

    Function Find_Vol (D : Byte; Var S : SearchRec) : Boolean;
    begin
      FINDFIRST (CHR (D + 64) + ':\*.*', VolumeID, S);
      Find_Vol := DosError = 0
    end;

    Procedure Fix_FCB_NewFile (V : VolumeName; Var FCB : VolFCB);
    Var
      I : Byte;
    begin
      For I := 1 to 8 DO
        FCB.File_New [I] := ORD (V [I]);
      For I := 1 to 3 DO
        FCB.fExt_New [I] := ORD (V [I + 8])
    end;

    Procedure Fix_FCB_FileName (V : VolumeName; Var FCB : VolFCB);
    Var
       I : Byte;
    begin
      For I := 1 to 8 DO
        FCB.FileName [I] := ORD (V [I]);
      For I := 1 to 3 DO
        FCB.File_Ext [I] := ORD (V [I + 8])
    end;

    Function Vol_Int21 (Fnxn : Word; D : Drive; Var FCB : VolFCB) : Boolean;
    Var
      Regs : Registers;
    begin
      FCB.Drive_ID := D;
      FCB.FCB_Flag := $FF;
      FCB.FileAttr := $08;
      Regs.DS     := SEG (FCB);
      Regs.DX     := OFS (FCB);
      Regs.AX     := Fnxn;
      MSDos (Regs);
      Vol_Int21 := Regs.AL = 0
    end;

    Function DelVol (D : Byte) : Boolean;
    Var
       sRec : SearchRec;
       FCB  : VolFCB;
       V    : VolumeName;
    begin
      DelVol := False;
      if Valid_Drive_Num (D) then
      begin
        if Find_Vol (D, sRec) then
        begin
          V := Extract_Name (sRec);
          Pad_Name (V);
          Fix_FCB_FileName (V, FCB);
          DelVol := Vol_Int21 ($1300, D, FCB)
        end
      end
    end;

    Function AddVol (D : Byte; V : VolumeName) : Boolean;
    Var
      sRec : SearchRec;
      FCB  : VolFCB;
    begin
      AddVol := False;
      if Valid_Drive_Num (D) then
      begin
        if not Find_Vol (D, sRec) then
        begin
          Fix_Name (V);
          Fix_FCB_FileName (V, FCB);
          AddVol := Vol_Int21 ($1600, D, FCB)
        end
      end
    end;

    Function ChgVol (D : Byte; V : VolumeName) : Boolean;
    Var
       sRec : SearchRec;
       FCB  : VolFCB;
       x    : Byte;
    begin
      ChgVol := False;
      if Valid_Drive_Num (D) then
      begin
        if Find_Vol (D, sRec) then
        begin
          x := Fix_Ext_Sym (V);
          Fix_Name (V);
          Fix_FCB_NewFile (V, FCB);
          V := Extract_Name (sRec);
          Pad_Name (V);
          Fix_FCB_FileName (V, FCB);
          ChgVol := Vol_Int21 ($1700, D, FCB)
        end
      end
    end;

    Function GetVol (D : Byte) : VolumeName;
    Var
      sRec : SearchRec;
    begin
      GetVol := '';
      if Valid_Drive_Num (D) then
        if Find_Vol (D, sRec) then
          GetVol := Extract_Name (sRec)
    end;

    end.

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