ScriptChangeheader

From 40tude Dialog Wiki

Problem: What I'm trying to do is to use a nice feature of arcor.de . They offer free email accounts and news access in Germany. One little feature off this account is that you can use an address like user@expires-2003-03-31.arcornews.de that maps to user@arcor.de and expires on 28.4.2003 (4 weeks later). This seems to be a great thing to fight spam.

Don't forget to replace 'invalid' with userpart of email ('user' in user@arcor.de)


New Script:

//(C)Marcus Mönnig & Ingo Pflanz
program OnBeforeSendingMessage;

function OnBeforeSendingMessage(var Message: TStringlist; Servername: string; IsEmail: boolean):boolean;
var i,j:integer;
    s:string;
    originalemail:string;
    newemaillocal:string;
    newemaildomain:string;
    emailuser:string;
    expiredate:string;
    lastdayofmonth:string;
begin
result:=true;
if isemail then exit;

//replace invalid with userpart of email ('user' in user@arcor.de)
emailuser:='invalid';
originalemail:=emailuser+'@arcor.de';
newemaillocal:=emailuser+'@expires-';
newemaildomain:='.arcornews.de';

case formatdatetime('mm',now) of
//  '01', '03', '05', '07', '08', '10', '12': lastdayofmonth:='31';
  '01' : lastdayofmonth:='31';
  '03' : lastdayofmonth:='31';
  '05' : lastdayofmonth:='31';
  '07' : lastdayofmonth:='31';
  '08' : lastdayofmonth:='31';
  '10' : lastdayofmonth:='31';
  '12' : lastdayofmonth:='31';
  '02' : begin
           if isleapyear(CurrentYear) then
	     lastdayofmonth:='29'
           else
	     lastdayofmonth:='28';
  	 end
else
  lastdayofmonth:='30'
end;

expiredate:=formatdatetime('yyyy-mm-',now)+lastdayofmonth;


for i:=0 to Message.count-1 do
 begin
 s:=message.strings[[i]];
 if s='' then break; //only scan through headers
 j:=pos(originalemail,s);
 if j>0 then
   begin
   delete(s,j,length(originalemail));
   insert(newemaillocal+expiredate+newemaildomain,s,j);
   message.strings[[i]]:=s;
   end;
 end;
end;

begin
end.


Old Script:

The still available old script might be usefull as an example, but it doesn't do what is needed to use arcor.de's expire-domains. The New Script below worked for me during the last few months, always setting the last day of the current month as part of the domain name. Should work in leap years as well.

program OnBeforeSendingMessage;


function OnBeforeSendingMessage(var Message: TStringlist; Servername: string; IsEmail: boolean):boolean;
var i,j:integer;
    s:string;
    originalemail:string;
    newemaillocal:string;
    newemaildomain:string;
    delaydays:integer;
begin
result:=true;
if isemail then exit;

// You will need to change these 4 values to your needs:

originalemail:='user@arcor.de';    //email address set up in Dialog
newemaillocal:='user@expires-';    //front part of new address
newemaildomain:='.arcornews.de';   //back part of new address
delaydays:=28;                     //number of days from today for the expiration string

for i:=0 to Message.count-1 do
 begin
 s:=message.strings[[i]];
 if s='' then break; //only scan through headers
 j:=pos(originalemail,s);
 if j>0 then
   begin
   delete(s,j,length(originalemail));
   insert(newemaillocal+FormatDateTime('yyyy-mm-dd',now+delaydays)+newemaildomain,s,j);
   message.strings[[i]]:=s;
   end;
 end;
end;

begin
end.