{$A+,B+,D-,E+,F+,I+,L+,N-,O+,R-,S+,V-}

unit mail2;

interface

uses

crt, dos,

{rcg11172000 no overlay under Linux.}

{overlay,}

common, timejunk, mail0, mail1;

procedure ssmail(mstr:astr);

procedure smail(massmail:boolean);

procedure email1(x:integer; ftit:string);

procedure email(x:integer);

procedure imail(x:integer);

function maxage(x:integer):integer;

implementation

uses misc3, miscx;

procedure ssmail(mstr:astr);

begin

if (mstr='') then smail(FALSE)

else begin

if (pos(';',mstr)=0) then irt:='Feedback' else

irt:=copy(mstr,pos(';',mstr)+1,length(mstr));

imail(value(mstr));

end;

end;

procedure smail(massmail:boolean);

var u,u2:userrec;

mheader:mheaderrec;

mixr:msgindexrec;

na:array[1..20] of word;

massacs,s:string;

i,nac,x:integer;

stype:byte;

abort,next,ok:boolean;

procedure checkitout(var x:integer; showit:boolean);

var i,ox:integer;

b:boolean;

procedure unote(s:string);

begin

if (showit) then

print('[> '+caps(u.name)+' #'+cstr(x)+': '+s);

end;

begin

{x:=value(s);} ox:=x;

if ((x<1) or (x>filesize(uf)-1)) then begin x:=0; exit; end;

seek(uf,x); read(uf,u);

i:=0; b:=TRUE;

while ((i<4) and (b)) do begin

inc(i); b:=moremail(u,x,i);

if (not b) then

case i of

1:unote('Mailbox is full.');

2:unote('Mailbox is closed.');

3:x:=0;

4:unote('Can''t send mail to yourself!');

end;

end;

if (not b) then begin x:=0; exit; end;

i:=u.forusr; if ((i<1) or (i>filesize(uf)-1)) then i:=0;

if (i<>0) then begin

seek(uf,i); read(uf,u2);

unote('Mail forwarded to '+caps(u2.name)+' #'+cstr(i)+'.');

x:=i;

end;

if (showit) then

for i:=1 to 20 do

if (na[i]=x) then begin

unote('Can''t send more than once.');

x:=0; exit;

end;

if (ox<>x) then

if ((ox>=1) and (ox<=filesize(uf)-1)) then begin

seek(uf,ox); read(uf,u);

end;

end;

procedure sendit(x:integer);

begin

checkitout(x,FALSE);

if (x=0) then exit;

if ((x>=1) and (x<=filesize(uf)-1)) then begin

seek(uf,x); read(uf,u);

if (x=1) then begin

inc(thisuser.feedback);

inc(ftoday);

end else begin

inc(thisuser.emailsent);

inc(etoday);

end;

inc(u.waiting);

seek(uf,x); write(uf,u);

if (x=usernum) then inc(thisuser.waiting);

end;

with mheader.toi do begin

anon:=0;

usernum:=x;

as:=allcaps(u.name)+' #'+cstr(x);

real:=allcaps(u.realname);

alias:=allcaps(u.name);

end;

with mixr do begin

messagenum:=x;

msgid:=0;

hdrptr:=filesize(brdf);

msgindexstat:=msgindexstat+[mimassmail];

end;

seek(brdf,mixr.hdrptr);

savemhead(mheader);

newmix(mixr);

end;

procedure doit;

var s:string;

i,x:integer;

begin

initbrd(-1);

if (not inmsg(FALSE,FALSE,'',mixr,mheader)) then exit;

case stype of

0:begin

nl; print('Sending mass-mail to:');

sysoplog('Mass-mail sent to:');

for i:=1 to nac do begin

sendit(na[i]); s:=' '+caps(u.name)+' #'+cstr(na[i]);

sysoplog(s); print(s);

end;

end;

1:begin

nl; print('Sending mass-mail to:');

sysoplog('Mass-mail sent to: (by ACS "'+massacs+'")');

seek(uf,1);

for i:=1 to filesize(uf)-1 do begin

read(uf,u);

if (aacs1(u,i,massacs)) then begin

sendit(i); s:=' '+caps(u.name)+' #'+cstr(i);

sysoplog(s); print(s);

end;

end;

end;

2:begin

print('Sending mass-mail to ALL USERS.');

sysoplog('Mass-mail sent to ALL USERS.');

for i:=1 to filesize(uf)-1 do sendit(i);

end;

end;

end;

begin

nl;

if ((remail in thisuser.ac) or (not (aacs(systat.normprivpost)))) then begin

print('Your access privledges do not include sending mail.');

exit;

end else

if ((etoday>=systat.maxprivpost) and (not mso)) then begin

print('Too much mail send today already.');

exit;

end;

if (not massmail) then begin

print('Enter user number, user name, or partial search string:');

prt(':'); finduserws(x);

if (x>0) then imail(x);

end else begin

print('Mass mail: send mail to more than one user.');

print('Enter a max of 20 user NUMBERS, seperated by commas.');

if (cso) then begin

print('CoSysOps:');

print(' ALL: Send to every user.');

print(' ACS: Send to an ACS group of users.');

end;

prt(':'); input(s,78); if (s='') then exit;

reset(uf);

ok:=FALSE; nac:=0; stype:=0;

for i:=1 to 20 do na[i]:=0;

nl;

if (cso) then

if (s='ACS') then begin

ok:=TRUE;

stype:=1;

prt('Enter ACS: '); inputl(massacs,160);

