/tags/Alpha_3_9_8/xp4o.pas

Large files files are truncated, but you can click here to view the full file

{   $Id: xp4o.pas 6395 2003-09-29 18:26:17Z mk $

    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[suchlen];
    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,
  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;
    sst   : string;   { evtl. UpString von suchstring }
    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
  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);
  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);…