/trunk/xp4o.pas
Pascal | 4422 lines | 3509 code | 231 blank | 682 comment | 475 complexity | 82439597a33e9b6db539ea369e8388a5 MD5 | raw file
Possible License(s): GPL-2.0, BSD-3-Clause
Large files files are truncated, but you can click here to view the full file
- { $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 / gewhlt }
- 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 gewhlt' }
- 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;…
Large files files are truncated, but you can click here to view the full file