Ver Mensaje Individual
  #42  
Antiguo 11-07-2007
Phantom_Drake Phantom_Drake is offline
Miembro
 
Registrado: jun 2007
Posts: 13
Reputación: 0
Phantom_Drake Va por buen camino
Post

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
Código Delphi [-]
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('
'
); richedit1.Lines.Add('
'
); richedit1.Lines.Add('
'
); richedit1.Lines.Add('
'
); richedit1.Lines.Add('
'
); richedit1.Lines.Add('
'
); richedit1.Lines.Add('
'
); richedit1.Lines.Add(''); richedit1.Lines.Add(''); //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.Add(''); html.Add(''); html.Add('

Hello

'); //html.Add(''); html.Add(''); html.Add('');}
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?
Responder Con Cita