Este es un trozo del código que utilizo para descargar y guardar los correos, en la BBDD
Código Delphi
[-]
const
TableEmail: string = 'EmailRAW';
type
TDescargarEmails = class(TDataModule)
IdAntiFreeze1: TIdAntiFreeze;
IdMessage1: TIdMessage;
IdPOP31: TIdPOP3;
IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
procedure DataModuleCreate(Sender: TObject);
procedure DataModuleDestroy(Sender: TObject);
private
FMailRAW:TStringStream;
function DescargarEmails: boolean;
function RetrieveListMailsAndSave: boolean;
function RetrieveMailAndSave(const AIdx: integer): Boolean;
function MessageAsSQLString: string;
function SaveEmail(const values: string): Boolean; overload;
function SaveEmail: Boolean; overload;
function GetMailRaw: string;
function ExtractBodyHTML(var bodyText: string): string;
function FindMail(const AMsgId: string): boolean;
public
end;
implementation
{$R *.dfm}
uses plogs, Util_MySQL, IdText, IdAttachmentFile, UMyDDBB;
procedure TDescargarEmails.DataModuleCreate(Sender: TObject);
begin
FMailRAW := TStringStream.Create;
end;
function TDescargarEmails.SaveEmail: Boolean;
begin
result := SaveEmail(MessageAsSQLString);
end;
function TDescargarEmails.RetrieveMailAndSave(const AIdx: integer): Boolean;
begin
result := false;
try
IdMessage1.Clear;
FMailRAW.Clear;
IdPop31.RetrieveHeader(AIdx, IdMessage1);
result := FindMail(IdMessage1.MsgId);
if not result then begin
IdPop31.RetrieveRaw(AIdx, FMailRAW);
IdPop31.Retrieve(AIdx, IdMessage1);
result := SaveEmail;
end;
except
on E: Exception do
logs.Error(E, 'RetrieveMailAndSave', true);
end;
end;
function TDescargarEmails.SaveEmail(const values: string): Boolean;
begin
Result:=(Values='') or MyDDBB.Execute(
'INSERT INTO ' + TableEmail + ' '+
'(`msgId`, `date`, `fromList`, `bcclist`, `cclist`, `subject`, `bodyText`, `bodyHTML`, `mailRAW`) '+
'VALUES ' + Values + ' '+
'ON DUPLICATE KEY UPDATE '+
' `msgId`=VALUES(`msgId`), '+
' `date`=VALUES(`date`), '+
' `fromList`=VALUES(`fromList`), '+
' `bcclist`=VALUES(`bcclist`), '+
' `cclist`=VALUES(`cclist`), '+
' `subject`=VALUES(`subject`), '+
' `bodyText`=VALUES(`bodyText`), '+
' `bodyHTML`=VALUES(`bodyHTML`), '+
' `mailRAW`=VALUES(`mailRAW`) '
);
end;
function TDescargarEmails.RetrieveListMailsAndSave: boolean;
var
i: integer;
begin
Result := true;
with IdPop31 do
for i := CheckMessages downto 1 do begin
try
if RetrieveMailAndSave(i) then
Delete(i);
except
on E: Exception do
logs.error(E, self, 'RetrieveListMailsAndSave(#' + IntToStr(i) + ')');
end;
end; end;
procedure TDescargarEmails.DataModuleDestroy(Sender: TObject);
begin
FMailRAW.free;
end;
function TDescargarEmails.DescargarEmails:boolean;
begin
Result := false;
with IdPOP31 do
try
try
AutoLogin := True;
Connect;
if not Connected then
logs.Error(Nil, 'No se ha podido conectar con el servidor.', true)
else if not RetrieveListMailsAndSave then
logs.Error(Nil, 'No se ha podido descarga los correos del servidor.', true)
else
result := true;
finally
if Connected then
Disconnect;
end;
except
on E: Exception do
logs.Error(E, Self, 'DescargarEmails: Error en el proceso de descarga de correos.', true);
end;
end;
function TDescargarEmails.ExtractBodyHTML(var bodyText: string): string;
var
S, ContentType: string;
I: Integer;
begin
bodyText := '';
Result := '';
I := 0;
with IdMessage1, MessageParts do
while (I < count) and (result = '') do begin
if (Items[i] is TIdAttachmentFile) then begin
end
else if Items[i] is TIdText then begin if TIdText(Items[i]).ContentType = 'text/plain' then
bodyText := UTF8Decode(UTF8Encode(TIdText(Items[i]).Body.Text))
else
Result := UTF8Decode(UTF8Encode(TIdText(Items[i]).Body.text));
end;
inc(I);
end;
end;
function TDescargarEmails.FindMail(const AMsgId: string): boolean;
begin
result := (MyDDBB.RecordCount(
'SELECT `MsgID`'+ #13#10 +
'FROM ' + TableEmail + ' '+ #13#10 +
'WHERE `MsgID` = :msgID',
[AMsgId]) >= 1);
end;
function TDescargarEmails.GetMailRaw: string;
begin
result := UTF8Decode(UTF8Encode(FMailRAW.DataString));
end;
function TDescargarEmails.MessageAsSQLString: string;
var
bodyText: string;
begin
With IdMessage1 do
Result := MySQL.AsValue([
MsgId, Date, UTF8Decode(UTF8Encode(FromList.EMailAddresses)), UTF8Decode(UTF8Encode(BccList.EMailAddresses)), UTF8Decode(UTF8Encode(CCList.EMailAddresses)), UTF8Decode(UTF8Encode(Subject)), UTF8Decode(UTF8Encode(Body.GetText)), ExtractBodyHTML(bodyText), GetMailRaw ])
end;
Espero te puedas hacer una idea.
Una puntualización sobre lo que puse anteriormente, viendo el código ahora nuevamente (este código lo desarrolle hace ya varios años), he visto que las indy si que devuelven un campo identificador único para cada correos y ese valor se almacena en la variable Message1.MsgID ( ya no lo recordaba
), por lo que llevar el control de correos descargados y pendientes es mas fácil.
Cita:
Empezado por juank1971
Ok gracias amigos,
Otra duda los adjuntos los guardas en la base de datos también o los tienes en carptetas, y guardas solamente el linck al fichero.
|
En cuanto al tema de los adjuntos, por el tipo de correo que yo proceso no suelen llevarlos y no los necesito, así que no los almaceno tampoco
saludos