home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TURBO5.ZIP / TURBLIST.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1986-12-26  |  2.3 KB  |  106 lines
  1. program turblist;
  2.  
  3. {
  4.  
  5.      TURBLIST.PAS -
  6.  
  7.           TLIST.COM as supplied with TURBO Pascal seems to loose
  8.           track of the page start and stop points.  This program
  9.           will list and insert include files.  The include state-
  10.           ment must start on column 1.  It will not underline or
  11.           mark reserved words.
  12.  
  13.  
  14.           Dave McCourt  - Williamsport Pa.
  15.  
  16. }
  17.  
  18. type
  19.   AnyString=string[255];
  20.  
  21. var
  22.  f,f1,f2  :    Text;
  23.  Line     :    string[255];
  24.  i,j,k,page,LineNum    :    integer;
  25.  FileName :    string[14];
  26.  IncFileName : string[14];
  27.  ch       :    char;
  28.  
  29. function Exist(FileN: Anystring): boolean;
  30.    var F: file;
  31.    begin
  32.       {$I-}
  33.       assign(F,FileN);
  34.       reset(F);
  35.       {$I+}
  36.       if IOResult <> 0 then Exist:=false
  37.       else Exist:=true;
  38.    end;
  39.  
  40. procedure GetFileName;
  41.    begin
  42.       Filename:='';
  43.       repeat
  44.          read(kbd,ch);
  45.          if Upcase(ch) in ['A'..'Z','0'..'9','.',^M] then
  46.          begin
  47.             write(Upcase(ch));
  48.             Filename:=Filename+upcase(ch);
  49.          end;
  50.       UNTIL(Ch=^M) or (length(Filename)=12);
  51.       if Ch=^M then Delete(Filename,Length(Filename),1);
  52.    end;
  53.  
  54. Procedure NewPage;
  55. begin
  56.    if page > 0 then writeln(lst,chr(12));
  57.    page:=page+1;
  58.    writeln(Lst);
  59.    writeln(lst,'Program listing for: ',Filename);
  60.    writeln(lst,'Page ',page);
  61.    writeln(lst);
  62.    LineNum:=4;
  63. end;
  64.  
  65. Procedure IncFile;
  66. begin
  67.    k:=5;
  68.    IncFileName :='';
  69.    repeat
  70.       IncFileName:=IncFileName + UpCase(copy(line,k,1));
  71.       k:=k+1;
  72.    until Upcase(copy(line,k,1)) = '}';
  73.    Assign(f1,IncFileName);
  74.    writeln(IncFileName:14);
  75.    ReSet(f1);
  76.    While not Eof(f1) do
  77.    begin
  78.       LineNum:=LineNum+1;
  79.       if LineNum > 60 then NewPage;
  80.       readln(f1,Line);
  81.       writeln(lst,Line);
  82.    end;
  83.    close(f1);
  84. end;
  85.  
  86. begin
  87.    ClrScr;
  88.    write('Enter file to print: ');
  89.    GetFileName;
  90.    Assign(f,FileName);
  91.    ReSet(f);
  92.    page:=0;
  93.    ClrScr;
  94.    NewPage;
  95.    While not Eof(f) do
  96.    begin
  97.       LineNum:=LineNum+1;
  98.       if LineNum > 60 then NewPage;
  99.       readln(f,Line);
  100.       writeln(lst,line);
  101.       if copy(line,1,4) = '{$I ' then incfile;
  102.    end;
  103.    close(f);
  104.    writeln(lst,chr(12));
  105. end.
  106.