Super Net 1/SUPERNET_1.iso/PC/OTROS/EXTRAS/UUCODE/UUCP/RSNU106A.ZIP/src/rusnkill.pas

Pascal/Delphi Source File | 1993-03-27 | 15.8 KB | 655 lines

unit rusnkill;

{

rusn-kil.pas - rusnews killfile and antikillfile processing

}

{$I rusn-def.pas}

interface

uses rusnglob,rusnfunc,rusnio,rusnproc;

procedure addtokill(header,words: string; isglobal: boolean);
procedure addtoantikill(header,words: string; isglobal: boolean);
procedure readinkill(backup: boolean);
procedure readinantikill(backup: boolean);

implementation

procedure addtosomekill(usekill: boolean; var somekillf: file;
 header,words: string; isglobal: boolean);

var
  spaceneeded: integer;
  i,j: integer;
  s: string;
  tempf: text;
  newsomekillwritten: boolean;
  nonglobalsomekills: boolean;
  numsomekills: integer;
  somekillsubjsp,somekillfromsp,somekilltextp: killsarrp;

begin
  if usekill then
    begin
      xwritelns('Updating kill file...');
      nonglobalsomekills := nonglobalkills;
      numsomekills := numkills;
      somekillsubjsp := killsubjsp;
      somekillfromsp := killfromsp;
      somekilltextp := killtextp;
    end
  else
    begin
      xwritelns('Updating antikill file...');
      nonglobalsomekills := nonglobalantikills;
      numsomekills := numantikills;
      somekillsubjsp := antikillsubjsp;
      somekillfromsp := antikillfromsp;
      somekilltextp := antikilltextp;
    end;

  spaceneeded := 1;
  if not isglobal then
    if not nonglobalsomekills then
      spaceneeded := 2;

  if numsomekills+spaceneeded<=maxkills then
    begin
      if isglobal then
        begin
          for i := numsomekills downto 1 do
            somekilltextp^[i+1] := somekilltextp^[i];
          somekilltextp^[1] := header+': '+words;
        end
      else if spaceneeded=2 then
        begin
          somekilltextp^[numsomekills+1] := 'Newsgroups'+': '+currgroup;
          somekilltextp^[numsomekills+2] := header+': '+words;
        end
      else
        begin
          for i := 1 to numsomekills do
            begin
              s := somekilltextp^[i];
              if (parseheadername(s)='Newsgroups') and
               (parseheadervalue(s)=currgroup) then
                begin
                  for j := numsomekills downto i+1 do
                    somekilltextp^[j+1] := somekilltextp^[j];
                  somekilltextp^[i+1] := header+': '+words;
                end;
            end;
        end;
      if usekill then
        inc(numkills,spaceneeded)
      else
        inc(numantikills,spaceneeded);
      inc(numsomekills,spaceneeded);
    end
  else

