home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol256 / trans-01.inc < prev    next >
Encoding:
Text File  |  1986-03-22  |  4.9 KB  |  263 lines
  1.  
  2. (* module 01 *)
  3.  
  4. procedure Box(X1,Y1,X2,Y2: integer);
  5. var
  6.   I: integer;
  7. begin
  8. gotoxy(X1,Y1);
  9. for I:= X1 to X2 do write('*');
  10. for I:= Y1 to Y2 do
  11.   begin
  12.   gotoxy(X2,I);
  13.   write('*');
  14.   end;
  15. gotoxy(X1,Y2);
  16. for I:= X2 downto X1 do write('*');
  17. for I:= Y2 downto Y1 do
  18.   begin
  19.   gotoxy(X1,I);
  20.   write('*');
  21.   end;
  22. end;
  23.  
  24.  
  25.  
  26. function MainSelection: char;
  27. var
  28.   Ch: char;
  29. begin
  30. ClrScr;
  31. Box(13,5,60,22);
  32. writeln('* TRANSFER - vers ',Vers:0:1,' ');
  33. gotoxy(MenuMargin,8);
  34. write('   CP/M= ',chr(CPM_Drive+ord('A')),':');
  35. write('             MS-DOS= ',chr(MS_DOS_Drive+ord('A')),':');
  36.  
  37. gotoxy(MenuMargin,10);
  38. write('1. Transfer File:  CP/M ==> MS-DOS');
  39.  
  40. gotoxy(MenuMargin,11);
  41. write('2. Transfer File:  CP/M <== MS-DOS');
  42.  
  43. gotoxy(MenuMargin,12);
  44. write('3. Directory of      MS-DOS Disk');
  45.  
  46. gotoxy(MenuMargin,13);
  47. write('4. Allocation Map    MS-DOS Disk');
  48.  
  49. gotoxy(MenuMargin,14);
  50. write('5. Directory of      CP/M Disk');
  51.  
  52. gotoxy(MenuMargin,15);
  53. write('6. Erase File        MS-DOS Disk');
  54.  
  55. gotoxy(MenuMargin,16);
  56. write('7. Restore FAT');
  57.  
  58. gotoxy(MenuMargin,17);
  59. write('8. Quit');
  60.  
  61. repeat
  62.   gotoxy(MenuMargin,19);
  63.   write('   Enter Your Selection? ');
  64.   read(KBD,Ch);
  65.   until (Ch in ['1'..'9']);
  66. MainSelection:= Ch;
  67. end;
  68.  
  69.  
  70.  
  71. procedure Continue;
  72. begin
  73. write('Press [Return] to Continue..');
  74. repeat
  75.   read(KBD,Selection);
  76.   until (Selection = #$D);
  77. end;
  78.  
  79.  
  80.  
  81. procedure NextSector(var S: integer; var T: integer);
  82. begin
  83. S:= S + 1;
  84. if (S >= NSectors) then
  85.   begin
  86.   S:= MinSector;
  87.   T:= T + 1;
  88.   end;
  89. end;
  90.  
  91.  
  92.  
  93. procedure DiskError;
  94. begin
  95. writeln;
  96. write('Disk I/O Error, ');
  97. Continue;
  98. end;
  99.  
  100.  
  101.  
  102. procedure BiosSelect(DriveCode: integer);
  103. begin
  104. BiosError:=(BiosHL(8,DriveCode)=0);
  105. end;
  106.  
  107.  
  108.  
  109. procedure ReadSector(Sector,Track,Address: integer);
  110. var
  111.   Rec: integer;
  112.   RPS: integer;
  113.   I:   integer;
  114. begin
  115. if SingleSided then Track:= Track * 2;
  116. RPS:= SectorSize div 128;
  117. BiosSelect(MS_DOS_Drive);
  118. BiosError:= False;
  119. for I:= 0 to (RPS -1)do
  120.   begin
  121.   bios(9,track);                               (* select track     *)
  122.   if SecTrans then
  123.     Rec:= BiosHL(15,Sector * RPS + I + SO)     (* translate sector *)
  124.   else
  125.     Rec:= (Sector * RPS + I + SO);
  126.   bios(10,Rec);                                (* select sector    *)
  127.   bios(11,(I * 128) + Address);                (* set dma addr     *)
  128.   BiosError:= (BiosError or (bios(12)<>0));    (* read 128 bytes   *)
  129.   end;
  130. bios(8,DefaultDisk);
  131. if BiosError then DiskError;
  132. end;
  133.  
  134.  
  135.  
  136. procedure WriteSector(Sector,Track,Address: integer);
  137. var
  138.   Rec: integer;
  139.   RPS: integer;
  140.   I:   integer;
  141. begin
  142. if SingleSided then Track:= Track * 2;
  143. RPS:= SectorSize div 128;
  144. BiosSelect(MS_DOS_Drive);
  145. BiosError:= False;
  146. for I:= 0 to (RPS -1)do
  147.   begin
  148.   bios(9,track);                               (* select track     *)
  149.   if SecTrans then
  150.     Rec:= BiosHL(15,Sector * RPS + I + SO)     (* translate sector *)
  151.   else
  152.     Rec:= (Sector * RPS + I + SO);
  153.   bios(10,Rec);                                (* select sector    *)
  154.   bios(11,(I * 128) + Address);                (* set dma addr     *)
  155.   BiosError:= (BiosError or (bios(13)<>0));    (* read 128 bytes   *)
  156.   end;
  157. bios(8,DefaultDisk);
  158. if BiosError then DiskError;
  159. end;
  160.  
  161.  
  162.  
  163. procedure GetFAT;
  164. begin
  165. ReadSector(FirstFATSector,0,addr(FAT));
  166. ReadSector(FirstFATSector + 1,0,addr(FAT)+SectorSize);
  167. end;
  168.  
  169.  
  170. procedure PutFAT;
  171. var
  172.   S,T,I: integer;
  173. begin
  174. S:= FirstFATSector;
  175. T:= 0;
  176. for I:= 0 to FATSize-1 do
  177.   begin
  178.   WriteSector(S,T,addr(FAT) + (SectorSize * I));
  179.   NextSector(S,T);
  180.   end;
  181. end;
  182.  
  183.  
  184. procedure ReadCluster(Cl: integer);
  185. var
  186.   I:      integer;
  187.   Sector: integer;
  188.   Track:  integer;
  189. begin
  190. Cl:= Cl - 2;
  191. Track:= (Cl * SecsPerCluster) div NSectors;
  192. Sector:= (Cl * SecsPerCluster) mod NSectors;
  193. Sector:= Sector + FirstDataSector;
  194. Track:= Track + FirstDataTrack + (Sector div NSectors);
  195. Sector:= Sector mod NSectors;
  196. for I:= 0 to (SecsPerCluster -1) do
  197.   begin
  198.   ReadSector(Sector,Track,addr( ClusterBuffer[ I * SectorSize + 1] ));
  199.   NextSector(Sector,Track);
  200.   end;
  201. end;
  202.  
  203.  
  204.  
  205. procedure WriteCluster(Cl: integer);
  206. var
  207.   I:      integer;
  208.   Sector: integer;
  209.   Track:  integer;
  210. begin
  211. Cl:= Cl - 2;
  212. Track:= (Cl * SecsPerCluster) div NSectors;
  213. Sector:= (Cl * SecsPerCluster) mod NSectors;
  214. Sector:= Sector + FirstDataSector;
  215. Track:= Track + FirstDataTrack + (Sector div NSectors);
  216. Sector:= Sector mod NSectors;
  217. for I:= 0 to (SecsPerCluster -1) do
  218.   begin
  219.   WriteSector(Sector,Track,addr( ClusterBuffer[ I * SectorSize + 1] ));
  220.   NextSector(Sector,Track);
  221.   end;
  222. end;
  223.  
  224.  
  225.  
  226. function FATPointer(Index: integer): Integer; (* 2..NClusters + 2 *)
  227. var
  228.   Result,I:    Integer;
  229.   OddNum:      Boolean;
  230. begin
  231. I:= ((Index * 3) div 2) +1;
  232. Result:= (FAT[I] + (256 * FAT[I + 1]));
  233. if odd(Index) then Result:= Result shr 4;
  234. FATPointer:= (Result and $FFF);
  235. end;
  236.  
  237.  
  238.  
  239. function Break: boolean;
  240. var
  241.   Ch: char;
  242. begin
  243. if KeyPressed then
  244.   begin
  245.   read(KBD,Ch);
  246.   if (Ch = ^S) then
  247.     begin
  248.     while not KeyPressed do;
  249.     read(KBD,Ch);
  250.     end;
  251.   if (Ch = #27) then
  252.     Break:= true
  253.   else
  254.     Break:= false;
  255.   end
  256. else
  257.   Break:= false;
  258. end;
  259.  
  260.  
  261.  
  262. (* end module 01 *)
  263.