{@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
The purchaser of these procedures and functions may include them in COMPILED
programs freely, but may not sell or give away the source text.
sidesectortrack

     This program uses a number of the procedures on this disk to
     find, change, or create a volume label.  You might think you
     could simply FIND it with Find_First (from GETFILE.LIB) and
     change it with a simple RENAME, or create a new file and set
     its attribute to 8 (= Volume label) with FileAttribute (found
     in FILEATTR.LIB.   It ain't that easy!  The only one of the
     routines I just mentioned that will work is Find_First--the
     others are deeply protected agains acting on the LABEL

     This being the case, we seek the label by directly reading
     and writing the directory sectors.  It ain't elegant, but
     it does the job.
}

{$I regpack.typ}
{$I disktyp.lib}
{$I grfxtabl.lib}
{$I titles.lib}

type
  Label_type = string[11];
  directory_entry = record
                      name      : array[1..11] of char; { See the DOS 2.0    }
                      attribute : byte;                 { Manual, Appendix   }
                      junk1     : array[1..10] of byte; { C, for description }
                      time      : array[1..2] of byte;  { of directory.  But }
                      date      : array[1..2] of byte;  { don't look in the  }
                      junk2     : array[1..6] of byte;  { 2.1 Manual--they   }
                    end;                                { took a lot of good }
  buffer_type = array[1..16] of directory_entry;        { stuff out!         }
  sector_loc  = record
                  side, sector, track : byte;
                end;

var
  buffer        : buffer_type;
  drive         : char;
  label_sector, which_entry, free_sector, free_entry  : byte;
  N, M, P, error_return, attrib                       : byte;
  the_label, new_label : label_type;
  dir_sectors          : array[1..7] of sector_loc;

{$I getsectr.lib}
var
  OKAY, found : boolean;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure DirectoryMap;                  { This procedure checks what kind  }
  begin                                  { of disk we're looking at and     }
    for N := 1 to 7 do                   { locates the sectors that contain }
      with dir_sectors[N] do             { the directory.                   }
        side := 2;
    case disktype(drive) of
      160: begin
             for N := 1 to 4 do
               with dir_sectors[N] do
                 begin
                   side := 0;
                   track := 0;
                   sector := 3+N;
                 end;
           end;
      180: begin
             for  N := 1 to 4 do
               with dir_sectors[N] do
                 begin
                   side := 0;
                   track := 0;
                   sector := 5+N;
                 end;
           end;
      320: begin
             for N := 1 to 5 do
               with dir_sectors[N] do
                 begin
                   side := 0;
                   track := 0;
                   sector := 3+N;
                 end;
             for N := 6 to 7 do
               with dir_sectors[N] do
                 begin
                   side := 1;
                   track := 0;
                   sector := N-5;
                 end;
           end;
      360: begin
             for N := 1 to 4 do
               with dir_sectors[N] do
                 begin
                   side := 0;
                   track := 0;
                   sector := 5+N;
                 end;
             for N := 5 to 7 do
               with dir_sectors[N] do
                 begin
                   side := 1;
                   track := 0;
                   sector := N-4;
                 end;
           end;
      else
        WriteLn('Non-standard format.  Halting program');
        HALT;
    end; {case}
end; {procedure}
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure FindLabel;
begin
  N := 0;
  Free_entry := 0;
  found := false;
  repeat
    N := N + 1;
    if dir_sectors[N].side < 2 then   {if side = 2 here, it means we've
                                       run out of sectors on a single-
                                       sided disk}
      begin
        with dir_sectors[N] do
          begin
            GetSector('R',drive,side,sector,track,OKAY);
                                       { GetSector dumps a sector into
                                         the buffer.  Because the buffer
                                         is "shaped" like a directory, we
                                         have instant access to the dir-
                                         ectory information }
          end;
        if OKAY then
          begin
            for M := 1 to 16 do
              begin
                with buffer[M] do
                  begin
                    if ((name[1] = #0) or (name[1] = #229))
                       and (Free_Entry = 0) then     { Note the first free   }
                         begin                       { entry--a never-used   }
                           Free_Entry := M;          { one starts w/ chr(0), }
                           Free_Sector := N;         { an erased one, with   }
                         end;                        { chr(229)              }
                    if attribute = 8 then
                      begin                  { Attribute = 8 means we have }
                        Label_sector := N;   { found the label.            }
                        which_entry  := M;
                        found := true;
                        the_label := '';
                        for P := 1 to 11 do
                          the_label := the_label + name[P];
                      end;
                  end;
              end;
          end
        else writeLn('Not OKAY!');
      end;
  until found or (not OKAY) or (dir_sectors[N].side = 2) or (N = 7);
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure WriteNewLabel;
begin
  new_label[length(new_label)+1] := #0;
  for P := 1 to 11 do
    buffer[which_entry].name[P] := new_label[P];
  with dir_sectors[label_sector] do
    GetSector('W',drive,side,sector,track,OKAY);
  if OKAY then
    WriteLn('Sucessfully changed label of drive ',drive,' to ',new_label)
  else
    WriteLn('Not OKAY!');
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
procedure CreateLabel;
var
  registers : regpack;
  {=================================================}
    procedure GetTime(VAR Byt1,Byt2: byte);
    var
      hours, mins, twoSecs : byte;      { The DOS TIME function delivers }
    begin                               { hours, minutes and seconds in  }
      registers.AX := $2C shl 8;        { one format, but the time info  }
      MSDOS(registers);                 { in the directory is formatted  }
      with registers do                 { quite differently.  The point  }
        begin                           { of all the manipulation and    }
          hours := CX shr 8;            { shifting left and right is to  }
          mins  := CX and $00FF;        { get the time info into this    }
          twoSecs := DX shr 9;          { shape:                         }
        end;                            {  ||  }
                                        {  \/  }
{               high byte                            low byte               }
{bit # 15  14  13  12  11  10   9   8      7   6   5   4   3   2   1   0    }
{     | h   h   h   h   h | m   m   m      m   m   m | s   s   s   s   s |  }
{     |    hour           |    minutes               |   2-seconds       |  }

      byt2 := (hours shl 3) + (mins shr 3);
      byt1 := ((mins and 7) shl 5) + twoSecs;
    end;
  {=================================================}
    procedure GetDate(VAR Byt1,Byt2: byte);
    var
      month, day : byte;
      year       : integer;
    begin
      registers.AX := $2A shl 8;
      MSDOS(registers);
      with registers do
        begin
          year := CX;
          month := DX shr 8;
          day   := DX and $00FF;
        end;

{ The date information in the directory entry is also in an odd format.     }

{          high byte                                 low byte               }
{bit # 15  14  13  12  11  10   9   8      7   6   5   4   3   2   1   0    }
{     | y   y   y   y   y   y   y | m      m   m   m | d   d   d   d   d |  }
{     |  year - 1980              |  month (1-12)    |  day (1-31)       |  }

      Byt2 := (((Year - 1980) and $00FF) shl 1) + (month shr 3);
      Byt1 := ((month and 7) shl 5) + day;
    end;
  {=================================================}
begin
  WriteLn('Diskette in drive ',drive,' has no label.');
  new_label := '';
  Write('Enter label, or just <return> to quit :');
  ReadLn(new_label);
  if new_label <> '' then
    begin
      with dir_sectors[Free_sector] do                { Get the sector with  }
        GetSector('R',drive,side,sector,track,OKAY);  { the first free entry }
      if OKAY then                                    { back into the buffer }
        begin
          with buffer[Free_Entry] do
            begin
              for N := 1 to length(new_label) do
                name[N] := new_label[N];
              if length(new_label) < 11 then
                for N := length(new_label)+1 to 11 do
                  name[N] := ' ';
              attribute := 8;
              for N := 1 to 10 do Junk1[N] := 0;
              GetTime(time[1],time[2]);
              GetDate(date[1],date[2]);
              for N := 1 to 6 do Junk2[N] := 0;
            end;  {with}
          with dir_sectors[Free_sector] do
            GetSector('W',drive,side,sector,track,OKAY);
          if OKAY then
            WriteLn('Sucessfully created label ',new_label,' for drive ',drive);
        end;  { if OKAY}
    end; {if not = ''}
end;
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
begin
  MakeTitle('LABEL',1);   { This procedure is in TITLES.LIB }
  window(1,10,80,25);
  ClrScr;
  repeat
    gotoXY(1,WhereY); ClrEOL;
    Write('Which drive? ');
    Read(drive);
    drive := UpCase(drive);
  until drive in ['A'..'D'];
  WriteLn;
  DirectoryMap;
  FindLabel;
  if found then
    begin
      WriteLn('Current label is ',the_label);
      new_label := '';
      Write('Enter new label, or <return> to leave alone: ');
      readLn(new_label);
      if new_label <> '' then WriteNewLabel;
    end
  else CreateLabel;
end.