home *** CD-ROM | disk | FTP | other *** search
/ Media Share 13 / mediashare_13.zip / mediashare_13 / ZIPPED / COMM / XP300U.ZIP / UUCP-FL1.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-15  |  4KB  |  152 lines
  1. { UUCP-Dateiliste konvertieren }
  2. { Format: UNIX ls -lr          }
  3.  
  4. { Format der Eingabedatei:
  5.  
  6. /public/TeX/unix-tex:
  7. total 2
  8. dr-xr-xr-x   6 uucp     uucp         1024 Apr 28 10:26 DVIware
  9. dr-xr-xr-x   5 uucp     uucp         1024 Apr 24 21:59 LaTeXfonts
  10.  
  11. /public/TeX/unix-tex/DVIware:
  12. total 4
  13. dr-xr-xr-x   3 uucp     uucp         1024 Apr 28 10:26 crt-viewers
  14. dr-xr-xr-x   3 uucp     uucp         1024 Apr 28 10:26 laser-setters
  15. dr-xr-xr-x   4 uucp     uucp         1024 Apr 28 10:26 lpr-viewers
  16. dr-xr-xr-x   6 uucp     uucp         1024 Apr 28 10:26 obsolete
  17.  
  18. /public/TeX/unix-tex/DVIware/crt-viewers:
  19. total 1
  20. dr-xr-xr-x   3 uucp     uucp         1024 Apr 28 10:26 X
  21.  
  22. /public/TeX/unix-tex/DVIware/crt-viewers/X:
  23. total 1
  24. dr-xr-xr-x   2 uucp     uucp         1024 Apr 24 18:35 xdvi
  25.  
  26. /public/TeX/unix-tex/DVIware/crt-viewers/X/xdvi:
  27. total 193
  28. -r--r--r--   1 uucp     uucp          809 Apr 24 18:38 AUTHOR
  29. -r--r--r--   1 uucp     uucp          898 Apr 24 18:38 Imakefile
  30. -r--r--r--   1 uucp     uucp          551 Apr 24 18:38 MAKE_VMS.COM
  31. -r--r--r--   1 uucp     uucp         1682 Apr 24 18:38 Makefile
  32.  
  33. }
  34.  
  35.  
  36. {$I-,R-,B-,A+}
  37.  
  38. const bufsize = 2048;
  39.  
  40. var  f1       : file;
  41.      t2       : text;
  42.      s        : string;
  43.      p        : byte;
  44.      buf      : array[0..bufsize-1] of char;
  45.      bufp,bufanz : word;
  46.      dirs     : longint;
  47.  
  48.  
  49. procedure helppage;
  50. begin
  51.   writeln('Syntax: UUCP-FL1 <Eingabedatei> <Ausgabedatei>');
  52.   halt(1);
  53. end;
  54.  
  55. procedure error(txt:string);
  56. begin
  57.   writeln('Fehler: ',txt);
  58.   halt(1);
  59. end;
  60.  
  61. procedure ReadBuf;
  62. begin
  63.   blockread(f1,buf,bufsize,bufanz);
  64.   bufp:=0;
  65. end;
  66.  
  67.  
  68. procedure ReadInputString(var s:string);
  69. var len : byte;
  70.  
  71.   procedure skip(ch:char);
  72.   begin
  73.     if (bufp<bufanz) and (buf[bufp]=ch) then begin
  74.       inc(bufp);
  75.       if bufp=bufanz then ReadBuf;
  76.       end;
  77.   end;
  78.  
  79. begin
  80.   len:=0;
  81.   while (bufp<bufanz) and (buf[bufp]<>#13) and (buf[bufp]<>#10) do begin
  82.     if len<255 then begin
  83.       inc(len);
  84.       s[len]:=buf[bufp];
  85.       end;
  86.     inc(bufp);
  87.     if bufp=bufanz then ReadBuf;
  88.     end;
  89.   Skip(#13);
  90.   Skip(#10);
  91.   s[0]:=chr(len);
  92. end;
  93.  
  94.  
  95. function forms(s:string; len:byte):string;
  96. begin
  97.   if length(s)>len then
  98.     forms:=s
  99.   else
  100.     forms:=copy(s+'                                        ',1,len);
  101. end;
  102.  
  103.  
  104. function min(a,b:longint):longint;
  105. begin
  106.   if a<b then min:=a
  107.   else min:=b;
  108. end;
  109.  
  110.  
  111. begin
  112.   writeln;
  113.   writeln('UUCP-Filelisten-Konvertierer #1 (*NIX ls -lr)     15/07/93');
  114.   writeln;
  115.   if paramcount<>2 then helppage;
  116.   assign(f1,paramstr(1));
  117.   reset(f1,1);
  118.   if ioresult<>0 then error('Eingabedatei nicht vorhanden');
  119.   assign(t2,paramstr(2));
  120.   rewrite(t2);
  121.   if ioresult<>0 then error('ungültige Ausgabedatei');
  122.   writeln(paramstr(1),' » ',paramstr(2));
  123.   dirs:=0;
  124.   ReadBuf;
  125.   repeat
  126.     ReadInputString(s);
  127.     while (s[length(s)]=' ') do
  128.       dec(byte(s[0]));
  129.     if (s='') or (s[1]=' ') or (s[1]='#') then
  130.       writeln(t2,s)
  131.     else if (s[1]='/') or (s[1]='~') then begin
  132.       writeln(t2,'Directory ',s);
  133.       writeln(t2);
  134.       inc(dirs);
  135.       write(#13,'Verzeichnisse: ',dirs);
  136.       end
  137.     else if (pos(' ',copy(s,1,10))=0) and (s[11]=' ') then begin
  138.       p:=length(s);
  139.       while s[p]<>' ' do dec(p);
  140.       if (p>20) and (copy(s,p-2,2)='->') then begin   { symbolic link }
  141.         s:=copy(s,1,p-4);
  142.         p:=length(s);
  143.         while s[p]<>' ' do dec(p);
  144.         end;
  145.       writeln(t2,forms(copy(s,p+1,100),min(40,77-p)),' ',copy(s,1,p-1));
  146.       end;
  147.   until (bufp=bufanz);
  148.   close(f1);
  149.   close(t2);
  150.   writeln;
  151. end.
  152.