/trunk/xp4o.pas

{   $Id: xp4o.pas 6885 2004-11-29 14:19:31Z mkaemmerer $

    Copyright (C) 1991-2001 Peter Mandrella
    Copyright (C) 2000-2002 OpenXP team (www.openxp.de)

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}

{ CrossPoint - Overlayroutinen, die von XP4 aufgerufen werden }

{$I xpdefine.inc }

{.$DEFINE sDebug}

unit xp4o;

interface

uses
  keys, //taste
  classes,
  lister; //TLister


var  such_brett  : string;    { fuer Suche im gewaehlten Brett }
     FMsgReqnode : string;    { F3 - Request - Nodenr. }

const max_arc = 3;    { maximale verschachtelte Archivdateien }
      suchlen = 160;  { Maximallaenge der Suchbegriffe }
      histmax = 14;   { Anzahl Eintraege in Suchbegriff-History}
      opthmax = 4;    { Anzahl Eintraege in Optionen-History }
      suchmax = 20;   { Anzahl AND/OR Teilstrings im Suchbegriff }

var seeklen   : array[0..suchmax-1] of byte;
    seekstart : array[0..suchmax-1] of byte;
    seeknot   : array[0..suchmax-1] of boolean;
    suchand   : boolean;
    suchanz   : Integer;
    sst       : string; // evtl. UpString von suchstring
    igcase    : boolean;
    umlaut    : boolean;

Const
    historyFile = 'SEEK.TXT';
    libraryFile = 'SEEKLIB.TXT';
    optionsFile = 'OPTIONS.TXT';
var Suchergebnis : boolean = false;

procedure msg_info;          { interpretierten Header anzeigen }
procedure ShowHeader;        { Original-Header anzeigen        }

function  Suche(anztxt,suchfeld,autosuche:string):boolean;
procedure betreffsuche;
procedure SucheWiedervorlage;
procedure BU_reorg(user,adrbuch,auto:boolean);
procedure MsgReorgScan(_del,repair:boolean; var brk:boolean);
procedure MsgReorg;
procedure ImportBrettliste;
procedure ImportUserliste;
procedure ExportUB(user:boolean);

procedure ModiEmpfDatum;
procedure ModiBetreff;
procedure ModiText;
procedure ModiRot13;
procedure ModiTyp;
procedure ModiGelesen;
procedure ModiHighlite;

procedure zeige_unversandt;
function  ViewArchive(var fn:string; typ:shortint):shortint;
procedure FileArcViewer(fn:string);

procedure ShowArch(const fn:string);
function  a_getfilename(nr,nn:byte):string;
procedure ArcSpecial(LSelf: TLister; var t:taste);

procedure DupeKill(autodupekill:boolean);
procedure CompleteMaintenance;

procedure print_msg(initpr:boolean);
function  UserMarkSuche(allmode:boolean):boolean;
procedure BrettInfo;
procedure ntinfo;
procedure do_bseek(fwd:boolean);
procedure FidoMsgRequest(var nnode:string);
function  _killit(ask:boolean):boolean;
function  testbrettscope(var s:string):boolean;
procedure seek_cutspace(var s:string);

procedure seekmenu(var s:string);
procedure OldSEEK_ed(LSelf: TLister; var t:taste); {Lister-Tastenabfrage fuer Seek-Menue}

function Bool_BrettGruppe(var s:string):boolean;
function Bool_Brettindex(var s:string):boolean;
Procedure Brettmarksuche;

implementation  {-----------------------------------------------------}

uses
  sysutils,
{$IFDEF NCRT }
  xpcurses,
{$ENDIF }
{$IFDEF Kylix}
   xplinux,
{$ENDIF}
  typeform,fileio,inout,
  maske,datadef,database,
  archive,maus2,winxp,printerx,resource,osdepend,
  xp0,xp1,xp1o,xp1o2,xp1help,xp1input,xp3,xp3o,xp3o2,xp3ex,xp4,xp4o2,xp9bp,
  xpkeys,xpnt,xpfido,xpmaus,xpheader, xpmakeheader,xpconst,
  xp_pgp,debug,viewer, MarkedList, regexpr, xpconfigedit,
  xprope,
  xpspam,
  xpglobal;

type arcbuf = record
                arcer_typ : shortint;
                arcname   : string;
              end;

var   arcbufp : byte = 0;
      suchopt : string = '*';  { Flag fuer erste Suche seit Programmstart }

    history : array[0..histmax] of String[Suchlen]=
     ('','','','','','','','','','','','','','','');
    history_changed   : boolean = false;

var  reobuf : array[0..ablagen-1] of boolean;
     bufsiz : array[0..ablagen-1] of longint;  { Groesse nach Reorg }
     abuf   : array[1..max_arc+1] of arcbuf;
     exdir  : string;
     arctyp_save : shortint;
     mid_bretter       : byte;
     Mid_teilstring    : boolean;

function testbrettscope(var s:string):boolean;
var i : integer;
begin
  if (length(s)=1) and (lastkey<>keybs) then begin
    for i:=4 downto 0 do
      if upcase(FirstChar(s))=UpperCase(FirstChar(getres2(442,i))) then
        s:=getres2(442,i);
    freeres;
    if length(s)>1 then _keyboard(keyend);
    end;
  testbrettscope:=true;
end;

procedure seek_cutspace(var s:string);
begin
  if s=' ' then s:='';
end;

function mid_suchoption(var s:string):boolean;
begin
  if aktdispmode <> 11 then setfieldenable(mid_bretter,s='J');
  mid_suchoption:=true;
end;

procedure OldSEEK_ed(LSelf: TLister; var t:taste); {Lister-Tastenabfrage fuer Seek-Menue}
begin
  if (UpperCase(t)='E') then begin
    EditFile(libraryFile,false,false,false,0,false);
    t:=keyesc;
    pushkey(keysf2);
    end;
end;

procedure seekmenu(var s:string);

const height = 10;
      width  = 70;
  var t    : text;
      brk  : boolean;
  x,y  : Integer;
  List: TLister;
