DP Tool Club 31/CDASC_31_1996_juillet_aout.iso/internet/rnr214.zip/RNRNOV.PAS

Pascal/Delphi Source File | 1995-12-31 | 4KB | 188 lines

unit rnrnov;

{

rnrnov.pas - rnr news overview routines (non-re-entrant)

}

{$I rnr-def.pas}

interface

uses genericf,rnrglob,rnrconf,rnrfile,rnrio;

procedure overviewreset(adir: string);
function eofoverview: boolean;
procedure closeoverview;

procedure readoverviewline;
function nextoverviewitem: string;
function readoverviewfilenum: articlefilenametype;

{getoverviewheader is _destructive_, alas}
{tag has to end with `:'}
function getoverviewheader(tag: string): string;

implementation

var
  overviewf: text;
  overviewlines: array[1..maxoverviewlines] of string;



procedure overviewreset;

var
  newdir: string;

begin
  if overviewbasename='' then
    fileresult := 2  {file not found}
  else
    begin
      newdir := unslash(adir);
      if (right(newdir,1)='\') or (right(newdir,1)=':') then
        newdir := newdir+'.';

      safereset(overviewf,withbackslash(newdir)+overviewbasename)
    end;
end;

function eofoverview;

begin
  eofoverview := eof(overviewf);
end;

procedure closeoverview;

begin
  close(overviewf);
end;



procedure readoverviewline;

var
  i: integer;

begin
  for i := 1 to maxoverviewlines do
    overviewlines[i] := '';

  for i := 1 to maxoverviewlines do
    begin
      if not eof(overviewf) and not eoln(overviewf) then
        read(overviewf,overviewlines[i]);
    end;

  if not eoln(overviewf) then
    xwritelns('overview information overflowed!');

  readln(overviewf);
end; {procedure readoverviewline}

function nextoverviewitem;

var
  result: string;
  ch: char;
  currline: integer;
  tabpos: integer;
  done: boolean;

begin
  result := '';

  currline := 1;

  done := false;

  while not done do
    begin
      if length(overviewlines[currline])=0 then
        inc(currline)
      else if currline>maxoverviewlines then
        done := true
      else
        begin

{$ifdef old}
          ch := overviewlines[currline][1];
          overviewlines[currline] := copy(overviewlines[currline],2,255);
          if ch=tab then
            done := true
          else
            result := result+ch;
{$endif}

          tabpos := pos(tab,overviewlines[currline]);
          if tabpos=0 then
            begin
              result := result+overviewlines[currline];
              overviewlines[currline] := '';
              inc(currline);
            end
          else
            begin
              result := result+copy(overviewlines[currline],1,tabpos-1);
              overviewlines[currline] :=
               copy(overviewlines[currline],tabpos+1,255);
              done := true;
            end;
        end;
    end;

  nextoverviewitem := result;
end; {function nextoverviewitem}

{for speed only -- cannot use read or next with this}
function readoverviewfilenum;

var
  overviewline: string;
  tabpos: integer;

begin
  readln(overviewf,overviewline);
  tabpos := pos(tab,overviewline);
  readoverviewfilenum := atol(copy(overviewline,1,tabpos-1));
end;

{getoverviewheader is _destructive_, alas}
{tag has to end with `:'}
function getoverviewheader;

var
  result: string;
  foundheader: string;
  done: boolean;
  uptag: string;

begin
  result := '';

  done := false;
  uptag := upper(tag);

  while not done do
    begin
      foundheader := nextoverviewitem;

      if foundheader='' then
        done := true
      else if upper(copy(foundheader,1,length(tag)))=uptag then
        begin
          result := ltrim(copy(foundheader,length(tag)+1,255));
          done := true;
        end;
    end;

  getoverviewheader := result;
end;  {function getoverviewheader}

end.