ps como no he tenido tiempo de acomodar el ejemplo ahi te va el codigo espero ke le puedas entender por ke esta todo desacomodado alguna duda no hay pex tu pregunta
procedure TFrm_Email.Button2Click(Sender: TObject);
var I,J,K,L,enviados:Integer;
cadena,correo:string;
Check: TcheckBox;
ChildControl: TControl;
html: TStrings;
htmpart, txtpart: TIdText;
bmppart: TIdAttachment;
email: TIdMessage;
//archiv:TStrings;
filename,ss,filename1: string;
a,count:Integer;
idStars: TIdAttachment;
//archiv:t;
begin
bandera:=true;
enviados:=0;
count:=0;
Redt_Texto.Lines.SaveToFile('C:\WINDOWS\EMKTMP.RTF');
r2hconv.rtf2html('C:\WINDOWS\EMKTMP.RTF', 'C:\WINDOWS\EMKTMP.HTM',['']);
try
RichEdit2.lines.LoadFromFile('C:\WINDOWS\EMKTMP.HTM');
for A:=0 to RichEdit2.lines.Count -1 do
begin
SS:=RichEdit2.Lines.Strings[A];
RichEdit1.Lines.Add(SS);
end;
finally
richedit1.Lines.Add('');
richedit1.Lines.Add('<br>');
richedit1.Lines.Add('<br>');
richedit1.Lines.Add('<br>');
richedit1.Lines.Add('<br>');
richedit1.Lines.Add('<br>');
richedit1.Lines.Add('<br>');
richedit1.Lines.Add('<br>');
richedit1.Lines.Add('</BODY>');
richedit1.Lines.Add('</HTML>');
//RichEdit2.Free;
end;
if DBLookupComboBox1.Text='' then
ShowMessage('debe seleccionar un formato')
else
begin
Lst_Mails.Items.Clear;
with dtm_contactos.Qry_Correos do
begin
Close;
SQL.Clear;
cadena:='select email from contactos where grupo<''0'' ';
for I := 0 to GroupBox9.ControlCount - 1 do
if GroupBox9.Controls[i] is TCheckBox then
if TCheckBox(GroupBox9.Controls[i]).Checked then
cadena:=cadena+ ' or grupo='''+(IntToStr(i+1))+'''';
sql.Add(cadena);
Open;
First;
if Lst_Correos.Items.Count > 0 then
Lst_Mails.Items:=Lst_Correos.Items;
while not Eof do
begin
Lst_Mails.Items.Add(fieldbyname('email').AsString);
next;
end;
end;
Lst_Correos.Items.Clear;
ProgressBar1.Max:=Lst_Mails.Items.Count;
Timer1.Enabled:=True;
end;
for K:=0 to Lst_Mails.Items.Count -1 do
begin
ProgressBar1.Position:=k+1;
correo:= Lst_Mails.Items.Strings[k];
CopyFile(PChar('C:\Proyecto Email\Formatos\'+ DBLookupComboBox1.text ),PChar('C:\Archivos de programa\Borland\Delphi7\Projects\'+ DBLookupComboBox1.text),TRUE);
//filename := ExtractFilePath(Application.ExeName) + '\homerorx.jpg';
//filename1 := 'C:\Proyecto Email\Formatos\'+ DBLookupComboBox1.text + '''';
filename := 'C:\Proyecto Email\Formatos\'+ DBLookupComboBox1.text ;
html := TStringList.Create();
{html.Add('<html>');
html.Add('<head>');
html.Add('</head>');
html.Add('<body bgcolor="blue"> <h1>Hello</h1>');
//html.Add('<img src="\homerorx.jpg" />');
html.Add('</body>');
html.Add('</html>');}
for L:=0 to RichEdit2.lines.Count do
begin
html.Add(RichEdit2.Lines.Strings[L]);
end;
email := TIdMessage.Create(self);
email.From.Text := 'correo';
email.Recipients.EMailAddresses := correo;
email.Subject := 'Aviso Muelle 7';
email.ContentType := 'text/html';
email.charset := 'iso-8859-1';
email.Body.Assign(html);
{ txtpart := TIdText.Create(email.MessageParts);
txtpart.ContentType := 'text/html';
txtpart.Body.Text := RichEdit2.Text;
htmpart := TIdText.Create(email.MessageParts, html);
htmpart.ContentType := 'text/html';
//htmpart.charset := 'iso-8859-1';
bmppart := TIdAttachment.Create(email.MessageParts, filename);
bmppart.ExtraHeaders.Values['Content-ID'] := '';
bmppart.ContentType := 'image/html';
//bmppart.charset := 'iso-8859-1'; }
try
SMTP.Host:='smtp.prodigy.net.mx';
SMTP.Port:=25;
If (k=0) OR (count=0)then
SMTP.Connect();
try
count:=count+1;
SMTP.Send(email);
//ShowMessage('Sent');
except
on E: Exception do
begin //ShowMessage('Failed: ' + E.Message);
SMTP.disConnect();
SMTP.Connect();
SMTP.Send(email);
end;
end;
end;
finally
email.Free();
html.Free();
if count=14 then
begin
SMTP.Disconnect;
count:=0;
end;
enviados:=enviados+1;
Label2.Caption:=IntToStr(enviados);
end;
end;
ProgressBar1.Position:=0;
ShowMessage('Mensajes Enviados Satisfactoriamente: ' + IntToStr(enviados));
SMTP.Disconnect();
end;
por cierto tambien tengo un problema con este solo me permite mandar hasta 70 correos alguien sabe como hacerle para ke no me rechaze la coexion el server?:o