telegard/mail5.pas

729 lines
22 KiB
ObjectPascal

{$A+,B+,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit mail5;
interface
uses
crt, dos,
{rcg11172000 no overlay under Linux.}
{overlay,}
common, timejunk,
sysop4,
mail0, mail1, mail2, mail3, mail4, mail6;
procedure post(replyto:longint; ttoi:fromtoinfo);
procedure scanmessages;
procedure qscan(b:integer; var quit:boolean);
procedure gnscan;
procedure nscan(mstr:string);
implementation
procedure post(replyto:longint; ttoi:fromtoinfo);
var pinfo:pinforec;
mheader:mheaderrec;
mixr,mixr2:msgindexrec;
saveit:string;
itreepos,lng,otreepos:longint;
i:integer;
numread:word;
savilevel:byte;
ok:boolean;
procedure nope(s:string);
begin
if (ok) then begin nl; print(s); end;
ok:=FALSE;
end;
begin
ok:=TRUE;
loadboard(board);
if (not aacs(memboard.postacs)) then
nope('Your access does not allow you to post on this board.');
if ((rpost in thisuser.ac) or (not aacs(systat.normpubpost))) then
nope('Your access privledges do not include posting.');
if ((ptoday>=systat.maxpubpost) and (not mso)) then
nope('Too many messages posted today.');
if (ok) then begin
savepinfo(pinfo);
initbrd(board);
saveit:='';
if (replyto<>-1) then begin
mheader.toi:=ttoi;
if (mheader.toi.anon<>0) then begin
saveit:=mheader.toi.as;
mheader.toi.as:=what00(mheader.toi.anon,mheader.toi.as);
end;
end else
mheader.toi.as:='';
if (inmsg(TRUE,(replyto<>-1),'',mixr,mheader)) then begin
if (saveit<>'') then mheader.toi.as:=saveit;
seek(brdf,mixr.hdrptr);
savemhead(mheader);
if (replyto<>-1) then begin
mixr.isreplyto:=replyto;
mixr.numreplys:=0;
mixr.msgindexstat:=mixr.msgindexstat+[mithreads];
ensureloaded(replyto);
mixr2:=mintab[getmixnum(replyto)];
mixr.isreplytoid:=mixr2.msgid;
inc(mixr2.numreplys);
mixr2.msgindexstat:=mixr2.msgindexstat+[mithreads];
ensureloaded(replyto);
savemix(mixr2,replyto);
ensureloaded(replyto);
end;
newmix(mixr);
ensureloaded(himsg);
sysoplog('+ "'+mheader.title+'" posted on '+#3#5+memboard.name);
if (mheader.toi.as<>'') then sysoplog(' To: "'+mheader.toi.as+'"');
topscr;
sprint(#3#9+'Message posted on '+#3#5+memboard.name+#3#9+'.');
inc(thisuser.msgpost);
inc(ptoday);
inc(systat.todayzlog.pubpost);
end;
loadpinfo(pinfo);
end;
end;
function isnew1(msgdatepp:packdatetimepp):boolean;
var msgdate:packdatetime;
l1,l2,l3:longint;
function zzzb(xx,yy:longint):longint;
begin xx:=xx shl yy; zzzb:=xx; end;
begin
msgdate:=msgdatepp^;
isnew1:=FALSE;
with zscanr do begin
l1:=zzzb(msgdate[1],16);
inc(l1,zzzb(msgdate[2],8));
inc(l1,msgdate[3]);
l2:=zzzb(mhiread[board][1],16);
inc(l2,zzzb(mhiread[board][2],8));
inc(l2,mhiread[board][3]);
if (l1<l2) then exit;
if (l1=l2) then begin
l1:=zzzb(msgdate[4],16);
inc(l1,zzzb(msgdate[5],8));
inc(l1,msgdate[6]);
l2:=zzzb(mhiread[board][4],16);
inc(l2,zzzb(mhiread[board][5],8));
inc(l2,mhiread[board][6]);
if (l1<=l2) then exit;
end;
isnew1:=TRUE;
end;
end;
function isnew(cn:integer):boolean;
var mixr:msgindexrec;
begin
ensureloaded(cn);
mixr:=mintab[getmixnum(cn)];
isnew:=isnew1(@mixr.msgdate);
end;
procedure updateptr(x:word; var zup:boolean);
var mixr:msgindexrec;
l1,l2:longint;
i:integer;
begin
if (isnew(x)) then begin
ensureloaded(x);
mixr:=mintab[getmixnum(x)];
for i:=1 to 6 do zscanr.mhiread[board][i]:=mixr.msgdate[i];
zup:=TRUE;
end;
end;
procedure editmessage(i:integer);
var t:text;
f:file;
g:text;
mheader:mheaderrec;
mixr:msgindexrec;
s:string;
brdsig,dfdt1,dfdt2,newmsgptr,totload:longint;
begin
loadmhead(i,mheader);
assign(t,'tgtempx.msg'); rewrite(t);
totload:=0;
repeat
blockreadstr2(brdf,s);
inc(totload,length(s)+2);
writeln(t,s);
until (totload>=mheader.msglength);
close(t);
tedit(allcaps('tgtempx.msg'));
begin
assign(t,'tgtempx.msg');
reset(t);
mheader.msglength:=0;
repeat
readln(t,s);
inc(mheader.msglength,length(s)+2);
until (eof(t));
close(t);
newmsgptr:=filesize(brdf);
seek(brdf,newmsgptr);
outmessagetext('tgtempx.msg',mheader,TRUE);
ensureloaded(i);
mixr:=mintab[getmixnum(i)];
mixr.hdrptr:=newmsgptr;
savemix(mixr,i);
ensureloaded(i);
end;
end;
procedure pubreply(cn:word);
var t:text;
mheader:mheaderrec;
s:string;
brdsig,dfdt1,dfdt2,newmsgptr,totload:longint;
begin
if (gotlastmheader) then begin
loadmhead(cn,mheader);
assign(t,'msgtmp'); rewrite(t);
totload:=0;
repeat
blockreadstr2(brdf,s);
inc(totload,length(s)+2);
writeln(t,s);
until (totload+1>=mheader.msglength);
close(t);
post(cn,lastmheader.fromi);
assign(t,'msgtmp');
{$I-} reset(t); {$I+}
if (ioresult=0) then begin close(t); erase(t); end;
end else begin
nl; print('Can''t reply YET.'); nl;
end;
end;
type
mstype =
(msreadp, { read prompt }
msshowt, { show titles }
msreadm); { read message }
sttype =
(stnewscan, { NewScan mode }
stscan); { normal Scan mode }
procedure doscan(var quit:boolean; cn:word; st:sttype; ms:mstype);
var t:text;
u:userrec;
mheader:mheaderrec;
mixr:msgindexrec;
lastdate:packdatetime;
inp,s:string;
brdsig,getm,totload:longint;
i,j,k:integer;
cmd:char;
abort,askpost,b,contlist,donescan,hadunval,next,ufo,wasout,zup:boolean;
procedure cbounds;
begin
wasout:=((cn<0) or (cn>himsg));
if (not wasout) then exit;
if (cn>himsg) then cn:=himsg
else if (cn<0) then cn:=0;
end;
function tch(c:char; i:integer):string; (* duplicate.... MARTIN HANDLE THIS!*)
var s:string;
begin
s:=cstr(i); if (i<10) then s:=c+s;
tch:=s;
end;
procedure stitles;
var mheader:mheaderrec;
dt:ldatetimerec;
pdt:packdatetime;
s,real,alias:string;
i,j,numdone:word;
abort,ndone,next:boolean;
begin
nl;
ndone:=TRUE;
abort:=FALSE; numdone:=0;
cbounds; if (wasout) then exit;
while ((not hangup) and (not abort) and (numdone<10) and (ndone)) do begin
cbounds; if (wasout) then ndone:=FALSE;
if (ndone) then begin
loadmhead(cn,mheader); ensureloaded(cn);
i:=cn;
with mheader do begin
real:=allcaps(thisuser.realname);
alias:=allcaps(thisuser.name);
if ((fromi.usernum=usernum) or
(allcaps(copy(fromi.as,1,length(real)))=real) or
(allcaps(copy(fromi.alias,1,length(alias)))=alias)) then
s:=#3#9+'['+#3#5+cstr(i+1)+#3#9+']'
else if ((toi.usernum=usernum) or
(allcaps(copy(toi.as,1,length(real)))=real) or
(allcaps(copy(toi.alias,1,length(alias)))=alias)) then
s:=#3#9+'<'+#3#5+cstr(i+1)+#3#9+'>'
else
s:=#3#7+'('+#3#5+cstr(i+1)+#3#7+')';
end;
for j:=1 to 6 do pdt[j]:=mintab[getmixnum(cn)].msgdate[j];
pdt2dt(pdt,dt);
s:=#3#1+mrn(s,8)+#3#3+' '+mrn(cstr(dt.month),2)+'/'+
tch('0',dt.day)+'/'+copy(tch('0',dt.year),3,2)+' - ';
if (isnew(cn)) then begin
delete(s,1,3);
s:=#3#8+'*'+s;
end;
if (miunvalidated in mintab[getmixnum(cn)].msgindexstat) then begin
if (mso) then begin
delete(s,1,4);
s:=#3#8+'NV'+s;
end else
s:=s+#3#8+'<<Unvalidated>>';
end;
if ((not (miunvalidated in mintab[getmixnum(cn)].msgindexstat)) or
(mso)) then s:=s+mheader.title;
if (miallowmci in mintab[getmixnum(cn)].msgindexstat) then sprint(s)
else printacr(s,abort,next);
wkey(abort,next);
inc(numdone);
inc(cn);
end;
end;
dec(cn);
nl;
end;
procedure scaninput(var s:string; allowed:string);
var os:string;
i:integer;
c:char;
gotcmd:boolean;
begin
gotcmd:=FALSE; s:='';
repeat
getkey(c); c:=upcase(c);
os:=s;
if ((pos(c,allowed)<>0) and (s='')) then begin gotcmd:=TRUE; s:=c; end
else
if (pos(c,'0123456789')<>0) then begin
if (length(s)<5) then s:=s+c;
end
else
if ((s<>'') and (c=^H)) then s:=copy(s,1,length(s)-1)
else
if (c=^X) then begin
for i:=1 to length(s) do prompt(^H' '^H);
s:=''; os:='';
end
else
if (c=#13) then gotcmd:=TRUE;
if (length(s)<length(os)) then prompt(^H' '^H);
if (length(s)>length(os)) then prompt(copy(s,length(s),1));
until ((gotcmd) or (hangup));
nl;
end;
begin
askpost:=FALSE; contlist:=FALSE; donescan:=FALSE; hadunval:=FALSE;
zup:=FALSE;
while ((not donescan) and (not hangup)) do begin
getm:=-1;
if (ms=msshowt) then begin stitles; ms:=msreadp; end;
if (ms=msreadp) then begin
msg_on:=cn+1;
cbounds;
ensureloaded(cn);
if ((contlist) and (not abort)) then
if (cn=himsg) then abort:=TRUE;
if ((not contlist) or (abort)) then begin
if (contlist) then begin
contlist:=FALSE;
nl; print('Continuous message listing Off'); nl;
end;
sprompt(fstring.scanmessage);
scaninput(inp,'ABCDEHMPQRTVWXZ-*!&?');
end else
inp:='';
getm:=-1; cmd:=#0;
if (inp='') then getm:=cn+1 else begin
getm:=value(inp)-1;
if (getm>-1) then
if (st=stnewscan) then st:=stscan;
end;
if ((getm=-1) and (inp<>'')) then cmd:=inp[1];
case cmd of
'R':getm:=cn;
'-':begin
getm:=cn-1;
if (getm=-1) then begin
nl; sprint('Already at the first message.'); nl;
end;
if (st=stnewscan) then st:=stscan;
end;
end;
if ((getm=-1) and (cmd<>#0)) then
case cmd of
'?':begin
nl;
sprint('<^3CR^1>Next message ^3#^1:Message to read');
sprint('(^3-^1)Prev. message (^3C^1)ontinuous listing');
nl;
sprint('(^3A^1)uto-reply (pub/priv) (^3B^1)Next board in NewScan');
sprint('(^3P^1)ost public (^3H^1)igh message pointer');
sprint('(^3R^1)e-read (^3T^1)itles');
sprint('(^3W^1)rite public reply (^3Z^1)Toggle NewScan of this base');
nl;
s:='(^5E^1)dit message (owner only)';
if (mso) then
s:=s+' (^5D^1)elete message (SysOp only)';
sprint(s);
if (mso) then begin
sprint('(^5V^1)alidation toggle (^5M^1)ove msg to other base');
sprint('(^5X^1)tract message to file (^5!^1)Toggle permanence');
if (cso) then begin
s:='(^7*^1)Toggle anonymous';
if (memboard.mbtype<>0) then s:=s+' (^7&^1)Toggle scanned/outbound';
sprint(s);
end;
nl;
end;
sprint('(^3Q^1)uit');
nl;
end;
'A':begin
nl;
if pynq('Is this to be a private reply? ') then autoreply
else pubreply(cn);
end;
'B':donescan:=TRUE;
'C':begin
contlist:=TRUE; abort:=FALSE;
nl; print('Continuous message listing On'); nl;
end;
'D':if (mipermanent in mintab[getmixnum(cn)].msgindexstat) then begin
nl; print('This is a permanent message.'); nl;
end else begin
loadmhead(cn,mheader);
if ((mso) and (cn>=0) and (cn<=himsg)) then begin
delmail(cn);
nl;
if (miexist in mintab[getmixnum(cn)].msgindexstat) then begin
print('Undeleted message.');
sysoplog('* Undeleted "'+mheader.title+'"');
end else begin
print('Deleted message.');
sysoplog('* Deleted "'+mheader.title+'"');
end;
nl;
end else begin
nl; print('Sorry... can''t delete that!'); nl;
end;
if (cn>himsg) then cn:=himsg;
if (himsg<=0) then begin donescan:=TRUE; askpost:=TRUE; end;
end;
'E':if ((mso) and (lastname<>'')) then
editmessage(cn)
else begin
loadmhead(cn,mheader);
if ((mheader.fromi.usernum=usernum) and
(allcaps(mheader.fromi.real)=
allcaps(thisuser.realname))) then
editmessage(cn)
else begin
nl;
print('You didn''t post this message!');
nl;
end;
end;
'H':begin
nl;
i:=cn;
print('Highest-read pointer for this base set to message #'+
cstr(i+1)+'.');
nl;
for i:=1 to 6 do
zscanr.mhiread[board][i]:=mintab[getmixnum(cn)].msgdate[i];
savezscanr;
end;
'M':if (mso) then movemsg(cn);
'P':begin post(-1,mheader.fromi); nl; end;
'Q':begin quit:=TRUE; donescan:=TRUE; end;
'T':ms:=msshowt;
'V':if (mso) then begin
loadmhead(cn,mheader); mixr:=mintab[getmixnum(cn)];
if (miunvalidated in mixr.msgindexstat) then begin
nl; print('Message validated.'); nl;
mixr.msgindexstat:=mixr.msgindexstat-[miunvalidated];
sysoplog('* Validated "'+mheader.title+'"');
end else begin
nl; print('Message unvalidated.'); nl;
mixr.msgindexstat:=mixr.msgindexstat+[miunvalidated];
sysoplog('* Unvalidated "'+mheader.title+'"');
end;
savemix(mixr,cn);
end;
'W':pubreply(cn);
'X':if (mso) then begin
nl;
prt('Extract filename? (default="EXT.TXT") : ');
input(s,40);
if (s='') then s:='EXT.TXT';
if pynq('Are you sure? ') then begin
b:=pynq('Strip color codes from output? ');
loadmhead(cn,mheader);
assign(t,s);
{$I-} append(t); {$I+}
if (ioresult<>0) then rewrite(t);
totload:=0;
repeat
blockreadstr2(brdf,s);
inc(totload,length(s)+2);
if ((b) and (pos(#3,s)<>0)) then s:=stripcolor(s);
writeln(t,s);
until (totload>=mheader.msglength);
close(t);
nl;
print('Done!');
end;
end;
'Z':begin
nl;
sprompt(#3#5+memboard.name+#3#3);
if (board in zscanr.mzscan) then begin
zscanr.mzscan:=zscanr.mzscan-[board];
sprint(' will NOT be scanned in future NewScans.');
sysoplog('* Took "'+#3#5+memboard.name+#3#1+'" out of NewScan');
end else begin
zscanr.mzscan:=zscanr.mzscan+[board];
sprint(' WILL be scanned in future NewScans.');
sysoplog('* Put "'+#3#5+memboard.name+#3#1+'" back in NewScan');
end;
nl;
savezscanr;
end;
'!':if (mso) then begin
nl;
loadmhead(cn,mheader); mixr:=mintab[getmixnum(cn)];
if (mipermanent in mixr.msgindexstat) then begin
mixr.msgindexstat:=mixr.msgindexstat-[mipermanent];
print('Message is no longer permanent.');
sysoplog('* "'+mheader.title+'" made unpermanent');
end else begin
mixr.msgindexstat:=mixr.msgindexstat+[mipermanent];
print('Message is now permanent.');
sysoplog('* "'+mheader.title+'" made permanent');
end;
savemix(mixr,cn);
nl;
end;
'*':if (cso) then begin
nl;
j:=getmixnum(cn); loadmhead(j,mheader);
if (mheader.fromi.anon in [1,2]) then
mheader.fromi.anon:=0
else begin
i:=mheader.fromi.usernum;
ufo:=(filerec(uf).mode<>fmclosed);
if (not ufo) then reset(uf);
if ((i>=1) and (i<=filesize(uf)-1)) then begin
seek(uf,i); read(uf,u);
b:=aacs1(u,i,systat.csop);
end else
b:=FALSE;
if (not ufo) then close(uf);
if (b) then mheader.fromi.anon:=2 else mheader.fromi.anon:=1;
end;
seek(brdf,mintab[j].hdrptr);
savemhead(mheader);
if (mheader.fromi.anon=0) then begin
print('Message is no longer anonymous.');
sysoplog('* "'+mheader.title+'" made non-anonymous');
end else begin
print('Message is now anonymous.');
sysoplog('* "'+mheader.title+'" made anonymous');
end;
nl;
end;
'&':if ((cso) and (memboard.mbtype<>0)) then begin
nl;
loadmhead(cn,mheader); mixr:=mintab[getmixnum(cn)];
if (miscanned in mixr.msgindexstat) then begin
mixr.msgindexstat:=mixr.msgindexstat-[miscanned];
print('Message is no longer marked as scanned.');
sysoplog('* "'+mheader.title+'" not marked as scanned');
end else begin
mixr.msgindexstat:=mixr.msgindexstat+[miscanned];
print('Message is now marked as "sent".');
sysoplog('* "'+mheader.title+'" marked as scanned');
end;
savemix(mixr,cn);
nl;
end;
end;
end;
if (getm<>-1) then cn:=getm;
cbounds;
if (wasout) then
if (not contlist) then begin
donescan:=TRUE;
if (ms=msreadp) then askpost:=TRUE;
end else
contlist:=FALSE;
if (not donescan) then begin
if (getm<>-1) then ms:=msreadm;
if (ms=msreadm) then begin
if (contlist) then next:=TRUE;
if ((thisuser.clsmsg=1) and (not contlist)) then cls;
if (miunvalidated in mintab[getmixnum(cn)].msgindexstat) then
hadunval:=TRUE;
readmsg(1,cn,cn+1,himsg+1,abort,next);
updateptr(cn,zup);
for i:=1 to 6 do lastdate[i]:=mintab[getmixnum(cn)].msgdate[i];
if (not next) then ms:=msreadp else inc(cn);
inc(mread);
end;
end;
end;
if ((hadunval) and (mso)) then begin
nl;
if pynq(^G'Validate messages here? ') then
for i:=0 to himsg do begin
ensureloaded(i); mixr:=mintab[getmixnum(i)];
if (miunvalidated in mixr.msgindexstat) then begin
mixr.msgindexstat:=mixr.msgindexstat-[miunvalidated];
savemix(mixr,i);
end;
end;
end;
if ((askpost) and (aacs(memboard.postacs)) and
(not (rpost in thisuser.ac)) and (ptoday<systat.maxpubpost)) then begin
nl;
if pynq('Post on '+#3#5+memboard.name+#3#7+'? ') then
post(-1,mheader.fromi);
end;
if (zup) then savezscanr;
end;
procedure scanmessages;
var cn:word;
s:string;
i:integer;
c:char;
quit:boolean;
begin
initbrd(board); { loads memboard }
nl;
if (himsg<>-1) then begin
sprint(cstr(himsg+1)+' msgs on '+#3#5+memboard.name+#3#1+'.');
prt('Start listing at (Q=Quit)? '); input(s,20);
i:=value(s)-1; cn:=0;
if (i<0) then i:=0 else
if (i<=himsg) then cn:=i;
if (s<>'') then c:=s[1] else c:=^M;
if (c<>'Q') then doscan(quit,cn,stscan,msshowt);
end else
sprint('No messages on '+#3#5+memboard.name+#3#1+'.');
closebrd;
end;
procedure qscan(b:integer; var quit:boolean);
var cn:word;
oldboard,savlil,i:integer;
abort,next:boolean;
begin
oldboard:=board;
if (not quit) then begin
if (board<>b) then changeboard(b);
if (board=b) then begin
nl;
initbrd(board);
lil:=0; sprompt(#3#3+fstring.newscan1);
if (himsg<>-1) then begin
cn:=0;
while ((not isnew(cn)) and (cn<=himsg)) do inc(cn);
if ((cn<=himsg) and (isnew(cn))) then doscan(quit,cn,stnewscan,msreadm)
else quit:=FALSE;
end;
closebrd;
if (not quit) then begin
lil:=0;
sprompt(fstring.newscan2);
end;
end;
wkey(quit,next);
end;
board:=oldboard;
end;
procedure gnscan;
var bb,oldboard:integer;
quit:boolean;
begin
sysoplog('NewScan of message bases');
oldboard:=board;
nl; sprint(#3#5+')[ NewScan All ](');
bb:=1; quit:=FALSE;
repeat
if (bb in zscanr.mzscan) then qscan(bb,quit);
inc(bb);
until ((bb>numboards) or (quit) or (hangup));
nl; sprint(#3#5+')[ NewScan Done ](');
board:=oldboard;
initbrd(board);
end;
procedure nscan(mstr:string);
var abort,next:boolean;
begin
abort:=FALSE; next:=FALSE;
if (mstr='C') then qscan(board,next)
else if (mstr='G') then gnscan
else if (value(mstr)<>0) then qscan(value(mstr),next)
else begin
nl;
if pynq('Global NewScan? ') then gnscan else qscan(board,next);
end;
end;
end.