A lo mejor me excedo un poco, con la cantidad de código, o incluso podría haber adjuntado un ZIP, pero te pongo el código que yo utilizo para enviar un correo a través de Indy, directamente desde el programa Delphi, y además dentro de un Thread.
Los correos que yo envío, pueden contener una imagen en la cabecera del correo, y otra en el pie del mensaje. Supongo que lo mismo se puede aplicar a cualquier imagen en cualquier parte del texto.
Tienes que fijarte especialmente en los diferentes 'tipos' que se pueden definir.
Además de las imágenes de principio y final, se puede añadir cualquier otro fichero adjunto, diferente de las imágenes.
Espero te sirva :
Código Delphi
[-]procedure TEMailsSend.Send_EMail;
var
m : TMemoryStream;
f : TFileStream;
g : TStream;
i : Integer;
filename : string;
img_t_align : Integer;
img_b_align : Integer;
int_no : Int64;
tempFileName : String;
messagetype : Integer;
Top_Image : Boolean;
Bot_Image : Boolean;
begin
with pDataSet2 do begin
SelectSQL.Clear;
SelectSQL.Add('Select * from EMAIL_CONFIG');
SelectSQL.Add('where BUILDINGNO = :Txt1');
ParamByName('Txt1').Value := pDataSet1.FieldByName('BUILDINGNO').Value;
Prepare;
Open;
end;
if (pDataSet2.Eof) or
(pDataSet2.FieldByName('SMTP_HOST').AsString = '') or
(pDataSet2.FieldByName('SMTP_PORT').AsInteger = 0) then begin
Error_Str := 'Configuracion e-Correo para Dpto. '+pDataSet2.FieldByName('DEPARTMENT').AsString+' incorrecta';
Synchronize(ErrorMainForm);
Exit;
end;
if pDataSet2.FieldByName('SMTP_SSL').AsInteger = 1 then begin
IdIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
IdIOHandler.RecvBufferSize := 65000;
IdIOHandler.SendBufferSize := 65000;
IdIOHandler.SSLOptions.Method := sslvSSLv3;
IdIOHandler.SSLOptions.Mode := sslmUnassigned;
IdIOHandler.SSLOptions.VerifyDepth := 0;
IdIOHandler.SSLOptions.VerifyMode := [];
IdIOHandler.UseNagle := False;
IdIOHandler.Port := pDataSet2.FieldByName('SMTP_PORT').AsInteger;
IdIOHandler.Destination := pDataSet2.FieldByName('SMTP_HOST').AsString + ':' + pDataSet2.FieldByName('SMTP_PORT').AsString;
IdIOHandler.Host := pDataSet2.FieldByName('SMTP_HOST').Value;
end;
IdSMTP1 := TIdSMTP.Create(nil);
IdSMTP1.OnWork := IdSMTP1Work;
IdSMTP1.Host := pDataSet2.FieldByName('SMTP_HOST').Value;
IdSMTP1.Port := pDataSet2.FieldByName('SMTP_PORT').Value;
if pDataSet2.FieldByName('SMTP_SSL').AsInteger = 1 then begin
IdSMTP1.IOHandler := IdIOHandler;
IdSMTP1.UseTLS := utUseImplicitTLS;
end;
img_t_align := pDataSet2.FieldByName('IMAGE_T_ALIGN').AsInteger;
img_b_align := pDataSet2.FieldByName('IMAGE_B_ALIGN').AsInteger;
with pDataSet2 do begin
SelectSQL.Clear;
SelectSQL.Add('Select * from EMAIL_CONFIG_DEPARTMENTS');
SelectSQL.Add('where BUILDINGNO = :Txt1');
SelectSQL.Add('and INTERNALNO = :Txt2');
ParamByName('Txt1').Value := pDataSet1.FieldByName('BUILDINGNO').Value;
ParamByName('Txt2').Value := pDataSet1.FieldByName('FROM_DEPARTMENT').Value;
Prepare;
Open;
end;
if (pDataSet2.Eof) or
(pDataSet2.FieldByName('SMTP_USERNAME').AsString = '') or
(pDataSet2.FieldByName('SMTP_PASSWORD').AsString = '') then begin
IdSMTP1.Free;
Error_Str := 'Configuracion e-Correo para Dpto. '+pDataSet2.FieldByName('DEPARTMENT').AsString+' incorrecta';
Synchronize(ErrorMainForm);
Exit;
end;
IdSMTP1.Username := pDataSet2.FieldByName('SMTP_USERNAME').Value;
IdSMTP1.Password := pDataSet2.FieldByName('SMTP_PASSWORD').Value;
IdMessage1 := TIdMessage.Create(nil);
if not pDataSet2.FieldByName('SMTP_FROM_ADDR').IsNull then
IdMessage1.From.Address := pDataSet2.FieldByName('SMTP_FROM_ADDR').Value;
if not pDataSet2.FieldByName('SMTP_FROM_NAME').IsNull then
IdMessage1.From.Name := pDataSet2.FieldByName('SMTP_FROM_NAME').Value;
if not pDataSet2.FieldByName('SMTP_REPLYTO').IsNull then
IdMessage1.ReplyTo.EMailAddresses := pDataSet2.FieldByName('SMTP_REPLYTO').Value;
IdMessage1.Charset := 'iso-8859-1';
if pDataSet1.FieldByName('ASKFORRECEIPT').AsInteger = 1 then
if not pDataSet2.FieldByName('SMTP_FROM_ADDR').IsNull then
IdMessage1.ReceiptRecipient.Address := pDataSet2.FieldByName('SMTP_FROM_ADDR').Value;
with pDataSet2 do begin
SelectSQL.Clear;
SelectSQL.Add('Select * from BOOKINGS_EMAIL_TO');
SelectSQL.Add('where INTERNALNO = :Txt1');
SelectSQL.Add('and TYPE_TO_CC_CCO = 1');
ParamByName('Txt1').Value := pDataSet1.FieldByName('INTERNALNO').Value;
Prepare;
Open;
First;
while not Eof do begin
with IdMessage1.Recipients.Add do begin
Name := pDataSet2.FieldByName('EMAILNAME').AsString;
Address := pDataSet2.FieldByName('EMAILADDRESS').AsString;
end;
Next;
end;
end;
with pDataSet2 do begin
SelectSQL.Clear;
SelectSQL.Add('Select * from BOOKINGS_EMAIL_TO');
SelectSQL.Add('where INTERNALNO = :Txt1');
SelectSQL.Add('and TYPE_TO_CC_CCO = 2');
ParamByName('Txt1').Value := pDataSet1.FieldByName('INTERNALNO').Value;
Prepare;
Open;
First;
while not Eof do begin
with IdMessage1.CCList.Add do begin
Name := pDataSet2.FieldByName('EMAILNAME').AsString;
Address := pDataSet2.FieldByName('EMAILADDRESS').AsString;
end;
Next;
end;
end;
with pDataSet2 do begin
SelectSQL.Clear;
SelectSQL.Add('Select * from BOOKINGS_EMAIL_TO');
SelectSQL.Add('where INTERNALNO = :Txt1');
SelectSQL.Add('and TYPE_TO_CC_CCO = 3');
ParamByName('Txt1').Value := pDataSet1.FieldByName('INTERNALNO').Value;
Prepare;
Open;
First;
while not Eof do begin
with IdMessage1.BCCList.Add do begin
Name := pDataSet2.FieldByName('EMAILNAME').AsString;
Address := pDataSet2.FieldByName('EMAILADDRESS').AsString;
end;
Next;
end;
end;
IdMessage1.Subject := pDataSet1.FieldByName('SUBJECT').AsString;
Mail_Str := '';
Mail_Size := 0;
Mail_BSize := 0;
Mail_BSent := 0;
Top_Image := False;
Bot_Image := False;
Synchronize(UpdateMainForm);
html.Clear;
html.Add(':html: :head: :/head:'+
':body text=#000000 bgcolor=#FFFFFF link=#FF0000'+
'alink=#FF0000 vlink=#FF0000:'+#13#10);
html.Add(':html::body:');
if pDataSet1.FieldByName('TOP_IMAGE').AsInteger = 1 then begin
with pDataSet2 do begin
SelectSQL.Clear;
SelectSQL.Add('Select * from EMAIL_CONFIG_IMAGES');
SelectSQL.Add('where BUILDINGNO = :Txt1');
SelectSQL.Add('and TOP_BOTTOM = 1');
ParamByName('Txt1').Value := pDataSet1.FieldByName('BUILDINGNO').Value;
Prepare;
Open;
end;
if not pDataSet2.IsEmpty then begin
Mail_Str := 'Añadiendo Imagen Cabecera';
Synchronize(UpdateMainForm);
if not DirectoryExists('DocTemp') then
CreateDir(ExtractFilePath(Application.ExeName)+'DocTemp');
tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+'AT0001.JPG';
if not FileExists(tempFileName) then begin
f := TFileStream.Create(tempFileName,fmCreate);
g := pDataSet2.CreateBlobStream(pDataSet2.FieldByName('IMAGE'), bmRead);
f.seek(0,soFromBeginning);
f.CopyFrom(g, 0);
Mail_Size := Mail_Size + f.size;
g.free;
f.Free;
end;
case img_t_align of
0,1 : html.Add(':img src="cid:0001":');
2 : html.Add('
IV align=center::IMG src="cid:0001" align=center::/DIV:');
3 : html.Add('IV align=right::IMG src="cid:0001" align=right::/DIV:');
end;
Top_Image := True;
end;
end;
with pDataSet2 do begin
SelectSQL.Clear;
SelectSQL.Add('Select * from BOOKINGS_EMAIL_BLOB');
SelectSQL.Add('where INTERNALNO = :Txt1');
ParamByName('Txt1').Value := pDataSet1.FieldByName('INTERNALNO').Value;
Prepare;
Open;
end;
MainFormMailSend2 := TMainFormMailSend2.Create(nil);
if not pDataSet2.IsEmpty then begin
m := TMemoryStream.Create;
(pDataSet2.FieldByName('BODY_TEXT') as TBlobField).SaveToStream(m);
m.Seek(0,soFromBeginning);
MainFormMailSend2.Editor.Lines.LoadFromStream(m);
Mail_Size := Mail_Size + m.size;
m.Free;
end
else MainFormMailSend2.Editor.Text := '';
Mail_Str := 'Convirtiendo Texto a HTML';
Synchronize(UpdateMainForm);
if pDataSet1.FieldByName('TEXT_FORMAT').AsInteger = 1 then html.Add(RTFToHTMLSimple(MainFormMailSend2.Editor));
if pDataSet1.FieldByName('TEXT_FORMAT').AsInteger = 2 then html.Add(RTFToHTMLWords(MainFormMailSend2.Editor));
if pDataSet1.FieldByName('TEXT_FORMAT').AsInteger = 3 then html.Add(RTFToHTMLDetailed(MainFormMailSend2.Editor));
if pDataSet1.FieldByName('FINAL_TEXT').AsInteger = 1 then begin
with pDataSet2 do begin
SelectSQL.Clear;
SelectSQL.Add('Select * from EMAIL_CONFIG_FINALTEXT');
SelectSQL.Add('where BUILDINGNO = :Txt1');
SelectSQL.Add('and DEPARTMENT_INTNO = :Txt2');
ParamByName('Txt1').Value := pDataSet1.FieldByName('BUILDINGNO').Value;
ParamByName('Txt2').Value := pDataSet1.FieldByName('FROM_DEPARTMENT').Value;
Prepare;
Open;
end;
if not pDataSet2.IsEmpty then begin
Mail_BSent := 0;
Mail_Str := 'Añadiendo Texto Final';
Synchronize(UpdateMainForm);
m := TMemoryStream.Create;
(pDataSet2.FieldByName('COMMENTS') as TBlobField).SaveToStream(m);
m.Seek(0,soFromBeginning);
MainFormMailSend2.Editor.Lines.LoadFromStream(m);
Mail_Size := Mail_Size + m.size;
m.Free;
Mail_Str := 'Convirtiendo Texto Final';
Synchronize(UpdateMainForm);
html.Add(':div: :/div:');
html.Add(RTFToHTMLDetailed(MainFormMailSend2.Editor));
end;
end;
MainFormMailSend2.Free;
if pDataSet1.FieldByName('BOTTOM_IMAGE').AsInteger = 1 then begin
html.Add(':div: :/div:');
with pDataSet2 do begin
SelectSQL.Clear;
SelectSQL.Add('Select * from EMAIL_CONFIG_IMAGES');
SelectSQL.Add('where BUILDINGNO = :Txt1');
SelectSQL.Add('and TOP_BOTTOM = 2');
ParamByName('Txt1').Value := pDataSet1.FieldByName('BUILDINGNO').Value;
Prepare;
Open;
end;
if not pDataSet2.IsEmpty then begin
Mail_BSent := 0;
Mail_Str := 'Añadiendo Imagen Pie de Página';
Synchronize(UpdateMainForm);
if not DirectoryExists('DocTemp') then
CreateDir(ExtractFilePath(Application.ExeName)+'DocTemp');
tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+'AT0002.JPG';
if not FileExists(tempFileName) then begin
f := TFileStream.Create(tempFileName,fmCreate);
g := pDataSet2.CreateBlobStream(pDataSet2.FieldByName('IMAGE'), bmRead);
f.seek(0,soFromBeginning);
f.CopyFrom(g, 0);
Mail_Size := Mail_Size + f.size;
g.free;
f.Free;
end;
case img_b_align of
0,1 : html.Add(':img src="cid:0002":');
2 : html.Add('IV align=center::IMG src="cid:0002" align=center::/DIV:');
3 : html.Add('IV align=right::IMG src="cid:0002" align=right::/DIV:');
end;
Bot_Image := True;
end;
end;
html.Add(':/body::/html:');
with pDataSet2 do begin
SelectSQL.Clear;
SelectSQL.Add('Select * from BOOKINGS_EMAIL_ATTACH');
SelectSQL.Add('where INTERNALNO = :Txt1');
SelectSQL.Add('order by INTERNALNO2');
ParamByName('Txt1').Value := pDataSet1.FieldByName('INTERNALNO').Value;
Prepare;
Open;
end;
if (pDataSet2.IsEmpty) and (not Top_Image) and (not Bot_Image) then begin
MessageType := 1;
IdMessage1.ContentType := 'multipart/alternative';
end;
if (not pDataSet2.IsEmpty) and (not Top_Image) and (not Bot_Image) then begin
MessageType := 2;
IdMessage1.ContentType := 'multipart/mixed';
end;
if (not pDataSet2.IsEmpty) and ((Top_Image) or (Bot_Image)) then begin
MessageType := 3;
IdMessage1.ContentType := 'multipart/mixed';
with TIdText.Create(IdMessage1.MessageParts, nil) do begin
ContentType := 'multipart/related; type="multipart/alternative"';
end;
with TIdText.Create(IdMessage1.MessageParts, nil) do begin
ContentType := 'multipart/alternative';
ParentPart := 0;
end;
end;
if (pDataSet2.IsEmpty) and ((Top_Image) or (Bot_Image)) then begin
MessageType := 4;
IdMessage1.ContentType := 'multipart/related; type="text/html"';
end;
with TIdText.Create(IdMessage1.MessageParts, nil) do begin
Body.Assign(html);
ContentType := 'text/html';
if MessageType = 3 then ParentPart := 1;
CharSet := 'iso-8859-1';
end;
if Top_Image then begin
tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+'AT0001.JPG';
with TIdAttachmentFile.Create(IdMessage1.MessageParts, tempFileName) do begin
ContentID := '0001';
ContentType := 'image/jpeg';
FileName := 'AT0001.JPG';
if MessageType = 3 then ParentPart := 0;
end;
end;
if Bot_Image then begin
tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+'AT0002.JPG';
with TIdAttachmentFile.Create(IdMessage1.MessageParts, tempFileName) do begin
ContentID := '0002';
ContentType := 'image/jpeg';
FileName := 'AT0002.JPG';
if MessageType = 3 then ParentPart := 0;
end;
end;
if not pDataSet2.IsEmpty then begin
Mail_BSent := 0;
Mail_Str := 'Adjuntando Archivos al Mensaje';
Synchronize(UpdateMainForm);
pDataSet2.First;
while not pDataSet2.Eof do begin
if not DirectoryExists('DocTemp') then
CreateDir(ExtractFilePath(Application.ExeName)+'DocTemp');
tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+Trim(pDataSet2.FieldByName('FILENAME').Value);
with pDataSet3 do begin
SelectSQL.Clear;
SelectSQL.Add('Select * from BOOKINGS_EMAIL_ATTACH_BLOB');
SelectSQL.Add('where INTERNALNO = :Txt1');
SelectSQL.Add('and INTERNALNO2 = :Txt2');
ParamByName('Txt1').Value := pDataSet2.FieldByName('INTERNALNO').Value;
ParamByName('Txt2').Value := pDataSet2.FieldByName('INTERNALNO2').Value;
Prepare;
Open;
end;
f := TFileStream.Create(tempFileName,fmCreate);
g := pDataSet3.CreateBlobStream(pDataSet3.FieldByName('DOCUMENT'), bmRead);
f.seek(0,soFromBeginning);
f.CopyFrom(g, 0);
Mail_Size := Mail_Size + f.size;
g.free;
f.Free;
with TIdAttachmentFile.Create(IdMessage1.MessageParts, tempFileName) do begin
ContentType := 'application/'+pDataSet2.FieldByName('FILEEXTENSION').AsString;
FileName := tempFileName;
end;
pDataSet2.Next;
end;
end;
pDataSet2.Close;
if Act_Status <> 'ABORT' then begin
try
Mail_Size := Mail_Size + ((Mail_Size*36) div 100);
Mail_BSent := 0;
Mail_Str := 'Conectando con Servidor de Correo';
Synchronize(UpdateMainForm);
IdSMTP1.Connect;
if Tot_Mails > 1 then
Mail_Str := 'Enviando '+IntToStr(Num_Mail)+' de '+IntToStr(Tot_Mails)+' e-Correos al Servidor de Correo'
else
Mail_Str := 'Enviando e-Correo al Servidor de Correo';
Synchronize(UpdateMainForm);
Act_Status := 'SENDING';
IdSMTP1.Send(IdMessage1);
Mail_Str := 'Desconectando del Servidor de Correo';
Synchronize(UpdateMainForm);
IdSMTP1.Disconnect;
Act_Status := 'OK';
except
on E: Exception do begin
Act_Status := 'ABORT';
end;
end;
end;
IdSMTP1.Free;
IdMessage1.Free;
if Top_Image then begin
tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+'AT0001.JPG';
DeleteFile(tempFileName);
end;
if Bot_Image then begin
tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+'AT0002.JPG';
DeleteFile(tempFileName);
end;
with pDataSet2 do begin
Open;
if not IsEmpty then begin
First;
while not Eof do begin
tempFileName := ExtractFilePath(Application.ExeName)+'DocTemp\'+Trim(pDataSet2.FieldByName('FILENAME').Value);
if FileExists(tempFileName) then DeleteFile(tempFileName);
Next;
end;
end;
Close;
end;
pDataSet1.Edit;
if Act_Status = 'OK' then pDataSet1.FieldByName('DATE_SENT_RECEIV').Value := Now;
pDataSet1.FieldByName('CURRENTLY_SENDING').Value := 0;
pDataSet1.Post;
pTransact.CommitRetaining;
end;
Edito : He tenido que reemplazar algunos 'tags HTML' por ':' en vez de '<' y '>' porque se veían mal en el hilo
22-08-2011
, he editado el otro post poniendo este enlace, así no queda huérfano 
Temas Similares
os diré como ha ido.
Modo Híbrido