if (massacs='') then begin close(uf); exit; end;

seek(uf,1); i:=1;

nl;

print('Users marked by ACS "'+massacs+'":');

abort:=FALSE; next:=FALSE;

while ((i<=filesize(uf)-1) and (not abort)) do begin

read(uf,u);

if (aacs1(u,i,massacs)) then

print(' '+caps(u.name)+' #'+cstr(i));

inc(i); wkey(abort,next);

end;

end else

if (s='ALL') then begin

ok:=FALSE;

print('ALL USERS marked for mass-mail.');

stype:=2;

end;

if (not ok) then begin

print('Users marked:');

while ((s<>'') and (nac<20)) do begin

x:=value(s); checkitout(x,TRUE);

if (x<>0) then begin

inc(nac); na[nac]:=x;

print(' '+caps(u.name)+' #'+cstr(x));

end;

i:=pos(',',s); if (i=0) then s:='';

if (s<>'') then s:=copy(s,i+1,length(s)-i);

end;

end;

nl;

if pynq('Is this OK? ') then begin doit; closebrd; end;

close(uf);

end;

end;

procedure email1(x:integer; ftit:string);

var u:userrec;

pinfo:pinforec;

mheader:mheaderrec;

mixr:msgindexrec;

fto:string;

i,t,e,cp:integer;

a:anontyp;

s,tousers:astr;

us:userrec;

bb:byte;

b,ok,wasanon:boolean;

procedure nope(s:astr);

begin

if ok then begin nl; print(s); end;

ok:=FALSE;

end;

begin

ok:=TRUE;

reset(uf);

if ((x<0) or (x>filesize(uf)-1)) then begin close(uf); exit; end;

if (copy(ftit,1,1)<>'\') then begin

seek(uf,x); read(uf,u); close(uf);

nl;

if ((remail in thisuser.ac) or (not aacs(systat.normprivpost))) and

(not mso) then

nope('Your access privledges do not include sending mail.');

if (etoday>=systat.maxprivpost) and (not mso) then

nope('Too much mail sent today.');

if ((x=1) and (ftoday>=systat.maxfback) and (not mso)) then

nope('Too much feedback sent today.');

i:=0; b:=TRUE;

while ((i<4) and (b)) do begin

inc(i); b:=moremail(u,x,i);

if (not b) then

case i of

1:nope('That user''s mailbox is full.');

2:nope('That user''s mailbox is closed.');

3:nope('That user has been deleted.');

4:nope('Why do you want to send mail to yourself!??!');

end;

end;

if ((cso) and (not b) and (i<>3)) then ok:=TRUE;

if (not ok) then exit;

end;

savepinfo(pinfo);

initbrd(-1);

if (inmsg(FALSE,FALSE,ftit,mixr,mheader)) then begin

reset(uf);

if ((x>=1) and (x<=filesize(uf)-1)) then begin

seek(uf,x); read(uf,u);

if (x=1) then begin

inc(thisuser.feedback);

inc(ftoday);

end else begin

inc(thisuser.emailsent);

inc(etoday);

end;

inc(u.waiting);

seek(uf,x); write(uf,u);

if (x=usernum) then inc(thisuser.waiting);

end;

close(uf);

with mheader.toi do begin

anon:=0;

usernum:=x;

as:=allcaps(u.name)+' #'+cstr(x);

real:=allcaps(u.realname);

alias:=allcaps(u.name);

end;

mixr.msgid:=0;

mixr.messagenum:=x;

seek(brdf,mixr.hdrptr);

savemhead(mheader);

newmix(mixr);

s:=caps(u.name)+' #'+cstr(x);

if (useron) then sysoplog('Mail sent to '+s);

print('Mail sent to '+s);

topscr;

end;

loadpinfo(pinfo);

end;

procedure email(x:integer);

begin email1(x,''); end;

procedure imail(x:integer);

var u:userrec;

i:integer;

b,xx:boolean;

procedure nope(s:string);

begin

if (not xx) then begin

print(s);

xx:=TRUE;

end;

end;

begin

xx:=FALSE;

reset(uf);

if ((x<1) or (x>filesize(uf)-1)) then begin close(uf); exit; end;

seek(uf,x); read(uf,u);

nl;

i:=0; b:=TRUE;

while ((i<4) and (b)) do begin

inc(i); b:=moremail(u,x,i);

if (not b) then

case i of

1:nope('That user''s mailbox is full.');

2:nope('That user''s mailbox is closed.');

3:nope('That user has been deleted.');

4:nope('Why do you want to send mail to yourself!??!');

end;

end;

if (xx) then begin close(uf); exit; end;

if (u.forusr<>0) then begin

x:=forwardm(x);

if ((x<1) or (x>filesize(uf)-1)) then x:=0;

if (x>0) then begin

seek(uf,x); read(uf,u); close(uf);

print('That user is forwarding his mail to '+caps(u.name)+'.');

if pynq('Send mail to ['+caps(u.name)+' #'+cstr(x)+'] ? ') then email(x);

end else begin

print('Can''t send mail to that user.');

close(uf);

end;

end else begin

close(uf);

if pynq('Send mail to ['+caps(u.name)+' #'+cstr(x)+']? ') then email(x);

end;

end;

function maxage(x:integer):integer;

begin

case x of

0..19:maxage:=5;

20..29:maxage:=14;

30..39:maxage:=90;

40..59:maxage:=120;

else

maxage:=255;

end;

end;

end.

end.