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-02.INC < prev    next >
Text File  |  2000-06-30  |  6KB  |  256 lines
  1.  
  2.  
  3. procedure ConvertName(Str: Str20; var N: NameAry; var T: TypeAry);
  4. var
  5.   I,J: integer;
  6. begin
  7. for I:= 1 to NameSize do N[I]:= ' ';
  8. for I:= 1 to TypeSize do T[I]:= ' ';
  9. if (Str = '') then Str:= '*.*';
  10. if (pos('.',Str) = 0) then Str:= concat(Str,'.');
  11. if not (pos('.',Str)-1 > NameSize) then
  12.   for I:= 1 to pos('.',Str)-1 do
  13.     N[I]:= upcase(Str[I]);
  14. if not (length(copy(Str,pos('.',Str)+1,20)) > TypeSize) then
  15.   for I:= pos('.',Str)+1 to length(Str) do
  16.     T[I-pos('.',Str)]:= upcase(Str[I]);
  17. for I:= 1 to NameSize do
  18.   if (N[I] = '*') then
  19.     for J:= I to NameSize do
  20.       N[J]:= '?';
  21. for I:= 1 to TypeSize do
  22.   if (T[I] = '*') then
  23.     for J:= I to TypeSize do
  24.       T[J]:= '?';
  25. end;
  26.  
  27.  
  28.  
  29. function SameName(S: Str20; FN: NameAry; FT: TypeAry): boolean;
  30. var
  31.   N: NameAry;
  32.   T: TypeAry;
  33.   I,J: integer;
  34.   Match: boolean;
  35. begin
  36. ConvertName(S,N,T);
  37. Match:= true;
  38. for I:= 1 to NameSize do
  39.   if ((N[I] <> FN[I]) and (N[I] <> '?')) then
  40.     Match:= False;
  41. for I:= 1 to TypeSize do
  42.   if ((T[I] <> FT[I]) and (T[I] <> '?')) then
  43.     Match:= False;
  44. SameName:= Match;
  45. end;
  46.  
  47.  
  48.  
  49. procedure SearchNextAll(FileName: Str20; var Error: integer);
  50. var
  51.   I,FCBsPerSector: integer;
  52.  
  53. begin
  54. repeat
  55.   Error:= FoundDir;  { default }
  56.   FCBsPerSector:= (SectorSize div SizePC_FCB);
  57.  
  58.   if ((DirOffset mod FCBsPerSector) = 0) then
  59.     begin
  60.     DirOffset:= 0;
  61.     NextSector(DirSector,DirTrack);
  62.     ReadSector(DirSector,DirTrack,Addr(DirBuffer));
  63.     DirSectorCount:= DirSectorCount +1;
  64.     end;
  65.  
  66.   if (DirSectorCount < DirSecs) then
  67.     begin
  68.     DOS_FCB:= ptr(addr(DirBuffer) + (DirOffset * SizePC_FCB));
  69.  
  70.     if (Selection <> '3') and DEBUG then
  71.       begin
  72.       if (DirOffset = 0) then writeln;
  73.       for I := 1 to 8 do
  74.         write(ord(DOS_FCB^.Name[I]), ' ');
  75.       writeln(' ', DOS_FCB^.Attribute, '  ', DOS_FCB^.ClusterNo);
  76.       end;
  77.  
  78.     if (DOS_FCB^.Name[1] in [#0,#$F6,#$E5]) then
  79.       Error:= MTDirectory;
  80.     end
  81.   else
  82.     Error:= EODirectory;
  83.   DirOffset:= DirOffset +1;
  84.   until ((Error = EODirectory)
  85.     or (Error = MTDirectory)
  86.     or (SameName(FileName,DOS_FCB^.Name,DOS_FCB^.Extention)));
  87.  
  88. If (Error = EODirectory) Then
  89.   Begin
  90.   VolumeName:= False;
  91.   SubDirName:= False;
  92.   End
  93. Else
  94.   Begin
  95.   VolumeName:= (DOS_FCB^.Attribute and $08) <> 0;
  96.   SubDirName:= (DOS_FCB^.Attribute and $10) <> 0;
  97.  
  98.   VolumeName := VolumeName and (DOS_FCB^.Name[1] <> #0); {for IBM-PC clones}
  99.   SubDirName := SubDirName and (DOS_FCB^.Name[1] <> #0);
  100.  
  101.   End
  102. end;
  103.  
  104.  
  105.  
  106. procedure SearchNext(FN: Str20; var Err: integer);
  107. begin
  108. repeat
  109.   SearchNextAll(FN,Err);
  110.   if (DOS_FCB^.Name[1] = #0) then { "high water" mark }
  111.     Err:= EODirectory;
  112.   until ((Err = EODirectory) or (Err = FoundDir));
  113. end;
  114.  
  115.  
  116.  
  117. procedure SearchFirstAll( FileName: Str20; var Error: integer );
  118. var
  119.   I: integer;
  120. begin
  121. DirOffset:= 0;
  122. DirTrack:= 0;
  123. DirSectorCount:= -1;
  124. DirSector:= FirstDirSector -1;
  125. SearchNextAll(FileName,Error);
  126. end;
  127.  
  128.  
  129.  
  130. procedure SearchFirst(FN: Str20; var Err: integer);
  131. begin
  132. SearchFirstAll(FN,Err);
  133. if (Err = MTDirectory) then
  134.   SearchNext(FN,Err);
  135. end;
  136.  
  137.  
  138.  
  139. procedure IdentifyMS_DOS;
  140. begin
  141. BiosSelect(MS_DOS_Drive, First);
  142. SectorSize:= 512;
  143. RecordsPerSector:= SectorSize div 128;
  144. FirstFATSector:= 1;
  145. GetFAT;
  146. case FAT[1] of
  147.   $FF:
  148.     begin
  149.     Identity:=       ds8spt;  (* MSDOS-1 DS *)
  150.     FATSize:=        1;          (* size of FAT in sectors (1 copy)*)
  151.     DirSecs:=        7;          (* number of sectors in directory *)
  152.     NTracks:=        80;         (* number of tracks on disk       *)
  153.     NSectors:=       8;          (* number of sectors per track    *)
  154.     SecsPerCluster:= 2;          (* number of sectors per cluster  *)
  155.     SingleSided:=    false;
  156.     end;
  157.   $FE:
  158.     begin
  159.     Identity:=       ss8spt;  (* MSDOS-1 SS *)
  160.     FATSize:=        1;
  161.     DirSecs:=        4;
  162.     NTracks:=        40;
  163.     NSectors:=       8;
  164.     SecsPerCluster:= 1;
  165.     SingleSided:=    true;
  166.     end;
  167.   $FD:
  168.     begin
  169.     Identity:=       ds9spt;  (* MSDOS-2 DS *)
  170.     FATSize:=        2;
  171.     DirSecs:=        7;
  172.     NTracks:=        80;
  173.     NSectors:=       9;
  174.     SecsPerCluster:= 2;
  175.     SingleSided:=    false;
  176.     end;
  177.   $FC:
  178.     begin
  179.     Identity:=       ss9spt;  (* MSDOS-2 SS *)
  180.     FATSize:=        2;
  181.     DirSecs:=        4;
  182.     NTracks:=        40;
  183.     NSectors:=       9;
  184.     SecsPerCluster:= 1;       { should be 1, instead of 2 }
  185.     SingleSided:=    true;
  186.     end;
  187. else
  188.   begin  (* Try Another Sector Size *)
  189.   SectorSize:= 256;
  190.   FirstFATSector:= 2;
  191.   RecordsPerSector:= SectorSize div 128;
  192.   GetFAT;
  193.   Case FAT[1] of
  194.     $F8:
  195.       Begin
  196.       Identity:=       B_20; (* Burroughs B-20 *)
  197.       FATSize:=        2;
  198.       DirSecs:=        18;
  199.       NTracks:=        160;
  200.       NSectors:=       16;
  201.       SecsPerCluster:= 8;
  202.       SingleSided:=    false;
  203.       End;
  204.   else
  205.     Begin
  206.     Identity:= Unidentified;
  207.     gotoxy(1,23);
  208.     write('Cannot Identify MS-DOS Disk, ');
  209.     Continue;
  210.     end; (* else Case *)
  211.     end; (* Case      *)
  212.   end;   (* else Case *)
  213.   end;   (* Case      *)
  214. if not (Identity = Unidentified) then
  215.   begin
  216.   FirstDirSector:=   FatSize * 2 + FirstFATSector;
  217.   FirstDataSector:=  (FirstDirSector + DirSecs) mod NSectors;
  218.   FirstDataTrack:=   (FirstDirSector + DirSecs) div NSectors;
  219.   NClusters:= (NTracks * NSectors div SecsPerCluster)
  220.               - (((FATSize * 2) + DirSecs + 1) div SecsPerCluster);
  221.   end;
  222. end;
  223.  
  224.  
  225.  
  226. procedure RestoreFAT;
  227. var
  228.   Ch: char;
  229.   S,T,I: integer;
  230. begin
  231. BiosSelect(MS_DOS_Drive, First);
  232.  
  233. writeln('WARNING: Your disk can be distroyed!');
  234. writeln;
  235. write('FAT Size in Sectors (1 or 2, <CR> to abort): ');
  236. repeat
  237.   read(KBD, Ch);
  238.   until (Ch in [#13, '1', '2']);
  239. writeln(Ch);
  240. if (Ch = #13) then
  241.   exit;
  242. FATSize := ord(Ch) - 48;
  243.  
  244. S:= 1 + FATSize;
  245. T:= 0;
  246. for I:= 0 to FATSize-1 do
  247.   begin
  248.   ReadSector(S,T,addr(FAT) + (SectorSize * I));
  249.   NextSector(S,T);
  250.   end;
  251. PutFAT;
  252. Continue;
  253. end;
  254.  
  255.  
  256.