Hallo,
ich habe folgenden Code (er ist erstmal nur zum Testen, daher ist er noch nicht mit try-Anweisungen, etc. optimiert worden):
Delphi-Quellcode:
procedure TForm1.MailsAbrufen;
var
//Integers
intIndex,i:integer;
begin
try
idPOP31.Connect;
except
MessageDlg('Es konnte keine Verbindung zum Postfach hergestellt werden. Bitte überprüfen Sie alle Einstellungen.',mtInformation,[mbOk],0);
end;
MailCount := idPOP31.CheckMessages;
idPOP31.Retrieve(1,idMessage1);
anhang_list := TStringList.Create;
anhang_id_list := TStringList.Create;
anhang_list_stream := TMemoryStream.Create;
anhang_id_list_stream := TMemoryStream.Create;
IBTable2.Last;
ID2 := IBTable2.RecordCount;
// Inhalt der Mail überprüfen
if IdMessage1.MessageParts.Count <> 0 then begin
for intIndex := 0 to (IdMessage1.MessageParts.Count-1) do begin
if idMEssage1.MessageParts.Items[intIndex] is TIdText then begin
mailBody := TidText(IdMessage1.MessageParts.Items[intIndex]).Body.Text;
end
else if idMEssage1.MessageParts.Items[intIndex] is TIdAttachmentFile then begin
attFileName := (idMEssage1.MessageParts.Items[intIndex] as tIdAttachmentFile).Filename;
TidAttachmentFile(idMessage1.MessageParts.Items[intIndex]).SaveToFile(path+'\tmp\'+attFileName);
ID2 := ID2+1;
anhang_id_list.Add(IntToStr(ID2));
anhang_list.Add(attFileName);
end;
end;
end
else if IdMessage1.MessageParts.Count = 0 then begin
MailBody := idMessage1.Body.Text;
end;
if anhang_list.Text <> '' then begin
anhang_list.SaveToStream(anhang_list_stream);
anhang_id_list.SaveToStream(anhang_id_list_stream);
end;
id1 := IBTable1.RecordCount+1;
mailHeader := idMessage1.Headers.Text;
mailSubject := idMessage1.Subject;
mailDate := idMessage1.Date;
mailFromName := idMessage1.From.Name;
mailFromMail := idMessage1.From.Address;
// Mails in die Datenbank speichern
Mails2DB;
// Alles wieder freigeben
FreeAndNil(anhang_list);
FreeAndNil(anhang_id_list);
FreeAndNil(anhang_list_stream);
FreeAndNil(anhang_id_list_stream);
// Verbindung zum Server trennen
idPOP31.Disconnect;
end;
//------------------------------------------------------------------------------
procedure TForm1.Mails2DB;
var
i:integer;
begin
try
// 1. Tabelle
IBTable1.Insert;
IBTable1.FieldByName('Message').AsString := mailBody;
IBTable1.FieldByName('MSGID').AsInteger := id1;
IBTable1.FieldByName('Header').AsString := mailHeader;
IBTable1.FieldByName('Subject').AsString := mailSubject;
IBTable1.FieldByName('Date').AsString := FormatDateTime('ddd, dd.mm.yyyy hh:mm', mailDate);
IBTable1.FieldByName('FromName').AsString := mailFromName;
IBTable1.FieldByName('FromMail').AsString := mailFromMail;
if anhang_list.Text <> '' then begin
anhang_list_stream.Position := 0;
anhang_id_list_stream.Position := 0;
Pic2DB.StoreStreamInDB(TBlobField(IBTable1.FieldByName('Anhang')),anhang_list_stream);
Pic2DB.StoreStreamInDB(TBlobField(IBTable1.FieldByName('AID')),anhang_id_list_stream);
IBTable1.FieldByName('AttIcon').AsInteger := 1;
end;
IBTable1.Post;
// 2. Tabelle
if anhang_list.count <> 0 then begin
for i:=0 to anhang_list.Count-1 do begin
IBTAble2.Insert;
Pic2DB.StoreFileInDB(TBlobField(IBTable2.FieldByName('FILE')),path+'\tmp\'+anhang_list.Strings[i]);
IBTable2.FieldByName('ID').AsInteger := StrToInt(anhang_id_list.Strings[i]);
IBTable2.Post;
end;
end;
// Ende
mailsaved := true;
except
mailsaved := false;
end;
end;
Das merkwürdige ist folgendes:
anhang_id_list ist leer. Das kann aber nicht. Wenn ich "Mails2DB" weglasse und an der Stelle den Inhalt von anhang_id_list in ein Memo lade, dann stehen dort 2 Zahlen (bei meiner Testmail), alle anderen Variablen sind auch ausgefüllt und die Schleife beim Anhang durchläuft er auch, da die Dateien im TMP-Ordner angelegt werden. Wenn ich aber die Prozedur "Mails2DB" verwende, sind anhang_id_list und anhang_id_list_stream wieder leer.
Ich versteh es einfach nicht und ein debuggen hat auch nichts gebracht.
Viele Grüße
Sascha