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

    {
    Could somebody help me out here? I'm trying to Write a
    Program that reads the File names and their attributes from
    disk/drive.

    Unit volLabel;

      Type String11 = String[11];
      Function  GetCurrentVolumeLabel : String11;
      Procedure DelVolumeLabel(CurrentVolumeLabel:String11);
      Procedure WriteVolumeLabel(CurrentVolumeLabel:String11);
      ( to change a volume Label: delete old, then Write new )
    }

    (* Implementation *)

    Uses
      Dos;

    Var
      oldir : String; { only For test Program }

    Type
      ExtendedFCBType = Record
                          ExtendedFCBflag : Byte;
                          Reserved1       : Array[1..5] of Byte;
                          Attr            : Byte;
                          DriveID         : Byte;
                          FileName        : Array[1..8] of Char;
                          FileExt         : Array[1..3] of Char;
                          CurrentBlockNum : Word;
                          RecordSize      : Word;
                          FileSize        : LongInt;
                          PackedDate      : Word;
                          PackedTime      : Word;
                          Reserved2       : Array[1..8] of Byte;
                          CurrentRecNum   : Byte;
                          RandomRecNum    : LongInt;
                        end;

    Type String11 = String[11];
    Function GetCurrentVolumeLabel : String11;
    Var
      CurrentDrive: String;
      VolumeLabel : SearchRec;  { defined in the Dos Unit }
      i : Word;
    begin                    { 12345678901 }
      GetCurrentVolumeLabel:= 'no Label   ';
      getdir(0,CurrentDrive); {in Dos Unit }
      CurrentDrive:= copy(CurrentDrive,1,3) + '*.*';
      {get Volume Label in A: drive}
      findfirst(CurrentDrive,VolumeID,VolumeLabel);
      if Doserror=0 then
        With VolumeLabel do
          begin
            {remove period}
            delete(VolumeLabel.name,pos('.',VolumeLabel.name),1);
            { pad to 11 Chars }
            For i:= length(name) to 11 do name:= name + ' ';
            GetCurrentVolumeLabel:= name;
          end; { With VolumeLabel}
    end; {of GetCurrentVolumeLabel }

    Procedure DelVolumeLabel(CurrentVolumeLabel:String11);
    {delete volume Label from disk in current drive}
    Var
      regs : Registers;
      FCB  : ExtendedFCBType;
    begin
      fillChar(FCB,sizeof(FCB),#0);  {initialize FCB With nulls }
      With FCB do
        begin
          ExtendedFCBflag:= $ff;      { always }
          Attr           := VolumeID; {defined in the Dos Unit}
          DriveID        := 0;        {default drive}
          move(CurrentVolumeLabel[1],FileName,8); {you have to put these in}
         move(CurrentVolumeLabel[9],FileExt ,3); {For some silly reason   }
        end; { With FCB do }

      { set up regs For Dos call }
      fillChar(regs,sizeof(regs),#0); {initialize regs With nulls}
      regs.ah:= $13; {Dos 1.0 delete File Function}
      regs.ds:= seg(FCB);
      regs.dx:= ofs(FCB);
      MsDos(regs); {call Dos to delete the volume Label }
      if regs.al=0 then Writeln('Success -- volume Label deleted.')
      else Writeln('Failure -- volume Label not deleted.');
    end; { of DelVolumeLabel }

    Procedure WriteVolumeLabel(CurrentVolumeLabel:String11);
    {create volume Label from disk in current drive}
    Var
      regs : Registers;
      FCB  : ExtendedFCBType;
    begin
      fillChar(FCB,sizeof(FCB),#0);  {initialize FCB With nulls }
      With FCB do
        begin
          ExtendedFCBflag:= $ff;      { always }
          Attr           := VolumeID; {defined in the Dos Unit}
          DriveID        := 0;        {default drive}
          move(CurrentVolumeLabel[1],FileName,8);
          move(CurrentVolumeLabel[9],FileExt ,3);
        end; { With FCB do }

      { set up regs For Dos call }
      fillChar(regs,sizeof(regs),#0); {initialize regs With nulls}
      regs.ah:= $16; {Dos 1.0 create File Function}
      regs.ds:= seg(FCB);
      regs.dx:= ofs(FCB);
      MsDos(regs); {call Dos to delete the volume Label }
      if regs.al=0 then Writeln('Success -- volume Label written.')
      else Writeln('Failure -- volume Label not written.');
    end; { of WriteVolumeLabel }

    begin { test Program }
      getdir(0,oldir); { save current directory }
      chdir('a:');     { play With diskette in A: }
      Writeln('Old volume Label: ',GetCurrentVolumeLabel);
      DelVolumeLabel(GetCurrentVolumeLabel);
      WriteVolumeLabel('10987654321');
      Writeln('New volume Label: ',GetCurrentVolumeLabel);
      chdir(oldir); { go back to original directory }
    end. { test program }

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