home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / utils / dskutl / transf18.ark / TRANS-01.INC < prev    next >
Encoding:
Text File  |  1989-09-27  |  7.0 KB  |  317 lines
  1.  
  2. (* module 01 *)
  3.  
  4.  
  5. procedure Box (X1, Y1, X2, Y2: integer);
  6.  
  7. var
  8.   I: integer;
  9.  
  10. begin
  11.   gotoxy (X1,Y1);
  12.   for I:= X1 to X2 do
  13.     write ('*');
  14.   for I:= Y1 to Y2 do
  15.   begin
  16.     gotoxy (X2,I);
  17.     write ('*')
  18.   end;
  19.   gotoxy (X1,Y2);
  20.   for I:= X2 downto X1 do
  21.     write ('*');
  22.   for I:= Y2 downto Y1 do begin
  23.     gotoxy (X1,I);
  24.     write ('*')
  25.   end;
  26. end;
  27.  
  28.  
  29.  
  30. function MainSelection: char;
  31.  
  32. var
  33.   Ch: char;
  34.  
  35. begin
  36.   ClrScr;
  37.   Box(13,4,60,23);
  38.   writeln('* TRANSFER - vers ',Vers,' ');
  39.  
  40.   gotoxy(MenuMargin,7);
  41.   write('   CP/M= ',chr(CPM_Drive+ord('A')),':');
  42.   write('             MS-DOS= ',chr (MS_DOS_Drive+ord ('A')), ':');
  43.  
  44.   gotoxy (menuMargin, 8);
  45.   write ('   Path == ', pathStr);
  46.  
  47.   gotoxy(MenuMargin,10);
  48.   write('1. Transfer File:     CP/M >> MS-DOS');
  49.  
  50.   gotoxy(MenuMargin,11);
  51.   write('2. Transfer File:   MS-DOS >> CP/M');
  52.  
  53.   gotoxy(MenuMargin,12);
  54.   write('3. Directory of     MS-DOS Disk');
  55.  
  56.   gotoxy(MenuMargin,13);
  57.   write('4. Allocation Map   MS-DOS Disk');
  58.  
  59.   gotoxy(MenuMargin,14);
  60.   write('5. Directory of       CP/M Disk');
  61.  
  62.   gotoxy(MenuMargin,15);
  63.   write('6. Erase File       MS-DOS Disk');
  64.  
  65.   gotoxy(MenuMargin,16);
  66.   write('7. Boot Sector      MS-DOS Disk');
  67.  
  68.   gotoxy (menuMargin, 17);
  69.   write ('8. Open MS-DOS SubDirectory');
  70.  
  71.   gotoxy(MenuMargin,18);
  72.   write('9. Quit');
  73.  
  74.   repeat
  75.     gotoxy(MenuMargin,20);
  76.     write('   Enter Your Selection? ');
  77.     read(KBD,Ch);
  78.   until (Ch in ['1'..'9']);
  79.   MainSelection:= Ch
  80. end;
  81.  
  82.  
  83.  
  84. procedure Continue;
  85. begin
  86. write('Press [Return] to Continue..');
  87. repeat
  88.   read(KBD,Selection);
  89.   until (Selection = #$D);
  90. end;
  91.  
  92.  
  93.  
  94. procedure NextSector(var S: integer; var T: integer);
  95. begin
  96. S:= S + 1;
  97. if (S >= NSectors) then
  98.   begin
  99.   S:= MinSector;
  100.   T:= T + 1;
  101.   end;
  102. end;
  103.  
  104.  
  105.  
  106. procedure DiskError;
  107. begin
  108. writeln;
  109. write('Disk I/O Error, ');
  110. Continue;
  111. end;
  112.  
  113.  
  114.  
  115. procedure BiosSelect(DriveCode: integer);
  116. var firstsel:integer;
  117. begin
  118.   firstsel:=1;
  119.   if((DriveCode = MS_DOS_Drive) and dosnew) then begin
  120.     dosnew:=false;
  121.     firstsel:=0;
  122.   end;
  123.   if((DriveCode = CPM_Drive) and cpmnew) then begin
  124.     cpmnew:=false;
  125.     firstsel:=0;
  126.   end;
  127.   { hier stand mal ne 9 drin, aber bei der BIOS Nummerierung }
  128.   { von Turbo Pascal muss es ne 8 sein !!! }
  129.   BiosError:=(mybioshl(8, DriveCode, firstsel) = 0);
  130. end;
  131.  
  132.  
  133.  
  134. procedure ReadSector(Sector, Track, Address: integer);
  135. var
  136.   Rec: integer;
  137.   RPS: integer;
  138.   I:   integer;
  139.   dummy: integer;
  140. begin
  141.   BiosSelect(MS_DOS_Drive);                     { SWITCH TO DOS DISK }
  142.   if cpm3 then begin
  143.     { new code for cpm3 }
  144.     dummy := mybioshl(11, address, 0);          { SET DMA ADDRESS }
  145.     dummy := mybioshl(9, track, 0);             { SET TRACK }
  146.     dummy := mybioshl(10, sector + 1, 0);       { SET SECTOR }
  147.     biosError := (mybios(12, 0, 0) <> 0);       { READ SECTOR }
  148.   end else begin
  149.     { old (CPM2) Code }
  150.     (* if singlesided then Track:= Track * 2; *)
  151.     RPS:= SectorSize div 128;
  152.     BiosError:= False;
  153.     for I:= 0 to (RPS -1)do begin
  154.       dummy := mybioshl(9, track, 0);              (* select track     *)
  155.       if SecTrans then
  156.         Rec:= myBiosHL(15,Sector * RPS + I + SO, 0)     (* translate sector *)
  157.       else
  158.         Rec:= (Sector * RPS + I + SO);
  159.       dummy := mybioshl(10,Rec,0);                 (* select sector    *)
  160.       dummy := mybioshl(11,(I * 128) + Address,0); (* set dma addr     *)
  161.       BiosError:= (BiosError or (mybios(12,0,0)<>0));    (* read 128 bytes   *)
  162.     end;
  163.   end;
  164.   dummy := mybioshl(8,CPM_Drive,0);             { SWITCH BACK TO CP/M }
  165.   if BiosError then DiskError;
  166. end;
  167.  
  168.  
  169.  
  170. procedure WriteSector(Sector,Track,Address: integer);
  171. var
  172.   Rec: integer;
  173.   RPS: integer;
  174.   I:   integer;
  175.   l:   integer;
  176.   dummy: integer;
  177. begin
  178.   BiosSelect(MS_DOS_Drive);                     { SWITCH TO DOS DISK }
  179.   if cpm3 then begin
  180.     { new code for cpm3 }
  181.     dummy := mybioshl(11, address, 0);          { SET DMA ADDRESS }
  182.     dummy := mybioshl(9, track, 0);             { SET TRACK }
  183.     dummy := mybioshl(10, sector + 1, 0);       { SET SECTOR }
  184.     biosError := (mybios(13, 0, 0) <> 0);       { WRITE SECTOR }
  185.   end else begin
  186.     { old (CPM2) Code }
  187.     (* if singlesided then Track:= Track * 2; *)
  188.     RPS:= SectorSize div 128;
  189.     BiosError:= False;
  190.     for I:= 0 to (RPS -1)do begin
  191.       if i = rps-1 then l := 1 else l := 2;
  192.       dummy := mybioshl(9,track,0);                (* select track     *)
  193.       if SecTrans then
  194.         Rec:= myBiosHL(15,Sector * RPS + I + SO,0) (* translate sector *)
  195.       else
  196.         Rec:= (Sector * RPS + I + SO);
  197.       dummy := mybioshl(10,Rec,0);                 (* select sector    *)
  198.       dummy := mybioshl(11,(I * 128) + Address,0); (* set dma addr     *)
  199.       BiosError:= (BiosError or (mybios(13,l,0)<>0));  (* write 128 bytes   *)
  200.     end;
  201.   end;
  202.   dummy := mybioshl(8,CPM_Drive,0);             { SWITCH BACK TO CP/M }
  203.   if BiosError then DiskError;
  204. end;
  205.  
  206.  
  207.  
  208. procedure GetFAT;
  209.  
  210. var
  211.   s, t, i: integer;
  212. begin
  213.   s := firstfatsector;
  214.   t := 0;
  215.   for i := 0 to fatsize-1 do begin
  216.     ReadSector (s, t, addr (fat) + (sectorsize * i));
  217.     NextSector (s, t)
  218.   end
  219. end;
  220.  
  221.  
  222. procedure PutFAT;
  223.  
  224. var
  225.   S, T, I, j: integer;
  226.  
  227. begin
  228.   S := FirstFATSector;
  229.   T := 0;
  230.   for j := 1 to fatnum do
  231.     for I := 0 to FATSize-1 do begin
  232.       WriteSector (S,T,addr(FAT) + (SectorSize * I));
  233.       NextSector (S,T);
  234.     end;
  235. end;
  236.  
  237.  
  238. procedure ReadCluster(Cl: integer);
  239. var
  240.   I:      integer;
  241.   Sector: integer;
  242.   Track:  integer;
  243. begin
  244. Cl:= Cl - 2;
  245. Track:= (Cl * SecsPerCluster) div NSectors;
  246. Sector:= (Cl * SecsPerCluster) mod NSectors;
  247. Sector:= Sector + FirstDataSector;
  248. Track:= Track + FirstDataTrack + (Sector div NSectors);
  249. Sector:= Sector mod NSectors;
  250. for I:= 0 to (SecsPerCluster -1) do
  251.   begin
  252.   ReadSector(Sector,Track,addr( ClusterBuffer[ I * SectorSize + 1] ));
  253.   NextSector(Sector,Track);
  254.   end;
  255. end;
  256.  
  257.  
  258.  
  259. procedure WriteCluster(Cl: integer);
  260. var
  261.   I:      integer;
  262.   Sector: integer;
  263.   Track:  integer;
  264. begin
  265. Cl:= Cl - 2;
  266. Track:= (Cl * SecsPerCluster) div NSectors;
  267. Sector:= (Cl * SecsPerCluster) mod NSectors;
  268. Sector:= Sector + FirstDataSector;
  269. Track:= Track + FirstDataTrack + (Sector div NSectors);
  270. Sector:= Sector mod NSectors;
  271. for I:= 0 to (SecsPerCluster -1) do
  272.   begin
  273.   WriteSector(Sector,Track,addr( ClusterBuffer[ I * SectorSize + 1] ));
  274.   NextSector(Sector,Track);
  275.   end;
  276. end;
  277.  
  278.  
  279.  
  280. function FATPointer(Index: integer): Integer; (* 2..NClusters + 2 *)
  281. var
  282.   Result,I:    Integer;
  283.   OddNum:      Boolean;
  284. begin
  285. I:= ((Index * 3) div 2) +1;
  286. Result:= (FAT[I] + (256 * FAT[I + 1]));
  287. if odd(Index) then Result:= Result shr 4;
  288. FATPointer:= (Result and $FFF);
  289. end;
  290.  
  291.  
  292.  
  293. function Break: boolean;
  294. var
  295.   Ch: char;
  296. begin
  297. if KeyPressed then
  298.   begin
  299.   read(KBD,Ch);
  300.   if (Ch = ^S) then
  301.     begin
  302.     while not KeyPressed do;
  303.     read(KBD,Ch);
  304.     end;
  305.   if (Ch = #27) then
  306.     Break:= true
  307.   else
  308.     Break:= false;
  309.   end
  310. else
  311.   Break:= false;
  312. end;
  313.  
  314.  
  315.  
  316. (* end module 01 *)
  317.