Michael Heydekamp <[EMAIL PROTECTED]> wrote on 06.10.04:
[...]
> Ich h�nge im Followup zu diesem Posting mal die zentralen neuen
> Routinen f�r das ganze Ged�nse an.
Bzw. als Text geht das in diesem Falle auch:
Vor dem Schreiben des Headers jeder Nachricht Variablen mit Inhalt
f�llen:
------------------------------------------------------------------
[...]
begin { of WriteRFCheader }
with hd do
begin
msgtime:='';
msgdate:='';
msg_TZ:='';
nowdate:=date;
nowtime:=time;
now_DST:=sommer(nowdate,nowtime);
now_TZ:=iifs(now_DST,'+0200','+0100'); { Default: MEZ/MESZ }
if (length(zdatum)>7) and (length(datum)>5) then
begin
{ my: Ggf. Jahr bei Jahrhundertwechsel korrigieren, }
{ damit bei Nachrichten, die als UTC-Datum in }
{ 'zdatum' noch den 31.12.1999, als lokales Datum }
{ in 'datum' aber bereits den 01.01.00 (zweistel- }
{ lige Jahreszahl!) ausweisen, nicht wie bisher }
{ durch das blinde Kopieren der ersten beiden }
{ Ziffern der Jahreszahl aus 'zdatum' das lokale }
{ RFC-Datum "01 Jan 1900" erzeugt wird. }
msgdate:=copy(datum,5,2)+'.'+copy(datum,3,2)+'.'+
iifs(((copy(zdatum,3,2)='99') and (left(datum,2)='00')),
strs(ival(left(zdatum,2))+1)+left(datum,2),
left(zdatum,2)+left(datum,2));
if (length(zdatum)>13) and (length(datum)>9) then
msgtime:=copy(datum,7,2)+':'+copy(datum,9,2)+':'+copy(zdatum,13,2);
if (length(zdatum)>16) and (upcase(zdatum[15]) in ['W','S']) and
(zdatum[16] in ['+','-']) and (zdatum[17] in ['0'..'9']) then
begin
msg_DST:=sommer(msgdate,msgtime);
p:=cpos(':',zdatum);
if p=0 then p:=byte(zdatum[0])+1;
msg_TZ:=zdatum[16]+formi(ival(copy(zdatum,17,p-17)),2)+
formi(ival(mid(zdatum,p+1)),2);
if right(msg_TZ,4)='0000' then { bei TZ '0000' immer '+' }
msg_TZ[1]:='+';
p:=ival(left(msg_TZ,3))+ { 'p' f�r Zeitzone mi�brauchen }
iif(not msg_DST and now_DST,1,
iif(msg_DST and not now_DST,-1,0));
now_TZ:=iifs(p<0,'-','+')+formi(abs(p),2)+right(msg_TZ,2);
end;
end;
[...]
Die Routine, die aus den obigen Variablen wahlweise RFC- oder asctime()-
Format (mit Wochentag) erzeugt:
------------------------------------------------------------------------
{ --------------------------------------------------------- }
{ asc=false: Datums-/Zeitstring in RFC-Format umwandeln }
{ (f�r "Date:"-Header, Quelle: EDA:-Header) }
{ (f�r "Received:"-Header, akt. Zeit) }
{ "Fri, 31 Dec 1999 23:01:00 +0100" }
{ }
{ asc=true : Datums-/Zeitstring in asctime-Format umwandeln }
{ (f�r "From_"-Zeile in UUCP-Mails, akt. Zeit) }
{ "Fri Dec 31 23:01:00 1999" }
{ }
{ dateS = Datum im Format "31.12.1999" }
{ timeS = Zeit im Format "23:01:00" }
{ --------------------------------------------------------- }
function RFCdate(const dateS,timeS,TZ:datetimest; const asc:boolean):string;
begin
if dateS<>'' then
begin
RFCdate:=copy('MonTueWedThuFriSatSun',dow(dateS)*3-2,3)+
iifs(asc,'',', ')+
iifs(asc,'',left(dateS,2))+' '+month(copy(dateS,4,2))+
iifs(asc,iifs(dateS[1]='0',' '+copy(dateS,2,1),left(dateS,2)),
right(dateS,4))+
iifs(timeS='','',' '+timeS)+
iifs(asc,' '+right(dateS,4),iifs(TZ='','',' '+TZ));
end
else RFCdate:='';
end;
Und hier die Zeilen/Header, wo 'RFCdate' letztlich verwendet wird:
------------------------------------------------------------------
----------8<----------
if ddatum<>'' then
begin
fpar:=fpar+'modification-date="'+
RFCdate(copy(ddatum,7,2)+'.'+copy(ddatum,5,2)+'.'+
left(ddatum,4),copy(ddatum,9,2)+':'+
copy(ddatum,11,2)+':'+copy(ddatum,13,2),
'-0000',false)+'"';
if hd.groesse>0 then fpar:=fpar+'; size='+strs(hd.groesse);
end
----------8<----------
----------8<----------
else wrs(f,'From '+left(s,p-1)+' '+
RFCdate(nowdate,nowtime,now_TZ,true)+ { akt. Datum/Uhrzeit }
' remote from '+mid(s,p+1));
if (wab<>'') and (cpos('@',oem)>0) and not smtp { (*1) - s.u. }
then rfor:=empfaenger
else rfor:='';
wrs(f,'Received: by '+mid(s,cpos('@',s)+1)+
iifs(programm<>'',' ('+programm+')','')+
iifs(rfor<>'',#10#9'for '+rfor+';',';'));
wrs(f,#9+RFCdate(nowdate,nowtime,now_TZ,false)); { akt. Datum/Uhrzeit }
end
----------8<----------
----------8<----------
wrs(f,'Date: '+iifs(msgdate<>'',RFCdate(msgdate,msgtime,msg_TZ,false),
RFCdate(nowdate,nowtime,now_TZ,false)));
----------8<----------
Wenn jemand was dazu sagen m�chte und/oder einen Bug sieht...
Michael
------------------------------------------------------------------------
FreeXP Entwickler-Mailingliste
[EMAIL PROTECTED]
http://www.freexp.de/cgi-bin/mailman/listinfo/dev-list
