home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 02 / diskver / diskver.pas
Encoding:
Pascal/Delphi Source File  |  1988-05-10  |  7.7 KB  |  254 lines
  1. {
  2.  COMPILED ON TURBO PASCAL 3.xx for PC or MS-DOS
  3.  this is sent in answer to Tom Douglass' letter to TUG issue 24 wanting to
  4.  format a disk from a program.  This is a routine I wrote to format and verify
  5.  a disk.  To make the disk usable you need to read the Boot Sector, the FAT,
  6.  and the directory sectors from a formatted disk into some kind of data file
  7.  and use the WRITESCT procedure below to write them to the correct place.
  8.  There are no references to the WriteSct and ReadSct procedures in the program.
  9.  They are provided so you can read the Boot,Fat,and Dir in and write them out.
  10.  I realize this doesn't do everything Tom wanted but it should provide a good
  11.  start.  And Tom, If you do get this into one procedure to format a data disk,
  12.  I could problably use it someday if you could send it to me.
  13. }
  14.  
  15.  
  16. program diskver;
  17. {
  18. this program was written by Michael Bush 1/5/87
  19. The purpose of this program is to verify the surface of the disk by putting
  20. a normal DOS format on the disk and then reading it back.  It does NOT put
  21. Directory and FAT info on the disk.  To use it to format this would be
  22. neccecary.  It will destroy all data on the disk.
  23. }
  24. {$U+,C+}{allow user breaks}
  25. const drivea = 0;
  26.       driveb = 1;
  27.  
  28. type {these are field definitions for the format intterupt to use}
  29.      FieldType = record
  30.                    Track,Head,Sector,Bytes:byte;
  31.                  end;
  32.  
  33.      AddressFieldsType = array[1..18] of FieldType;
  34.  
  35.      buffertype = array[1..9] of array[1..512] of byte;
  36.  
  37. var HeadSettleOfs,HeadSettleSeg : integer;
  38.     DiskPointerVectorOfs        : integer absolute $0000:$0078;
  39.     DiskPointerVectorSeg        : integer absolute $0000:$007a;
  40.     regs                        :record
  41.                                   ax,bx,cx,dx,bp,si,di,ds,es,flags:integer;
  42.                                 end;
  43.     i,oldax                    :integer;
  44.     track,head,drive,sector    :integer;
  45.     ok                         :boolean;
  46.     ch                         :char;
  47.     AddressFields              :AddressFieldsType;
  48.     Field                      :FieldType;
  49.     buffer0,buffer1            :buffertype;
  50.  
  51. procedure beep;
  52. begin
  53.   sound(440);
  54.   delay(100);
  55.   nosound;
  56. end;
  57.  
  58. procedure beeep;
  59. begin
  60.   sound(880);
  61.   delay(25);
  62.   nosound;
  63. end;
  64.  
  65. procedure diskspeed;
  66. {
  67. this procedure was written by Michael Bush 1/5/87
  68. The purpose of this program is to speed up diskcopy and format
  69. and other reads and writes of more than one track at a time
  70. }
  71. var
  72.     b,srt:byte;
  73. begin
  74.   b:=mem[DiskpointerVectorSeg:DiskPointerVectorOfs];
  75.   b:= (b shl 4) shr 4;
  76.   srt:=$D shl 4;{new Step Rate Time}
  77.   b:=b+srt;
  78.   mem[DiskpointerVectorSeg:DiskPointerVectorOfs]:=b;
  79.  
  80.   {new Head Settle Time}
  81.   mem[DiskpointerVectorSeg:DiskPointerVectorOfs+9]:=00;
  82. end;
  83.  
  84. procedure Verify(Track,head,drive:integer);
  85. begin
  86.   with regs do begin                           
  87.     ax:=$0409;{ah=command=verify sectors, al=# of sectors}
  88. {
  89. 0=reset, 1=read the status of the system into al, 2=read sectors,
  90. 3=write sectors, 4=verify sectors, 5=format track
  91. }
  92.     head:=swap(head);
  93.     dx:=drive+head;{dh=head, dl=drive=0=a:}
  94.     track:=swap(track);
  95.     cx:=track+$0001;{ch=track, cl=sector}
  96.     {es:bx = address of buffer for read or write}
  97.   end;
  98.   intr($13,regs);{BIOS diskette interrupt}
  99. end;
  100.  
  101. procedure readsct(drive,Track,head,sector:integer;var buf);
  102. var buffer : byte absolute buf;
  103. begin
  104.   with regs do begin
  105.     ax:=$0201;{ah=command=read sectors, al=# of sectors}
  106. {
  107. 0=reset, 1=read the status of the system into al, 2=read sectors,
  108. 3=write sectors, 4=verify sectors, 5=format track
  109. }
  110.     head:=swap(head);
  111.     dx:=drive+head;{dh=head, dl=drive=0=a:}
  112.     track:=swap(track);
  113.     cx:=track+sector;{ch=track, cl=sector}
  114.     {es:bx = address of buffer for read or write}
  115.     es:=seg(buffer);
  116.     bx:=ofs(buffer);
  117.   end;
  118.   intr($13,regs);{BIOS diskette interrupt}
  119. end;
  120.  
  121. procedure writesct(drive,Track,head,sector:integer;var buf);
  122. var buffer : byte absolute buf;
  123. begin
  124.   with regs do begin
  125.     ax:=$0309;{ah=command=verify sectors, al=# of sectors}
  126. {
  127. 0=reset, 1=read the status of the system into al, 2=read sectors,
  128. 3=write sectors, 4=verify sectors, 5=format track
  129. }
  130.     head:=swap(head);
  131.     dx:=drive+head;{dh=head, dl=drive=0=a:}
  132.     track:=swap(track);
  133.     cx:=track+sector;{ch=track, cl=sector}
  134.     {es:bx = address of buffer for read or write}
  135.     es:=seg(buffer);
  136.     bx:=ofs(buffer);
  137.   end;
  138.   intr($13,regs);{BIOS diskette interrupt}
  139. end;
  140.  
  141. procedure Format(Track,head,drive:integer;var AddrField);
  142. var AddressFields : byte absolute AddrField;
  143. begin
  144.   with regs do begin
  145.     ax:=$0509;{ah=command=format a track , al=# of sectors}
  146. {
  147. 0=reset, 1=read the status of the system into al, 2=read sectors,
  148. 3=write sectors, 4=verify sectors, 5=format track
  149. }
  150. {
  151. look at source code for jformat for clues as to how to format a disk
  152. }
  153.     dx:=swap(head)+drive;{dl=head=0, dh=drive 0=a: 1=b:}
  154.     track:=swap(track);
  155.     cx:=track+$0001;{ch=track=0, cl=sector=01}
  156.     {es:bx = address of buffer for read or write}
  157.     es:=seg(AddressFields);
  158.     bx:=ofs(AddressFields);
  159.   end;
  160.   intr($13,regs);{BIOS diskette interrupt}
  161. end;
  162.  
  163. procedure SctErrChk;
  164. var
  165.   err   :boolean;
  166.   ErrMsg:string[128];
  167. begin
  168. {
  169. regs.flags bits = 11=overflow, 10=direction, 9=interrupt, 8=Trap,   7=Sign
  170.                    6=Zero,      4=Auxiliary carry,        2=Parity, 0=Carry
  171. }
  172.   ErrMsg:='';
  173. if hi(regs.ax)=$20 then regs.ax:=$0200;
  174.   err:=((regs.flags shl 15)shr 15)=1;
  175.   if err then begin
  176.     ok:=false;
  177.     case hi(regs.ax) of
  178.       $80:ErrMsg:='Attachment failed to respond';
  179.       $40:ErrMsg:='SEEK operation failed';
  180.       $20:ErrMsg:='Controller failure';
  181.       $10:ErrMsg:='Bad CRC on diskette read';
  182.       $08:ErrMsg:='DMA overrun on operation';
  183.       $04:ErrMsg:='Requested sector not found';
  184.       $03:ErrMsg:='Write attempt on write-protected diskette';
  185.       $02:ErrMsg:='Address mark not found';
  186.       else ErrMsg:='Unknown Error';
  187.     end;
  188.     beeep;
  189.     writeln(ErrMsg,' on Track ',track);
  190.   end;
  191. end;
  192.  
  193. procedure ResetDisk(drive:integer);
  194. begin
  195.   with regs do begin
  196.     ax:=$0000;{ah=command=reset drive, al=#sectors=0}
  197.     dx:=$0000+drive;{dl=head=0, dh=drive=a:}
  198.     cx:=$0001;
  199.   end;
  200.   intr($13,regs);
  201. end;
  202.  
  203. begin
  204.   DiskSpeed;
  205.   writeln(^G'Warning this program DESTROYS ALL DATA on the floppy disks');
  206.   writeln('It alternates drives so both A: and B: will be formatted');
  207.   writeln('use Ctrl-C or Break to stop');
  208.   writeln('It will certify the surface (not the data) on that disk');
  209.   writeln;
  210.   write('Should I continue (Y/N)');
  211.   repeat read(kbd,ch);ch:=upcase(ch);until ch in ['Y','N'];
  212.   writeln;
  213.   if ch ='Y' then begin
  214.   {initialize the AddressFields for the format}
  215.     Field.Track:=0;
  216.     Field.Head:=0;
  217.     Field.Sector:=1;
  218.     Field.Bytes:=2;{2=512 bytes}
  219.     for i:=1 to 9 do begin
  220.       Field.Sector:=i;
  221.       AddressFields[i]:=Field;
  222.     end;
  223.     field.head:=1;
  224.     for i:=10 to 18 do begin
  225.       field.sector:=i-9;
  226.       AddressFields[i]:=field;
  227.     end;
  228.     drive:=1;
  229.     repeat
  230.       if drive=1 then drive:=0 else drive:=1;{alternate drives}
  231.       ResetDisk(drive);
  232.       ok:=true;
  233.       track:=-1;
  234.       repeat
  235.         track:=track+1;
  236.         for i:=1 to 18 do AddressFields[i].track:=track;
  237.         Format(track,0,drive,addressfields[1]);
  238.         SctErrChk;
  239.         format(track,1,drive,addressfields[10]);
  240.         SctErrChk;
  241.         Verify(track,0,drive);
  242.         SctErrChk;
  243.         Verify(track,1,drive);
  244.         SctErrChk;
  245.       until not ok or(track>38);
  246.       if not ok then writeln(^G,'This disk is bad.') else
  247.         writeln('Disk ',chr(65+drive),': is Good.');
  248.       writeln;
  249.       beep;
  250.     until true=false;
  251.   end;
  252. end.
  253.  
  254.