home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9203 / pastrick / doppel.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-07-26  |  3.3 KB  |  173 lines
  1. {Zweck : Diskcopy von HD-Disketten,
  2.          Mehrfachkopien ohne wechseln;
  3.          Disketten müssen formatiert sein
  4.          und dürfen keine schlechten
  5.          Sektoren enthalten;
  6. Sprache: Turbo Pascal 6.0
  7. System : PC AT 286,386,486 unter DOS 3.x}
  8.  
  9. program doppel {Version 1.0};
  10. {$A+,G+,I-,V-,R-,L-,D-,B-}
  11. uses crt,dos;
  12. const name='DOPPEL.SWP';
  13. var buff:array[1..40960] of byte;
  14. i,j,k,se:word;
  15. f,n     :integer;
  16. dat     :file;
  17. lw      :string[2];
  18. lwnr,run:byte;
  19. groesse :longint;
  20.  
  21. procedure ende(c:byte);
  22. {Swap-Datei löschen-Ende}
  23. begin
  24.   close(dat);
  25.   erase(dat);
  26.   halt(c)
  27. end;
  28.  
  29. procedure weiter(w:integer);
  30. {Benutzerdialog oder Abbruch}
  31. var t:char;
  32. begin
  33.   if w=0 then
  34.   writeln(#10,'QUELL-Diskette in'
  35.   +' ',lw,' einlegen') else
  36.   writeln(#7,w,'. ZIEL-Diskette in'
  37.   +' ',lw,' einlegen');
  38.   writeln('<ESC> Abbruch, sonst'+
  39.   ' andere Taste drücken',#10);
  40.   t:=readkey;
  41.   if t=#27 then ende(0)
  42. end;
  43.  
  44. procedure lies(s,a:word);
  45. {a Sektoren in Buffer direkt schreiben}
  46. var e:byte;
  47. begin
  48.   e:=0;
  49.   asm
  50.     mov al,lwnr
  51.     mov cx,a
  52.     mov dx,s
  53.     mov bx,seg buff
  54.     mov ds,bx
  55.     mov bx,offset buff
  56.     int 25h;
  57.     add e,ah
  58.   end;
  59.   if e<>0 then
  60.   begin
  61.     writeln(#7,'Lesefehler Code ',e);
  62.     ende(e)
  63.   end;
  64.   blockwrite(dat,buff,sizeof(buff))
  65. end;
  66.  
  67. procedure schreib(s:word);
  68. {80 Sektoren aus Buffer direkt schreiben}
  69. var e:byte;
  70. begin
  71.   e:=0;
  72.   blockread(dat,buff,sizeof(buff));
  73.   asm
  74.     mov al,lwnr
  75.     mov cx,80
  76.     mov dx,s
  77.     mov bx,seg buff
  78.     mov ds,bx
  79.     mov bx,offset buff
  80.     int 26h
  81.     add e,ah
  82.   end;
  83.   if e<>0 then
  84.   begin
  85.     writeln(#7,'Schreibfehler Code ',e);
  86.     ende(e)
  87.   end
  88. end;
  89.  
  90. procedure diskcheck;
  91. {Anzahl der Sektoren aus
  92.  Boot-Sektor auslesen}
  93.  
  94. function bytestoword(a,b:byte):word;
  95. {Verdreht auf Platte gespeicherte Bytes
  96.  in Word umwandeln}
  97. var w:word;
  98. begin
  99.   w:=b*256;
  100.   bytestoword:=w+a
  101. end;
  102. begin  
  103.   lies(0,1);  
  104.   se:=bytestoword(buff[20],buff[21]);
  105.   if se=2400 then {Sektor 0,Offset 19,20}
  106.   begin
  107.     run:=30;
  108.     groesse:=1228800
  109.   end else
  110.   if se=2880 then
  111.   begin
  112.     run:=36;
  113.     groesse:=1474560
  114.   end else
  115.   begin
  116.     writeln(#7,'Diskette ist kein DOS-HD-Typ!');
  117.     writeln('Enthält nur ',se,' Sektoren');
  118.     ende(1)
  119.   end
  120. end;
  121.  
  122. begin
  123.  lw:=paramstr(1); {Parameter auswerten}
  124.  val(paramstr(2),n,f);
  125.  if (lw='A:') or (lw='a:') then lwnr:=0
  126.  else
  127.  if (lw='B:') or (lw='b:') then lwnr:=1 else
  128.  n:=0;
  129.  if (f<>0) or (n<1) or (paramcount<>2) then
  130.  begin
  131.    writeln(#7,'Parameterfehler!');
  132.    writeln('Syntax: DOPPEL Laufwerk: Anzahl');
  133.    halt
  134.  end;
  135.  assign(dat,name); {Swap-Datei öffnen}
  136.  rewrite(dat,1);
  137.  if (ioresult<>0) then
  138.  begin
  139.    writeln(#7,'Fehler beim Dateiöffnen!');
  140.    halt(ioresult)
  141.  end;
  142.  j:=0;
  143.  weiter(0);
  144.  diskcheck; {Diskette und Platz prüfen}
  145.  if diskfree(0) < groesse then
  146.  begin
  147.    writeln(#7,'Es fehlen ',groesse-diskfree(0),
  148.    +' Bytes für die Swap-Datei!');
  149.    ende(8)
  150.  end;
  151.  for i:=1 to run do {Diskette einlesen}
  152.  begin
  153.    lies(j,80);
  154.    write('.');
  155.    inc(j,80)
  156.  end;
  157.  writeln;
  158.  j:=0;
  159.  reset(dat,1); {n-mal Diskette beschreiben}
  160.  for k:=1 to n do  
  161.  begin
  162.    writeln;
  163.    weiter(k);
  164.    diskcheck;
  165.    for i:=1 to run do
  166.    begin
  167.      schreib(j);
  168.      write('.');
  169.      inc(j,80)
  170.    end
  171.  end;
  172.  ende(0)
  173. end.