home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / RUN96.ZIP / FORMAT96.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-01-27  |  9.9 KB  |  372 lines
  1. program format96;
  2. {$R+}
  3. {$U+}
  4. const
  5.     getintrp = $35;     { dos 21 int functions }
  6.     setintrp = $25;
  7.  
  8.     disktable = $1E;       { disk parameter block has address stored here }
  9.     equipment = $11;
  10.  
  11.     diskio = $13;       { does the dirty work }
  12.     diskformat = $5;
  13.     diskverify = $4;
  14.     diskwrite  = $3;    { write up to 9 sectors per track }
  15.  
  16.  
  17.     MAXsector = 40; { max sector number on a track }
  18.     driveflag = $00c1 ;
  19. type
  20.    result = record
  21.             ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  22.             end;
  23.  
  24.    sectorheader = record
  25.                track : byte;
  26.                side : byte;
  27.                sectornum : byte;
  28.                sectorlen : byte;
  29.             end;
  30. var
  31.     diskparm : result;
  32.     i,sectorpertrack,ah,dh,sectorsize: integer;
  33.     headerbuf : array[1..MAXsector] of sectorheader;
  34.     c : char;
  35.     drivenum, numtraks : integer;
  36.     go_ahead : boolean;
  37.     starttrack, finishtrack : integer;
  38.     sectorbuf : array[0..512] of byte;
  39.     FATDIR : array[0..$17ff] of byte;
  40.  
  41. procedure makeFAT; { fill in the bpb, FATS, DIR }
  42. var i,j : integer;
  43.     manu : string[20];
  44.     jmpstr: string[5];
  45.     bpb: string[30];
  46.     sec0 : string[35];
  47.     banner : string[128];
  48.     code : string[40];
  49. begin
  50.      fillchar(FATDIR,$1800,$F6);
  51.      for i:= 0 to $17ff do
  52.           if (i mod 32) = 0 then fatdir[i]:=0;
  53.           { put in zeros in every 32 bytes }
  54.      fatdir[$200]:=$fd;
  55.      fatdir[$201]:=$ff;
  56.      fatdir[$202]:=$ff;
  57.      fatdir[$600]:=$fd;
  58.      fatdir[$601]:=$ff;
  59.      fatdir[$602]:=$ff;
  60.      for i:=$203 to $41A do fatdir[i]:=0;
  61.      for i:=$603 to $81A do fatdir[i]:=0;
  62.    { fats and directory done, now do BPB }
  63.      jmpstr:=#$eb#$20#$90;
  64.      manu:='WILKER31';
  65.      BPB:=#00#02#04#01#00#02#$70#00#$a0#05#$ED#$02#$00#$09#00#02#00#00#00#06#00;
  66.      sec0:= jmpstr+manu+bpb;
  67.      for i:=0 to (length(sec0)-1) do fatdir[i]:=ord(sec0[i+1]);
  68. end; { make fat }
  69.  
  70.  
  71. procedure smoothexit;
  72. begin
  73. end; { smoothexit }
  74.  
  75. function getdrives : integer;
  76. var x : result;
  77.     y : integer;
  78. begin
  79.   { returns number of floppy drives }
  80.   intr(equipment,x);
  81.  
  82.    y:=x.ax and ($00c1);
  83.  
  84.    {0000 0000 1100 0001}
  85.    { stupid ibm scheme, bit 0 = 0 => no drives }
  86.    { bit 0 = 1 => bits 6,7 give number -1 }
  87.  
  88.  
  89.  if y = 0 then getdrives:=0 else
  90.   begin
  91.      y:=y shr 6;
  92.      y:=y and 3;
  93.      getdrives:=y+1;
  94.   end;
  95. end; { getdrives }
  96.  
  97.  
  98. procedure errormsg( x : byte);
  99. begin
  100.    writeln;
  101.    case x of
  102.       0   : writeln('No error.');
  103.       1   : writeln('Bad command.');
  104.       2   : writeln('Bad address mark.');
  105.       3   : writeln('Write-protected disk.');
  106.       4   : writeln('Record not found.');
  107.       5   : writeln('Controller reset failed.');
  108.       7   : writeln('Controller won''t accept drive parameters.');
  109.       8   : writeln('DMA overrun.');
  110.       9   : writeln('DMA bounds error.');
  111.       $0b : writeln('Bad track flag found.');
  112.       $10 : writeln('Bad CRC on disk read.');
  113.       $11 : writeln('Recoverable ECC error.');
  114.       $20 : writeln('Disk controller chip failure.');
  115.       $40 : writeln('Bad seek.');
  116.       $80 : writeln('Time out error.');
  117.       $BB : writeln('Undefined error.');
  118.       $ff : writeln('Sense Drive Status failure.');
  119.     end;
  120.     writeln;
  121.  end; { error msg }
  122.  
  123.  
  124. function getformparams : boolean;
  125. var valid : boolean;
  126.     ch : char;
  127.     code : integer;
  128.     trackstr : string[20];
  129.     lastdrive : integer;
  130.     s : string[10];
  131. begin
  132.     getformparams:=true; { until proved otherwise }
  133.     repeat
  134.          lastdrive:=getdrives;
  135.          writeln('Last DOS floppy drive is number  ',lastdrive);
  136.          write('Floppy drive to use [ A=1, B=2.. D=4 ] ? ');
  137.          readln(ch); ch:=upcase(ch);
  138.          if ch in ['Z','Q','X',^Z] then smoothexit;
  139.     until ch in ['A'..'D'];
  140.    drivenum:=ord(ch) -ord('A');
  141.    if drivenum >( getdrives -1) then begin
  142.        writeln('Warning..drive selected is not set on system board switch SW-1.');
  143.        write('Type <CR> to continue, anything else to abort ');
  144.        readln(s);
  145.        if length(s) > 0 then
  146.          getformparams:=false;
  147.    end;
  148.    if drivenum < 2 then begin
  149.        writeln('Warning..drive selected is probably a 48 TPI drive.');
  150.        write('Type <CR> to continue, anything else to abort ');
  151.        readln(s);
  152.        if length(s) > 0 then
  153.            getformparams:=false;
  154.    end;
  155.  
  156.    sectorpertrack:=9;
  157.    { al }
  158.    sectorsize:=2;
  159.    { sectorsize }
  160.     starttrack:=0;
  161.     finishtrack:=79;
  162. end; { getformparams }
  163.  
  164.  
  165. procedure checkexit;
  166. var ch : char;
  167. begin
  168.    if keypressed then begin
  169.      read(kbd,ch);
  170.      if upcase(ch) in ['Q','X','Z',^Z] then smoothexit;
  171.     end;
  172. end; { check exit }
  173.  
  174. procedure initsector;
  175. var j : integer;
  176. begin
  177.      { initialize sector header array }
  178.      for j:=1 to MAXsector  do begin
  179.          headerbuf[j].sectornum:=lo(j);
  180.          headerbuf[j].sectorlen:=lo(sectorsize);
  181.       end; { j }
  182. end; { init sector }
  183.  
  184. procedure initbuf( x : byte);
  185. var i : integer;
  186. begin
  187.   for i:=0 to 511 do sectorbuf[i]:= x;
  188. end; { initbuf }
  189.  
  190.  
  191. procedure initside( side : integer);
  192. var j : integer;
  193. begin
  194.    for j:=1 to  MAXsector do
  195.        headerbuf[j].side:=lo(side);
  196. end; { initside }
  197.  
  198. procedure inittrack( track : integer);
  199. var j : integer;
  200.  begin
  201.   for j:=1 to MAXsector do
  202.       headerbuf[j].track:=track;
  203.  end; { inittrack }
  204.  
  205. procedure doit; { formatting call }
  206. var tracknum,side : integer;
  207. begin
  208. with diskparm do begin
  209.    initsector; { fill in the header }
  210.    for tracknum:=starttrack to finishtrack do begin
  211.       inittrack(tracknum);
  212.       write('*');
  213.       for side:= 0 to 1 do begin
  214.           initside(side);
  215.           { allow abort }
  216.           if keypressed then begin
  217.               read(c);
  218.               if upcase(c) in ['Q','X','Z',^Z] then smoothexit;
  219.           end;
  220.           dx:=drivenum + (side shl 8);  { dh =0 means side 0 }
  221.           ax:=sectorpertrack + (diskformat shl 8);
  222.           cx:= 1 + (tracknum shl 8);
  223.           es:=seg(headerbuf[1].track);
  224.           bx:=ofs(headerbuf[1].track);
  225.           intr($13,diskparm);
  226.           if hi(ax) <> 0 then errormsg(hi(ax));
  227.        end; { tracknum }
  228.     end; { side }
  229.   end; { with diskparm }
  230. end; { doit }
  231.  
  232.  
  233. procedure verify;
  234. var tracknum,side : integer;
  235. begin
  236.  with diskparm do begin
  237.    writeln;
  238.    writeln;
  239.    writeln('This reads each sector to verify the format.');
  240.    writeln;
  241.    writeln;
  242.    initsector; { fill in the header }
  243.    for tracknum:=starttrack  to finishtrack do begin
  244.       inittrack(tracknum);
  245.       write('*');
  246.       for side:= 0 to 1 do begin
  247.           initside(side);
  248.           { allow abort }
  249.           if keypressed then begin
  250.               read(kbd,c);
  251.               if upcase(c) in ['Q','X','Z',^Z] then smoothexit;
  252.           end;
  253.           dx:=drivenum + (side shl 8);  { dh =0 means side 0 }
  254.           ax:=sectorpertrack + (diskverify shl 8);
  255.           cx:= 1 + (tracknum shl 8);
  256.           es:=seg(headerbuf[1].track);
  257.           bx:=ofs(headerbuf[1].track);
  258.           intr($13,diskparm); { not needed }
  259.           if hi(ax) <> 0 then errormsg(hi(ax));
  260.        end; { tracknum }
  261.     end; { side }
  262.    end; { with diskparm }
  263. end; { verify }
  264.  
  265. procedure insertdisk;
  266. begin
  267.   writeln;
  268.   write(' Insert diskette in floppy drive ');
  269.   writeln((drivenum+1):4,' = ' ,chr(65+drivenum),': ');
  270.   write(' Press <CR> when ready.');
  271.   readln;
  272.   writeln;
  273.   writeln;
  274. end; { insertdisk }
  275.  
  276.  
  277. procedure writefat;
  278. var tracknum,side : integer;
  279. begin
  280.  writeln;writeln('Writing system information.');writeln;
  281.  with diskparm do begin
  282.  
  283.     tracknum:=0;
  284.     side:=0;
  285.     dx:=drivenum + (side shl 8);  { dh =0 means side 0 }
  286.     ax:=9 + (diskwrite shl 8);
  287.     cx:=1 + (tracknum shl 8);
  288.     es:=seg(fatdir[0]);
  289.     bx:=ofs(fatdir[0]);
  290.     intr($13,diskparm);
  291.     if hi(ax) <> 0 then errormsg(hi(ax));
  292.  
  293.     side:=1;
  294.     dx:=drivenum + (side shl 8);  { dh =0 means side 0 }
  295.     ax:=3 + (diskwrite shl 8);
  296.     cx:= 1 + (tracknum shl 8);
  297.     es:=seg(fatdir[9*512]);
  298.     bx:=ofs(fatdir[9*512]);
  299.     intr($13,diskparm);
  300.     if hi(ax) <> 0 then errormsg(hi(ax));
  301.  
  302.  end; { with diskparm }
  303. end;  { writefat }
  304.  
  305.  
  306.  
  307.  
  308. function menu : char;
  309. var  valid : boolean;
  310.      c : char;
  311. begin
  312.     writeln;writeln;
  313.     writeln('The options are  ');
  314.     writeln('   V) Verify 96 tpi floppy diskette.');
  315.     writeln('   F) Format 96 tpi floppy diskette.');
  316.     writeln('   T) Write FAT table to 96 tpi floppy disk.');
  317.     writeln('   X) Exit this program.');
  318.   repeat
  319.     writeln;writeln;
  320.     write('>>  Your choice..');
  321.     read(kbd,c);writeln(c);writeln;
  322.   until upcase(c) in ['V','F','T','X','Q','Z',^Z];
  323.   menu:=upcase(c);
  324. end; { menu }
  325.  
  326. procedure logo;
  327. begin
  328.      writeln;writeln;writeln;
  329.      writeln('This formats 80 trk/side 96 tpi DS QD disketts for PC-DOS on  ');
  330.      writeln('IBM PC BIOS compatible computers using the TANDY 2000 format');
  331.      writeln('( 2k clusters, 112 directory entries )');
  332.      writeln('A 96 TPI double sided drive is required.');
  333.      writeln('Floppies in positions 3 and 4 are accessed as C: and D:');
  334.      writeln('Even if not logged as DOS drives C: and D:.');
  335.      writeln;
  336.      writeln('Copyright 9-15-85 by Clarence Wilkerson. All rights reserved.');
  337.      writeln('Released for non-commercial usage only.');
  338.      writeln;
  339.      write('Type Q, Z, or X to exit at any prompt.');
  340.      checkexit;
  341.      writeln;
  342.      writeln;
  343. end; { logo }
  344.  
  345. begin  { main }
  346.   logo;
  347.   makefat;
  348.  repeat
  349.     c:=menu;
  350.     case c of
  351.  
  352.       'V' :if getformparams then begin
  353.                insertdisk;
  354.                verify;
  355.             end;
  356.  
  357.       'F' :
  358.            if getformparams then begin
  359.                insertdisk;
  360.                doit;
  361.                writefat; { fill in the directory and FAT tables }
  362.             end;
  363.       'T' :
  364.             if getformparams then begin
  365.                insertdisk;
  366.                 writefat;
  367.             end;
  368.  
  369.      end; { case }
  370.      until c in [^Z, 'X','Q','Z'];
  371.     smoothexit; { reset disk parameters }
  372.     end.