{it definitely won't all fit in memory now}

    if usekill then
      killfileinmem := false
    else
      antikillfileinmem := false;

  if header='Subject' then
    begin
      if numsubjks<maxkills then
        begin
          inc(numsubjks);
          killsubjsp^[numsubjks] := words;
        end
      else
{}{} {should delete the oldest one}
        warn('kill file too large');
    end
  else
    begin
      if numfromks<maxkills then
        begin
          inc(numfromks);
          killfromsp^[numfromks] := words;
        end
      else
{}{} {should delete the oldest one}
        warn('kill file too large');
    end;

  if haskillfile then
    begin
      newsomekillwritten := false;
      assign(tempf,temporarydir+'\'+userid);
      reset(killf);
      rewrite(tempf);
      if isglobal then
        begin
          writeln(tempf,header,': ',words);
          newsomekillwritten := true;
        end;
      while not eof(killf) do
        begin
          readln(killf,s);
          if (parseheadername(s)='Newsgroups') and
           (parseheadervalue(s)=currgroup) then
            begin
              writeln(tempf,s);
              writeln(tempf,header,': ',words);
              newsomekillwritten := true;
            end
          else
            writeln(tempf,s);
        end;
      if not newsomekillwritten then {this group had no kill information}
        begin
          writeln(tempf,'Newsgroups',': ',currgroup);
          writeln(tempf,header,': ',words);
          newsomekillwritten := true;
        end;
      close(killf);
      close(tempf);
      reset(tempf);
      rewrite(killf);
      while not eof(tempf) do
        begin
          readln(tempf,s);
          writeln(killf,s);
        end;
      close(tempf);
      close(killf);

      erase(tempf);
    end
  else
    begin
      haskillfile := true;
      assign(killf,killfn);
      rewrite(killf);
      if not isglobal then
        writeln(killf,'Newsgroups',': ',currgroup);
      writeln(killf,header,': ',words);
    end;

  reset(killf);
end;

procedure addtokill;

var
  spaceneeded: integer;
  i,j: integer;
  s: string;
  tempf: text;
  newkillwritten: boolean;

begin
  xwritelns('Updating kill file...');

  spaceneeded := 1;
  if not isglobal then
    if not nonglobalkills then
      spaceneeded := 2;

  if numkills+spaceneeded<=maxkills then
    begin
      if isglobal then
        begin
          for i := numkills downto 1 do
            killtextp^[i+1] := killtextp^[i];
          killtextp^[1] := header+': '+words;
        end
      else if spaceneeded=2 then
        begin
          killtextp^[numkills+1] := 'Newsgroups'+': '+currgroup;
          killtextp^[numkills+2] := header+': '+words;
        end
      else
        begin
          for i := 1 to numkills do
            begin
              s := killtextp^[i];
              if (parseheadername(s)='Newsgroups') and
               (parseheadervalue(s)=currgroup) then
                begin
                  for j := numkills downto i+1 do
                    killtextp^[j+1] := killtextp^[j];
                  killtextp^[i+1] := header+': '+words;
                end;
            end;
        end;
      inc(numkills,spaceneeded);
    end
  else
    killfileinmem := false;  {it definitely won't all fit in memory now}

  if header='Subject' then
    begin
      if numsubjks<maxkills then
        begin
          inc(numsubjks);
          killsubjsp^[numsubjks] := words;
        end
      else
{}{} {should delete the oldest one}
        warn('kill file too large');
    end
  else
    begin
      if numfromks<maxkills then
        begin
          inc(numfromks);
          killfromsp^[numfromks] := words;
        end
      else
{}{} {should delete the oldest one}
        warn('kill file too large');
    end;

  if haskillfile then
    begin
      newkillwritten := false;
      assign(tempf,temporarydir+'\'+userid);
      reset(killf);
      rewrite(tempf);
      if isglobal then
        begin
          writeln(tempf,header,': ',words);
          newkillwritten := true;
        end;
      while not eof(killf) do
        begin
          readln(killf,s);
          if (parseheadername(s)='Newsgroups') and
           (parseheadervalue(s)=currgroup) then
            begin
              writeln(tempf,s);
              writeln(tempf,header,': ',words);
              newkillwritten := true;
            end
          else
            writeln(tempf,s);
        end;
      if not newkillwritten then {this group had no kill information}
        begin
          writeln(tempf,'Newsgroups',': ',currgroup);
          writeln(tempf,header,': ',words);
          newkillwritten := true;
        end;
      close(killf);
      close(tempf);
      reset(tempf);
      rewrite(killf);
      while not eof(tempf) do
        begin
          readln(tempf,s);
          writeln(killf,s);
        end;
      close(tempf);
      close(killf);

      erase(tempf);
    end
  else
    begin
      haskillfile := true;
      assign(killf,killfn);
      rewrite(killf);
      if not isglobal then
        writeln(killf,'Newsgroups',': ',currgroup);
      writeln(killf,header,': ',words);
    end;

  reset(killf);
end;

procedure addtoantikill;

var
  spaceneeded: integer;
  i,j: integer;
  s: string;
  tempf: text;
  newantikillwritten: boolean;

begin
  xwritelns('Updating antikill file...');

  spaceneeded := 1;
  if not isglobal then
    if not nonglobalantikills then
      spaceneeded := 2;

  if numantikills+spaceneeded<=maxkills then
    begin
      if isglobal then
        begin
          for i := numantikills downto 1 do
            antikilltextp^[i+1] := antikilltextp^[i];
          antikilltextp^[1] := header+': '+words;
        end
      else if spaceneeded=2 then
        begin
          antikilltextp^[numantikills+1] := 'Newsgroups'+': '+currgroup;
          antikilltextp^[numantikills+2] := header+': '+words;
        end
      else
        begin
          for i := 1 to numantikills do
            begin
              s := antikilltextp^[i];
              if (parseheadername(s)='Newsgroups') and
               (parseheadervalue(s)=currgroup) then
                begin
                  for j := numantikills downto i+1 do
                    antikilltextp^[j+1] := antikilltextp^[j];
                  antikilltextp^[i+1] := header+': '+words;
                end;
            end;
        end;
      inc(numantikills,spaceneeded);
    end
  else
    antikillfileinmem := false;  {it definitely won't all fit in memory now}

  if header='Subject' then
    begin
      if numsubjaks<maxkills then
        begin
          inc(numsubjaks);
          antikillsubjsp^[numsubjaks] := words;
        end
      else
{}{} {should delete the oldest one}
        warn('antikill file too large');
    end
  else
    begin
      if numfromaks<maxkills then
        begin
          inc(numfromaks);
          antikillfromsp^[numfromaks] := words;
        end
      else
{}{} {should delete the oldest one}
        warn('antikill file too large');
    end;

  if hasantikillfile then
    begin
      newantikillwritten := false;
      assign(tempf,temporarydir+'\'+userid);
      reset(antikillf);
      rewrite(tempf);
      if isglobal then
        begin
          writeln(tempf,header,': ',words);
          newantikillwritten := true;
        end;
      while not eof(antikillf) do
        begin
          readln(antikillf,s);
          if (parseheadername(s)='Newsgroups') and
           (parseheadervalue(s)=currgroup) then
            begin
              writeln(tempf,s);
              writeln(tempf,header,': ',words);
              newantikillwritten := true;
            end
          else
            writeln(tempf,s);
        end;
      if not newantikillwritten then {this group had no antikill information}
        begin
          writeln(tempf,'Newsgroups',': ',currgroup);
          writeln(tempf,header,': ',words);
          newantikillwritten := true;
        end;
      close(antikillf);
      close(tempf);
      reset(tempf);
      rewrite(antikillf);
      while not eof(tempf) do
        begin
          readln(tempf,s);
          writeln(antikillf,s);
        end;
      close(tempf);
      close(antikillf);

      erase(tempf);
    end
  else
    begin
      hasantikillfile := true;
      assign(antikillf,antikillfn);
      rewrite(antikillf);
      if not isglobal then
        writeln(antikillf,'Newsgroups',': ',currgroup);
      writeln(antikillf,header,': ',words);
    end;

  reset(antikillf);
end;

{$ifdef oldaddtoantikill}

procedure addtoantikill(header,words: string; isglobal: boolean);

var
  s: string;
  tempf: text;
  newantikillwritten: boolean;

begin
  xwritelns('Updating antikill file...');

  if numantikills<maxkills then
    begin
      inc(numantikills);
      antikilltextp^[numantikills] := header+': '+words;
    end
  else
    antikillfileinmem := false;

  if header='Subject' then
    begin
      if numsubjaks<maxkills then
        begin
          inc(numsubjaks);
          antikillsubjsp^[numsubjaks] := words;
        end
      else
{}{} {should delete the oldest one?}
        warn('antikill file too large');
    end
  else
    begin
      if numfromaks<maxkills then
        begin
          inc(numfromaks);
          antikillfromsp^[numfromaks] := words;
        end
      else
{}{} {should delete the oldest one?}
        warn('antikill file too large');
    end;

  if hasantikillfile then
    begin
      newantikillwritten := false;
      assign(tempf,temporarydir+'\'+userid);
      reset(antikillf);
      rewrite(tempf);
      if isglobal then
        begin
          writeln(tempf,header,': ',words);
          newantikillwritten := true;
        end;
      while not eof(antikillf) do
        begin
          readln(antikillf,s);
          if (parseheadername(s)='Newsgroups') and
           (parseheadervalue(s)=currgroup) then
            begin
              writeln(tempf,s);
              writeln(tempf,header,': ',words);
              newantikillwritten := true;
            end
          else
            writeln(tempf,s);
        end;
      if not newantikillwritten then {this group had no antikill information}
        begin
          writeln(tempf,'Newsgroups',': ',currgroup);
          writeln(tempf,header,': ',words);
          newantikillwritten := true;
        end;
      close(antikillf);
      close(tempf);
      reset(tempf);
      rewrite(antikillf);
      while not eof(tempf) do
        begin
          readln(tempf,s);
          writeln(antikillf,s);
        end;
      close(tempf);
      close(antikillf);

      erase(tempf);
    end
  else
    begin
      hasantikillfile := true;
      assign(antikillf,antikillfn);
      rewrite(antikillf);
      if not isglobal then
        writeln(antikillf,'Newsgroups',': ',currgroup);
      writeln(antikillf,header,': ',words);
    end;

  reset(antikillf);
end;

{$endif}

procedure readinkill;

var
  s: string;
  tempf: text;

begin
  killfileinmem := true;
  numkills := 0;

  if haskillfile then
    close(killf);

  haskillfile := true;

  killfn := home+'\kill';
  assign(killf,killfn);
  {$I-}
  reset(killf);
  {$I+}
  if ioresult<>0 then
    begin
      haskillfile := false;
      xwritelns('(no kill file found)');
    end;

  if haskillfile then
    begin
      if backup then
        begin
          xwritelns('Backing up kill file...');
          assign(tempf,home+'\kill.bak');
          rewrite(tempf);
        end
      else
        xwritelns('Reading in kill file...');
      reset(killf);
      while not eof(killf) do
        begin
          readln(killf,s);
          if backup then
            writeln(tempf,s);
          if numkills<maxkills then
            begin
              inc(numkills);
              killtextp^[numkills] := s;
            end
          else
            killfileinmem := false;
        end;
      if backup then
        close(tempf);
      reset(killf);
    end;
end;

procedure readinantikill;

var
  s: string;
  tempf: text;

begin
  if hasantikillfile then
    close(antikillf);

  antikillfileinmem := true;
  numantikills := 0;

  hasantikillfile := true;

  antikillfn := home+'\antikill';
  assign(antikillf,antikillfn);
  {$I-}
  reset(antikillf);
  {$I+}
  if ioresult<>0 then
    begin
      hasantikillfile := false;
      xwritelns('(no antikill file found)');
    end;

  if hasantikillfile then
    begin
      if backup then
        begin
          xwritelns('Backing up antikill file...');
          assign(tempf,home+'\antikill.bak');
          rewrite(tempf);
        end
      else
        xwritelns('Reading in antikill file...');
      reset(antikillf);
      while not eof(antikillf) do
        begin
          readln(antikillf,s);
          if backup then
            writeln(tempf,s);
          if numantikills<maxkills then
            begin
              inc(numantikills);
              antikilltextp^[numantikills] := s;
            end
          else
            antikillfileinmem := false;
        end;
      if backup then
        close(tempf);
      reset(antikillf);
    end;
end;

end.