home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ENTERPRS / CPM / UTILS / S / TRANS12C.LBR / TRANS-04.INC < prev    next >
Text File  |  2000-06-30  |  6KB  |  258 lines
  1.  
  2. procedure SetFATPointer(Loc,Val: integer);
  3. var
  4.   I,R: integer;
  5. begin
  6. I:= ((Loc * 3) div 2) +1;
  7. R:= (FAT[I] or (FAT[I+1] shl 8));
  8. if odd(loc) then
  9.   R:= ((R and $F) or (Val shl 4))
  10. else
  11.   R:= ((R and $F000) or (Val and $FFF));
  12. FAT[I]:= (R and $FF);
  13. FAT[I+1]:= ((R shr 8) and $FF);
  14. end;
  15.  
  16.  
  17. procedure WriteMS_DOS;
  18. var
  19.   FileName:       Str20;
  20.   UnAmbiguous:    Str20;
  21.   ErrorCode:      integer;
  22.   I:              integer;
  23.   RecsPerCluster: integer;
  24.   Remaining:      integer;
  25.   NRecs:          integer;
  26.   FAT_Marker:     integer;
  27.   LastMarker:     integer;
  28.  
  29.  
  30. procedure Get_Unambiguous;
  31. begin
  32.   UnAmbiguous:= '';
  33.   for I:= 1 to NameSize do
  34.     if not (CPM_FCB.Name[I] = ' ') then
  35.       UnAmbiguous:= UnAmbiguous + CPM_FCB.Name[I];
  36.   UnAmbiguous:= UnAmbiguous + '.';
  37.   for I:= 1 to TypeSize do
  38.     if not (CPM_FCB.Extention = ' ') then
  39.       UnAmbiguous:= UnAmbiguous + CPM_FCB.Extention[I];
  40. end;
  41.  
  42.  
  43. function FirstFree(Start: integer): integer;
  44. var
  45.   I: integer;
  46. begin
  47. I:= Start;
  48. while (I < NClusters + 2) and (FATPointer(I) <> 0) do
  49.   I:= I + 1;
  50. FirstFree:= I;
  51. if (I = NClusters + 2) then BiosError:= true;
  52. end;
  53.  
  54.  
  55. procedure ReadCPMfileIntoBuffer;
  56. begin
  57. if (Remaining > DataBufferSize div 128) then
  58.   NRecs:= DataBufferSize div 128
  59. else
  60.   NRecs:= Remaining;
  61. fillchar(DataBuffer, DataBufferSize, 0);
  62. BlockRead(InFile, DataBuffer[1], NRecs);
  63. if DEBUG then
  64.   writeln('NRecs=', NRecs);
  65. end;
  66.  
  67.  
  68. procedure WriteMS_DOSfileFromBuffer;
  69. begin
  70. NumberOfClusters := NRecs div RecsPerCluster;
  71. if ((NRecs mod RecsPerCluster) > 0) then
  72.   NumberOfClusters := NumberOfClusters + 1;
  73. for I := 0 to NumberOfClusters - 1 do
  74.   begin
  75.   SetFATPointer(FAT_Marker,FirstFree(FAT_Marker + 1));
  76.   WriteCluster(FAT_Marker, I * RecsPerCluster * 128 + 1);
  77.   LastMarker:= FAT_Marker;
  78.   FAT_Marker:= FirstFree(FAT_Marker + 1);
  79.   end;
  80. end;
  81.  
  82.  
  83. procedure ReWriteMS_DOS(FN: NameAry; FT: TypeAry); {Open a new MS_DOS file}
  84. var
  85.   ErrorCode: integer;
  86.   S:         Str20;
  87. begin
  88. S:= '????????.???';
  89. VolumeName:= False;
  90. SubDirName:= False;
  91. SearchFirstAll(S,ErrorCode);
  92.   while (ErrorCode <> MTDirectory)
  93.     and (ErrorCode <> EODirectory)
  94.     or VolumeName
  95.     or SubDirName do
  96.       SearchNextAll(S,ErrorCode);
  97. if (ErrorCode = EODirectory) then
  98.   BiosError:= true
  99. else
  100.   begin
  101.   DOS_FCB^.Name:= FN;
  102.   DOS_FCB^.Extention:= FT;
  103.   DOS_FCB^.Attribute:= $20;   {changed from 0: for IBM-PC Clones}
  104.   for I:= 12 to 21 do DOS_FCB^.Rsrvd[I]:= 0;
  105.   DOS_FCB^.Time:= 0;
  106.   DOS_FCB^.Date:= 0;
  107.   FAT_Marker:= FirstFree(2);
  108.   DOS_FCB^.ClusterNo:= FAT_Marker;
  109.   end;
  110. end;
  111.  
  112.  
  113. procedure CloseMS_DOS(Size: integer);   {Update Directory and FAT sectors}
  114. { Size is filesize / 128 }
  115. var
  116.   Size2: integer;
  117. begin
  118. Size2:= hi(Size shr 1);       { prevent overflow }
  119. Size:= ((Size and $1FF) shl 7);
  120. DOS_FCB^.FileSize[1]:= lo(Size);
  121. DOS_FCB^.FileSize[2]:= hi(Size);
  122. DOS_FCB^.FileSize[3]:= lo(Size2);
  123. DOS_FCB^.FileSize[4]:= hi(Size2);
  124.  
  125. if (Size = 0) then
  126.   (* DOS_FCB^.Cluster:= $FFF *)
  127. else
  128.   SetFATPointer(LastMarker,$FFF);
  129. WriteSector(DirSector,DirTrack,addr(DirBuffer));
  130. PutFAT;
  131. end;
  132.  
  133.  
  134. begin (* WriteMS_DOS *)
  135. {bdos(RESETDSK);}               {for safety}
  136. repeat
  137.   ClrScr;
  138.   writeln;
  139.   writeln('File Transfer From CP/M to MS-DOS');
  140.   writeln;
  141.   write('File Name to Get From CP/M: ');
  142.   readln(Filename);
  143.   writeln;
  144.   Stop:= (pos(':',FileName) <> 0);
  145.   if Stop then
  146.     begin
  147.     write('DriveCode = ',CPM_DriveCh);
  148.     writeln(', Do Not Include In Name.');
  149.     Continue;
  150.     end;
  151.   until not Stop;
  152.  
  153. Stop:= false;
  154. CheckWildcard(FileName);
  155. BiosSelect(CPM_Drive, First);
  156. SearchFileCPM(FileName,ErrorCode,First);
  157. if (ErrorCode = EODirectory) then
  158.   write('File Not Found, ')
  159. else
  160.   begin
  161.   Get_Unambiguous;
  162.   assign(InFile,UnAmbiguous);
  163.   reset(InFile);
  164.  
  165.   Remaining := FileSize(InFile);
  166.   if DEBUG then
  167.     writeln('FileSize=', Remaining);
  168.   ReadCPMfileIntoBuffer;
  169.  
  170.   IdentifyMS_DOS;
  171.   if (Identity = Unidentified) then
  172.     begin
  173.     BiosSelect(CPM_Drive, Next);
  174.     close(InFile);
  175.     end
  176.   else
  177.     begin
  178.     write('Transfering -');
  179.     RecsPerCluster:= RecordsPerSector * SecsPerCluster;
  180.     repeat
  181.       SearchFirst(Unambiguous,ErrorCode);
  182.       writeln;
  183.       write(CPM_DriveCh + ':',UnAmbiguous);
  184.       if (ErrorCode = FoundDir) then
  185.         begin
  186.         write(' Exists');
  187.         Stop := true;
  188.         end
  189.       else
  190.         begin
  191.         ReWriteMS_DOS(CPM_FCB.Name,CPM_FCB.Extention);
  192.         if DEBUG then
  193.           writeln;
  194.         Stop := Stop or Break;
  195.         if not BiosError and not Stop then
  196.           begin
  197.           WriteMS_DOSfileFromBuffer;
  198.           Stop := Stop or BiosError or Break;
  199.           Remaining := Remaining - NRecs;
  200.  
  201.           while (Remaining > 0) and not Stop do
  202.             begin
  203.             BiosSelect(CPM_Drive, Next);
  204.             ReadCPMfileIntoBuffer;
  205.  
  206.             BiosSelect(MS_DOS_Drive, Next);
  207.             WriteMS_DOSfileFromBuffer;
  208.  
  209.             Stop:= BiosError or Stop or Break;
  210.             Remaining:= Remaining - NRecs;
  211.             end;  (* while *)
  212.  
  213.           if not Stop then
  214.             CloseMS_DOS(FileSize(InFile));
  215.           end; (* if not bioserror *)
  216.         end; (* if founddir *)
  217.  
  218.       BiosSelect(CPM_Drive,Next);
  219.       close(InFile);
  220.       Stop := Stop or Break;
  221.       if BiosError then
  222.         begin
  223.         Stop:= true;
  224.         writeln;
  225.         writeln('MS-DOS Write Error or Disk or Directory Full');
  226.         end
  227.       else
  228.         if WildCard and not Stop then
  229.           begin
  230.           SearchFileCPM(UnAmbiguous,ErrorCode,First);
  231.           SearchFileCPM(FileName,ErrorCode,Next);
  232.           if (ErrorCode = FoundDir) then
  233.             begin
  234.             Get_Unambiguous;
  235.             assign(InFile,UnAmbiguous);
  236.             reset(InFile);
  237.  
  238.             Remaining := FileSize(InFile);
  239.             if DEBUG then
  240.               writeln('FileSize=', Remaining);
  241.             ReadCPMfileIntoBuffer;
  242.  
  243.             BiosSelect(MS_DOS_Drive,Next);
  244.             end;
  245.           end;
  246.  
  247.       until (ErrorCode = EODirectory) or Stop or not WildCard;
  248.  
  249.     writeln;
  250.     writeln;
  251.     end;  (* if not Identity *)
  252.   end;  (* if EODirectory *)
  253. if Stop then
  254.   write('Aborted, ');
  255. Continue;
  256. end;  (* WriteMS_DOS *)
  257.  
  258.