home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / PNL010.ZIP / MDP5.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-29  |  2.1 KB  |  77 lines
  1. program mdp5;
  2.  
  3. {Program to accompany article in issue #10 of the Pascal NewsLetter.        }
  4. {Author: Mitch Davis, (3:634/384.6) +61-3-890-2062.                         }
  5.  
  6. {After reading the file specified on the command line, this program will   }
  7. {instantly jump to any line (up to about 16000) you choose.  This shows a  }
  8. {"random-access" way of accessing normally-sequential text files.  Note    }
  9. {that it works by storing the file offset of the start of each line in an  }
  10. {array.                                                                    }
  11.  
  12. {$M 16384,21000,21000} {leave room for the text buffer}
  13.  
  14. uses crt,Textutl2;
  15.  
  16. const MaxLines = 16000;
  17.       TBuffSize = 20; {k}
  18.       ScreenLen = 24;
  19.       LineCount:word = 0;
  20.  
  21. type TBuffPtr  = ^TBuffType;
  22.      TBuffType = array [1..TBuffSize*1024] of byte; {20k text buffer}
  23.  
  24. var LinePtr:array [1..MaxLines] of longint; { This takes nearly 64k }
  25.     TBuff:TBuffPtr;
  26.     Buffer:string;
  27.     Loop,LNum:word;
  28.     f:text;
  29.  
  30.   procedure PrLn (var s:string);
  31.  
  32.   begin
  33.     writeln (copy (s,1,79));
  34.   end;
  35.  
  36. begin
  37.   writeln ('Reading...');
  38.   {Set up text buffer}
  39.   new (TBuff); {Get the memory for the buffer}
  40.   assign (f,paramstr (1));
  41.   SetTextBuf (f,TBuff^); {Tell the TP RTL about it.}
  42.   reset (f);
  43.   LineCount := 0;
  44.   while not (eof (f) or (LineCount = MaxLines)) do begin
  45.     inc (LineCount);
  46.     write (LineCount,#13);
  47.     LinePtr [LineCount] := TextFilePos (f);
  48.     readln (f);
  49.   end;
  50.   writeln;
  51.  
  52.   clrscr;
  53.   repeat
  54.     if Linecount = 0 then begin
  55.       writeln ('File is empty.');
  56.       close (f);
  57.       dispose (TBuff); {not really needed, but here for looks.}
  58.       halt;
  59.     end;
  60.     write ('Enter a line number (1-',LineCount,', 0 to quit): ');
  61.     readln (lnum);
  62.     if (lnum > 0) and (lnum <= LineCount) then begin
  63.       clrscr;
  64.       TextSeek (f,LinePtr [lnum]);
  65.       loop := 0;
  66.       repeat
  67.         readln (f,buffer);
  68.         prLn (buffer);
  69.         inc (loop);
  70.       until (loop = ScreenLen) or eof (f);
  71.       repeat until keypressed;
  72.     end;
  73.   until lnum = 0;
  74.   close (f);
  75.   dispose (TBuff);
  76. end.
  77.