home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / utils / dskutl / transf18.ark / TRANS-03.INC < prev    next >
Encoding:
Text File  |  1989-09-27  |  2.8 KB  |  126 lines
  1.  
  2. (* module 3 *)
  3.  
  4.  
  5.  
  6. procedure SearchFileCPM( FileName: Str20; var Error: integer; First: boolean );
  7. const
  8.   SizeCPM_FCB = 32;
  9.   SearchF = 17;
  10.   SearchN = 18;
  11.   SetDMAF = 26;
  12. var
  13.   I,J: integer;
  14. begin
  15. BDos(SetDMAF,addr(CPM_Buf));
  16. ConvertName(FileName,CPM_FCB.Name,CPM_FCB.Extention);
  17. CPM_FCB.DriveCode:= CPM_Drive + 1;
  18. CPM_FCB.Extent:= 0;
  19. CPM_FCB.CR:= 0;
  20. if First then
  21.   I:= BDos(SearchF,addr(CPM_FCB))
  22. else
  23.   I:= BDos(SearchN,addr(CPM_FCB));
  24. if (I = $FF) then
  25.   Error:= EODirectory
  26. else
  27.   begin
  28.   Error:= 0;
  29.   I:= (((I and 3) * SizeCPM_FCB) + 1);
  30.   for J:= 0 to (NameSize + TypeSize)  do
  31.     mem[addr( CPM_FCB ) + J]:= mem[ addr( CPM_Buf[I]) + J];
  32.   end;
  33. end;
  34.  
  35.  
  36.  
  37. procedure DirCPM;
  38. const
  39.   First = true;
  40.   Next  = false;
  41. var
  42.   ErrorCode,
  43.   Count,
  44.   I,N:      integer;
  45.   FileName: Str20;
  46. begin
  47. Count:= 0;
  48. ClrScr;
  49. writeln;
  50. write('Dir Mask: ');
  51. readln(FileName);
  52. writeln;
  53. SearchFileCPM(FileName,ErrorCode,First);
  54.  
  55. if (ErrorCode = EODirectory) then
  56.   begin
  57.   write('No File, ');
  58.   Continue;
  59.   end
  60. else
  61.   begin
  62.   repeat
  63.     if (count > 0) and (count mod 80 = 0) then begin
  64.       writeln;
  65.       continue;
  66.     end;
  67.     if ((Count mod 4) = 0) then
  68.       writeln
  69.     else
  70.       write('  :  ');
  71.     write(CPM_DriveCh,':');
  72.     for I:= 1 to NameSize do
  73.       write(CPM_FCB.Name[I]);
  74.     write('.');
  75.     for I:= 1 to TypeSize do
  76.       write(CPM_FCB.Extention[I]);
  77.     Count:= Count + 1;
  78.     SearchFileCPM(FileName,ErrorCode,Next);
  79.     until (ErrorCode = EODirectory) or Break;
  80.   writeln;
  81.   writeln;
  82.   writeln('File Count: ',Count);
  83.   Continue;
  84.   end;
  85. end;
  86.  
  87.  
  88. procedure chDir;        {Die Systemvariable pathStr veraendern}
  89.  
  90. var
  91.   s: string [31];       {neuer Pfad, Eingabe}
  92.   i: integer;           {Zaehlvariable}
  93.  
  94. begin
  95.   clrscr;
  96.   writeln;
  97.   writeln ('Change MS-DOS Directory Path');
  98.   writeln;
  99.   writeln ('Path is "', pathStr, '"');
  100.   write ('Change to: ');
  101.   readln (s);
  102.   if s <> '' then begin
  103.     if s [1] = '\' then                         {vollstaendiger Pfadname}
  104.       pathStr := s
  105.     else if s = '..' then begin                 {in Parent Directory zurueck}
  106.       if length (pathStr) > 1  then begin
  107.         i := length (pathStr)-1;
  108.         while (pathStr [i] <> '\') and (i > 1) do
  109.           i := pred (i);
  110.         pathStr [0] := chr (i)        {Laenge des Strings neu setzen}
  111.       end;
  112.     end
  113.     else
  114.       pathStr := pathStr + s;                   {unvollstaendiger Pfadname}
  115.     if pathStr [length (pathStr)] <> '\' then
  116.       pathStr := pathStr+'\'
  117.   end;  {if s <> ''}
  118.   writeln;
  119.   writeln ('Path was changed to "', pathStr, '".');
  120.   writeln;
  121.   continue
  122. end;
  123.  
  124.  
  125. (* end module 3 *)
  126.