title image


Smiley @Steffer und Andere die sich mit Mails auskennen
Hallo,



entschuldige Steffer, daß ich mich erst wieder jetzt melde.



Ich schicke hier den Source meines Progrämmchens und bitte um Vorschläge.



Es kann sein, daß dieses Programm die selbe Mail 10 x richtig Forwardet (MessageParts werden richtig angezeigt) und danach der Mailbody Leerbleibt (Obwohl lt. KB Zahl alle Attachments mitgekommen sind) order die Html Mail als Text angezeigt wird. Dieses passiert beliebig im Wechsel !



Danke im voraus und viele Grüße



Hahe





procedure TSpamclient.Empfangen;

var itm : TListItem;

MsgCount,

intIndex : Integer;

PartCount,i,j : Integer;

SendBool,

SendOK : Boolean;

MSGParts : TIdMessageParts;

St : TStream;

Procedure MakeItem(Empfaenger : TListView;Cap,HintStr,Subject:String);

var TM : TListItem;

begin

TM := Empfaenger.Items.Add;

TM.Caption := Cap;



Liste.Add(HintStr + ' - ' + Subject);

TM.ImageIndex := LISTE.Count - 1;

end;

begin

try;

POP.Host := 'TEST-POP-SERVER';

POP.Port := 110;

POP.Username := 'TEST';

POP.Password := 'TEST-POP-PWD';

POP.Connect;

SendList.Items.Clear;

LISTE := TStringList.Create;



intIndex := 1;

For intIndex := POP.CheckMessages downto 1 do

begin

Mail := TIdMessage.Create(pop);

POP.Retrieve(intIndex, Mail);

// Infos einer ListView hinzufügen

SendBool := True;

SendOK := False;

IF (POS('test',LowerCase(Mail.Recipients.EmailAddresses)) > 0)

or (POS('test',LowerCase(Mail.BCCList.EmailAddresses)) > 0)

or (POS('test',LowerCase(Mail.CCList.EmailAddresses)) > 0) then

begin

For i := 0 to BlList.Lines.Count - 1 do

begin

IF (POS(LowerCase(BlList.Lines[i]),LowerCase(Mail.From.Address)) > 0) then

begin

SendBool := False;

end;

If not SendBool then Break;

end;

For i := 0 to WhiteList.Lines.Count - 1 do

begin

IF (POS(LowerCase(WhiteList.Lines[i]),LowerCase(Mail.From.Address)) > 0) then

begin

SendBool := True;

SendOK := True;

end;

If SendOK then Break;

end;



IF SendBool then MakeItem(SendList,Mail.From.Address,Mail.From.Text,Mail.subject); //Absender



If SendBool and SendOK then

begin



SMTP.Username := 'TEST';

SMTP.Host := 'TEST-SMTP-SERVER';



SMTP.Password := 'TEST-PWD';

SMTP.Connect(-1);

SendMail := TIdMessage.Create(SMTP);

SendMail.NoDecode := False;

SendMail := Mail;

Mail.SaveToFile('TEMP');

SendMail.LoadFromFile('TEMP');

SendMail.ProcessHeaders;



SendMail.ContentType := Mail.ContentType;

SendMail.MIMEBoundary := Mail.MIMEBoundary;

SendMail.AttachmentEncoding := Mail.AttachmentEncoding;

SendMail.Body := Mail.Body;

SendMail.Encoding := Mail.Encoding;

SendMail.Recipients.Clear;

SendMail.Recipients.EMailAddresses := 'TEST@FORWARD.de';

SendMail.MessageParts.AttachmentEncoding := Mail.MessageParts.AttachmentEncoding;



//Liste mit Mailanhängen und Mailbody

for PartCount := 0 to Pred(Mail.MessageParts.Count) do

begin

if (Mail.MessageParts.Items[PartCount] is TIdAttachment) then

begin

IF not FileExists(TIdAttachment(MAIL.MessageParts.Items[PartCount]).FileName) then

TIdAttachment(MAIL.MessageParts.Items[PartCount]).SaveToFile(TIdAttachment(MAIL.MessageParts.Items[PartCount]).FileName);

TIdAttachment.Create(SENDMAIL.MessageParts,TIdAttachment(MAIL.MessageParts.Items[PartCount]).FileName);

end

else

begin

TIdText.Create(SendMail.MessageParts,TIdText(Mail.MessageParts.Items[PartCount]).Body);

end;

SendMail.MessageParts.Items[PartCount].ContentType := Mail.MessageParts.Items[PartCount].ContentType;

end;



SMTP.Send(SendMail);

SMTP.Disconnect;



//Liste mit Mailanhängen wieder löschen !!

for PartCount := 0 to Pred(Mail.MessageParts.Count) do

begin

if (Mail.MessageParts.Items[PartCount] is TIdAttachment) then

begin

IF FileExists(TIdAttachment(MAIL.MessageParts.Items[PartCount]).FileName) then

DeleteFile(TIdAttachment(MAIL.MessageParts.Items[PartCount]).FileName);

end;

end;

end

else if SendBool = False then

MakeItem(RausList,Mail.From.Address,Mail.From.Text,Mail.Subject); //Absender

IF (SendBool = False) OR ((SendBool=TRUE) AND (SendOK=True)) then

POP.Delete(intIndex);



IF FileExists('TEMP') then

DeleteFile('TEMP');

end;

FreeAndNil(Mail);

end;

POP.Disconnect;

except;

SMTP.Disconnect;

POP.Disconnect;

end;

end;



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: