home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / FLOPPIES / FDFORM16.ZIP / FDCOPY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-26  |  12.3 KB  |  421 lines
  1. {$A+,B-,D+,E+,F-,I-,L+,N-,O-,R-,S-,V-}
  2. {$M 8192,10000,655360 }
  3.  
  4. uses dos;
  5.  
  6. type boottyp   = array[30..511] of byte;
  7.      fattyp    = array[0..4095] of byte;
  8.  
  9.      bpbtyp  =  record
  10.           jmp: array[1..3] of byte;  {Die ersten drei Bytes für JUMP}
  11.           oem: array[1..8] of char;  {OEM-Eintrag}
  12.           bps: word;                 {Bytes pro Sektor}
  13.           spc: byte;                 {Sektoren pro Cluster}
  14.           res: word;                 {BOOT-Sektoren}
  15.           fat: byte;                 {Anzahl der FAT's}
  16.           rde: word;                 {Basisverzeichniseinträge}
  17.           sec: word;                 {Gesamtsektoren der Diskette}
  18.           mds: byte;                 {Media-Deskriptor}
  19.           spf: word;                 {Sektoren pro FAT}
  20.           spt: word;                 {Sektoren pro Spur}
  21.           hds: word;                 {Seiten}
  22.           shh: word;                 {Versteckte Sektoren}
  23.           boot_code: boottyp;        {Puffer für BOOT-Code}
  24.         end;
  25.  
  26. var regs:        registers;                  {Prozessor-Register}
  27.     x:           word;                       {Hilfsvariable}
  28.     old58:       pointer;                    {Speicher für Interrupt 58}
  29.     src:     bpbtyp;                     {BOOT-Sektor Quelldiskette}
  30.     dst:         bpbtyp;                     {BOOT-Sektor Zieldiskette}
  31.     chx:         Char;                       {Hilfsvariable}
  32.     para:     String[5];                  {Kommandozeileneingabe}
  33.     i:           Word;                       {Hilfsvariable}
  34.     fat:         ^fattyp;                    {FAT der Quelldiskette}
  35.     lwsrc,lwdst: byte;                       {Quell/Ziellaufwerksnummer}
  36.     driveinfo:   array[0..30] of byte;       {Laufwerksbeschreibung}
  37.     Sector:      Word;                       {Sektor, ab dem kopiert wird}
  38.     memory:      Pointer;                    {Hilfsvariable}
  39.     memfree:     Word;                       {Freier Speicher in Sektoren}
  40.     StartSeg:    Word;                       {Segment des freien Speichers}
  41.     StartOfs:    Word;                       {Offset des freien Speichers}
  42.     SourceIn:    Boolean;                    {True, wenn Quelldisk eingelegt}
  43.     WantSource:  Boolean;                    {True, wenn Quelldisk benötigt}
  44.     CopyAll:     Boolean;                    {True, wenn /A Parameter}
  45.     First:       Boolean;                    {True, wenn Zieldisk 1.Mal kommt}
  46.     BadCluster:  Array[1..20] of Word;       {Tabelle der schlechten Cluster}
  47.     BCCount:     Byte;                       {Counter für BadCluster}
  48.  
  49. const Read58: Array[0..5] of Byte =(
  50.  
  51.             $CD,$25,           {  INT  25H            }
  52.             $59,               {  POP  CX             }
  53.             $CA,$02,$00);      {  RETF 2              }
  54.  
  55.       Write58: Array[0..5] of Byte =(
  56.  
  57.             $CD,$26,           {  INT  26H            }
  58.             $59,               {  POP  CX             }
  59.             $CA,$02,$00);      {  RETF 2              }
  60.  
  61.  
  62. Function ReadKey:Char;
  63. Var r:Registers;
  64. begin
  65.   with r do begin
  66.     ah:=7;
  67.     intr($21,r);
  68.     if al in [3,27] then begin writeln; halt end;
  69.     ReadKey:=chr(al);
  70.   end;
  71. end;
  72.  
  73. Function Cluster(Sector: Word):Word;
  74. Var h: byte;
  75. begin
  76.   Cluster:=((Sector-(src.rde shr 4)
  77.             -(src.spf shl 1)-1)
  78.            div Word(src.spc))+2;
  79. end;
  80.  
  81. Function ClusterCont(Cluster:Word):Word;
  82. Var Offset: Word;
  83. begin
  84.   Offset:=Cluster*3 shr 1;
  85.   if Cluster and 1 = 0 then
  86.     ClusterCont:=(fat^[offset]+Word(fat^[offset+1]) shl 8) and $fff
  87.   else
  88.     ClusterCont:=((fat^[offset]+Word(fat^[offset+1]) shl 8) and $fff0) shr 4;
  89. end;
  90.  
  91. Procedure FreeBadCluster(Cluster:Word);
  92. Var Offset:Word;
  93. begin
  94.   if (Cluster>1) and (Cluster<4096) and (ClusterCont(Cluster)=$ff7) then begin
  95.     Offset:=Cluster*3 shr 1;
  96.     if Cluster and 1 = 0 then begin
  97.       fat^[offset]:=0;
  98.       fat^[offset+1]:=fat^[offset+1] and $F0;
  99.     end else begin
  100.       fat^[offset+1]:=0;
  101.       fat^[offset]:=fat^[offset] and $F;
  102.     end;
  103.   end;
  104. end;
  105.  
  106. Procedure MarkBadClusters;
  107. Var i,j,Offset:Word;
  108. begin
  109.   for i:=1 to BCCount do begin
  110.     j:=BadCluster[i];
  111.     if ClusterCont(j)=0 then begin
  112.       Offset:=j*3 shr 1;
  113.       writeln('Cluster ',j,' auf der Zieldiskette als schlecht markiert');
  114.       if j and 1 = 0 then begin
  115.         fat^[offset]:=$F7;
  116.         fat^[offset+1]:=fat^[offset+1] or $F
  117.       end else begin
  118.         fat^[offset+1]:=$FF;
  119.         fat^[offset]:=fat^[offset] or $70
  120.       end;
  121.     end;
  122.   end;
  123.   BCCount:=0;
  124. end;
  125.  
  126. Procedure Insert;
  127. begin
  128.   writeln('Anschließend die Eingabetaste betätigen (ESC=Abbruch)');
  129.   repeat until Readkey=#13;
  130.   writeln;
  131. end;
  132.  
  133.  
  134. Procedure InsertSource;
  135. begin
  136.   writeln;
  137.   writeln('Quelldiskette in Laufwerk ',chr(lwsrc+$40),': einlegen.');
  138.   SourceIn:=true;
  139.   Insert;
  140. end;
  141.  
  142. Procedure InsertDest;
  143. begin
  144.   writeln;
  145.   writeln('Zieldiskette in Laufwerk ',chr(lwdst+$40),': einlegen.');
  146.   Insert;
  147.   SourceIn:=false;
  148. end;
  149.  
  150. Procedure error(rw:byte; Var er:boolean; Sector:Word);
  151. Var c,d: Word;
  152. begin
  153.   writeln;
  154.   write('Fehler ',regs.al,': Sektor: ',Sector,' ');
  155.   c:=Cluster(Sector);
  156.   if Sector=0 then writeln('BOOT-Sektor');
  157.   if Sector in [1..src.spf] then writeln('FAT 1');
  158.   if Sector in [src.spf+1..src.spf shl 1] then writeln('FAT 2');
  159.   if (Sector > src.spf shl 1) and ((c<2) or (c>4096)) then
  160.     writeln('Basisverzeichnis');
  161.   if (c>1) and (c<4096) then begin
  162.     write('Cluster ',c,': ');
  163.     d:=ClusterCont(c);
  164.     case d of
  165.       0: writeln('Freier Cluster');
  166.       $ff7: writeln('Schlechter Cluster');
  167.       else writeln('Belegter Cluster');
  168.     end;
  169.   end;
  170.   repeat
  171.     write('(A)bbrechen, (W)iederholen, (I)gnorieren ? ');
  172.     chx:=UpCase(ReadKey); writeln(chx);
  173.   until chx in ['A','I','W'];
  174.   case chx of
  175.     'A': halt;
  176.     'I': begin
  177.            er:=false;
  178.            if (rw=1) and (c>1) and (c<4096) then begin
  179.              inc(BCCount);
  180.              BadCluster[BCCount]:=c;
  181.            end;
  182.          end;
  183.     'W': er:=true;
  184.   end;
  185. end;
  186.  
  187. Procedure DiskReadWrite(rw,lw:Byte; Sector:Word; Count:Byte; Transfer:Pointer);
  188. Var er:boolean;
  189. begin
  190.   if (lwdst=lwsrc) then begin
  191.     if not(WantSource) and SourceIn then InsertDest;
  192.     if WantSource and not(SourceIn) then InsertSource;
  193.   end;
  194.   with regs do begin
  195.   GetIntVec($58,old58);
  196.   al:=lw-1;
  197.   dx:=Sector;
  198.   cx:=Count;
  199.   bx:=LongInt(transfer) and $ffff;
  200.   ds:=LongInt(transfer) shr 16;
  201.   if rw=0 then SetIntVec($58,@read58) else SetIntVec($58,@write58);
  202.   intr($58,regs);
  203.   if (FCarry and Flags) <> 0 then
  204.     for i:=0 to Count-1 do
  205.       repeat
  206.         al:=lw-1;
  207.         dx:=Sector+i;
  208.         cx:=1;
  209.         bx:=LongInt(transfer) and $ffff;
  210.         ds:=(LongInt(transfer) shr 16)+(i shl 5);
  211.         if rw=0 then SetIntVec($58,@read58) else SetIntVec($58,@write58);
  212.         intr($58,regs);
  213.         SetIntVec($58,old58);
  214.         er:=false;
  215.         if (FCarry and Flags) <> 0 then error(rw,er,Sector+i);
  216.       until not er;
  217.   SetIntVec($58,old58);
  218.   end;
  219. end;
  220.  
  221. Procedure ReadSystemArea(lw:Byte);
  222. begin
  223.   with regs do begin
  224.     DiskReadWrite(0,lw,0,1,@src);
  225.     writeln;
  226.     writeln('Gesamtsektoren: ',src.sec);
  227.     writeln('Seiten:         ',src.hds);
  228.     writeln('Spuren:         ',src.sec div src.hds div src.spt);
  229.     writeln('Sektoren/Spur:  ',src.spt);
  230.     GetMem(fat,src.spf shl 9);
  231.     DiskReadWrite(0,lw,1,src.spf,fat);
  232.   end;
  233. end;
  234.  
  235. Procedure CheckDrive(lw:Byte);
  236. begin
  237.   with regs do begin
  238.     ax:=$4409;
  239.     bl:=lw;
  240.     bh:=0;
  241.     intr($21,regs);
  242.     if (FCarry and Flags) <> 0 then begin
  243.       writeln(chr(lw+$40),': ist kein gültiges Laufwerk');
  244.       halt;
  245.     end;
  246.     if (dx and $9200)<>0 then begin
  247.       writeln(chr(lw+$40),': SUBST oder ASSIGN wurde zur Umleitung verwendet.');
  248.       halt;
  249.     end;
  250.     ax:=$440d;
  251.     cx:=$860;
  252.     bl:=lw;
  253.     bh:=0;
  254.     dx:=ofs(driveinfo);
  255.     ds:=seg(driveinfo);
  256.     intr($21,regs);
  257.     if not(driveinfo[1] in [0,1,2,7]) then begin
  258.       writeln(chr(lw+$40),': ist kein Floppy-Laufwerk');
  259.       halt;
  260.     end;
  261.   end;
  262. end;
  263.  
  264. Procedure SyntaxError;
  265. begin
  266.   writeln('Syntax Fehler bei der Eingabe!'#10#13);
  267.   writeln('Korrektes Format ist: '#10#13);
  268.   writeln('FDCOPY Quellaufwerk: Ziellaufwerk: [/A]'#10#13);
  269.   writeln('Die /A Option bewirkt, daß auch freie Cluster kopiert werden'#10#13);
  270.   writeln('Beispiel FDCOPY a: b: /A'#10#13);
  271.   halt;
  272. end;
  273.  
  274. Procedure CheckMemory;
  275. begin
  276.   memfree:=(MaxAvail shr 9);
  277.   GetMem(Memory,1);
  278.   StartSeg:=LongInt(Memory) shr 16;
  279.   StartOfs:=LongInt(Memory) and $ffff;
  280.   FreeMem(Memory,1);
  281.   writeln('Im Speicher ist Platz für ',memfree,' Sektoren.');
  282.   writeln;
  283.   if memfree=0 then begin
  284.     writeln('Zu wenig Speicher');
  285.     halt;
  286.   end;
  287.   if StartOfs>$8000 then begin
  288.     StartOfs:=StartOfs-$8000;
  289.     StartSeg:=StartSeg+$800;
  290.   end;
  291. end;
  292.  
  293. Function MustCopy(i:Word):Byte;
  294. Var j:Word;
  295. begin
  296.   if i<=src.spf shl 1 then
  297.     MustCopy:=0
  298.   else begin
  299.     j:=Cluster(i);
  300.     if (j<2) or (j>4095) then
  301.       MustCopy:=2
  302.     else begin
  303.       j:=ClusterCont(j);
  304.       if (j=0) or (j=$ff7) then
  305.         MustCopy:=1
  306.       else
  307.         MustCopy:=2;
  308.     end;
  309.   end;
  310. end;
  311.  
  312. Procedure DoOneBlock(rw:Byte);
  313. Var SectorSave:  Word;            {Speicher für Startsektor}
  314.     i,j:         Word;            {Hilfsvariablen}
  315.     SectorsLeft: Word;            {Noch verbleibender Speicherplatz}
  316.     Segment:     Word;            {Segment für aktuelle Sektoren}
  317.     cnt:         Byte;            {Anzahl der zu lesenden Sektoren}
  318.     StartSec:    Word;            {Startsektor eines Lese/Schreibvorgangs}
  319.     EndSec:      Word;            {Endsektor eines Lese/Schreibvorgangs}
  320.     Copy:        Byte;            {1=Alle Sektoren/2=Nur belegte Sektoren}
  321. begin
  322.   SectorSave:=Sector;
  323.   Segment:=StartSeg;
  324.   SectorsLeft:=memfree;
  325.   repeat
  326.     if CopyAll then Copy:=1 else Copy:=2;
  327.     StartSec:=$ffff;
  328.     for i:=Sector to Sector+src.spt-1 do begin
  329.       if MustCopy(i)>=Copy then EndSec:=i;
  330.       j:=(Sector shl 1)+src.spt-i-1;
  331.       if MustCopy(j)>=Copy then StartSec:=j;
  332.     end;
  333.     if StartSec<>$ffff then begin
  334.       cnt:=EndSec-StartSec+1;
  335.       write('Speicher: ',SectorsLeft-cnt,', Sektoren: ',Startsec,'-',EndSec);
  336.       x:=Cluster(Startsec);
  337.       if (x>1) and (x<4096) then
  338.         write(', Cluster: ',x,'-',Cluster(EndSec),'         ')
  339.       else
  340.         write(' Basisverzeichnis       ');
  341.       write(#13);
  342.       Case rw of
  343.         0: begin
  344.              WantSource:=true;
  345.              DiskReadWrite(0,lwsrc,Startsec,cnt,ptr(Segment,StartOfs));
  346.            end;
  347.         1: begin
  348.              WantSource:=false;
  349.              DiskReadWrite(1,lwdst,Startsec,cnt,ptr(Segment,StartOfs))
  350.            end;
  351.       end;
  352.       SectorsLeft:=SectorsLeft-cnt;
  353.       Segment:=Segment+(cnt shl 5);
  354.     end;
  355.     for i:=Sector to Sector+src.spt-1 do
  356.       FreeBadCluster(Cluster(i));
  357.     MarkBadClusters;
  358.     Sector:=Sector+src.spt;
  359.   until (Sector>=src.sec) or (SectorsLeft<src.spt);
  360.   if rw=0 then Sector:=SectorSave;
  361. end;
  362.  
  363. begin
  364.   writeln;
  365.   writeln('FDCOPY - Diskcopy Programm für alle Formate -- Ver 1.00');
  366.   writeln('Copyright (c) 30. August 1988, Christoph H. Hochstätter');
  367.   writeln;
  368.   SourceIn:=false;
  369.   WantSource:=true;
  370.   CopyAll:=false;
  371.   BCCount:=0;
  372.   para:=ParamStr(1);
  373.   if length(para)<>2 then SyntaxError;
  374.   if para[2]<>':' then SyntaxError;
  375.   lwsrc:=ord(UpCase(para[1]))-$40;
  376.   para:=ParamStr(2);
  377.   if length(para)<>2 then SyntaxError;
  378.   if para[2]<>':' then SyntaxError;
  379.   lwdst:=ord(UpCase(para[1]))-$40;
  380.   if (ParamStr(3)='/A') or (ParamStr(3)='/a') then
  381.     CopyAll:=true
  382.   else
  383.     if ParamStr(3)<>'' then SyntaxError;
  384.   InsertSource;
  385.   CheckDrive(lwsrc);
  386.   ReadSystemArea(lwsrc);
  387.   if lwsrc<>lwdst then begin
  388.     WantSource:=false;
  389.     InsertDest;
  390.     CheckDrive(lwdst);
  391.   end;
  392.   CheckMemory;
  393.   Sector:=0;
  394.   first:=true;
  395.   repeat
  396.     DoOneBlock(0);
  397.     if first then begin
  398.       WantSource:=false;
  399.       first:=false;
  400.       DiskReadWrite(0,lwdst,0,1,@dst);
  401.       if src.sec <> dst.sec then begin
  402.         writeln(#10#10'Zieldiskette ist nicht kompatibel');
  403.         halt;
  404.       end;
  405.     end;
  406.     DoOneBlock(1);
  407.   until Sector>=src.sec;
  408.   src.oem:='CH-COPY1';
  409.   src.spt:=dst.spt;
  410.   src.hds:=dst.hds;
  411.   if src.spc=dst.spc then begin
  412.     src.mds:=dst.mds;
  413.     fat^[0]:=dst.mds;
  414.   end;
  415.   WantSource:=false;
  416.   DiskReadWrite(1,lwdst,0,1,@src);
  417.   DiskReadWrite(1,lwdst,1,src.spf,fat);
  418.   DiskReadWrite(1,lwdst,1+src.spf,src.spf,fat);
  419.   writeln(#13#10#10'Kopie erstellt');
  420. end.
  421.