Busquedas rapidas en buzones de correos

[juank1971]

Ok gracias amigos,
Lo que bucanero, a nosotros los programadores nos gusta más algo de código para poder masticar mejor las ideas, pudieras comentarme de los componentes que estas usando, para
“El primer paso de descargar todos los correos y almacenarlos en la BBDD” si tienes un time, un fragmento de código de la forma de descargar todos los mensajes, porque lo que quiero es con todos los mensajes y guardarlos todos en la base de datos.

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.

[bucanero]

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
    { Private declarations }
    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
    { Public declarations }
  end;

implementation

{%CLASSGROUP 'Vcl.Controls.TControl'}

{$R *.dfm}

uses plogs, Util_MySQL, IdText, IdAttachmentFile, UMyDDBB;

procedure TDescargarEmails.DataModuleCreate(Sender: TObject);
begin
  FMailRAW := TStringStream.Create;

  ///
  /// loadConfigServerPop;
  ///
end;

function TDescargarEmails.SaveEmail: Boolean;
begin
  result := SaveEmail(MessageAsSQLString);
end;

function TDescargarEmails.RetrieveMailAndSave(const AIdx: integer): Boolean;
begin
  result := false;
  try
     // Leemos la cabecera del mensaje
    IdMessage1.Clear;
    FMailRAW.Clear;

      //Se decarga la cabezera del mensaje
    IdPop31.RetrieveHeader(AIdx, IdMessage1);
    result := FindMail(IdMessage1.MsgId);
    if not result then begin
      //se descarga en formato RAW
      IdPop31.RetrieveRaw(AIdx, FMailRAW);
      //se descarga el mensaje completo
      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; //For
end;

procedure TDescargarEmails.DataModuleDestroy(Sender: TObject);
begin
  FMailRAW.free;
end;

function TDescargarEmails.DescargarEmails:boolean;
begin
  Result := false;
  // conectamos con el servidor
  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
        //general attachment

      end
      else if Items[i] is TIdText then begin //body text
        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,        // msgId
        Date,         //date
        UTF8Decode(UTF8Encode(FromList.EMailAddresses)),  //  fromList
        UTF8Decode(UTF8Encode(BccList.EMailAddresses)),   //  bcclist
        UTF8Decode(UTF8Encode(CCList.EMailAddresses)),    //  cclist
        UTF8Decode(UTF8Encode(Subject)),                  //  subject
        UTF8Decode(UTF8Encode(Body.GetText)),             //  bodyText
        ExtractBodyHTML(bodyText),                        //  bodyHTML
        GetMailRaw                                        //  mailRAW
      ])
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.

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

[juank1971]

ok gracias