begin
      assign(t,libraryFile);
      reset(t);
      s:='';
      if ioresult<>0 then exit;
      selbox(width+2,height+2,getres2(441,21),x,y,true);
      List := TLister.CreateWithOptions(x+1,x+width,y+1,y+height,0,'/NS/SB/DM/S/M/');
      ListboxCol(List);
      List.SetArrows(x+width+1,y+1,y+height,col.colselrahmen,col.colselrahmen,'ł');
      while not eof(t) do
      begin
        readln(t,s);
        List.AddLine(LeftStr(s,suchlen));
        end;
      List.OnKeyPressed := oldseek_ed;
      brk := List.Show;
      if List.SelCount =0 then
      begin
        s := List.GetSelection;
        if FirstChar(s)=' ' then brk:=true;
        end
      else if not brk then begin
        s:= List.FirstMarked;
        x:=0;
        repeat
          if (s<>#0) and (s<>'') and (s[1]<>' ')
          then inc(x);
          s:= List.NextMarked;
        until (s=#0) or (x=histmax);
        for y:=histmax downto x do history[y]:=history[y-x];
        s:= List.FirstMarked;
        y:=0;
        repeat
          if (s<>#0) and (s<>'') and (s[1]<>' ')
          then begin
            history[y]:=s;
            inc(y);
            end;
          s:= List.NextMarked;
        until (y>x) or (s=#0);
        s:=history[0];
        history_changed:=true;
        pushkey(keyctcr);
        end;
      List.Free;
      closebox;
      close(t);
      if brk then s:='';
end;


{ Suchfeld:  '' (Volltext), '*' (Umiversal), 'Betreff', 'Absender', 'MsgID' }

type  suchrec    = record
                     betr,user,txt : string;
                     fidoempf,mid  : string;
                     nbetr,nuser   : Boolean;
                     nfidoempf     : Boolean;
                     or_betr       : Boolean;
                     or_user       : Boolean;
                     or_fidoempf   : Boolean;
                     vondat,bisdat : string;
                     vonkb,biskb   : longint;
                     status        : string;
                     typ           : string;
                   end;

var   srec       : ^suchrec = nil;
      opthist : array[0..opthmax] of String[8]=('','','','','');
      history0   : string='';
      history1   : string='';
      history2   : string='';

function Suche(anztxt,suchfeld,autosuche:string):boolean;
var x,y   : Integer;
    brk   : boolean;
    n,nf  : longint;
    p     : pointer;
    psize : Integer;
    spez  : boolean;
    i     : integer;
    brett : string;
    me,uu : boolean;
    hdp   : Theader;
    hds   : longint;
    bretter : string;
    t               : text;

    suchstring      : string;
    typc          : char;
    statb           : byte;
    _vondat,_bisdat : longint;
    minsize,maxsize : longint;
    regex           : boolean;          // regexpressions zulassen?
    bereich         : shortint;
    _brett          : string;
    mi,add          : byte;
    bera            : array[0..4] of string;
    stata           : array[0..5] of string;
    typa            : array[0..4] of string;
    RegExpr: TRegExpr;

    seek            : string;
    found           : boolean;
    markedback      : TMarkedList;
    markanzback     : integer;
    check4date      : boolean;
    headersuche     : byte;
    andmask,ormask  : byte;
    holdmarked      : boolean;

label ende, restart;


{ Check_Seekmode:

  Wenn bei Normalsuche die Suchoptionen "ua&" fuer UND oder "o|" fuer ODER angegeben wurden,
  werden in den Arrays die Anfangs und End Offsets von bis zu 10 Teilsuchstrings gespeichert,
  und Suchanz auf die Anzahl der (durch Leerzeichen getrennten, bzw in Anfuehrungszeichen
  eingefassten) Teilsuchstrings gesetzt. Suchand ist "true" bei UND Verknuepfung und "false"
  bei ODER Verknuepfung.  Wurden keine Verknuepfungsoptionen angegeben, wird eine OR
  Verknuepfung durchgefuehrt, mit einem einzigen "Teilsuchstring", der die Ganze Laenge
  des Suchstring abdeckt
}
  procedure check_seekmode;
  var
  m,n,i   : Integer;
  quotes  : boolean;

{$IFDEF sDebug}                      { Zum Debuggen der Suchstringerkennung}

  Procedure Show_Seekstrings;
  var n,x,y: byte;
  const width=75; height=20;
  begin
    selbox(width+2,height+2,'Suchstring-Check',x,y,true);
    openlist(x+1,x+width,y+1,y+height,0,'/NS/CR/');
    ListboxCol;
    listarrows(width+3,y+1,y+height,col.colselrahmen,col.colselrahmen,'ł');
    app_L('');
    app_L(' Benutzte Teilstrings: '+StrS(suchanz)+iifs(suchand,'  AND','  OR')+
      '   Igcase='+iifs(igcase,'1','0')+'   Umlaut='+iifs(umlaut,'1','0')+
      iifs(spez,'    SPEZIAL',''));
    app_L('');
    app_l(' Suchstring: '+chr($af)+iifs(spez,srec^.txt,suchstring)+chr($ae));
    app_l(' sst:        '+chr($af)+sst+chr($ae));
    app_l('');
    for n:=0 to iif(suchanz<10,10,suchanz-1) do
    begin
      app_l(' String'+rforms(strs(n),2)+': '+rforms(strs(seekstart[n]),3)+','+
        rforms(strs(seeklen[n]),3)+
        iifs(seeknot[n],' NOT ','     ')+chr($af)+
        left(mid(sst,seekstart[n]),seeklen[n])+chr($ae));
    end;
    app_l(''); 
    app_l(' Length(sst)='+strs(length(sst))+'  i='+(strs(i)));
    if spez then with srec^do
    begin
      app_l('');
      app_l(dup(30,'-'));
      app_l(' AND-Maske: '+bin(andmask,3)+'   OR-Maske: '+bin(ormask,3));
      app_l('');
      app_l(' User:     '+iifs(or_user,' OR','   ')
           +iifs(nuser,' NOT ','     ')+chr($af)+user+chr($ae));
      app_l(' Betr:     '+iifs(or_betr,' OR','   ')
           +iifs(nbetr,' NOT ','     ')+chr($af)+betr+chr($ae));
      app_l(' Fidoempf: '+iifs(or_fidoempf,' OR','   ')
           +iifs(nfidoempf,' NOT ','     ')+chr($af)+fidoempf+chr($ae));
    end;
    list(brk);
    closelist;
    closebox;
   end;
{$ENDIF}

  begin
{$IFDEF sDebug}
      for n:=0 to suchmax-1 do
      begin
        seekstart[n]:=0;
        seeklen[n]:=0;
        seeknot[n]:=false;
        end;
{$ENDIF}
    suchand:=cpos('o', LowerCase(suchopt))=0;             { OR }
    if not suchand or (cpos('a', LowerCase(suchopt))>0)   { oder AND ?}
     and not (trim(sst)='') then                    { und nicht Leertext (Suche-Spezial) }
    begin
      n:=0;
      seek:=trim(sst);                                 { Leerzeichen vorne und hinten, }
      i:=length(seek);
      while (i <> 0) and (seek[i]='"') do dec(i);      { Und Ausrufezeichen hinten abschneiden }
      truncstr(seek,i);
      if seek<>'' then begin
        i:=1;
        sst:=seek+'"';  quotes:=false;
        while (i<length(sst)) and (n<suchmax) do
        begin
          while sst[i]=' ' do inc(i);                  { Leerzeichen ueberspringen }
          if not quotes then
          begin
            seeknot[n]:=sst[i]='~';                    { NOT Flag setzen }
            while ((sst[i]='~') or (sst[i]=' '))
              do inc(i);                               { und evtl weitere ^ ueberspringen }
            end;
          quotes:=sst[i]='"';                          { Evtl. "- Modus aktivieren....}
          while sst[i]='"' do inc(i);                  { weitere " ueberspringen }
          seekstart[n]:=i;
          while (i<length(sst)) and not                { Weiterzaehlen bis Stringende      }
           ((not quotes and (sst[i]=' ')) or           { oder Space das nicht in " ist     }
            (sst[i]='"')) do inc(i);                   { oder das naechste " gefunden wird }
          seeklen[n]:=i-seekstart[n];
          quotes:=not quotes and (sst[i]='"');         { -"- Modus umschalten }
          if (not quotes) then inc(i);
          inc(n);
        end;
        if seeklen[n-1]=0 then dec(n);                 { Falls String mit > "< Endete... }
        suchanz:=n;
      end;

      if suchanz=1 then suchand:=true;
      m:=0;
      for n:=0 to suchanz-1 do        { Teilstrings Umsortieren: NOT zuerst }
      begin
        if (seeknot[n]=true) and (seeklen[n]<>0) then
        begin
          i:=seekstart[m];    seekstart[m]:=seekstart[n];  seekstart[n]:=i;
          i:=seeklen[m];      seeklen[m]:=seeklen[n];      seeklen[n]:=i;
          quotes:=seeknot[m]; seeknot[m]:=seeknot[n];      seeknot[n]:=quotes;
          inc(m);
          end;
        end;
      end

    else begin
      suchand:=true;
      suchanz:=1;
      seekstart[0]:=1;
      seeklen[0]:=length(sst);
      seeknot[0]:=false;
      end;

{$IFDEF sDebug}
    if cpos('c',lstr(suchopt))>0 then show_seekstrings; { "Writeln ist der beste Debugger..." }
{$ENDIF}

  end;


  function InText(const key:string):boolean;
  var size : longint;
      ofs  : longint;
      wsize: Integer;
      s: String;
  begin
    dbReadN(mbase,mb_msgsize,size);
    if size=0 then begin   { leerer Datensatz - vermutlich durch RuntimeError }
      dbDelete(mbase);
      InText:=false;
      end
    else begin
      wsize:=min(size,psize);
      ofs:=dbReadIntN(mbase, mb_msgsize)-dbReadIntN(mbase,mb_groesse);

      if headersuche=1 then begin           { nur Header durchsuchen }
        wsize:=ofs;
        ofs:=0;
        end
      else if headersuche=2 then ofs:=0;    { Header und Text durchsuchen }

      if (ofs>=0) and (ofs<wsize+1+length(key)) then
      begin
        dec(wsize,ofs);
        XmemRead(ofs,wsize,p^);
        if RegEx then
        begin
          RegExpr.Expression := key;
          SetString(s, PChar(p), WSize);
          InText := RegExpr.Exec(s);
        end else
        begin
          TxtSeekKey := Key;
          Intext:=TxtSeek(p,wsize,igcase,umlaut);
        end;
      end else
        Intext:=false;
      end;
  end;


  function DateFit:boolean;
  var d : longint;
  begin
    dbReadN(mbase,mb_origdatum,d);
    DateFit:=not smdl(d,_vondat) and not smdl(_bisdat,d);
  end;

  function Sizefit:boolean;
  var s : longint;
  begin
    dbReadN(mbase,mb_groesse,s);
    sizefit:=(s>=minsize) and (s<=maxsize);
  end;

  function TypeFit:boolean;
  var t     : char;
      nt    : longint;
      flags : longint;
  begin
    if typc=' ' then typefit:=true
    else begin
      dbReadN(mbase,mb_typ,t);
      dbReadN(mbase,mb_netztyp,nt);
      dbReadN(mbase,mb_flags,flags);
      TypeFit:=((typc='F') and (nt and $200<>0)) or
               ((typc='M') and (flags and 4<>0)) or
               (t=typc);
      end;
  end;

  function StatOk:boolean;
  var flags : byte;
  begin
    dbReadN(mbase,mb_halteflags,flags);
    case statb of
     1,2 : StatOK:=(statb=flags);
       3 : StatOK:=(flags=1) or (flags=2);
       4 : StatOK:=(dbReadInt(mbase,'gelesen')=0);
       5 : StatOK:=(dbReadInt(mbase,'gelesen')<>0);
     else
       {0 : }StatOk:=true;
    end;
  end;


  { Leerzeichen Links und rechts loschen, Tilden links ebenfalls }
  { boolean setzen, wenn Tilde gefunden wurde }

  procedure Scantilde(var s:String; var suchnot:boolean);
  begin
    trim(s);
    if s='' then
     suchnot:=false
    else
    begin
      suchnot:=s[1]='~';
      i:=1;
      while ((s[i]='~') or (s[i]=' ')) do inc(i);
      s:=mid(s,i);
    end;
  end;


{--Einzelne Nachricht mit Sucheingaben vergleichen--}

  procedure TestMsg;
  var betr2 : string;
      user2 : string;
      realn : string;
      such  : string;
          j : byte;
          d : Longint;
          b : byte;
      found_not : boolean;
      foundmask : byte;

  label msg_ok;

{   Volltextcheck:

    Seekstart und Seeklen sind Zeiger auf Anfang und Ende der Teilsuchstrings
    innerhalb des Gesamtsuchstrings SST. Suchand ist "true" bei UND-Suche,
    und "false" bei ODER-Suche Der Textinhalt wird mit den  Teilsuchstrings verglichen,
    solange Suchand=1 (UND) und Found=0, bzw bis Suchand=0 (OR) und Found=1,
    wurde ein Teilsuchstring gefunden, obwol SeekNOT fuer ihn definiert ist,
    wird die Suche beendet und Found nachtraeglich auf 0 gesetzt (Suche gescheitert).
    NOT-Suchstrings werden dabei aus der UND-Verknuepfung ausgeklammert.
}
    procedure Volltextcheck;
    begin
      j:=0;
      repeat
        seek:=LeftStr(mid(sst,seekstart[j]),seeklen[j]);
        found:=Intext(seek);
        found_not:=found and seeknot[j];
        if suchand and not found and seeknot[j] then found:=true;
        inc(j);
      until (j=suchanz) or (suchand xor found) or found_not;
    if found_not then found:=false;
    end;


  begin
    inc(n);
    if (n mod 30)=0 then
    begin
      moff;
      FWrt(x+9, WhereY, Format('%7d', [n]));
      FWrt(x+26, WhereY, Format('%5d', [nf]));
      mon;
    end;

{--Spezialsuche--}
    if spez then with srec^ do
    begin
      if DateFit and SizeFit and TypeFit and StatOk then begin
        Betr2 := dbReadNStr(mbase,mb_betreff);
        if (betr<>'') and (length(betr2)=40) then begin
          ReadHeader(hdp,hds,false);
          if length(hdp.betreff)>40 then
            betr2:=hdp.betreff;
          end;
        user2 := dbReadNStr(mbase,mb_absender);
        if not ntEditBrettEmpf(mbnetztyp) then begin   { <> Fido, QWK }
          realn:= dbReadNStr(mbase,mb_name);
          end
        else
          realn:=#0;
        if fidoempf<>'' then
          if not ntBrettEmpf(mbnetztyp) then
            hdp.fido_to:=''
          else begin
            ReadHeader(hdp,hds,false);
            end;
        if umlaut then begin                    { Umlaute anpassen}
          UkonvStr(betr2,Length(betr2));
          UkonvStr(user2,Length(user2));
          UkonvStr(realn,Length(realn));
          UkonvStr(hdp.fido_to,Length(hdp.fido_to));
          end;
        if igcase then begin                    { Ignore Case}
          UpString(betr2);
          UpString(user2);
          UpString(realn);
          UpString(hdp.fido_to);
          end;

        if andmask<>0 then begin
          foundmask:=0;
          if ((betr='') or (pos(betr,betr2)>0) xor nbetr)
            then inc(foundmask,2);
          if ((user='') or ((pos(user,user2)>0) or (pos(user,realn)>0)) xor nuser)
            then inc(foundmask,4);
          if ((fidoempf='') or (pos(fidoempf,hdp.fido_to)>0) xor nfidoempf)
            then inc(foundmask);
          if foundmask and ormask <> 0 then goto msg_ok;
          if (foundmask and andmask) <> (andmask and not ormask) then exit;
          end;

        if txt<>'' then begin
          volltextcheck;
          if not found then exit;
          end;

msg_ok: MsgAddmark;
        inc(nf);
        end
    end

    else begin

      if check4date and (readmode >0) then 
      begin                                     { Suchen im akt. Lesemodus }
        if readmode=1 then begin
          dbReadN(mbase,mb_gelesen,b);    
          if b>0 then exit;
          end
        else if aktdispmode <> 10 then begin
          dbReadN(mbase,mb_empfdatum,d);
          if smdl(d,readdate) then exit; 
          end;
        end;
                                                { Headereintrag-Suche }
      if suchfeld<>'' then
      begin
        such := dbReadStr(mbase,suchfeld);
 
        if (suchfeld='Absender') and not ntEditBrettEmpf(mbnetztyp)
        then begin
          seek := dbReadNStr(mbase,mb_name);          { Bei Usersuche auch Realname ansehen... }
          such:=such+seek;
        end;

        if stricmp(suchfeld,'betreff') and (length(such)=40)
        then begin
          ReadHeader(hdp,hds,false);
          if length(hdp.betreff)>40 then
            such:=hdp.betreff;
          end;
         if suchfeld='MsgID' then begin
          ReadHeader(hdp,hds,false);
          such:=hdp.msgid;
          end;
        if umlaut then UkonvStr(such,Length(such));

        j:=0;
        repeat
          seek:=LeftStr(mid(sst,seekstart[j]),seeklen[j]);      { Erklaerung siehe Volltextcheck }
          found:=((igcase and (pos(seek,UpperCase(such))>0)) or
           (not igcase and (pos(seek,such)>0)));
          found_not:=found and seeknot[j];
          if suchand and not found and seeknot[j] then found:=true;
          inc(j);
        until (j=suchanz) or (suchand xor found) or found_not;
        if found_not then found:=false;

        if Found then Begin
          MsgAddmark;
          inc(nf);
          end;
      end

      else begin                           { Volltextsuche }
        volltextcheck;
        if found then Begin
          MsgAddmark;
          inc(nf);
          end;
        end;
      end;
  end;



  procedure TestBrett(const _brett:string);
  begin
    if check4date {and (aktdispmode<=10) } and (readmode>0)
      then if Readmode>1 then dbSeek(mbase,miBrett,_brett+dbLongStr(readdate))
                         else dbSeek(mbase,miGelesen,_brett+#0)
    else dbSeek(mbase,miBrett,_brett);
    while not dbEof(mbase) and (dbReadStrN(mbase,mb_brett)=_brett) and not brk do
    begin
      TestMsg;
      dbNext(mbase);
      testbrk(brk);
      end;
  end;

  function userform(const s:string):string;
  var p : Integer;
  begin
    p:=cpos('@',s);
    if p=0 then userform:=s
    else userform:=trim(LeftStr(s,p-1))+'@'+trim(mid(s,p+1));
  end;


  procedure InitHistory;        { Such-History beim Programmstart aus Datei laden }
  var i : byte;
  var t : text;
  begin
    assign(t,historyFile);
    reset(t);
    if ioresult<>0 then exit;
    for i:=0 to histmax do readln(t,history[i]);
    close(t);
    assign(t,optionsFile);
    reset(t);
    if ioresult<>0 then exit;
    for i:=0 to opthmax do readln(t,opthist[i]);
    close(t);
  end;

  procedure CheckHistory;       { Such-History Aktualisieren und in Datei speichern }
  var i,h: byte;
  var t  : text;
  begin
    if (suchstring='') or history_changed then exit;
    h:=histmax;
    for i:=0 to histmax do if history[i]=suchstring then h:=i;
    for i:=h downto 1 do history[i]:=history[i-1];
    history[0]:=suchstring;

    h:=opthmax;
    for i:=0 to opthmax do if opthist[i]=suchopt then h:=i;
    for i:=h downto 1 do opthist[i]:=opthist[i-1];
    opthist[0]:=suchopt;

    assign(t,historyFile);
    rewrite(t);
    for i:=0 to histmax do writeln(t,history[i]);
    close(t);

    assign(t,optionsFile);
    rewrite(t);
    for i:=0 to opthmax do writeln(t,opthist[i]);
    close(t);
  end;

  // adds new message id to boxname.mid
  procedure AddMsgId;
  var
    Boxname, Filename: String;
    IDList: TStringList;
  begin
    if ReadJN('Soll die Message-ID online gesucht werden?', true) then
    begin
      BoxName := UniSel(usBoxes, false, DefaultBox);
      if BoxName <> '' then
      begin
        ReadboxPar(0, Boxname); 
        Filename := OwnPath + BoxPar.ClientPath + GetServerFilename(Boxname, extMid);
        IDLIst := TStringList.Create;
        try
          with IDList do
          begin
            if FileExists(Filename) then
            begin
              LoadFromFile(Filename);
              Sort;
            end;
            Sorted := true;
            Duplicates := dupIgnore;
            Add(Suchstring);
            SaveToFile(Filename);
          end;
        finally
          IDList.Free;
        end;
      end;
    end;
  end;

{--# Suche #--}

begin
  RegExpr := TRegExpr.Create;
  for i:=0 to 4 do bera[i]:=getres2(442,i);
  for i:=0 to 5 do stata[i]:=getres2(442,10+i);
  for i:=0 to 4 do typa[i]:=getres2(442,20+i);
  if FirstChar(suchopt)='*' then
  begin                                       { Erste Suche seit Programmstart? }
    suchopt:='au';
    InitHistory;
  end;

  if srec=nil then begin
    new(srec);
    fillchar(srec^,sizeof(srec^),0);
    with srec^ do begin
      vondat:='01.01.80'; bisdat:='31.12.69';
      vonkb:=0; biskb:=maxlongint div 2048;
      typ:=typa[0]; status:=stata[0];
      end;
    end;
  spez:=(suchfeld='*');
  case aktdispmode of
    -1,0 : bretter:=bera[iif(bmarkanz>0,3,1)];
    1..4 : bretter:=bera[iif(bmarkanz>0,3,2)];
    10   : bretter:=bera[4];
  else     bretter:=bera[0];
  end;
  i:=0;
  while (i<=4) and (bretter<>bera[i]) do inc(i);
  if i>4 then bretter:=bera[0];


{-- Eingabemaske Normalsuche --}

  MaskShiftF2(seekmenu,534);

restart:

  MaskSeekMenu:=iif(spez,4,1);
  if not spez then begin
    add:=0;
(*  if autosuche='' then begin *)
      dialog(51,7,getreps2(441,1,anztxt),x,y);         { '%s-Suche' }
      if autosuche<>'' then suchstring:=autosuche
      else if suchfeld='Betreff' then suchstring:=srec^.betr
      else if suchfeld='Absender' then suchstring:=srec^.user
      else if suchfeld='MsgID' then suchstring:=srec^.mid       { MID Suche aus Menue  }

      else suchstring:=srec^.txt;
      maddstring(3,2,getres2(441,2),suchstring,32,SuchLen,range(' ',#255));
      mnotrim;
      if history[0] <> '' then  { Bei Leerer Suchhistory kein Auswahlpfeil... }
        for i:=0 to histmax do mappsel(false,history[i]);
      mset3proc(seek_cutspace);
      mhnr(530);                                       { 'Suchbegriff ' }
      maddstring(3,4,getres2(441,3),suchopt,8,8,'');   { 'Optionen    ' }
      if opthist[0] <>'' then
        for i:=0 to opthmax do mappsel(false,opthist[i]);
      maddstring(31,4,getres2(441,4),bretter,8,8,'');  { 'Bretter '     }
      mid_bretter:=fieldpos;
      if (aktdispmode=11) or (suchfeld='#') then
        MDisable
      else begin
        for i:=0 to 4 do
          mappsel(true,bera[i]);    { Alle / Netz / User / markiert / gew„hlt }
        mset1func(testbrettscope);
        end;
      if autosuche<>'' then _keyboard(keypgdn);

      if suchfeld='MsgID' then
      Begin
        Mid_teilstring:=false;
        Maddbool(3,6,getres2(442,25),Mid_teilstring);
        MSet1func(Mid_suchoption);
        if mid_suchoption(suchfeld) then;
      end;

      readmask(brk);
      MaskSeekMenu:=0;
      closemask;
      CheckHistory;

      if suchfeld='Betreff' then begin
        i:=ReCount(suchstring);         // Re's wegschneiden
        srec^.betr:=suchstring
        end

      else if suchfeld='Absender' then begin
        suchstring:=userform(suchstring);
        srec^.user:=suchstring;
        end

      else if suchfeld='MsgID' then srec^.mid:=suchstring   {JG: 22.01.00}

      else srec^.txt:=suchstring;
      if suchstring='' then goto ende;
      dec(x); inc(y);
    end


{--Eingabemaske Spezialsuche--}

  else with srec^ do begin
                                     { Spezial: NOT-Flags wieder an Suchstrings setzen }
    if nbetr and (betr[1]<>'~') then betr:='~'+betr; 
    if nuser and (user[1]<>'~') then user:='~'+user;
    if nfidoempf and (fidoempf[1]<>'~') then fidoempf:='~'+fidoempf;
  
    add:=iif(ntBrettEmpfUsed,1,0);
    dialog(53,12+add,getreps2(441,1,anztxt),x,y);
    i:=4;
    while (i>0) and (UpperCase(typ)<>UpperCase(typa[i])) do dec(i);
    typ:=typa[i];
    i:=5;
    while (i>0) and (UpperCase(status)<>UpperCase(stata[i])) do dec(i);
    status:=stata[i];
    maddstring(3,2,getres2(441,6),user,30,SuchLen,'');  mhnr(630);   { 'Absender  ' }
    maddstring(3,3,getres2(441,7),betr,30,SuchLen,'');    { 'Betreff   ' }
    mnotrim;
    mset3proc(seek_cutspace);
    if ntBrettEmpfUsed then
      maddstring(3,4,getres2(441,9),fidoempf,30,SuchLen,'');    { 'Fido-Empf.' }
    maddstring(3,4+add,getres2(441,8),txt,35,SuchLen,'');     { 'Text      ' }
    if history[0] <> '' then  { Bei leerer Suchhistory kein Auswahlpfeil... }
      for i:=0 to histmax do mappsel(false,history[i]);
    mnotrim;
    mset3proc(seek_cutspace);
    maddtext(48,1,'OR',0);
    maddbool(46,2,'',or_user);mhnr(640); 
    maddbool(46,3,'',or_betr);
    if ntBrettEmpfUsed then maddbool(46,4,'',or_fidoempf);  
    madddate(3,6+add,getres2(441,10),vondat,false,false); mhnr(634); { 'von Datum ' }
    madddate(3,7+add,getres2(441,11),bisdat,false,false); mhnr(634); { 'bis Datum ' }
    maddint(30,6+add,getres2(441,19),vonkb,6,5,0,99999);  mhnr(635); { 'von ' }
      maddtext(45,6+add,getres(14),0);   { 'KBytes' }
    biskb:=min(biskb,99999);
    maddint(30,7+add,getres2(441,20),biskb,6,5,0,99999);  mhnr(635); { 'bis ' }
      maddtext(45,7+add,getres(14),0);   { 'KBytes' }
    maddstring(3,9+add,getres2(441,12),typ,8,9,'');         { 'Typ       ' }
    for i:=0 to 4 do
      mappsel(true,typa[i]);
    maddstring(3,10+add,getres2(441,13),status,8,8,'');     { 'Status    ' }
    for i:=0 to 5 do
      mappsel(true,stata[i]);
    maddstring(30,9+add,getres2(441,14),bretter,8,8,'');    { 'Bretter   ' }
    if aktdispmode=11 then
      MDisable
    else begin
      for i:=0 to 4 do
        mappsel(true,bera[i]);
      mset1func(testbrettscope);
      end;
    maddstring(30,10+add,getres2(441,15),suchopt,8,8,'');   { 'Optionen  ' }
    if opthist[0] <>'' then
      for i:=0 to opthmax do mappsel(false,opthist[i]);
    readmask(brk);
    MaskSeekMenu:=0;
    closemask;
    dec(x);
    suchstring:=txt;
    CheckHistory;
    end;

{--Eingaben auswerten--}

  if not brk then with srec^ do begin

    if spez then begin
      andmask:=0; ormask:=0;
      if user='' then or_user:=false else andmask:=4;
      if betr='' then or_betr:=false else inc(andmask,2);
      if fidoempf='' then or_fidoempf:=false else inc(andmask); 
      if or_user then ormask:=4;
      if or_betr then inc(ormask,2);
      if or_fidoempf then inc(ormask);   
      if txt='' then
        asm
             mov al,ormask  { verhindern, dass alle Suchbegriffe auf OR stehen }
             or al,al 
             je @2 
             cmp al,andmask
             jne @2
             mov cl,0
         @1: inc cx 
             shr al,1
             jnc @1
             shl al,cl
             mov ormask,al
         @2: 
        end; 
      end;

    sst:=suchstring;
    igcase:=multipos('iu', LowerCase(suchopt));
    umlaut:=multipos('„”u', LowerCase(suchopt)); { Umlautschalter}
    regex := pos('r', LowerCase(suchopt)) > 0 ;
    if umlaut and not igcase then 
    begin
      suchopt:=suchopt+'i';
      igcase:=true;
      end;
    check4date:=cpos('l', LowerCase(suchopt))>0;  { Suchen ab aktuellem Lesedatum }
    HoldMarked:=cpos('m', LowerCase(suchopt))>0;  { Alte Markierungen beibehalten } 

    i:=cpos('s', LowerCase(suchopt));             { Such-History loeschen }
    if i>0  then                   
    begin 
      delete(suchopt,i,1); 
      for i:=1 to histmax do history[i]:='';
      CheckHistory;
      closebox;
      goto restart;
      end;

    i:=cpos('k', LowerCase(suchopt));             { Such-History loeschen }
    if i>0  then                   
    begin
      delete(suchopt,i,1); 
      assign(t,libraryFile);
      append(t);
      if ioresult<>0 then rewrite(t);
      if trim(suchstring)<>'' then writeln(t,suchstring);
      close(t);
      closebox;
      goto restart;
      end; 

    headersuche:=0;                                     { Volltextsuche }
    if cpos('h', LowerCase(Suchopt))>0 then headersuche:=1;   { Headersuche   }
    if cpos('g', LowerCase(suchopt))>0 then headersuche:=2;   { Volltext+Headersuche } 

    bereich:=0;
    for i:=1 to 4 do
      if UpperCase(bretter)=UpperCase(bera[i]) then bereich:=i;
    statb:=0;
    for i:=1 to 5 do
      if UpperCase(status)=UpperCase(stata[i]) then statb:=i;
    me:=true;
    attrtxt(col.coldialog);

    if spez then with srec^ do begin
      sst:=txt;
      user:=userform(user);
      if umlaut then begin                              { Umlaute konvertieren }
        UkonvStr(betr, Length(betr)); UkonvStr(user, Length(user));
       { UkonvStr(txt,high(txt));} UkonvStr(fidoempf,Length(fidoempf));
        end;
      if igcase then begin
        UpString(betr); UpString(user); {UpString(txt);} UpString(fidoempf);
        end;
      scantilde(betr,nbetr); scantilde(user,nuser);
      scantilde(fidoempf,nfidoempf);
      if UpperCase(typ)=UpperCase(typa[1]) then typc:='T'
      else if UpperCase(typ)=UpperCase(typa[2]) then typc:='B'
      else if UpperCase(typ)=UpperCase(typa[3]) then typc:='F'
      else if UpperCase(typ)=UpperCase(typa[4]) then typc:='M'
      else typc:=' ';
      _vondat:=ixdat(copy(vondat,7,2)+copy(vondat,4,2)+copy(vondat,1,2)+'0000');
      _bisdat:=ixdat(copy(bisdat,7,2)+copy(bisdat,4,2)+copy(bisdat,1,2)+'2359');
      if biskb=99999 then biskb:=maxlongint div 2048;
      minsize:=vonkb*1024;
      maxsize:=biskb*1024+1023;
      end;
   { else begin}
      if umlaut then UkonvStr(sst, Length(sst));                        { 15.02.00}
      if igcase then UpString(sst);
    {  end;}

{--Start der Suche--}

    markanzback:= Marked.Count;

    if suchfeld='#' then begin   {Lister-Dummysuche}
      check_seekmode; 
      CloseBox;
      suche:=false;
      exit;
      end;

    if (suchfeld='MsgID') and NOT MID_teilstring then begin      {-- Suche: Message-ID  --}
      if not brk then begin
        if not holdmarked then Marked.Clear;
        check_seekmode;
        for i:=0 to suchanz-1 do
        begin
          seek:=copy(suchstring,seekstart[i],seeklen[i]);
          n:=GetBezug(seek);
          if n<>0 then begin
            dbGo(mbase,n);
            MsgAddmark;
            end;
          end;
        end;
      end
                                             { Anzeige fuer alle anderen Suchvarianten }
    else begin
      {if spez then sst:=txt;  } { Bei Spezialsuche nur im Volltext... }
      if brk then goto ende;

      if history_changed then begin
        history_changed:=false;
        closebox;
        goto restart;
        end;

      check_seekmode;          { Vorbereiten fuer verknuepfte Suche}
      if brk then begin
        closebox;
        goto restart;
        end;

      mwrt(x+3,y+iif(spez,11+add,4),getres2(441,16)); { 'Suche:         passend:' }
      if (aktdispmode<>11) and not holdmarked then Marked.Clear;
      n:=0; nf:=0;
      hdp := THeader.Create;
      attrtxt(col.coldiahigh);
      psize:=65536;
      getmem(p,psize);
      brk:=false;

      if aktdispmode=11 then
      begin                       {-- Suche markiert (Weiter suchen) --}
        MarkedBack := TMarkedList.Create;
        MarkedBack.Assign(Marked);
        markanzback:= Marked.Count;
        i:=0;
        while i< Marked.Count do begin
          dbGo(mbase,marked[i].recno);
          msgunmark;
          TestMsg;
          if MsgMarked then inc(i);
          end;
        aufbau:=true;

        if (Marked.Count = 0) and (markanzback<>0) then
        begin
          hinweis(getres2(441,18));   { 'keine passenden Nachrichten gefunden' }
          Marked.Assign(MarkedBack);
        end;
        MarkedBack.Free;
      end

      else if bereich<3 then begin                       {-- Suche: Alle/Netz/User --}
        mi:=dbGetIndex(mbase);
        dbSetIndex(mbase,0);
        dbGoTop(mbase);
        brk:=false; i := 0;
        while not dbEOF(mbase) and not brk do begin
          _brett := dbReadNStr(mbase,mb_brett);
          if (bereich=0) or ((bereich=1) and (FirstChar(_brett)='A')) or
                            ((bereich=2) and (FirstChar(_brett)='U')) then
            TestMsg;
          if not dbEOF(mbase) then    { kann passieren, wenn fehlerhafter }
            dbNext(mbase);            { Satz geloescht wurde               }
          Inc(i);
          if i mod 50 = 0 then testbrk(brk);
        end;
        dbSetIndex(mbase,mi);
        end

      else begin                                         {-- Suche: aktuelles Brett --}
        mi:=dbGetIndex(mbase);
        dbSetIndex(mbase,miBrett);
        if bereich=3 then begin                          { bzw. markierte Bretter  }
          if aktdispmode<11 then begin
            i:=0;
            uu:=((aktdispmode>0) and (aktdispmode<10));
            while (i<bmarkanz) and not brk do begin
              if uu then begin
                dbGo(ubase,bmarked^[i]);
                TestBrett(mbrettd('U',ubase));
                end
              else begin
                dbGo(bbase,bmarked^[i]);
                brett := dbReadNStr(bbase,bb_brettname);
                TestBrett(mbrettd(FirstChar(brett),bbase));
                end;
              inc(i);
              end;
            end;
          end
        else
          case aktdispmode of
            -1..0 : begin
                      brett := dbReadNStr(bbase,bb_brettname);
                      TestBrett(mbrettd(FirstChar(brett),bbase));
                    end;
             1..4 : TestBrett(mbrettd('U',ubase));
               10 : TestBrett(such_brett);
          else      begin
                      hinweis(getres2(441,17));   { 'kein Brett gew„hlt' }
                      me:=false;
                    end;
          end;
        dbSetIndex(mbase,mi);
        end;

      freemem(p,psize);
      CloseBox;
      hdp.Free;
      end;

{--Suche beendet--}

    if (Marked.Count =0) or (holdmarked and (Marked.Count=markanzback))   { Nichts gefunden }
    then
    begin 
      if me then
      begin
        if Suchfeld = 'MsgID' then
          AddMsgId
        else
          hinweis(getres2(441,18));   { 'keine passenden Nachrichten gefunden' }
        aufbau:=true;               { wg. gelöschter Markierung! }
      end;
      goto ende;                    { Fenster wiedeherstellen...}
    end
      
    else begin
      Suchergebnis:=true;
      suche:=true;                  { Suche erfolgreich }
      signal;
      CloseBox;
      end;

    end { of NOT Brk }

  else begin   { brk }
ende:                               { Suche gescheitert/abgebrochen }
    suche:=false;
    CloseBox;
    end;
  freeres;
end;
{ R+}



{ Betreff-Direktsuche }

procedure betreffsuche;
var betr,betr2   : string;
    brett,_Brett : string;
begin
  moment;
  betr := dbReadNStr(mbase,mb_betreff);
  ReCount(betr);  { schneidet Re's weg }
  betr:=trim(betr);
  UkonvStr(betr, Length(betr));
  brett := dbReadNStr(mbase,mb_brett);
  dbSetIndex(mbase,miBrett);
  dbSeek(mbase,miBrett,brett);
  Marked.Clear;
  repeat
    betr2 := dbReadNStr(mbase,mb_betreff);
    ReCount(betr2);
    betr2:=trim(betr2);
    UkonvStr(betr2, Length(betr2));
 (*  ll:=min(length(betr),length(betr2));
    if (ll>0) and (UpperCase(left(betr,ll))=UpperCase(left(betr2,ll))) then *)
   if UpperCase(betr)=UpperCase(betr2) then
      MsgAddmark;
    dbSkip(mbase,1);
    if not dbEOF(mbase) then
      _brett := dbReadNStr(mbase,mb_brett);
  until dbEOF(mbase) or (_brett<>brett);
  closebox;
  signal;
  if Marked.Count >0 then select(11);
  aufbau:=true;
end;

//Nachricht/Suchen/Wiedervorlage
procedure SucheWiedervorlage;
var x,y,xx : Integer;
    brk    : boolean;
    _brett : string;
    mbrett : string;
    dat    : string;
    n,nn   : longint;
    bi     : shortint;

  procedure testbase(xbase:pointer);
  begin
    bi:=dbGetIndex(xbase);
    if xbase=bbase then begin
      dbSetIndex(xbase,bibrett);
      dbGoTop(xbase);
      end
    else begin
      dbsetindex(xbase,uiadrbuch);
      dbseek(xbase,uiadrbuch,#1);
      end;
    dat:=dbLongStr(ixDat('2712310000'));

    brk:=false;
    dbSetIndex(mbase,miBrett);
    while not dbEOF(xbase) and not brk do
    begin
      inc(n);
      attrtxt(col.colmboxhigh);
      FWrt(xx, y+2, Format('%3d', [n*100 div nn]));
      if (xbase=ubase) or (not smdl(dbReadInt(xbase,'ldatum'),ixDat('2712310000')))
      then begin
        if xbase=ubase then _brett:='U' else
        _brett:=copy(dbReadStr(xbase,'brettname'),1,1);
        _brett:=_brett+dbLongStr(dbReadInt(xbase,'int_nr'));
        dbSeek(mbase,miBrett,_brett+dat);
        mbrett:=_brett;
        while not dbEOF(mbase) and (mbrett=_brett) do begin
          mbrett := dbReadNStr(mbase,mb_brett);
          if mbrett=_brett then MsgAddmark;
          dbSkip(mbase,1);
          end;
        end;
      dbSkip(xbase,1);
      testbrk(brk);
      end;
    dbSetIndex(xbase,bi);
  end;

begin
  Marked.Clear;
  msgbox(33,5,'',x,y);
  wrt(x+3,y+2,getres(443));   { 'Einen Moment bitte...     %' }
  xx:=wherex-5;
  n:=0;
  nn:=dbRecCount(bbase)+dbreccount(ubase);

  testbase(ubase);
  if not brk then
    testbase(bbase);
  CloseBox;
  if not brk then
    if Marked.Count=0 then
      hinweis(getres(444))   { 'keine Wiedervorlage-Nachrichten gefunden' }
    else begin
      signal;
      select(11);
    end;
end;                                           

{.$I xp4o.inc}     { Reorg }

{ XP4O - Reorganisation }

procedure BU_reorg(user,adrbuch,auto:boolean);
var x,y,xx  : Integer;
    brk,ask : boolean;
    typ     : string;
    d       : DB;
    brett   : string[BrettLen];
    brettc  : char;
    _brett  : string;
    _mbrett : string;
    nfeld   : integer;
    loesch  : string;
    n,gel   : longint;
    leer    : boolean;
    next    : longint;
    null    : byte;

  procedure wrstat;
  begin
    attrtxt(col.coldiahigh);
    moff;
    Wrt(xx,y+1, Format('%5d', [n]));
    Wrt(xx,y+2, Format('%5d', [gel]));
    mon;
  end;

const
  _user12: array[boolean] of integer = (2,1);
  _user34: array[boolean] of integer = (4,3);
begin
  typ:=getres2(445,iif(user,1,2));     { 'User' / 'Bretter' }

  if auto then
    brk := false
  else
  begin
    if not adrbuch then
    { 'Beim Loeschen von '+typ+'n nachfragen' }
      n := _user34[user] //ask:=ReadJNesc(getres2(445,iif(user,3,4)),true,brk)
    else
      n := 5; { 'Beim Austragen von Usern nachfragen' }
    ask:=ReadJNesc(getres2(445,n),not adrbuch,brk);
  end;
  if not brk then begin
    if user then begin
      d:=ubase; nfeld:=ub_username; end
    else begin
      d:=bbase; nfeld:=bb_brettname; end;
    n:=0; gel:=0;
    msgbox(25,4,'',x,y);
    if not adrbuch then begin
      mwrt(x+3,y+1,forms(typ,8)+':');
      mwrt(x+3,y+2,getres2(445,6));    { 'geloescht:' }
      xx:=x+13;
      end
    else begin
      mwrt(x+3,y+1,getres2(445,7));    { 'User ..... :' }
      mwrt(x+3,y+2,getres2(445,8));    { 'ausgetragen:' }
      xx:=x+16;
      end;
    if adrbuch then begin
      dbSetindex(d,uiAdrbuch);
      dbSeek(d,uiAdrbuch,#1);
      end
    else begin
      dbSetindex(d,1);
      dbGoTop(d);
      end;
    brettc:='U';
    null:=0;
    while not (dbEOF(d) or brk) do
    begin
      inc(n);
      if not user then
      begin
        brett := dbReadNStr(bbase,bb_brettname);
        brettc:= FirstChar(brett);
      end else
        brett := dbReadNStr(ubase,ub_username);
      _brett:=mbrettd(brettc,d);
      dbSeek(mbase,miBrett,_brett);
      leer:=dbEOF(mbase);
      if not leer then begin
        _Mbrett := dbReadNStr(mbase,mb_brett);
        leer:=_mbrett<>_brett;
        end;

      if leer and ((user and (LeftStr(brett,4)<>#0+'$/T')) or
        (not user and (LeftStr(brett,3)<>'$/T'))) then
      begin
        loesch := dbReadNStr(d,nfeld);
        if not user then loesch:=copy(loesch,2,80);
        if adrbuch then
          if (dbReadInt(ubase,'userflags') and 4=0) and
             (dbXsize(ubase,'adresse')=0) then
            if not ask or (ReadJNesc(getreps2(445,9,LeftStr(loesch,55)),true,brk)and not brk)
            then begin                                    { '%s austragen' }
              dbSkip(d,1);
              next:=dbRecno(d);
              if dbEOF(d) then dbGoEnd(d)
              else dbSkip(d,-1);
              dbWriteN(d,ub_adrbuch,null);
              dbGo(d,next);
              inc(gel);
              end
            else
              dbNext(d)
          else
            dbNext(d);
        if not adrbuch then
          if (not user or
             ((dbReadInt(d,'adrbuch')=0) and (dbReadInt(d,'userflags') and 5=1)))
            and (not ask or (ReadJNesc(getreps2(445,10,LeftStr(loesch,60)),true,brk)and not brk))
          then begin                                      { '%s loeschen' }
            if (user and (aktdispmode in [1..4])) or
               (not user and (aktdispmode<=0)) then
              UBunmark(dbRecno(d));
            dbDelete(d);
            inc(gel);
            end
          else
            dbNext(d);
        end   { not leer }
      else dbNext(d);
      wrstat;
      if (n mod 16=0) and not brk then
      begin
        testbrk(brk);
        if brk and not ReadJN(getres(446),true) then   { 'Reorganisation abbrechen' }
          brk:=false;
        end;
      end;
    closebox;
    end;
  freeres;
end;


procedure MsgReorgScan(_del,repair:boolean; var brk:boolean);
var x,y,wdt: Integer;
    n,ndel,
    nbesch : longint;
    bt,dbt,
    bbt    : longint;
    disp   : string;
    hzeit  : integer16;
    hzahl  : boolean;
    dat    : TDateTime;
    bi     : shortint;

  procedure display;
  begin
    attrtxt(col.colmboxhigh);
    moff;
    Wrt(x+wdt+3,y+4, Format('%7d', [n]));
    Wrt(x+wdt+3,y+5, Format('%7d', [ndel]));
    Wrt(x+wdt+3,y+6, Format('%7d', [nbesch]));
    Wrt(x+wdt+12,y+4, Format('%7d', [bt div 1024]));
    Wrt(x+wdt+12,y+5, Format('%7d', [dbt div 1024]));
    Wrt(x+wdt+12,y+6, Format('%7d', [bbt div 1024]));
    mon;
  end;

  procedure testdel(const _brett:string);
  var _mbrett : string;
      haltedat: longint;
      edat    : longint;
      msize   : longint;
      groesse : longint;
      hflags  : byte;
      uvs,b   : byte;
      ablage  : byte;
      defekt  : boolean;
      hdp     : THeader;
      hds     : longint;
      nzahl   : longint;
      typ     : char;

    function htimeout:boolean;
    begin
      htimeout:=(hzahl and (hzeit>0) and (nzahl>hzeit)) or
                (not hzahl and smdl(edat,haltedat));
    end;

  begin
    if hzahl then begin
      dbSeek(mbase,miBrett,_brett+#$ff#$ff);  { Brettende suchen }
      if dbEOF(mbase) then dbGoEnd(mbase)
      else dbSkip(mbase,-1);
      if dbBOF(mbase) then exit;
      while not dbBOF(mbase) and (dbReadStrN(mbase,mb_brett)=_brett) and
            (dbReadIntN(mbase,mb_unversandt) and 8<>0) do
        dbSkip(mbase,-1);
      if dbBOF(mbase) then exit;
      end
    else begin
      dbSeek(mbase,miBrett,_brett);           { Brettanfang suchen }
      if dbEOF(mbase) then exit;
      end;

    if hzahl or (hzeit=0) then
      haltedat:=0
    else
      haltedat:=ixdat(FormatDateTime('yymmdd', Dat-hzeit+1) + '0000');
    nzahl:=1;

    brk := false;
    hdp := THeader.Create;
    repeat
      if n mod 100 = 0 then testbrk(brk);
      if brk then
        brk:=ReadJN(getres(iif(_del,446,447)),true);   { (Reorganisation) 'abbrechen' }
      _mbrett := dbReadNStr(mbase,mb_brett);
      if _mbrett=_brett then begin
        inc(n);
        dbReadN(mbase,mb_msgsize,msize);
        inc(bt,msize);
        dbReadN(mbase,mb_groesse,groesse);
        dbReadN(mbase,mb_ablage,ablage);
        dbReadN(mbase,mb_typ,typ);
        dbReadN(mbase,mb_halteflags,hflags);
        defekt:=(groesse<0) or (msize<0) or (groesse+14>msize) or (ablage>=ablagen) or
                (msize-groesse>iif(ntZCablage(ablage),1000000,8000)) or
                (dbReadIntN(mbase, mb_adresse)+msize>ablsize[ablage]) or
                ((typ<>'T') and (typ<>'B') and (typ<>'M')) or (hflags>2) or
                (dbReadIntN(mbase, mb_adresse)<0) or
                (dbReadIntN(mbase, mb_netztyp)<0);    { empfanz > 127 ? }
        if repair and not defekt then begin
          dbReadN(mbase,mb_gelesen,b);
          if b>1 then begin
            b:=0;
            dbWriteN(mbase,mb_gelesen,b);
            end;
          ReadHeader(hdp,hds,false);
          defekt:=(hds=1) or (hds<>msize-groesse) or (groesse<>hdp.groesse);
          end;
        if defekt then begin
          hflags:=2;        { Nachricht defekt }
          dbWriteN(mbase,mb_halteflags,hflags);
          if repair then msgaddmark;
          inc(nbesch); inc(bbt,msize);
        end;
        if typ='M' then begin
          typ := 'T';
          dbWriteN(mbase,mb_typ,typ);
        end;
        
        dbReadN(mbase,mb_empfdatum,edat);
        dbReadN(mbase,mb_unversandt,uvs);
        if (msize=0) or   { nur zur Sicherheit - sollte nicht vorkommen }
           ((uvs and 1=0) and ((hflags=2) or ((hflags<>1) and htimeout)))
        then begin
          inc(ndel);
          inc(dbt,msize);
          if _del and (hflags<>2) then begin
            hflags:=2;
            dbWriteN(mbase,mb_halteflags,hflags);
            end;
          if ablage<ablagen then reobuf[ablage]:=true;
          end
        else
          if ablage<ablagen then inc(bufsiz[ablage],msize);
        dbSkip(mbase,iif(hzahl,-1,1));
        inc(nzahl);
        if n mod 20=0 then display;
        end;
    until brk or (_mbrett<>_brett) or dbEOF(mbase) or dbBOF(mbase);
    Hdp.Free;
  end;

begin
  if dbRecCount(mbase)=0 then begin
    rfehler(420);   { 'keine Nachrichten vorhanden!' }
    brk:=true;
    exit;
    end;
  if not repair then MausInfoReorg;
  wdt:=length(getres2(448,4));
  msgbox(max(45,wdt+33),iif(_del,9,10),getres2(448,iif(_del,1,iif(repair,2,3))),x,y);
  mwrt(x+3,y+4,getres2(448,4)+'        /        KB');   { 'Nachrichten:' }
  mwrt(x+3,y+5,getres2(448,5)+'        /        KB');   { 'auf Loeschen:' }
  mwrt(x+3,y+6,getres2(448,6)+'        /        KB');   { 'fehlerhaft: ' }
  n:=0; ndel:=0; nbesch:=0;
  bt:=0; dbt:=0; bbt:=0;
  getablsizes;
  Dat := Now;
  bi:=dbGetIndex(bbase);
  dbSetIndex(bbase,biBrett);
  dbGoTop(bbase);
  dbSetIndex(mbase,miBrett);
  brk:=false;
  fillchar(reobuf,sizeof(reobuf),false);
  fillchar(bufsiz,sizeof(bufsiz),0);
  if repair then
    Marked.Clear;
  while not brk and not dbEOF(bbase) do begin
    dbReadN(bbase,bb_haltezeit,hzeit);
    hzahl:=odd(dbReadInt(bbase,'flags'));
    disp := dbReadNStr(bbase,bb_brettname);
    if (disp <> '') and (LeftStr(disp,3)<>'$/T') then
    begin
      attrtxt(col.colmboxhigh);
      mwrt(x+3,y+2,forms(mid(disp,2),40));
      testdel(mbrettd(disp[1],bbase));
    end;
    dbSkip(bbase,1);
    end;
  dbSetIndex(ubase,uiAdrBuch);
  dbSeek(ubase,uiAdrbuch,#1);
  while not brk and not dbEOF(ubase) do begin
    if dbReadInt(ubase,'userflags') and 4=0 then begin   { keine Verteiler }
      dbReadN(ubase,ub_haltezeit,hzeit);
      hzahl:=false;
      disp := dbReadNStr(ubase,ub_username);
      attrtxt(col.colmboxhigh);
      mwrt(x+3,y+2,forms(disp,40));
      testdel(mbrettd('U',ubase));
      end;
    dbSkip(ubase,1);
    end;
  dbSetIndex(bbase,bi);
  if repair then begin
    closebox;
    if Marked.Count =0 then
      hinweis(getres2(448,7))   { 'keine fehlerhaften Nachrichten gefunden' }
    else
      select(11);
    aufbau:=true;
    end
  else begin
    if not brk then
      if _del then
        wkey(1,false)
      else begin
        signal;
        attrtxt(col.colmbox);
        mwrt(x+2,y+8,' '+getres(12){+' '#8});
        wait(curon);
        end;
    closebox;
    end;
  freeres;
  aufbau:=true;
end;


{ Alle Nachrichten mit halteflags=2 loeschen; Puffer ueberarbeiten }
{ Nachrichten mit defekter Groesse werden auf 'loeschen' gesetzt    }

procedure MsgReorg;
const tmp     = 'REORG.$$$';
      maxbufs = 20;
var x,y,yy  : Integer;
    lastproz: byte;
    abl     : byte;
    ablage  : byte;
    n,count : longint;
    f1,f2   : file;
    f1s     : longint;
    hdfree  : int64;
    hflags  : byte;
    uflags  : byte;
    p       : pointer;
    bsize   : Integer;
    newadr  : longint;
    reo     : boolean;
    bufa    : array[1..maxbufs] of record
                                     bp   : pointer;
                                     size : xpWord;
                                   end;
    bufs    : byte;
    break   : boolean;
    mi      : xpWord;
    voll    : boolean;        { kein Platz fuer eine ode mehrere Abl. }
    errflag : boolean;

  procedure test_killed;
  var f : file of boolean;
      b : boolean;
      i : byte;
  begin
    assign(f,killedDat);
    if existf(f) then begin
      reset(f);
      i:=0;
      while not eof(f) and (i<ablagen) do
      begin
        read(f,b);
        if b then reobuf[i]:=true;
        inc(i);
        end;
      close(f);
      end;
  end;

  procedure flushbufs;
  var i : byte;
  begin
    for i:=1 to bufs do
      with bufa[i] do begin
        blockwrite(f2,bp^,size);
        freemem(bp,size);
        end;
    bufs:=0;
  end;

  procedure movemsg;
  var adr,size : longint;
      rr       : Integer;
      mid      : string;
      domove   : boolean;
      rec : longint;
      b   : byte;
      mpos     : longint;

    function MsgOK:boolean;  { Test, ob Xgepostete Msg schon verschoben wurde }
    var fs  : longint;
        hdp : THeader;
        hds : longint;
        ok  : boolean;
        enr : shortint;
    begin
      flushbufs;
      fs:=filesize(f2);
      if adr+size>fs then
        MsgOK:=false
      else begin
        seek(f2,adr);
        enr:=dbReadInt(mbase,'netztyp') shr 24;
        hdp := THeader.Create;
        MakeHeader(true,f2,enr,hds,hdp,ok,true, true);
        MsgOK:=ok and (size=hds+hdp.groesse) and (hdp.Empfaenger.Count>=min(2,enr))
                  and (dbReadInt(mbase,'groesse')=hdp.groesse);
        Hdp.Free;
        seek(f2,fs);
        end;
    end;

  begin
    dbReadN(mbase,mb_adresse,adr);
    dbReadN(mbase,mb_msgsize,size);
    if (size<0) or (adr<0) or (MaxInt-adr<size) or (adr+size>f1s) then begin        { Nachricht defekt }
      dbDelete(mbase);
      exit;
      end;
    dbReadN(mbase,mb_gelesen,b);
    if b>1 then begin           { fehlerhaftes gelesen-Flag korrigieren }
      b:=1;
      dbWriteN(mbase,mb_gelesen,b);
      end;
    domove:=true;
    if dbReadInt(mbase,'netztyp') shr 24>0 then begin   { CrossPosting }
      rec:=dbRecno(mbase);
      mid:=LeftStr(dbReadStrN(mbase,mb_msgid),4);
      domove:=not MsgOk;
      if domove then begin
        dbSeek(bezbase,beiMsgid,mid);
        if dbFound then begin
          while not dbEOF(bezbase) and (dbLongStr(dbReadIntN(bezbase,bezb_msgid))=mid)
          do begin
            mpos:=dbReadIntN(bezbase,bezb_msgpos);
            if (mpos<>rec) and not dbDeleted(mbase,mpos) then begin
              dbGo(mbase,mpos);
              if (dbReadInt(mbase,'adresse')=adr) and
                 (dbReadInt(mbase,'ablage')=abl) and
                 (dbReadInt(mbase,'msgsize')=size) then
                dbWriteN(mbase,mb_adresse,newadr)
              end;
            dbNext(bezbase);
            end;
          dbGo(mbase,rec);
          end;
        end;   { of domove }
      end;   { of CrossPosting }

    if domove then begin
      dbWriteN(mbase,mb_adresse,newadr);
      seek(f1,adr);
      if size>bsize then
      begin
        flushbufs;
        while size>0 do begin
          blockread(f1,p^,min(bsize,size),rr);
          blockwrite(f2,p^,rr);
          dec(size,rr);
          end
        end
      else begin
        inc(bufs);                       { Nachricht in n„chsten Puffer lesen }
        bufa[bufs].size:=size;
        getmem(bufa[bufs].bp,size);
        blockread(f1,bufa[bufs].bp^,size,rr);
        end;
      if bufs=maxbufs then
        flushbufs;
      inc(newadr,dbReadInt(mbase,'msgsize'));
      end;
    dbSkip(mbase,1);
  end;

  procedure show;
  var
    proz : byte;
  begin
    attrtxt(col.colmbox);
    proz:=n*100 div count;
    if proz<>lastproz then
    begin
      moff;
      FWrt(WhereX, WhereY, Format('%3d', [min(proz,100)]));
      mon;
      lastproz:=proz;
    end;
    if not break then begin
      testbrk(break);
      if break then begin
        savecursor;
        break:=ReadJN(getres(449),true);   { 'Abbruch nach Ablagenende' }
        if break then begin
          attrtxt(col.colmbox);
          mwrt(x+2,y+14,getres(450));      { ' Abbruch bei Ablagenende.' }
          end;
        restcursor;
        end;
      end;
  end;

  procedure clkilled(ablage:byte);
  var f   : file of boolean;
      b: boolean;
  begin
    if FileExists(KilledDat) then begin
      assign(f,KilledDat);
      reset(f);
      while filesize(f)<ablage do begin
        b:=false;
        seek(f,filesize(f));
        write(f,b);
      end;
      seek(f,ablage);
      b:=false;
      write(f,b);
      close(f);
      end;
  end;

  procedure clw;
  begin
    clwin(x+1,x+48,y+1,y+13);
    yy:=y+1;
  end;

  function reobufs:boolean;
  var i : integer;
      b : boolean;
  begin
    b:=reobuf[0];
    for i:=1 to ablagen-1 do
      b:=b or reobuf[i];
    reobufs:=b;
  end;

  { Zugriff fuer /T/S/XPOINT und /Z/ALT/S/XPOINT setzen }

  procedure Rerout(znetz:boolean; brett:string; sperre:boolean);
  var b        : byte;
      newbrett : string;
  begin
    if znetz then
      dbSeek(bbase,biBrett,'A/Z-NETZ/ALT/SUPPORT/XPOINT/'+UpperCase(brett))
    else
      dbSeek(bbase,biBrett,'A/T-NETZ/SUPPORT/XPOINT/'+UpperCase(brett));
    if dbFound then begin
      if sperre then begin
        b:=dbReadInt(bbase,'flags') and (not 8)+8;
        dbWriteN(bbase,bb_flags,b);
        end;
      if znetz then
        newbrett:='/Z-NETZ/ALT/SUPPORT/XPOINT/ALLGEMEINES'
      else
        newbrett:='/T-NETZ/SUPPORT/XPOINT/ALLGEMEINES';
      dbWriteNStr(bbase,bb_adresse,newbrett);
      end;
  end;

begin
  CloseAblage;
  msgbox(50,15,getres2(451,1),x,y);    { 'Reorganisation' }
  bsize:=65536;
  getmem(p,bsize);
  test_killed;
  break:=false;
  DisableDos:=true;
  mi:=dbGetIndex(mbase);
  dbSetIndex(mbase,0);     { ohne Indexreihenfolge! }
  repeat
    hdfree:=DiskFree(0);
    clw;
    abl:=0;
    bufs:=0;
    voll:=false;
    reo:=false;
    while (abl<ablagen) and not break do begin
      if reobuf[abl] then begin
        inc(yy);
        attrtxt(col.colmbox);
        mwrt(x+3,yy,getreps2(451,2,strs(abl)));   { 'Ablage Nr. %s }
        if hdfree<bufsiz[abl]+50000 then begin
          moff;
          write(getres2(451,3));    { ' - kein Platz!!!' }
          mon;
          errsound;
          logerror(getreps2(451,4,strs(abl)));   { 'zu wenig Platz, um Ablage '+strs(abl)+' zu reorganisieren' }
          voll:=true;
          end
        else begin
          assign(f1,aFile(abl));
          if not FileExists(aFile(abl)) then begin
            savecursor;
            trfehler1(421,UpperCase(aFile(abl)),30);   { 'Warnung: Ablagendatei %s fehlt!' }
            restcursor;
            rewrite(f1,1);
            close(f1);
            end;
          moff;
          Wrt2(getres2(451,5));
          GotoXY(WhereX-5, WhereY); { ' packen ...     %' }
          mon;
          lastproz:=101;
          reset(f1,1);
          f1s:=filesize(f1);
          assign(f2,FileUpperCase(tmp));  { muss wg. rename jedesmal neu assigned werden! }
          rewrite(f2,1);
          newadr:=0;
          dbGoTop(mbase);
          count:=dbRecCount(mbase);
          n:=1;
          errflag:=false;
          while not dbEOF(mbase) do
          begin
            if n>count then
              errflag:=true;
            if n mod 10=0 then show;
            dbReadN(mbase,mb_ablage,ablage);
            if ablage=abl then
            begin
              dbReadN(mbase,mb_halteflags,hflags);
              dbReadN(mbase,mb_unversandt,uflags);
              if (hflags<>2) or odd(uflags) then
                movemsg           { impliziert Skip oder Delete }
              else begin
                DelBezug;
                dbDelete(mbase);
              end;
            end
            else
              if ablage>=ablagen then
                dbDelete(mbase)
              else
                dbSkip(mbase,1);
            inc(n);
          end;
          if n<=count then errflag:=true;
          flushbufs;
          if count>0 then show;
          close(f2);
          close(f1); erase(f1);
          rename(f2,aFile(abl));
          FlushClose;
          if errflag then begin
            trfehler(445,30);   { 'Nachrichtendatenbank fehlerhaft - verwenden Sie /Wartung/Packen!' }
            break:=true;
            end;
          clkilled(abl);
          reobuf[abl]:=false;
          reo:=true;
          end;
        end;
      inc(abl);
      if abl=10 then clw;
      end;
  until break or not (voll and reo and reobufs);
  dbSetIndex(mbase,mi);
  if reo then
  begin
    Wrt(x+3,yy+2,getres2(451,6));
    GotoXY(WhereX-5, WhereY);   { 'Einen Moment noch...     %' }
    brettdatumsetzen(true);
  end else
    mwrt(x+3,yy+2,getres2(451,7));   { 'nix zu loeschen' }
  DisableDOS:=false;
  signal;
  Rerout(false,'MELDUNGEN',true);
  Rerout(false,'UPDATES',true);
  Rerout(true,'MELDUNGEN',true);
  Rerout(true,'UPDATES',true);
  SysDelay(500);
  closebox;
  freeres;
  wrtiming('REORG');
  freemem(p,bsize);
  Marked.Clear;
  aufbau:=true; xaufbau:=true;
end;


procedure ModiEmpfDatum;
var d   : datetimest;
    brk : boolean;
   getdate: boolean;
    l   : longint;
begin
  getdate:=true;
  d:=longdat(dbReadInt(mbase,'empfdatum'));
  EditDate(15,11+(screenlines-25)div 2,getres2(452,1),d,getdate,brk);   { 'neues Empfangsdatum:' }
  if not brk then begin
    if getdate then d:=longdat(dbreadint(mbase,'origdatum'));
    l:=ixdat(d);
    dbWriteN(mbase,mb_empfdatum,l);
    aufbau:=true;
    end;
end;


function testuvs(const txt:atext):boolean;
var uvs : byte;
begin
  dbReadN(mbase,mb_unversandt,uvs);
  if uvs and 1<>0 then rfehler1(422,txt);  { 'Bitte verwenden Sie Nachricht/Unversandt/%s' }
  testuvs:=(uvs and 1<>0);
end;


procedure ModiBetreff;
var brk  : boolean;
    hdp  : THeader;
    hds  : longint;
    x,y  : Integer;
    fn   : string;
    f    : file;
begin
  if testuvs(getres(453)) then exit;   { 'Aendern' }
  hdp := THeader.Create;
  ReadHeader(hdp,hds,true);
  if hds>1 then begin
    diabox(63,5,'',x,y);
    readstring(x+3,y+2,getres(454),hdp.betreff,40,BetreffLen,'',brk);  { 'neuer Betreff:' }
    closebox;
    if not brk then begin
      PGP_BeginSavekey;
      fn:=TempS(dbReadInt(mbase,'msgsize')+100);
      assign(f,fn);
      rewrite(f,1);
      { ClearPGPflags(hdp); }
      hdp.orgdate:=true;
      WriteHeader(hdp,f);
      XreadF(hds,f);   { den Nachrichtentext anhaengen ... }
      close(f);
      Xwrite(fn);
      erase(f);
      wrkilled;
      TruncStr(hdp.betreff,40);
      dbWriteNStr(mbase,mb_betreff,hdp.betreff);
      PGP_EndSavekey;
      aufbau:=true;
      xaufbau:=true;
      end;
    end;
  Hdp.Free;
end;


procedure ModiHighlite;
var l : longint;
begin
  dbReadN(mbase,mb_netztyp,l);
  l:=l xor $1000;
  dbWriteN(mbase,mb_netztyp,l);
  aufbau:=true;
end;


procedure ModiText;
var fn   : string;
    fn2  : string;
    f,f2 : file;
    hdp  : Theader;
    hds  : longint;
    typ  : char;
    l    : longint;
begin
  dbReadN(mbase,mb_typ,typ);
  if (typ='B') or (typ='M') then begin
    rfehler(423);   { 'Bei Binaerdateien nicht moeglich' }
    exit;
  end;
  if testuvs(getres(455)) then exit;   { 'Edit' }
  hdp := THeader.Create;
  ReadHeader(hdp,hds,true);           { Heder einlesen }
  if hds>1 then begin
    PGP_BeginSavekey;
    fn:=TempS(dbReadInt(mbase,'msgsize'));
    assign(f,fn);
    rewrite(f,1);
    XReadIsoDecode:=true;
    XreadF(hds,f);                { Nachrichtentext in Tempfile.. }
    close(f);
    editfile(fn,true,false,false,0,false);    { ..editieren.. }
    fn2:=TempS(_filesize(fn)+2000);
    assign(f2,fn2);
    rewrite(f2,1);
    hdp.groesse:=_filesize(fn);
    dbWriteN(mbase,mb_groesse,hdp.groesse);
    hdp.charset:='';
    { ClearPGPflags(hdp); }
    hdp.orgdate:=true;
    WriteHeader(hdp,f2);          { ..Header in neues Tempfile.. }
    reset(f,1);
    fmove(f,f2);                  { ..den Text dranhaengen.. }
    close(f); erase(f);
    close(f2);
    dbReadN(mbase,mb_netztyp,l);
    l:=l and (not $2000);         { ISO-Codierung abschalten }
    dbWriteN(mbase,mb_netztyp,l);
    Xwrite(fn2);                  { ..und ab in die Datenbank. }
    erase(f2);
    wrkilled;
    PGP_EndSavekey;
    aufbau:=true;                 { wg. geaenderter Groesse }
    end;
   Hdp.Free;
end;


procedure ModiRot13;
var ablg   : byte;
    adr    : longint;
    f      : file;
    l,size : longint;
    p      : pointer;
    ps  : Integer;
    rr: Integer;
    typ    : char;
begin
  dbReadN(mbase,mb_typ,typ);
  if typ='B' then begin
    rfehler(423);   { 'Bei Binaerdateien nicht moeglich' }
    exit;
    end;
  if testuvs(getres(453)) then exit;   { 'Aendern' }
  dbReadN(mbase,mb_ablage,ablg);
  dbReadN(mbase,mb_adresse,adr);
  dbReadN(mbase,mb_groesse,size);
  assign(f,aFile(ablg));
  reset(f,1);
  if (size=0) or (adr+size>filesize(f)) then begin
    rfehler1(424,strs(ablg));   { 'Nachricht ist beschaedigt  (Ablage %s)' }
    close(f);
    end
  else
  begin
    ps:=32768;
    getmem(p,ps);
    seek(f,adr+dbReadInt(mbase,'msgsize')-size);
    repeat
      l:=filepos(f);
      blockread(f,p^,min(ps,size),rr);
      Rot13(p^,rr);
      seek(f,l);
      blockwrite(f,p^,rr);
      dec(size,rr);
    until size=0;
    close(f);
    freemem(p,ps);
    end;
end;


procedure ModiTyp;
var c   : char;
    uvs : byte;
    flags:longint;
begin
  dbReadN(mbase,mb_unversandt,uvs);
  if uvs and 1<>0 then
    rfehler(425)   { 'Bei unversandten Nachrichten leider nicht moeglich.' }
  else begin
    dbReadN(mbase,mb_typ,c);
    dbReadN(mbase,mb_flags,flags);

    if (c='T') and ((flags and 4)<>0) then c:='M';

    case c of
      'T': c:='B';
      'B': c:='M';
      else c:='T';
    end;

    if c='M' then flags := flags or 4 else
                  flags := flags and not 4;

    if c='M' then c:='T';
                  
    dbWriteN(mbase,mb_flags,flags);
    dbWriteN(mbase,mb_typ,c);
    aufbau:=true;
    end;
end;

procedure ModiGelesen;                    {Nachricht-Gelesen status aendern}
var b     : byte;
    brett : string;
begin
  if not dbBOF(mbase) then
  begin                                   {Nur Wenn ueberhaupt ne Nachricht gewaehlt ist...}
    dbReadN(mbase,mb_gelesen,b);
    if b=1 then b:=0 else b:=1;
    dbWriteN(mbase,mb_gelesen,b);
    Brett := dbReadNStr(mbase,mb_brett);
    if b=1 then begin
      dbSeek(mbase,miGelesen,brett+#0);
      if dbEOF(mbase) or (dbReadStrN(mbase,mb_brett)<>brett) or (dbReadInt(mbase,'gelesen')<>0)
      then b:=0   { keine ungelesenen Nachrichten mehr im Brett vorhanden }
      else b:=2;
      end
    else
      b:=2;        { noch ungelesene Nachrichten im Brett vorhanden }
    dbSeek(bbase,biIntnr,mid(brett,2));
    if dbFound then begin
      b:=dbReadInt(bbase,'flags') and (not 2) + b;
      dbWriteN(bbase,bb_flags,b);
      end;
    aufbau:=true;
    end;
end;


{ Brettliste importieren }

procedure ImportBrettliste;
var fn  : string;
    s   : string;
    t   : text;
    x,y : Integer;
    n   : longint;
    useclip: boolean;
begin
  fn:= WildCard;
  useclip:=true;
  if ReadFilename(getres2(456,1),fn,true,useclip) then   { 'Brettliste einlesen' }
    if not FileExists(fn) then
      fehler(getres2(456,2))   { 'Datei nicht vorhanden!' }
    else begin
      msgbox(30,5,'',x,y);
      wrt(x+3,y+2,getres2(456,3));   { 'Bretter anlegen ...' }
      n:=0;
      assign(t,fn);
      reset(t);
      while not eof(t) do
      begin
        readln(t,s);
        makebrett(s,n,DefaultBox,ntBoxNetztyp(DefaultBox),true);
        Wrt(x+22,y+2, Format('%5d', [n]));
      end;
      close(t);
      closebox;
      aufbau:=true;
      dbFlushClose(bbase);
      if useclip then _era(fn);
      end;
  freeres;
end;


{ Userliste importieren }

procedure ImportUserliste;
var fn  : string;
    adrb: boolean;
    brk : boolean;
    s   : string;
    t   : text;
    x,y : Integer;
    n   : longint;
    useclip: boolean;
    b   : byte;
begin
  fn:= WildCard;
  useclip:=true;
  if ReadFilename(getres2(456,11),fn,true,useclip) then   { 'Userliste einlesen' }
    if not FileExists(fn) then
      fehler(getres2(456,2))   { 'Datei nicht vorhanden!' }
    else begin
      dialog(38,3,'',x,y);
      adrb:=true;
      maddbool(3,2,getres2(456,12),adrb);   { 'User in Adressbuch eintragen' }
      readmask(brk);
      enddialog;
      if brk then exit;
      msgbox(34,5,'',x,y);
      wrt(x+3,y+2,getres2(456,13));   { 'Userbretter anlegen ...' }
      n:=0;
      assign(t,fn);
      reset(t);
      b:=0;
      while not eof(t) do begin
        readln(t,s);
        s:=trim(s);
        if cpos('@',s)>0 then begin
          dbSeek(ubase,uiName,UpperCase(s));
          if not dbFound then begin
            inc(n);
            AddNewUser(s,DefaultBox);
            if not adrb then dbWriteN(ubase,ub_adrbuch,b);
            Wrt(x+26, y+2, Format('%5d', [n]));
          end;
        end;
      end;
      close(t);
      wkey(1,false);
      closebox;
      aufbau:=true;
      dbFlushClose(ubase);
      if useclip then _era(fn);
      end;
  freeres;
end;


{ User-/Brettliste exportieren }

{ These "functions" are used as testfunc.
  What should be the default result?
}
function Bool_BrettGruppe(var s:string):boolean;
begin
  Result := s<>_jn_[2];
  if Result then
    setfield(2,_jn_[2]);
end;

function Bool_Brettindex(var s:string):boolean;
begin
  Result := s<>_jn_[2];
  if Result then
    setfield(1,_jn_[2]);
end;

procedure ExportUB(user:boolean);
var fname   : String;
    t       : text;
    d       : DB;
    x,y,xx  : Integer;
    cnt,n   : longint;
    exkom   : boolean;
    brk     : boolean;
    useclip : boolean;
    onlyadress : boolean;
    sortadress : boolean;
    sortbox    : boolean;
    sort      : byte;
    ab,ab1     : longint;
    dbindex    : xpWord;
    s          : string[80];
    sa,sa1     : string [20];

label ende;

  function komform(d:DB; s:string):string;
  var kom : string;
  begin
    kom:= dbReadStr(d,'kommentar');
    if exkom and (kom<>'') then
      komform:=forms(s,80)+kom
    else
      komform:=s;
  end;


  procedure getbrettinfos;
  var x1,y1 : Integer;
  begin
    sortadress:=false; sortbox:=Usersortbox;  exkom:=falsE;
    dialog(50,5,getres2(457,2),x1,y1);        { 'Brettliste erzeugen' }
    maddbool(2,2,getres2(457,7),SortAdress);  { 'nach Gruppen sortieren'}
    MSet1Func(bool_brettgruppe);
    maddbool(2,3,getres2(457,10),SortBox);    { 'Sortierung aus Brettuebersicht beibehalten'}
    MSet1Func(bool_brettindex);
    maddbool(2,5,getres2(457,4),exkom);       { 'auch Kommentare exportieren' }
    readmask(brk);
    enddialog;
  end;

  procedure getuserinfos;
  var x1,y1 : Integer;
  begin
    sortadress:=true; sortbox:=Usersortbox; Onlyadress:=true; exkom:=falsE;
    dialog(43,6,getres2(457,1),x1,y1);        { 'Userliste erzeugen' }
    maddbool(2,2,getres2(457,7),SortAdress);  { 'nach Adressbuchgruppen sortieren'}
    maddbool(2,3,getres2(457,8),SortBox);     { 'nach Serverbox sortieren'}
    maddbool(2,4,getres2(457,9),OnlyAdress);  { 'Nur User im Adressbuch exportieren' }
    maddbool(2,6,getres2(457,4),exkom);       { 'auch Kommentare exportieren' }
    readmask(brk);
    enddialog;
  end;
  
begin
  fname:='';
  useclip:=true;
  if ReadFilename(getres2(457,iif(user,1,2)),fname,true,useclip)
  then
    if not ValidFileName(fname) then
      fehler(getres2(457,3))   { 'ungueltiger Dateiname' }
    else begin
      if user then getuserinfos 
        else getbrettinfos;
      if brk then begin
        if useclip then _era(fname);
        goto ende;
      end;   
      sort:=0;
      if sortadress then sort:=sort or 2;
      if sortbox then sort:=sort or 1;
      if user then begin
        dbindex:=dbgetindex(ubase);
        case Sort of
          1 : dbSetIndex(ubase,uiBoxName);
          2 : dbSetIndex(ubase,uiAdrbuch);
          3 : dbSetIndex(ubase,uiBoxAdrbuch);
         else dbSetIndex(ubase,uiName);
         end;
        d:=ubase;
        dbGoTop(ubase);
      end
      else begin
        dbindex:=dbgetindex(mbase);
        case sort of
          2 : begin
                dbsetindex(bbase,biGruppe);
                dbgotop(bbase);
                end;
          1 : begin
                dbsetindex(bbase,biIndex);
                dbgotop(bbase);
                end;
         else begin
                dbsetindex(bbase,biBrett);
                dbSeek(bbase,biBrett,'A');
                end;
         end;
        d:=bbase;
        end;
      msgbox(34,5,'',x,y);
      wrt(x+3,y+2,getres2(457,iif(user,5,6)));  { 'erzeuge User/Brettliste...     %' }
      xx:=wherex-5;
      if not multipos(':\',fname) then fname:=ExtractPath+fname;
      assign(t,fname);
      rewrite(t);
      cnt:=dbRecCount(d); n:=0; ab1:=-1; sa1:='';
      while not dbEOF(d) do
      begin
        attrtxt(col.colmboxhigh);

        Wrt(xx, y+2, Format('%3d', [n*100 div cnt]));
        if user then
        begin
          s:=dbReadStrN(ubase,ub_username);
          ab:=dbreadint(ubase,'adrbuch');
          sa:=dbReadStrN(ubase,ub_pollbox);
          if (dbReadInt(ubase,'userflags') and 4=0) AND       { keine Verteiler }
           (LeftStr(s,4)<>#0+'$/T') AND                          { keine Trennzeile }
          not (onlyadress and (ab=0))                         { Evtl. nur Adressbuch-User }
          then begin
            if sortadress and (ab<>ab1) then begin
              ab1:=ab;
              writeln(t,sp(60),'('+Getres2(2715,11),ab,')');  {Gruppe}
              end;
            if (sort=1) and (sa<>sa1) then begin
              sa1:=sa;
              writeln(t,sp(60),sa);
              end;
            writeln(t,komform(ubase,s))
            end
          end
        else begin
          if sort=2 then ab:=dbreadint(bbase,'gruppe')
          else ab:=-1;
          s:=dbReadStrN(bbase,bb_brettname);
          if LeftStr(s,3)='$/T'           { keine Trennzeile }
          then begin
           if sort=1 then writeln(t,dup(40,s[4]));
           end
          else begin
            if ab1<>ab then begin
              ab1:=ab;
              writeln(t,sp(60),'('+Getres2(2715,11),ab,')');  {Gruppe}
              end;
            writeln(t,komform(bbase,copy(s,2,80)));
            end;
          end;
        dbNext(d);
        inc(n);
        end;
      close(t);
      dbsetindex(d,dbindex); 
      if useclip then WriteClipfile(fname);
      closebox;
      end;
ende:
  freeres;
end;


// N/U/Z
procedure zeige_unversandt;
var _brett   : string;
    _mbrett  : string;
    sr       : tsearchrec;
    rc       : integer;
    f        : file;
    hdp      : Theader;
    hds      : longint;
    ok       : boolean;
    adr,fsize: longint;
    box      : string;
    uvf      : boolean;
    uvs      : byte;
    mtyp     : char;
    ntyp     : longint;
    zconnect : boolean;
    crashs   : boolean;
    i        : integer;

begin
  if uvs_active then exit;
  crashs:=false;
  // temporary debug log
  Debug.DebugLog('xp4o','Searching for '+GetCurrentDir+'/*'+extBoxFile,dlDebug);
  rc:= findfirst('*'+extBoxFile,faArchive,sr);
  if rc<>0 then
  begin
    FindClose(sr);
    rc:= findfirst('*.cp',faArchive,sr);
    crashs:=true;
  end;
  Marked.Clear;
  moment;
  hdp := THeader.Create;
  while rc=0 do begin
    if crashs then begin
      box:=strs(hexval(LeftStr(sr.name,4)))+'/'+strs(hexval(copy(sr.name,5,4)));
      { ^^^ nur fuer Anzeige bei fehlerhaftem CP }
      zconnect:=true;
      end
    else begin
      box:=file_box(LeftStr(sr.name,cPos('.',sr.name)-1));
      zconnect:=ntZConnect(ntBoxNetztyp(box));
      end;
    dbSetIndex(mbase,miBrett);
    assign(f,ownpath+sr.name);
    reset(f,1);
    adr:=0;
    fsize:=filesize(f);
    ok:=true;
    while ok and (adr<fsize) do begin
      seek(f,adr);
      makeheader(zconnect,f,1,hds,hdp,ok,false, true);
      if not ok then
        rfehler1(427,box)   { 'fehlerhaftes Pollpaket:  %s' }
      else with hdp do 
      begin
        _brett:='';

        for i := 0 to hdp.Empfaenger.Count-1 do
        begin
          _mbrett := Addr2DB(hdp.Empfaenger[i]);
        
          if (cpos('@',_mbrett)=0) and
             ((netztyp<>nt_Netcall) or (FirstChar(_mbrett)='/'))
          then begin
            dbSeek(bbase,biBrett,'A'+UpperCase(_mbrett));
            if not dbFound then continue
            else _brett:='A'+dbLongStr(dbReadInt(bbase,'int_nr'));
            break;
            end
          else begin
            dbSeek(ubase,uiName,UpperCase(_mbrett+
                   iifs(cPos('@',_mbrett)>0,'','@'+box+'.ZER')));
            if not dbFound then continue
            else _brett:='U'+dbLongStr(dbReadInt(ubase,'int_nr'));
            break;
          end;
        end;

        if _brett='' then
        begin
          dbSeek(bbase,biBrett,'$/'#$AF'NIX');
          if dbFound then _brett:='$'+dbLongStr(dbReadInt(bbase,'int_nr'));
        end;        

        uvf:=false;

        if _brett<>'' then 
        begin
          dbSeek(mbase,miBrett,_brett+#255);
          if dbEOF(mbase) then dbGoEnd(mbase)
          else dbSkip(mbase,-1);
          if not dbEOF(mbase) and not dbBOF(mbase) then
            repeat
              _MBrett := dbReadNStr(mbase,mb_brett);
              if _mbrett=_brett then begin
                dbReadN(mbase,mb_unversandt,uvs);
                dbReadN(mbase,mb_typ,mtyp);
                dbReadN(mbase,mb_netztyp,ntyp);
                if (uvs and 1=1) and EQ_betreff(betreff)  and ((mtyp='B') or
                   ((uvs and 4 <> 0) or (ntyp and $4000<>0) or  { codiert / signiert }
                   (groesse=dbReadInt(mbase,'groesse'))))
                   and (FormMsgid(msgid)=dbReadStrN(mbase,mb_msgid))
                   and not msgmarked then
                begin
                  MsgAddmark;
                  uvf:=true;
                  end;
                end;
              dbSkip(mbase,-1);
            until uvf or dbBOF(mbase) or (_brett<>_mbrett);
        end;
        if not uvf then
          rfehler(426);   { 'Nachricht ist nicht mehr in der Datenbank vorhanden!' }
        inc(adr,groesse+hds);
      end; // with hdp
    end; // while ok and (adr<fsize)
    
    close(f);
    rc:= findnext(sr);
    if (rc<>0) and not crashs then
    begin
      FindClose(sr);
      rc:= findfirst('*.cp',faArchive,sr);
      crashs:=true;
    end;
  end;
  FindClose(sr);
  Hdp.Free;
  closebox;
  if Marked.Count = 0 then
    hinweis(getres(458))   { 'Keine unversandten Nachrichten vorhanden!' }
  else begin
    MarkUnversandt:=true;
    uvs_active:=true;
    select(11);
    uvs_active:=false;
    end;
  aufbau:=true;
end;


procedure msg_info;     { Zerberus-Header anzeigen }
var hdp   : Theader;
    hds   : longint;
    i     : integer;
    x,y  : Integer;
    dat   : datetimest;
    anz   : byte;
    xxs   : array[1..20] of string;
    netz  : string;
    p     : byte;
    elist : boolean;    { mehrere Empfaenger }
    rlist : boolean;    { mehrere References }
    spami : boolean;    { hat SPAM-Informationen }
    t     : taste;
    s     : atext;

  procedure apps(nr:xpWord; s:string);
  begin
    inc(anz);
    xxs[anz]:=getres2(459,nr)+' '+LeftStr(s,53);
  end;

  function ddat:string;
  begin
    with hdp do
      if ddatum='' then
        ddat:=''
      else
        ddat:=', '+copy(ddatum,7,2)+'.'+copy(ddatum,5,2)+'.'+LeftStr(ddatum,4)+
              ', '+copy(ddatum,9,2)+':'+copy(ddatum,11,2)+':'+copy(ddatum,13,2);
  end;

  procedure empfliste;   { Fenster mit Empfaengerliste }
  var ml  : byte;
      i,j : integer;
      x,y : Integer;
  begin
    ml:=length(getres2(459,30))+8;
    with hdp do begin
      for i:=1 to Empfaenger.Count do
      begin
        ReadHeadEmpf:=i;
        ReadHeader(hdp,hds,false);
        ml:=max(ml,length(Firstempfaenger)+6);
      end;
      ml:=min(ml,72);
      i:=min(Empfaenger.Count,screenlines-8);
      msgbox(ml,i+4,getres2(459,30),x,y);   { 'Empfaengerliste' }
      for j:=1 to i do begin
        ReadHeadEmpf:=j;
        ReadHeader(hdp,hds,false);
        mwrt(x+3,y+1+j,LeftStr(Firstempfaenger,72));
        end;
      wait(curoff);
      if rlist and (UpperCase(lastkey)='R') then keyboard('R');
{$IFDEF Debug}
      if (UpperCase(lastkey)='D') then keyboard('D');
{$ENDIF}
      closebox;
      end;
  end;

  procedure refliste;   { Fenster mit Referenzliste }
  var
    ml, i: integer;
    x, y: Integer;
  begin
    ml:=length(getres2(459,31))+8;
    with hdp do
    begin
      for i := 0 to References.Count - 1 do
        ml:=max(ml,length(References[i])+6);
      ml:=min(ml,72);
      i:=min(References.Count,screenlines-8);
      msgbox(ml,i+4,getres2(459,31),x,y);   { 'Empfaengerliste' }
      for i := 0 to References.Count - 1 do
        wrt(x+3,y+2+i,LeftStr(References[i],72));
      wait(curoff);
      if elist and (UpperCase(lastkey)='E') then keyboard('E');
{$IFDEF Debug}
      if (UpperCase(lastkey)='D') then keyboard('D');
{$ENDIF}
      closebox;
      end;
  end;

  procedure spam_info;
  var
      i    : integer;
      x,y  : Integer;
      s    : TRopeStream;
      stat : TSpamStats;
  begin
    msgbox(34,5+
      (High(stat.MostInteresting) - Low(stat.MostInteresting))+1+
      (High(stat.LeastInteresting) - Low(stat.LeastInteresting))+1,
      GetRes2(459,70),x,y);
    
    s := TRopeStream.Create;
    try
      XReadS(0,s);
      s.Seek(0,soFromBeginning);
      calc_message_spamicity(s,stat);      
    finally
      s.Free;
    end;

    inc(x,2);
    inc(y);
    
    wrt(x,y,Format(GetRes2(459,72),[Stat.Spamicity*100]));
    
    inc(y,2);
    for i:=Low(stat.MostInteresting) to High(stat.MostInteresting) do
    begin
      wrt(x,y,Format(GetRes2(459,73),[
        stat.MostInteresting[i].Word,
        stat.MostInteresting[i].GoodCount,
        stat.MostInteresting[i].BadCount,
        (1-stat.MostInteresting[i].Prob)*100]));
      inc(y);
    end;

    inc(y,1);
    for i:=Low(stat.LeastInteresting) to High(stat.LeastInteresting) do
    begin
      wrt(x,y,Format(GetRes2(459,73),[
        stat.LeastInteresting[i].Word,
        stat.LeastInteresting[i].GoodCount,
        stat.LeastInteresting[i].BadCount,
        (1-stat.LeastInteresting[i].Prob)*100]));
      inc(y);
    end;

    wait(curoff);
    closebox;
  end;
  

{$IFDEF Debug}
  procedure msgs_tuple;   { Fenster mit Datenbankinfo }
  var 
    x,y: Integer;

    procedure _(id:integer;s:string);
    begin
      attrtxt(col.colmboxhigh); wrt(x,y,getres2(459,id));  { 'Empfangsdatum: ' }
      attrtxt(col.colmbox);     wrt(x+12,y,LeftStr(s,70-15));
      inc(y);
    end;

    function brett(s:string):string;
    var i: integer;
    begin
      case s[1] of
        '$': result:=GetRes2(459,64);
        '1': result:=GetRes2(459,65);
        'A': result:=GetRes2(459,66);
        'U': result:=GetRes2(459,66);
        else result:=' ('+hex(Ord(s[1]),2)+')';
      end;

      for i:= 5 downto 2 do
        result := Hex(Ord(s[i]),2)+result;
    end;

  begin
    msgbox(70,23,getres2(459,32),x,y);   { 'Empfaengerliste' }
    inc(x,2); inc(y,2);

    _(40,brett(dbReadStrN(mbase,mb_brett)));    { 'Brett-Nr. :' }
    _(41,dbReadStrN(mbase,mb_betreff));         { 'Betreff   :' }
    _(42,dbReadStrN(mbase,mb_absender));        { 'Absender  :' }
    _(43,StrS(dbReadIntN(mbase,mb_origdatum))); { 'OrigDatum :' }
    _(44,StrS(dbReadIntN(mbase,mb_empfdatum))); { 'EmpfDatum :' }
    _(45,StrS(dbReadIntN(mbase,mb_groesse)));   { 'Groesse   :' }
    _(46,Chr(dbReadIntN(mbase,mb_typ)));        { 'Typ       :' }
    _(47,StrS(dbReadIntN(mbase,mb_HalteFlags)));{ 'HalteFlags:' }
    _(48,StrS(dbReadIntN(mbase,mb_gelesen)));   { 'gelesen   :' }
    _(49,hex(dbReadIntN(mbase,mb_unversandt),4));{'unversandt:' }
    _(50,StrS(dbReadIntN(mbase,mb_ablage)));    { 'Ablage    :' }
    _(51,StrS(dbReadIntN(mbase,mb_adresse)));   { 'Adresse   :' }
    _(52,StrS(dbReadIntN(mbase,mb_MsgSize)));   { 'MsgSize   :' }
    _(53,StrS(dbReadIntN(mbase,mb_WVdatum)));   { 'WVdatum   :' }
    _(54,dbReadStrN(mbase,mb_MsgID));           { 'MsgID     :' }
    _(55,hex(dbReadIntN(mbase,mb_netztyp),4));  { 'Netztyp   :' }
    _(57,dbReadStrN(mbase,mb_Name));            { 'Name      :' }
    _(58,hex(dbReadIntN(mbase,mb_flags),4));    { 'Flags     :' }
    _(59,dbReadStrN(mbase,mb_MimeTyp));         { 'Mimetyp   :' }

    wait(curoff);
    if rlist and (UpperCase(lastkey)='R') then keyboard('R');
    if elist and (UpperCase(lastkey)='E') then keyboard('E');
    closebox;
  end;
{$ENDIF}

  function typstr(typ,mimetyp:string):string;
  begin
    if mimetyp<>'' then
      typstr:=extmimetyp(mimetyp)
    else begin
      UpString(typ);
      if typ='T' then typstr:=typ+getres2(459,1) else   { '  (Text)' }
      if typ='B' then typstr:=typ+getres2(459,2) else   { '  (binaer)' }
      typstr:=typ;
      end;
  end;

begin
  hdp := THeader.Create;
  ReadHeader(hdp,hds,true);
  anz:=0;
  with hdp do begin
    apps(3,Firstempfaenger);
    if fido_to<>'' then apps(4,fido_to);
    apps(5,betreff);
    apps(6,LeftStr(absender,53));
    if realname<>'' then apps(7,realname);
    if organisation<>'' then apps(8,LeftStr(organisation,53));
//  if Replyto <> '' then apps(9,LeftStr(replyto,53));
    apps(10,iifs(ntZDatum(netztyp),zdatum,datum)+
         iifs(datum<>'','  ('+fdat(datum)+', '+ftime(datum)+
         iifs(ntSec(netztyp),':'+copy(zdatum,13,2),'')+')',''));
    apps(11,LeftStr(pfad,53));
    repeat
      pfad:=mid(pfad,54);
      if pfad<>'' then apps(12,LeftStr(pfad,53));
    until pfad='';
    if msgid<>''    then apps(13,msgid);
    if References.Count > 0 then apps(14, References[References.Count-1]);
    if pm_bstat<>'' then apps(15,pm_bstat);
    apps(16,typstr(typ,mime.contenttype.verb));
    if programm<>'' then apps(17,programm);
    if datei<>''    then apps(18,datei+ddat);
    apps(19,strs(groesse)+getres(13));
    if komlen>0 then apps(21,strs(komlen)+getres(13));
    if attrib<>0 then
      apps(22,hex(attrib,4)+' - '+
           iifs(attrib and attrCrash<>0,'Crash ','')+
           iifs(attrib and attrFile<>0,'File ','')+
           iifs(attrib and attrReqEB<>0,'Req-EB ','')+
           iifs(attrib and attrIsEB<>0,'EB ','')+
           iifs(attrib and attrPmReply<>0,'PM-Reply ','')+
           iifs(attrib and attrQuoteTo<>0,'QuoteTo ','')+
           iifs(attrib and attrControl<>0,'Control ',''));
    if netztyp in netsRFC then netz:=' / RFC'
    else begin
      netz:=ntName(netztyp);
      if netz='???' then netz:=''
      else netz:=' / '+netz;
      end;
    msgbox(70,anz+7,getres2(459,23)+' ('+            { 'Nachrichtenkopf' }
                    getres2(459,iif(ntZConnect(netztyp),24,25))+netz+')',x,y);
    moff;
    for i:=1 to anz do begin
      if FirstChar(xxs[i])=' ' then p:=0
      else p:=cpos(':',xxs[i]);
      if p>0 then begin
        attrtxt(col.colmboxhigh);
        wrt(x+3,y+i+1,LeftStr(xxs[i],p));
        end;
      attrtxt(col.colmbox);
      wrt(x+3+p,y+i+1,mid(xxs[i],p+1));
      end;
    attrtxt(col.colmboxhigh); wrt(x+3,y+anz+3,getres2(459,26));  { 'Groesse des Kopfes: ' }
    attrtxt(col.colmbox);     wrt(x+3+length(getres2(459,26)),y+anz+3,IntToStr(hds)+getres(13));
    dat:=longdat(dbReadInt(mbase,'empfdatum'));
    if smdl(IxDat('2712300000'),IxDat(dat)) then
      dat:=longdat(dbReadInt(mbase,'wvdatum'));
    attrtxt(col.colmboxhigh); wrt(x+40,y+anz+2,getres2(459,27));  { 'Empfangsdatum: ' }
    attrtxt(col.colmbox);     wrt(x+40+length(getres2(459,27)),y+anz+2,fdat(dat));
    attrtxt(col.colmboxhigh); wrt(x+40,y+anz+3,getres2(459,28));  { 'Ablagedatei  :' }
    attrtxt(col.colmbox);     wrt(x+40+length(getres2(459,28)),y+anz+3,
                                  FileUpperCase('mpuffer.')+IntToStr(dbReadInt(mbase,'ablage')));
    elist:=(Empfaenger.Count>1);
    rlist:=(References.Count>1);
    spami:=(FirstChar(dbReadStrN(mbase,mb_brett)) in ['1']) or
      (dbReadStrN(bbase,bb_brettname) = '$/ŻSpam');
    if elist then s:=' (E='+getres2(459,30)
    else s:='';
    if rlist then begin
      if s<>'' then s:=s+', '
      else s:=' (';
      s:=s+'R='+getres2(459,31);
      end;

    if spami then begin
      if s<>'' then s:=s+', '
      else s:=' (';
      s:=s+'S='+GetRes2(459,70);
      end;
      
{$IFDEF Debug}
    if s<>'' then s:=s+', '
    else s:=' (';
    s:=s+'D='+getres2(459,32);
{$ENDIF}
    if s<>'' then s:=s+')';
    wrt(x+3,y+anz+5,getres2(459,29)+s+' ...');    { Taste druecken / E=Empfaengerliste / R=Referenzliste }
    mon;
    x:=wherex; y:=wherey;
    repeat
      gotoxy(x,y);
      repeat
        get(t,curon);
      until (t<mausfirstkey) or (t>mauslastkey) or (t=mausleft) or (t=mausright);
      if elist and (UpperCase(t)='E') then empfliste;
      if rlist and (UpperCase(t)='R') then refliste;
      if spami and (UpperCase(t)='S') then spam_info;
{$IFDEF Debug}
      if (UpperCase(t)='D') then msgs_tuple;
{$ENDIF}
    until {$IFDEF Debug} (UpperCase(t)<>'D') and {$ENDIF}
      (not elist or (UpperCase(t)<>'E')) and (not rlist or (UpperCase(t)<>'R'));
    end;
  closebox;
  freeres;
  Hdp.Free;
end;


procedure ShowHeader;            { Header direkt so anzeigen wie er im PUFFER steht }
var fn  : string;
    f   : file;
    hdp : Theader;
    hds : longint;
    lm  : Byte;                  { Makrozwischenspeicher... }
begin
  hdp := THeader.Create;
  ReadHeader(hdp,hds,true);
  if hds>1 then begin
    fn:=TempS(dbReadInt(mbase,'msgsize')+1000);
    assign(f,fn);
    rewrite(f,1);
    XreadF(0,f);
    seek(f,hds);
    truncate(f);
    close(f);
    lm:=listmakros;                                   { Aktuelle Makros merken,       }
    listmakros:=16;                                   { Archivviewermakros aktivieren }
    ListFile(fn,getres(460),true,false,false,0);      { 'Nachrichten-Header' }
    listmakros:=lm;                                   { wieder alte Makros benutzen   }
    _era(fn);
    end;
  Hdp.Free;
end;


{ Es wird nicht im Temp-, sondern im XP-Verzeichnis entpackt! }
{ exdir='' -> Lister/ArcViewer;  exdir<>'' -> Xtrakt          }
{ Fehler -> exdir:=''                                         }

procedure ShowArch(const fn:string);
var decomp : string;
    p      : byte;
    datei  : string;
    newarc : longint;
    atyp   : shortint;
    spath  : string;
    ats    : shortint;
  MessageViewer: TMessageViewer;
begin
  MessageViewer := TMessageViewer.Create;
  ats:=arctyp_save;
  atyp:=abuf[arcbufp].arcer_typ;
  if atyp>arctypes then exit;  { ??? }
  if not getDecomp(atyp,decomp) then
    exdir:=''
  else begin
    p:=pos('$DATEI',UpperCase(decomp));
    datei:=trim(mid(fn, 80));
    if (exdir='') and ((temppath='') or (UpperCase(temppath)=ownpath))
      and FileExists(datei) then begin
        rfehler(428);   { 'extrahieren nicht moeglich - bitte Temp-Verzeichnis angeben!' }
        exit;
        end
    else if ((exdir<>'') and FileExists(exdir+datei)) or
            ((exdir='') and FileExists(temppath+datei)) then
      if exdir=ownpath then begin
        rfehler(429);  { 'Datei schon vorhanden - bitte Extrakt-Verzeichnis angeben!' }
        exit;
        end
      else
        if not ReadJN(getreps(461,fitpath(exdir+datei,40)),false)  { '%s existiert schon. ueberschreiben' }
        then exit
        else
          _era(iifs(exdir<>'',exdir,temppath)+datei);
    spath:=ShellPath;
    if exdir<>'' then SetCurrentDir(exdir)
    else SetCurrentDir(temppath);
    decomp:=copy(decomp,1,p-1)+datei+copy(decomp,p+6,127);
    p:=pos('$ARCHIV',UpperCase(decomp));
    decomp:=copy(decomp,1,p-1)+'"'+abuf[arcbufp].arcname+'" "' + copy(decomp,p+8,127)+'"';
    shell(decomp,400,3);
    if exdir='' then begin
      { !?! GoDir(temppath); }    { wurde durch Shell zurueckgesetzt }
      if not FileExists(temppath+datei) then
        rfehler(430)       { 'Datei wurde nicht korrekt entpackt.' }
      else begin
        newarc:=ArcType(TempPath+datei);
        if ArcRestricted(newarc) then newarc:=0;
        if newarc=0 then
        begin
         MessageViewer.GetFromExtension(ExtractFileExt(datei));
//          if MessageViewer.IsInternal then TestGifLbmEtc(datei,false,viewer);
          if MessageViewer.IsInternal then
            ListFile(TempPath+datei,datei,true,false,false,0)
          else
            MessageViewer.ViewFile(TempPath+datei,false);
          end
        else
          if arcbufp=max_arc then
            rfehler(432)   { 'Maximal 3 verschachtelte Archive moeglich!' }
          else begin
            decomp:=TempPath+datei;  { Stack sparen ... }
            if ViewArchive(decomp,newarc)<>0 then; 
        end;
        SafeDeleteFile(temppath+datei);
        end;
      { GoDir(OwnPath); }
      end;
    ShellPath:=spath;
    end;
  arctyp_save:=ats;
  attrtxt(col.colarcstat);
  wrt(77,4,arcname[ats]);
  keyboard(keydown);
  MessageViewer.Free;
end;


function a_getfilename(nr,nn:byte):string;
var fn   : string;
    sex  : string;
begin
//!!  fn:=trim(copy(get_selection,2,12));
  sex:=exdir; exdir:=TempPath;
  ShowArch(fn);
  exdir:=sex;
  a_getfilename:=TempPath+fn;
end;


procedure ArcSpecial(LSelf: TLister; var t:taste);
var s   : string;
    dp  : string;
    x,y : Integer;
    brk : boolean;
    fk  : string;
    sex : string;
    dd  : string;
begin
  if UpperCase(t)='X' then begin
    dp:=ExtractPath;
    dd:=getres(463);
    dialog(47+length(dd),3,getres(462),x,y);   { 'Extrakt' }
    maddstring(3,2,dd,dp,40,79,'');
    readmask(brk);
    enddialog;
    if brk then exit;
    UpString(dp);
    dp := IncludeTrailingPathDelimiter(dp);
    if not validfilename(dp+'test.$$1') then
      rfehler(433)   { 'ungueltiges Verzeichnis' }
    else begin
      sex:=exdir;
      exdir:=dp;
      s:=LSelf.FirstMarked;
      while (s<>#0) and (exdir<>'') do begin
        ShowArch(s);
        s:=LSelf.NextMarked;
        end;
      exdir:=sex;
      end;
    end
  else begin
    getfilename:=a_getfilename;
    fk:=clearkeybuf;  //forwardkeys; forwardkeys:='';
    if test_fkeys(t) then;
    keyboard(fk);
    xp1o.listext(LSelf, t);
    end;
end;


{ 0=Esc, 1=minus, 2=plus }

function ViewArchive(var fn:string; typ:shortint):shortint;
var
  List: TLister;
  ar   : ArchRec;
  lm   : byte;

  function dt(d,t:xpWord):string;
  begin
    dt:=formi(d and 31,2)+'.'+formi((d shr 5) and 15,2)+'.'+
        formi((d shr 9+80)mod 100,2)+'  '+
        formi(t shr 11,2)+':'+formi((t shr 5)and $3f,2)+':'+formi((t and $1f)*2,2);
  end;

  function prozent:string;
  begin
    with ar do
      if (OrgSize>0) and (OrgSize >= CompSize) then
        prozent:=strsrn(ar.CompSize/ar.OrgSize*100.0,3,1)
      else
        prozent:='     ';
  end;

  procedure renameDWC;
  var f  : file;
  begin
    assign(f,fn);
    fn:=ExtractFilePath(fn) +'temp$$.dwc';
    rename(f,fn);
  end;

begin
  if abs(typ)=ArcDWC then
    renameDWC;
  List := TLister.CreateWithOptions(1,ScreenWidth,5,screenlines-fnkeylines-1,1,'/NS/SB/M/NLR/');
  OpenArchive(fn,typ,ar);
  List.OnEnter := ShowArch;
  List.OnKeypressed := ArcSpecial;
  showkeys(11);
  attrtxt(col.colarcstat);
  mwrt(1,4,forms(getres(464), ScreenWidth));   { ' Name            OrgGroesse CompGroesse    %    Methode    Datum    Uhrzeit' }
  inc(arcbufp);
  with ar do begin
    arctyp_save:=arctyp;
    abuf[arcbufp].arcer_typ:=arctyp;
    abuf[arcbufp].arcname:=fn;
    mwrt(77,4,arcname[arctyp]);
    while not ende do begin
      if (name<>'') or (path='') then
        List.AddLine(iifc(path<>'','*',' ')+forms(name,12)+strsn(orgsize,11)+
              strsn(compsize,11)+'   '+ prozent+'  '+forms(method,10)+
              dt(datum,uhrzeit)+'       ' + name)
      else
        List.AddLine(forms('*'+path+name,80)+path+name);
      ArcNext(ar);
      end;
    end;
  CloseArchive(ar);

  exdir:='';
  llh:=true; listexit:=0;
  lm:=ListMakros; ListMakros:=16;
  pushhp(67);
  List.Show;
  pophp;
  ListMakros:=lm;
  dec(arcbufp);
  List.Free;
  attrtxt(col.colkeys);
  mwrt(1,2,sp(ScreenWidth));
  showlastkeys;
  if abs(typ)=ArcDWC then
    _era(fn);
  aufbau:=true;
  ViewArchive:=listexit;
end;

procedure FileArcViewer(fn:string);
var useclip : boolean;
    arc     : shortint;
    lm      : byte;
    ende    : boolean;
begin
  if (fn='') or multipos('?*',fn) then begin
    if fn='' then fn:=WildCard;
    useclip:=false;
    if not ReadFilename(getres(465),fn,true,useclip) then   { 'Archivdatei' }
      exit;
    fn:=ExpandFileName(fn);
    end;
  if FileExists(fn) then begin
    arc:=ArcType(fn);
    if ArcRestricted(arc) then arc:=0;
    if arc=0 then begin                                 { Wenns kein Archiv war...      }
      lm:=listmakros;
      listmakros:=16;                                   { Archivviewermacros benutzen!  }
      repeat
        if listfile(fn,fn,true,false,false, 0) = -4 then ende:=false
        else ende:=true;                                { und File einfach nur anzeigen }
      until ende;
      listmakros:=lm;
      end
      { rfehler(434)  } { 'keine Archivdatei' }
    else
      if ViewArchive(fn,arc)=0 then;
    end
  else
    rfehler(22);     { 'Datei ist nicht vorhanden!' }
end;


procedure DupeKill(autodupekill:boolean);
var d     : DB;
    f1,f2 : file;
    n,ll  : longint;
    x,y   : Integer;
    last,
    next  : string;
    flags : byte;
    log   : text;
    rec,rec2 : longint;
    brk: boolean;

  procedure show;
  begin
    wrt(x+22,y+3,strsn(n,7));
    wrt(x+22,y+4,strsn(ll,7));
  end;

  procedure log_it;
  var _brett : string;
  begin
    _brett := dbReadStr(d,'brett');
    write(log,fdat(longdat(dbReadInt(d,'origdatum'))),' ');
    if FirstChar(_brett)='U' then
      write(log,forms(dbReadStr(d,'absender'),32))
    else begin
      dbSeek(bbase,biIntnr,copy(_brett,2,4));
      if dbFound then write(log,forms(copy(dbReadStrN(bbase,bb_brettname),2,40),32));
      end;
    writeln(log,' ',LeftStr(dbReadStr(d,'betreff'),37));
  end;

begin
  if diskfree(0)<_filesize(MsgFile+dbExt)*2 then begin
    rfehler(435);   { 'zu wenig Festplatten-Platz' }
    exit;
    end;
  message(getres2(466,1));   { 'Nachrichtendatei kopieren...' }
  dbTempClose(mbase);
  assign(f1,MsgFile+dbExt);  reset(f1,1);
  assign(f2,DupeFile+dbExt); rewrite(f2,1);
  fmove(f1,f2);
  close(f1);
  close(f2);
  SafeDeleteFile(DupeFile+dbIxExt);
  closebox;
  dbOpen(d,DupeFile,1);   { indizieren }
  n:=1; ll:=0;
  msgbox(32,8,getres2(466,2),x,y);   { 'DupeKill' }
  wrt(x+3,y+2,getres2(466,3));       { 'Nachrichten gesamt:' }
  wrt(x+3,y+3,getres2(466,4));       { '        bearbeitet:' }
  wrt(x+3,y+4,getres2(466,5));       { '         geloescht:' }
  attrtxt(col.colmboxhigh);
  wrt(x+22,y+2,strsn(dbRecCount(d),7));
  assign(log,logpath+DupeLogfile);
  if existf(log) then append(log)
  else rewrite(log);
  writeln(log,getres2(466,6)+date+getres2(466,7)+time);   { 'DupeKill gestartet am ' / ' um ' }
  last:='';
  dbGoTop(d);
  brk := false;
  while not brk and not dbEOF(d) and (dbReadInt(d,'halteflags')=0) do
  begin
    show;
    repeat
      inc(n);
      next:=dbReadStr(d,'brett')+dbLongStr(dbReadInt(d,'origdatum'))+dbReadStr(d,'msgid');
      if (length(next)>10) and (next=last) and (dbReadInt(d,'unversandt') and 1=0)
      then begin
        dbRead(d,'HalteFlags',flags);
        rec:=dbRecno(d);
        dbSkip(d,1); rec2:=dbRecno(d);
        dbGo(d,rec);
        flags:=2;
        dbWrite(d,'HalteFlags',flags);
        log_it;
        dbGo(d,rec2);
        inc(ll);
        end
      else
        dbSkip(d,1);
      Testbrk(brk);
    until (next<>last) or dbEOF(d);
    last:=next;
  end;
  dbClose(d);
  DeleteFile(MsgFile+dbExt);
  assign(f1,DupeFile+dbExt); rename(f1,MsgFile+dbExt);
  DeleteFile(DupeFile+dbIxExt);
  writeln(log);
  close(log);
  dbTempOpen(mbase);
  if not autodupekill then
  begin
    signal;
    attrtxt(col.colmbox);
    wrt(x+2,y+6,' '+getres(12){+' '#8});
    wait(curon);
  end;
  closebox;
  freeres;
  aufbau:=true; xaufbau:=true;
end;

//Wartung/Komplett
procedure CompleteMaintenance;
var brk: boolean;
begin
  if true and(not brk) then
    DupeKill(true);

  if true and(not brk) then
  begin
    MsgReorgScan(true,false,brk);
    if not brk then
      MsgReorg;
  end;

  if true and(not brk) then
    PackAll(false);

  if true and(not brk) then
    BU_reorg(false,false,true);

  if true and(not brk) then
    BU_reorg(true,true,true);

  if true and(not brk) then
    BU_reorg(true,false,true);
    
  aufbau := true;
end;

procedure print_msg(initpr:boolean);
var t  : text;
    fn : string;
    s  : string;
begin
  if dbReadInt(mbase,'typ')=ord('B') then
    rfehler(436)   { 'Drucken nicht moeglich - Binaernachricht' }
  else begin
    fn:=TempS(dbReadInt(mbase,'groesse')+1000);
    extract_msg(1,'',fn,false,1);
    assign(t,fn);
    if existf(t) then begin
      if initpr then begin
        rmessage(119);
        initprinter;
        end;
      if checklst then begin
        reset(t);
        while not eof(t) do begin
          readln(t,s);
          printline(s);
          end;
        close(t);
        erase(t);
        end;
      if initpr then begin
        exitprinter;
        mdelay(200);
        closebox;
        end;
      end;
    end;
end;


Procedure Brettmarksuche;
var   x,y     : Integer;
      brk     : boolean;
      nn,n,nf : longint;
      suchst, bname   : string;
      rec     : longint;
      m1,m2,j : longint;
      found, found_not : boolean;
begin
  SuchSt := '';
  rec:=dbRecno(bbase);
  if not Suche(getres2(467,5),'#','') then exit;
  diabox(52,7,getres2(467,5),x,y);   { 'Brett-(markier)-Suche' }
  brk:=false;
  m1:=maxlongint;
  attrtxt(col.coldialog);
  wrt(x+3,y+4,getres2(467,3));   { 'Suchen...     %        gefunden:' }
  nn:=dbRecCount(bbase); n:=0; nf:=0;
  dbGoTop(bbase);
  attrtxt(col.coldiahigh);
  while not dbEOF(bbase) and not brk do
  begin
    inc(n);
    FWrt(x+13, y+4, Format('%3d', [n*100 div nn]));
    FWrt(x+35, y+4, Format('%4d', [nf]));
    bname := dbReadNStr(bbase,bb_brettname);
    j:=0;
    repeat
      suchst:= LeftStr(copy(sst,seekstart[j],seeklen[j]),40);
      found:=((igcase and (pos(suchst,UpperCase(bname))>0)) or
       (not igcase and (pos(suchst,bname)>0)));
      found_not:=found and seeknot[j];
      if suchand and not found and seeknot[j] then found:=true;
      inc(j);
    until (j=suchanz) or (suchand xor found) or found_not;
    if found_not then found:=false;
    if found then
    begin
      UBAddmark(dbRecno(bbase));
      dbreadN(bbase,bb_index,m2);
      if m2<m1 then
      begin
        m1:=m2;
        rec:=dbRecno(bbase);
      end;
      inc(nf);
    end;
    dbNext(bbase);
    if n mod 16=0 then testbrk(brk);
  end;
  dbGo(bbase,rec);
  aufbau:=true;
  closebox;
  if not brk and (nf=0) then fehler(getres2(467,6));  { 'keine passenden User gefunden' }
  freeres;
end;




{ Ausgabe true -> UserMode umschalten }

function UserMarkSuche(allmode:boolean):boolean;
var   suchst  : string;
var   x,y     : Integer;
      brk     : boolean;
      nn,n,nf : longint;
      uname,
      sname   : string;
      rec     : longint;
      mi,j    : shortint;
      found, found_not : boolean;
begin
  UserMarkSuche:=false;
  rec:=dbRecno(ubase);
  if not Suche(getres2(467,1),'#','') then exit;
  diabox(52,7,getres2(467,1),x,y);   { 'User-(markier)-Suche' }
  brk:=false;
  sname:=#255;
  attrtxt(col.coldialog);
  wrt(x+3,y+4,getres2(467,3));   { 'Suchen...     %        gefunden:' }
  nn:=dbRecCount(ubase); n:=0; nf:=0;
  mi:=dbGetIndex(ubase); dbSetIndex(ubase,0);
  dbGoTop(ubase);
  attrtxt(col.coldiahigh);
  while not dbEOF(ubase) and not brk do begin
    inc(n);
    FWrt(x+13, y+4, Format('%3d', [n*100 div nn]));
    FWrt(x+35, y+4, Format('%4d', [nf]));
    UName := dbReadNStr(ubase,ub_username);
    j:=0;
    repeat
      suchst:= LeftStr(copy(sst,seekstart[j],seeklen[j]),40);
      found:=((igcase and (pos(suchst,UpperCase(uname))>0)) or
       (not igcase and (pos(suchst,uname)>0)));
      found_not:=found and seeknot[j];
      if suchand and not found and seeknot[j] then found:=true;
      inc(j);
    until (j=suchanz) or (suchand xor found) or found_not;
    if found_not then found:=false;
    if found then begin
      UBAddmark(dbRecno(ubase));
      if not allmode and (dbReadInt(ubase,'adrbuch')=0) then
        UserMarkSuche:=true;
      if uname<sname then begin
        sname:=uname;
        rec:=dbRecno(ubase);
      end;
      inc(nf);
    end;
    dbNext(ubase);
    if n mod 16=0 then testbrk(brk);
  end;
  dbSetIndex(ubase,mi);
  dbGo(ubase,rec);
  aufbau:=true;
  closebox;
  if not brk and (nf=0) then fehler(getres2(467,4));  { 'keine passenden User gefunden' }
  freeres;
end;


procedure BrettInfo;
var i   : longint;
    x,y : Integer;
    brk : boolean;
begin
  dbReadN(bbase,bb_index,i);
  message(getres(468)+': '+strs(i));   { 'Brettindex-Nr.' }
  wait(curoff);
  closebox;
  if lastkey=' ' then begin
    dialog(30,1,'',x,y);
    maddint(3,1,getres(468)+' ',i,6,8,0,99999999);
    readmask(brk);
    enddialog;
    if not brk then begin
      dbWriteN(bbase,bb_index,i);
      aufbau:=true;
      end;
    end;
end;


procedure NtInfo;
var mnt : eNetz;  //longint;
    nts : string;
begin
  mnt := dbNetztyp(mbase);  //dbReadN(mbase,mb_netztyp,mnt);
  nts:=' ('+ntName(mnt)+')';
  message(getres(469)+strs(ord(mnt))+nts);   { 'Netztyp: ' }
  wait(curoff);
  closebox;
end;


procedure do_bseek(fwd:boolean);
begin
  repeat
    if fwd then dbSkip(bbase,1)
    else dbSkip(bbase,-1);
  until dbBOF(bbase) or dbEOF(bbase) or brettok(false);
end;


procedure FidoMsgRequest(var nnode:string);
var files    : string;
    ic,id,
    k,p      : byte;
    p1,s,s1,t,u : string;
    v        : char;
    node     : string;
    secondtry,
    mark,
    lMagics  : boolean;
    dir, name, ext: string;
begin
  nnode := '';
  if not LastLister.Selbar and (LastLister.SelCount=0) then begin
    rfehler(438);   { 'keine Dateien markiert' }
    exit
  end;
  if not TestNodelist or not TestDefbox then exit;
  s := FMsgReqnode;
  p := cpos('.',s);
  if (p>0) then node:=LeftStr(s,p-1)
    else node:=s;
  files := '';
  u := ''; t := '';
  lMagics := Magics;
  secondtry:=false;
  s := LastLister.FirstMarked;
  repeat
    { Von Anfang an leer oder Liste komplett durchlaufen und nichts gefunden,
      dann probieren wir's nochmal mit MAGICS }
    if (s=#0) then begin
      secondtry:=true;
      s := LastLister.FirstMarked;
      lMagics:=true;
    end;
    while (s<>#0) do begin
      { --- komplett neu:oh (aus MultiReq uebernommen) --->> }
{     if (s='') then lMagics:=false; }

      { Usernamen vor Quotes killen }
      k:=cPos('>',s);
      if (k>0) then if (k<6) then delete(s,1,k);

      k:=0;
      if (s<>'') then
      while (k<byte(FirstChar(s))) do begin
        t:=''; v:=#0;
        { Nach dem ersten erlaubten Zeichen suchen }
        while (Length(s)>0)
        and not (FirstChar(s) in ['a'..'z','A'..'Z','0'..'9','@','!','$','^']) do begin
            v:=s[1];
            delete(s,1,1);
          continue
        end;
        { Vor dem Dateinamen muss ein Trennzeichen stehen }
        if (v<>#0) then if not (v in [#32,'"','<','>','Ż','Ž','(','[','{',',',';',':','_','*']) then begin
          while (Length(s)>0)
          and not (s[1] in [#32,'"','<','>','Ż','Ž','(','[','{','_','*']) do begin
            delete(s,1,1);
            continue
          end;
          continue
        end;
        mark:=false;
        if (v<>#0) then if (v='*') or (v='_') then mark:=true;
        k:=1; { erstes Zeichen ist schon ok, also Rest testen }
        while (k<Length(s))
        and (s[k+1] in ['a'..'z','A'..'Z','0'..'9','_','@','.','!','/','?','*',
                        '$','%','-']) do inc(k);
        t:=copy(s,1,k);
        u:=UpperCase(t);
        delete(s,1,Length(t));
        { Auf den Dateinamen muss ein Trennzeichen folgen }
        if (Length(s)>0) then if not (s[1] in [#32,'"','<','>','Ż','Ž',')',']','}',',',';',':','_','*']) then continue;

        if (mark and (LastChar(t) in ['_','*'])) then DeleteLastChar(t);

        while LastChar(t) in ['.','!','?','/'] do DeleteLastChar(t);
        if (Length(t)<2) then continue;
        k:=0;
        for ic:=1 to Length(t) do if t[ic]='.' then inc(k);
        if (k>1) then continue;
        if (pos('**',t)>0) then continue;
        if not lMagics then if (cPos('.',t)<3) and (Length(t)<5) then continue;

        { Passwort suchen, erkennen und speichern }
        p1:='';
        ic:=cPos('/',t); if (ic>0) then begin
          p1:=copy(t,ic,20); delete(t,ic,99)
        end;

        u:=UpperCase(t);
        if (length(u)<2) then continue;
        s1:=u;
        if (s1='S0') or (s1='XP') then continue;
        if (s1='ZMH') or (s1='NMH') then continue;
        if (s1='V.FC') or (s1='VFC') then continue;
        if (s1='ISDN') or (s1='USR') then continue;
        if (s1='FQDN') or (s1='INC') then continue;
        if (s1='IMHO') or (s1='YMMV') then continue;
        if (s1='ORG') or (s1='PGP') then continue;
        if (s1='FAQ') or (s1='OS') then continue;
        if (s1='DOS') then continue;
        if (length(s1)=3) then if (copy(s1,1,2)='RC') and (s1[3] in ['0'..'9']) then continue;
        ic:=cPos('@',t); if (ic>1) and (ic<>Length(t)) then continue;

        { Auf Beschreibungs-Datei testen }
        FSplit(u,dir,name,ext);
        if (ext='.DIZ') then continue;
        if (name='FILES') or (name='FILE_ID') or (name='00GLOBAL')
          or (name='DESCRIPT') then continue;

        { Ist der String eine Versionsnummer? V42.3, 1.0, X75, V34B etc. }
        if (Length(t)<8) then begin
          u:=t;
          if (UpperCase(copy(u,1,3))='VOL') then delete(u,1,3);
          if (UpCase(u[1]) in ['V','X']) then delete(u,1,1);
          id:=0;
          for ic:=1 to length(u) do if not (UpCase(u[ic]) in ['0'..'9','.','A','B','G']) then id:=1;
          if (id=0) then continue
        end;

        { Ist der String eine Baudrate oder Dateigroesse? xx.xK, x in  [0..9] }
        if (length(t)<10) then begin
          u:=Uppercase(t);
          { Zahl }
          while ((u<>'') and (u[1] in ['0'..'9'])) do delete(u,1,1);
          { . }
          if (u<>'') then if (u[1]='.') then begin
            delete(u,1,1);
            { Zahl }
            while (u<>'') and (u[1] in ['0'..'9']) do delete(u,1,1);
          end;
          if (u='K') or (u='KB')
            or (u='M') or (u='MB')
            or (u='B') or (u='BYTES')
          then continue;
        end;

        { Telefonnummern ausblenden }
        id:=0;
        for ic:=1 to length(u) do if not (u[ic] in ['0'..'9','-','/','+','(',')']) then id:=1;
        if (id=0) then continue;

        if (lMagics) then if (Uppercase(t)=t) then begin
          files:=files+' '+t;
          continue
        end;
        u := Uppercase(t);
        ic := cPos('.',u); if not (ic in [2..9]) then continue;
        if (length(u)<4) then continue;
        if (length(u)-ic>3) then continue;
        if (p1<>'') then u:=u+p1; p1:='';
        files:=files+' '+u;
        continue
      end; { while (k<byte(s[0])) }
      { <<--- komplett neu:oh (aus MultiReq uebernommen) --- }
      s:=LastLister.NextMarked;
    end; { while (s<>#0) do begin }
    files:=trim(files);
    { Abbrechen, wenn was gefunden, oder zweiter Durchlauf oder schon beim
      ersten mal MAGICS an waren und ein zweiter Durchlauf unnoetig ist }
  until ((files<>'') or secondtry or lmagics);
  if (files='') then
    rfehler(438)    { 'keine Dateien markiert' }
  else
    nnode:=FidoRequest(node,files);
end;


function _killit(ask:boolean):boolean;
var uv     : byte;
    _brett : string;
begin
  _killit:=false;
  dbReadN(mbase,mb_unversandt,uv);
  if uv and 1<>0 then
    rfehler(439)   { 'Unversandte Nachricht mit "Nachricht/Unversandt/Loeschen" loeschen!' }
  else
    if not ask or ReadJN(getres(470)+   { 'Nachricht loeschen' }
      iifs(KK and HasRef,getres(471),''),true) then
    begin                            { ' (unterbricht Bezugsverkettung)' }
      if msgmarked then
        msgUnmark;
      wrkilled;
      _brett := dbReadStrN(mbase,mb_brett);
      DelBezug;
      dbDelete(mbase);
      if FirstChar(_brett)<>'U' then RereadBrettdatum(_brett);
      _killit:=true;
      aufbau:=true; xaufbau:=true;
      setbrettgelesen(_brett);
      end;
end;



{
  $Log: xp4o.pas,v $
  Revision 1.169  2004/01/18 19:58:38  mk
  - changed ^file to file

  Revision 1.168  2004/01/18 15:06:12  mk
  - use WildCard instead of * or *.*

  Revision 1.167  2004/01/17 16:33:44  mk
  - split xp0.pas in xp0.pas and xpconst.pas to remove some dependencies
    xpconst.pas should be used for global constants (only!)

  Revision 1.166  2003/11/09 14:35:12  mk
  - fixed access of false ressources while /Wartung/Komplett in CompleteMaintainance

  Revision 1.165  2003/11/02 12:07:06  cl
  - BUGFIX: range check error during reorganisation with defective database,
    see <news:8x4D6qprpVB@centermail.net>

  Revision 1.164  2003/10/21 21:25:04  cl
  - Changed THeader.MIME to use TMimeContentType and TMimeDisposition objects
  - Changed MausTausch headers for Maus-internal IDs: MID/BEZ => maus_*, org_* => MID/BEZ,

  Revision 1.163  2003/10/18 17:14:45  mk
  - persistent open database boxenfile (DB: boxbase)

  Revision 1.162  2003/09/29 18:26:17  mk
  - create .mid in client directory
    fixes #810685: Message-ID suchen (ALT+M)

  Revision 1.161  2003/09/17 15:28:06  mk
  - fixed drawing of status line in archiv viewer for screen width > 80

  Revision 1.160  2003/08/28 14:13:01  mk
  - TUniSelType for UniSel instead of numeric constants

  Revision 1.159  2003/08/23 23:02:35  mk
  - removed hints and warnings

  Revision 1.158  2003/08/23 17:36:47  mk
  - improved adding of new message ids

  Revision 1.157  2003/04/25 21:11:17  mk
  - added Headeronly and MessageID request
    toggle with "m" in message view

  Revision 1.156  2003/04/13 17:36:42  mk
  - purge old mail one day faster than before (same as OpenXP 3.40)

  Revision 1.155  2003/01/28 10:42:25  cl
  - Added statistical SPAM filter

  Revision 1.154  2003/01/07 00:56:46  cl
  - send window rewrite -- part II:
    . added support for Reply-To/(Mail-)Followup-To
    . added support to add addresses from quoted message/group list/user list

  - new address handling -- part II:
    . added support for extended Reply-To syntax (multiple addresses and group syntax)
    . added support for Mail-Followup-To, Mail-Reply-To (incoming)

  - changed "reply-to-all":
    . different default for Ctrl-P and Ctrl-B
    . more addresses can be added directly from send window

  Revision 1.153  2002/12/28 20:11:05  dodi
  - start keyboard input redesign

  Revision 1.152  2002/12/21 05:37:57  dodi
  - removed questionable references to Word type

  Revision 1.151  2002/12/14 07:31:34  dodi
  - using new types

  Revision 1.150  2002/12/12 11:58:46  dodi
  - set $WRITEABLECONT OFF

  Revision 1.149  2002/12/09 14:37:21  dodi
  - merged include files, updated comments

  Revision 1.148  2002/12/06 14:27:28  dodi
  - updated uses, comments and todos

  Revision 1.147  2002/12/02 14:04:30  dodi
  made xpmenu internal tool

  Revision 1.146  2002/09/09 08:33:53  mk
  - some performance improvements

  Revision 1.145  2002/08/01 20:46:46  mk
  - fixed range check error, ansistring suchopt can be empty

  Revision 1.144  2002/07/29 07:17:20  mk
  - fixed AnsiString[1] to FirstChar(AnsiString)

  Revision 1.143  2002/07/26 08:19:25  mk
  - MarkedList is now a dynamically created list, instead of a fixed array,
    removes limit of 5000 selected messages

  Revision 1.142  2002/07/25 20:43:55  ma
  - updated copyright notices

  Revision 1.141  2002/07/22 09:58:46  mk
  - added missing CloseBox in SucheWiedervorlage

  Revision 1.140  2002/07/18 01:11:57  mk
  - fixed potential AV with mbrettd calls

  Revision 1.139  2002/04/14 22:25:36  cl
  - added Wartung/Komplett
  - changes for new address handling

  Revision 1.138  2002/04/13 22:22:59  mk
  - fixed Bug #497283, MsgID-Suche kaputt

  Revision 1.137  2002/03/02 14:29:53  mk
  - fixed regex search

  Revision 1.136  2002/02/21 13:52:32  mk
  - removed 21 hints and 28 warnings

  Revision 1.135  2002/02/18 16:59:40  cl
  - TYP: MIME no longer used for RFC and not written into database

  Revision 1.134  2002/02/10 18:49:50  mk
  - fixes misc bugs in Suche()

  Revision 1.133  2002/02/10 13:10:25  mk
  - fixed several ANSIString dbReadN

  Revision 1.132  2002/02/04 17:26:36  mk
  - after merge fixes

  Revision 1.131  2002/01/30 17:34:14  mk
  - use absolute FieldConsts in dbReadX

  Revision 1.130  2002/01/28 20:32:25  mk
  - completed 3.40 merge, source is compilable for dos and win
    linux is still untested

  Revision 1.129  2002/01/22 19:15:29  mk
  - after 3.40 merge fixes

  Revision 1.128  2002/01/13 15:15:52  mk
  - new "empfaenger"-handling

  Revision 1.127  2002/01/13 15:07:30  mk
  - Big 3.40 Update Part I

  Revision 1.126  2002/01/03 19:19:13  cl
  - added and improved UTF-8/charset switching support

  Revision 1.125  2001/12/31 16:24:33  mk
  - removed unused variable

  Revision 1.124  2001/12/30 19:56:48  cl
  - Kylix 2 compile fixes

  Revision 1.123  2001/12/26 01:35:31  cl
  - renamed SaveDeleteFile --> SafeDeleteFile (cf. an English dictionary)

  Revision 1.122  2001/11/11 00:47:14  ma
  - added temporary debug log

  Revision 1.121  2001/10/24 08:18:05  mk
  - fixed two range check errors

  Revision 1.120  2001/10/20 17:26:41  mk
  - changed some Word to Integer
    Word = Integer will be removed from xpglobal in a while

  Revision 1.119  2001/10/12 23:27:07  mk
  - fixed search with marked areas/users

  Revision 1.118  2001/10/11 09:00:40  mk
  - external viewer files now with correct file extension

  Revision 1.117  2001/10/10 22:04:09  mk
  - enabled use of external mime viewers again

  Revision 1.116  2001/09/27 21:22:26  ml
  - Kylix compatibility stage IV

  Revision 1.115  2001/09/26 23:34:20  mk
  - fixed FPC compile error with newest snapshot:
    Error: Self can only be an explicit parameter in message handlers or class methods

  Revision 1.114  2001/09/14 18:09:56  cl
  - added database info to message <i>nfo screen

  Revision 1.113  2001/09/10 15:58:02  ml
  - Kylix-compatibility (xpdefines written small)
  - removed div. hints and warnings

  Revision 1.112  2001/09/08 16:29:34  mk
  - use FirstChar/LastChar/DeleteFirstChar/DeleteLastChar when possible
  - some AnsiString fixes

  Revision 1.111  2001/09/08 14:31:31  cl
  - cleaned up MIME-related fields in THeader
  - adaptions/fixes for MIME support

  Revision 1.110  2001/09/07 13:54:21  mk
  - added SafeDeleteFile
  - moved most file extensios to constant values in XP0
  - added/changed some FileUpperCase

  Revision 1.109  2001/09/06 19:31:20  mk
  - removed some hints und warnings

  Revision 1.108  2001/09/06 18:54:35  mk
  - removed some warnings
  - formatted source
  - added comment about false compiler warning

  Revision 1.107  2001/08/31 14:44:37  mk
  - changed TxtSeek for Delphi/Kylix compatiblity

  Revision 1.106  2001/08/29 19:30:38  mk
  - added regex search for special search functions

  Revision 1.105  2001/08/28 13:24:35  mk
  - added support for regular expressions

  Revision 1.104  2001/08/27 09:13:43  ma
  - changes in net type handling (1)

  Revision 1.103  2001/08/12 11:50:40  mk
  - replaced dbRead/dbWrite with dbReadN/dbWriteN

  Revision 1.102  2001/08/11 23:06:32  mk
  - changed Pos() to cPos() when possible

  Revision 1.101  2001/08/10 20:57:58  mk
  - removed some hints and warnings
  - fixed some minior bugs

  Revision 1.100  2001/08/10 17:45:26  mk
  - fixed litte type in SucheWiedervorlage

  Revision 1.99  2001/07/30 08:41:24  ma
  - fixed: Mail header info box was displayed incorrectly

  Revision 1.98  2001/07/28 12:04:13  mk
  - removed crt unit as much as possible

  Revision 1.97  2001/07/27 18:10:12  mk
  - ported Reply-To-All from 3.40, first part, untested
  - replyto is now string instead of TStringList again

  Revision 1.96  2001/07/23 16:05:20  mk
  - added some const parameters
  - changed most screen coordinates from byte to integer (saves some kb code)

  Revision 1.95  2001/07/10 07:59:38  mk
  JG:- added search Option "u"

  Revision 1.94  2001/03/13 19:24:57  ma
  - added GPL headers, PLEASE CHECK!
  - removed unnecessary comments

  Revision 1.93  2001/01/14 10:13:34  mk
  - MakeHeader() integreated in new unit

  Revision 1.92  2001/01/05 16:07:58  mo
  -suchlen von 1000 auf 255, type byte

  Revision 1.91  2001/01/04 10:11:20  mk
  - max search length is now 1000 instead of 73

  Revision 1.90  2001/01/02 10:05:25  mk
  - implemented Header.References

  Revision 1.89  2001/01/02 09:29:38  mo
  -Kommentare hinzugefügt und ergänzt

  Revision 1.88  2001/01/01 20:17:35  mo
  -Spezialsuche in markierten Brettern -lter Satnd wieder hergesetllt

  Revision 1.87  2000/12/31 11:52:10  mk
  JG:- MsgId-Suche mit mehreren Strings

  Revision 1.86  2000/12/30 18:45:17  mo
  -Spezialsuche in markierten Bretter auch aus der Nachrichten/User Übersicht

  Revision 1.85  2000/12/26 16:40:14  mk
  - fixed fido request detection

  Revision 1.84  2000/12/25 14:02:42  mk
  - converted Lister to class TLister

  Revision 1.83  2000/12/05 14:58:10  mk
  - AddNewUser

  Revision 1.82  2000/12/03 12:38:23  mk
  - Header-Record is no an Object

  Revision 1.81  2000/11/20 20:44:05  mk
  - Suchlaenge auf 73 reduziert

  Revision 1.80  2000/11/18 21:42:18  mk
  - implemented new Viewer handling class TMessageViewer

  Revision 1.79  2000/11/18 00:04:44  fe
  Made compileable again.  (Often a suboptimal way...)

  Revision 1.78  2000/11/16 21:31:06  hd
  - DOS Unit entfernt

  Revision 1.77  2000/11/15 23:00:41  mk
  - updated for sysutils and removed dos a little bit

  Revision 1.76  2000/11/14 15:51:31  mk
  - replaced Exist() with FileExists()

  Revision 1.75  2000/11/14 11:14:33  mk
  - removed unit dos from fileio and others as far as possible

  Revision 1.74  2000/10/26 12:59:57  mk
  - Fixed Bug #112798: Lange Dateinamen in Archiven

  Revision 1.73  2000/10/26 12:06:33  mk
  - THeader.Create/FreeHeaderMem Umstellung

  Revision 1.72  2000/10/22 21:58:59  mk
  - case of .pp and .epp is now UnixFS dependent

  Revision 1.71  2000/10/19 20:52:22  mk
  - removed Unit dosx.pas

  Revision 1.70  2000/10/17 10:05:51  mk
  - Left->LeftStr, Right->RightStr

  Revision 1.69  2000/09/28 03:30:48  mk
  - AnsiString-Fixes

  Revision 1.68  2000/09/26 05:12:26  mk
  - Archivviewer AnsiString-Fix

  Revision 1.67  2000/09/25 17:56:13  mk
  - nicht aktivierter Eintrag Bretter ist jetzt richtig verschwunden

  Revision 1.66  2000/08/27 20:47:50  mk
  OH: F3-Request, ist die automatische Magic-Erkennung abgeschaltet, werden
      sie trotzdem erkannt, und zwar dann, wenn keine normalen Dateinamen gefunden
      wurden

  Revision 1.65  2000/08/22 19:48:47  mk
  - unnoetige Umlautkonvertierung entfernt

  Revision 1.64  2000/08/09 13:27:55  mk
  - Ungelesen Bug beim (K)illen von Nachrichten aus der Markiert-Liste behoben

  Revision 1.63  2000/08/08 09:23:54  mk
  - Bugfixes fuer Suche

  Revision 1.62  2000/08/08 00:03:57  mk
  - TxtSeek auf Shortstring umgetsellt

  Revision 1.61  2000/08/05 10:06:58  mk
  - Ansistring Verbesserungen

  Revision 1.60  2000/08/03 00:06:47  mk
  - Crash bei leeren Suchoptionen beseitigt

  Revision 1.59  2000/07/27 10:13:02  mk
  - Video.pas Unit entfernt, da nicht mehr noetig
  - alle Referenzen auf redundante ScreenLines-Variablen in screenLines geaendert
  - an einigen Stellen die hart kodierte Bildschirmbreite in ScreenWidth geaendert
  - Dialog zur Auswahl der Zeilen/Spalten erstellt

  Revision 1.58  2000/07/23 10:01:01  mk
  - memavail wo moeglich rausgenommen

  Revision 1.57  2000/07/22 21:59:43  mk
  - Zugriff auf nicht initialisierten String beseitigt

  Revision 1.56  2000/07/22 14:05:27  hd
  - Anpassung von dbRead, dbReadN, dbReadX, dbWrite, dbWriteN, dbWriteX
    (sollte es jetzt gewesen sein)

  Revision 1.55  2000/07/21 20:56:25  mk
  - dbRead/Write in dbRead/WriteStr gewandelt, wenn mit AnsiStrings

  Revision 1.54  2000/07/21 17:39:53  mk
  - Umstellung auf AllocHeaderMem/FreeHeaderMem

  Revision 1.53  2000/07/09 08:35:17  mk
  - AnsiStrings Updates

  Revision 1.52  2000/07/06 08:58:45  hd
  - AnsiString

  Revision 1.51  2000/07/05 16:10:29  mk
  JG: - Weitersuchen bei Markierten Nachrichten: bei fehlgeschlagener Suche bleibt die alte Markierung erhalten

  Revision 1.50  2000/07/04 12:04:24  hd
  - UStr durch UpperCase ersetzt
  - LStr durch LowerCase ersetzt
  - FUStr durch FileUpperCase ersetzt
  - Sysutils hier und da nachgetragen

  Revision 1.49  2000/07/03 15:23:26  hd
  - Neue Definition: hasXCurrentDir (RTL-Fkt: GetCurrentDir, SetCurrentDir)
  - GoDir durch SetCurrentDir ersetzt

  Revision 1.48  2000/06/23 15:59:21  mk
  - 16 Bit Teile entfernt

  Revision 1.47  2000/06/17 06:18:35  jg
  - Bugfix: erfolglose Suche: Fensterhintergrund wurde nicht wiederhergestellt

  Revision 1.46  2000/06/05 16:38:51  jg
  Fix: (Suche) Stringvariable wurden vor initialisierung verwendet.

  Revision 1.45  2000/06/05 16:16:22  mk
  - 32 Bit MaxAvail-Probleme beseitigt

  Revision 1.44  2000/06/01 16:03:05  mk
  - Verschiedene Aufraeumarbeiten

  Revision 1.43  2000/05/22 15:52:55  jg
  - File-Kleinschreibungs-Bugfix: Suchoptionen

  Revision 1.42  2000/05/20 02:07:39  mk
  - 32 Bit/VP: FindFirst/FindNext aus Dos-Unit statta us SysTools verwendet

  Revision 1.41  2000/05/14 10:00:43  hd
  - Fix: SysUtils doppelt

  Revision 1.40  2000/05/14 07:22:21  mk
  - weiterer Fix fuer Debug-Modus

  Revision 1.39  2000/05/13 23:17:54  mk
  - jetzt mit FPC und Debug-Modus compilierbar

  Revision 1.38  2000/05/07 10:28:03  hd
  - Fix: (check_seekmode): wrt2 verlangt einen string, kein byte!

  Revision 1.37  2000/05/06 17:29:22  mk
  - DOS DPMI32 Portierung

  Revision 1.36  2000/05/02 19:14:01  hd
  xpcurses statt crt in den Units

  Revision 1.35  2000/04/27 16:36:09  jg
  - Nachricht/Aendern/Typ schaltet jetzt um zwischen Text,Bin und Mime

  Revision 1.34  2000/04/23 07:58:53  mk
  - OS/2-Portierung

  Revision 1.33  2000/04/22 08:32:47  jg
  - Bugfix: NOT - Verknuepfte Usersuche

  Revision 1.32  2000/04/15 18:21:33  mk
  - FindFirst-Fixes

  Revision 1.31  2000/04/13 12:48:37  mk
  - Anpassungen an Virtual Pascal
  - Fehler bei FindFirst behoben
  - Bugfixes bei 32 Bit Assembler-Routinen
  - Einige unkritische Memory Leaks beseitigt
  - Einge Write-Routinen durch Wrt/Wrt2 ersetzt
  - fehlende CVS Keywords in einigen Units hinzugefuegt
  - ZPR auf VP portiert
  - Winxp.ConsoleWrite provisorisch auf DOS/Linux portiert
  - Automatische Anpassung der Zeilenzahl an Consolengroesse in Win32

  Revision 1.30  2000/04/10 00:43:04  oh
  - F3-Request: Magicerkennung ein/ausschaltbar (C/O/e/V/Fido)

  Revision 1.29  2000/03/22 05:06:37  jg
  - Bugfix: Suchen-Spezial ohne Volltext aber mit Option "o" oder "a"
    Vorbereitung der Such Teilstrings fuehrte zu nem RTE 201.

  Revision 1.28  2000/03/21 15:22:10  jg
  - Suche: Pfeil fuer Historyauswahl kommt nur noch
    wenn auch was gewaehlt werden kann.

  Revision 1.27  2000/03/18 10:39:06  jg
  - Suche-MessageID Wahlmoeglichkeit:  schnelle Bezugs-DB Suche
    oder langsamere Msg-Base Suche mit Teilstrings und Suchoptionen

  Revision 1.26  2000/03/14 15:15:40  mk
  - Aufraeumen des Codes abgeschlossen (unbenoetigte Variablen usw.)
  - Alle 16 Bit ASM-Routinen in 32 Bit umgeschrieben
  - TPZCRC.PAS ist nicht mehr noetig, Routinen befinden sich in CRC16.PAS
  - XP_DES.ASM in XP_DES integriert
  - 32 Bit Windows Portierung (misc)
  - lauffaehig jetzt unter FPC sowohl als DOS/32 und Win/32

  Revision 1.25  2000/03/13 18:55:18  jg
  - xp4o+typeform: Ukonv in UkonvStr umbenannt
  - xp4o: Compilerschalter "History" entfernt,
          "Debugsuche" durch "Debug" ersetzt

  Revision 1.24  2000/03/09 23:39:33  mk
  - Portierung: 32 Bit Version laeuft fast vollstaendig

  Revision 1.23  2000/03/08 22:36:33  mk
  - Bugfixes fuer die 32 Bit-Version und neue ASM-Routinen

  Revision 1.22  2000/03/06 08:51:04  mk
  - OpenXP/32 ist jetzt Realitaet

  Revision 1.21  2000/03/04 18:34:18  jg
  - Externe Viewer: zum Ansehen von Fileattaches wird keine Temp-Kopie
    mehr erstellt, und nicht mehr gewartet, da kein Loeschen noetig ist

  Revision 1.20  2000/03/02 20:09:31  jg
  - NOT Operator (~) fuer Suchstrings und Such-History eingebaut

  Revision 1.19  2000/03/01 13:17:41  jg
  - Ukonv Aufrufe benutzen jetzt High() fuer Maxlaenge
  - STRG + INS funktioniert in Texteingabefeldern wie STRG+C

  Revision 1.18  2000/03/01 08:04:23  jg
  - UND/ODER Suche mit Suchoptionen "o" + "u"
    Debug-Checkfenster mit Suchoption "c"
  - Umlautkonvertierungen beruecksichtigen
    jetzt Maximalstringlaenge

  Revision 1.17  2000/02/29 17:50:40  mk
  OH: - Erkennung der Magics verbessert

  Revision 1.16  2000/02/29 12:59:16  jg
  - Bugfix: Umlautkonvertierung beachtet jetzt Originalstringlaenge
    (Wurde akut bei Spezialsuche-Betreff)

  Revision 1.15  2000/02/29 10:46:28  jg
  -Bugfix Spezialsuche - Betreff

  Revision 1.14  2000/02/23 19:11:04  jg
  -Suchfunktionen im Lister benutzen Autosuche,
   "Global_Suchstring" und dessen auswertung entfernt.
  -!Todo.txt aktualisiiert

  Revision 1.13  2000/02/22 15:51:20  jg
  Bugfix fuer "O" im Lister/Archivviewer
  Fix fuer Zusatz/Archivviewer - Achivviewer-Macros jetzt aktiv
  O, I,  ALT+M, ALT+U, ALT+V, ALT+B nur noch im Lister gueltig.
  Archivviewer-Macros gueltig im MIME-Popup

  Revision 1.12  2000/02/19 18:00:24  jg
  Bugfix zu Rev 1.9+: Suchoptionen werden nicht mehr reseted
  Umlautunabhaengige Suche kennt jetzt "‚"
  Mailadressen mit "!" und "=" werden ebenfalls erkannt

  Revision 1.11  2000/02/19 10:12:13  jg
  Bugfix Gelesenstatus aendern per F4 im ungelesen Modus

  Revision 1.10  2000/02/18 17:28:08  mk
  AF: Kommandozeilenoption Dupekill hinzugefuegt

  Revision 1.9  2000/02/18 15:54:52  jg
  Suchoptionen-Laenderabfrage verbessert

  Revision 1.8  2000/02/18 09:13:27  mk
  JG: * Volltextsuche jettz Sprachabhaengig gestaltet
      * XP3.ASM in XP3.PAS aufgenommen

  Revision 1.7  2000/02/16 15:25:32  mk
  OH: Schalter magics in FidoMsgRequest auf true gesetzt

  Revision 1.6  2000/02/15 21:19:24  mk
  JG: * Umlautkonvertierung von XP4O.Betreffsuche in Typeform verlagert
      * wenn man eine markierte Nachricht liest, wird beim Verlassen
        der Headeranzeige nicht gleich auch der Lister verlasssen
      * Die Suchfunktionen "Absender/User", "Betreff" und "Fidoempfaenger"
        koennen jetzt Umlautunabhaengig geschalten werden

  Revision 1.5  2000/02/15 20:43:36  mk
  MK: Aktualisierung auf Stand 15.02.2000

}
end.