home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol256 / trans-04.inc < prev    next >
Encoding:
Text File  |  1986-03-22  |  4.5 KB  |  197 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.  
  18. procedure WriteMS_DOS;
  19. var
  20.   FileName:       Str20;
  21.   UnAmbiguous:    Str20;
  22.   InFile:         File;
  23.   ErrorCode:      integer;
  24.   I:              integer;
  25.   Stop:           boolean;
  26.   RecsPerCluster: integer;
  27.   Remaining:      integer;
  28.   NRecs:          integer;
  29.   FAT_Marker:     integer;
  30.   LastMarker:     integer;
  31.  
  32.  
  33. function FirstFree(Start: integer): integer;
  34. var
  35.   I: integer;
  36. begin
  37. I:= Start;
  38. while (I < NClusters + 2) and (FATPointer(I) <> 0) do
  39.   I:= I + 1;
  40. FirstFree:= I;
  41. if (I = NClusters + 2) then BiosError:= true;
  42. end;
  43.  
  44.  
  45. procedure ReWriteMS_DOS(FN: NameAry; FT: TypeAry);
  46. var
  47.   ErrorCode: integer;
  48.   S:         Str20;
  49. begin
  50. S:= '????????.???';
  51. VolumeName:= False;
  52. SubDirName:= False;
  53. SearchFirstAll(S,ErrorCode);
  54.   while (ErrorCode <> MTDirectory)
  55.     and (ErrorCode <> EODirectory)
  56.     or VolumeName
  57.     or SubDirName do
  58.       SearchNextAll(S,ErrorCode);
  59. if (ErrorCode = EODirectory) then
  60.   BiosError:= true
  61. else
  62.   begin
  63.   DOS_FCB^.Name:= FN;
  64.   DOS_FCB^.Extention:= FT;
  65.   DOS_FCB^.Attribute:= 0;
  66.   for I:= 12 to 21 do DOS_FCB^.Rsrvd[I]:= 0;
  67.   DOS_FCB^.Time:= 0;
  68.   DOS_FCB^.Date:= 0;
  69.   FAT_Marker:= FirstFree(2);
  70.   DOS_FCB^.ClusterNo:= FAT_Marker;
  71.   end;
  72. end;
  73.  
  74.  
  75. procedure CloseMS_DOS(Size: integer);
  76. { Size is filesize / 128 }
  77. var
  78.   Size2: integer;
  79. begin
  80. Size2:= hi(Size shr 1);       { prevent overflow }
  81. Size:= ((Size and $1FF) shl 7);
  82. DOS_FCB^.FileSize[1]:= lo(Size);
  83. DOS_FCB^.FileSize[2]:= hi(Size);
  84. DOS_FCB^.FileSize[3]:= lo(Size2);
  85. DOS_FCB^.FileSize[4]:= hi(Size2);
  86. if (Size = 0) then
  87.   (* DOS_FCB^.Cluster:= $FFF *)
  88. else
  89.   SetFATPointer(LastMarker,$FFF);
  90. WriteSector(DirSector,DirTrack,addr(DirBuffer));
  91. PutFAT;
  92. end;
  93.  
  94.  
  95. begin (* WriteMS_DOS *)
  96. IdentifyMS_DOS;
  97. if not (Identity = Unidentified) then
  98.   begin
  99.   repeat
  100.     ClrScr;
  101.     writeln;
  102.     writeln('File Transfer From CP/M to MS-DOS');
  103.     writeln;
  104.     write('File Name to Get From CP/M: ');
  105.     readln(filename);
  106.     writeln;
  107.     Stop:= (pos(':',FileName) <> 0);
  108.     if Stop then
  109.       begin
  110.       write('DriveCode = ',CPM_DriveCh);
  111.       writeln(', Do Not Include In Name.');
  112.       Continue;
  113.       end;
  114.     until not Stop;
  115.   RecsPerCluster:= SecsPerCluster * SectorSize div 128;
  116.   Stop:= false;
  117.  
  118.  
  119.   SearchFileCPM(FileName,ErrorCode,First);
  120.   if (ErrorCode = $FF) then
  121.     write('File Not Found, ')
  122.   else
  123.     begin
  124.     write('Transfering -');
  125.  
  126.     repeat
  127.       UnAmbiguous:= '';
  128.       for I:= 1 to NameSize do
  129.         if not (CPM_FCB.Name[I] = ' ') then
  130.           UnAmbiguous:= UnAmbiguous + CPM_FCB.Name[I];
  131.       UnAmbiguous:= UnAmbiguous + '.';
  132.       for I:= 1 to TypeSize do
  133.         if not (CPM_FCB.Extention = ' ') then
  134.           UnAmbiguous:= UnAmbiguous + CPM_FCB.Extention[I];
  135.  
  136.       SearchFirst(Unambiguous,ErrorCode);
  137.       writeln;
  138.       write(CPM_DriveCh + ':',UnAmbiguous);
  139.       if (ErrorCode = FoundDir) then
  140.         write(' Exists')
  141.       else
  142.         begin
  143.         assign(InFile,UnAmbiguous);
  144.         reset(InFile);
  145.  
  146.         ReWriteMS_DOS(CPM_FCB.Name,CPM_FCB.Extention);
  147.  
  148.         if not BiosError then
  149.           begin
  150.           Remaining:= FileSize(InFile);
  151.           while (Remaining > 0) and not Stop do
  152.             begin
  153.             if (Remaining > RecsPerCluster) then
  154.               NRecs:= RecsPerCluster
  155.             else
  156.               begin
  157.               NRecs:= Remaining;
  158.               for I:= 1 to RecsPerCluster * 128 do ClusterBuffer[I]:= Chr(0);
  159.               end;
  160.             BlockRead(InFile,ClusterBuffer,NRecs);
  161.             SetFATPointer(FAT_Marker,FirstFree(FAT_Marker + 1));
  162.             WriteCluster(FAT_Marker);
  163.             LastMarker:= FAT_Marker;
  164.             FAT_Marker:= FirstFree(FAT_Marker + 1);
  165.             Stop:= BiosError or Stop;
  166.             Remaining:= Remaining - NRecs;
  167.             end;
  168.           CloseMS_DOS(FileSize(InFile));
  169.           end; (* if not bioserror *)
  170.         end; (* if founddir *)
  171.  
  172.       if BiosError then
  173.         begin
  174.         Stop:= true;
  175.         writeln;
  176.         writeln('MS-DOS Write Error or Disk or Directory Full');
  177.         end
  178.       else
  179.         begin
  180.         SearchFileCPM(UnAmbiguous,ErrorCode,First);
  181.         if (ErrorCode = 0) then
  182.           SearchFileCPM(FileName,ErrorCode,Next);
  183.         end;
  184.  
  185.       Stop:= (Stop or Break);
  186.       until (ErrorCode = $FF) or Stop;
  187.  
  188.     writeln;
  189.     writeln;
  190.     end;
  191.   if Stop then
  192.     write('Aborted, ');
  193.   Continue;
  194.   end;
  195. end;
  196.  
  197.