FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
Registrarse | FAQ | Miembros | Calendario | Guía de estilo | Temas de Hoy |
|
Herramientas | Buscar en Tema | Desplegado |
#1
|
|||
|
|||
Falla al enviar mail en algunas PCs
Hola Foro
tengo la rutina para enviar mails que la consegui de un compañero del club delphi, esta rutina la uso hace un par de años y pude comprobar que en algunas PCs anda y en otras me da error que no puede enviar el mail. He revisado el puerto que sea el 25 y otras cositas, pero no pude detectar cual es el problema. Les dejo la rutina y si alguno me puede dar una idea se lo agradezco. saludos tulio dirmail:='mail@hotmail.com '; mail := TStringList.Create; try mail.values['to'] :=dirmail; mail.values['subject'] := 'Leyenda'; mail.values['attachment0'] :=''; // mail.values['attachment1']:='C:\Test2.txt'; sendEMail(Application.Handle, mail); Finally mail.Free; End; Function tF_Mails.SendEMail(Handle: THandle; Mail: TStrings): Cardinal; type TAttachAccessArray = array [0..0] of TMapiFileDesc; PAttachAccessArray = ^TAttachAccessArray; var MapiMessage: TMapiMessage; Receip: TMapiRecipDesc; Attachments: PAttachAccessArray; AttachCount: Integer; i1: integer; FileName: string; dwRet: Cardinal; MAPI_Session: Cardinal; WndList: Pointer; begin dwRet := MapiLogon(Handle, PChar(''), PChar(''), MAPI_LOGON_UI or MAPI_NEW_SESSION, 0, @MAPI_Session); if (dwRet <> SUCCESS_SUCCESS) then begin MessageBox(Handle, PChar('Error while trying to send email'), PChar('Error'), MB_ICONERROR or MB_OK); end else begin FillChar(MapiMessage, SizeOf(MapiMessage), #0); Attachments := nil; FillChar(Receip, SizeOf(Receip), #0); if Mail.Values['to'] <> '' then begin Receip.ulReserved := 0; Receip.ulRecipClass := MAPI_TO; Receip.lpszName := StrNew(PChar(Mail.Values['to'])); Receip.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['to'])); Receip.ulEIDSize := 0; MapiMessage.nRecipCount := 1; MapiMessage.lpRecips := @Receip; end; AttachCount := 0; for i1 := 0 to MaxInt do begin if Mail.Values['attachment' + IntToStr(i1)] = '' then break; Inc(AttachCount); end; if AttachCount > 0 then begin GetMem(Attachments, SizeOf(TMapiFileDesc) * AttachCount); for i1 := 0 to AttachCount - 1 do begin FileName := Mail.Values['attachment' + IntToStr(i1)]; Attachments[i1].ulReserved := 0; Attachments[i1].flFlags := 0; Attachments[i1].nPosition := ULONG($FFFFFFFF); Attachments[i1].lpszPathName := StrNew(PChar(FileName)); Attachments[i1].lpszFileName := StrNew(PChar(ExtractFileName(FileName))); Attachments[i1].lpFileType := nil; end; MapiMessage.nFileCount := AttachCount; MapiMessage.lpFiles := @Attachments^; end; if Mail.Values['subject'] <> '' then MapiMessage.lpszSubject := StrNew(PChar(Mail.Values['subject'])); if Mail.Values['body'] <> '' then MapiMessage.lpszNoteText := StrNew(PChar(Mail.Values['body'])); WndList := DisableTaskWindows(0); try Result := MapiSendMail(MAPI_Session, Handle, MapiMessage, MAPI_DIALOG, 0); finally EnableTaskWindows( WndList ); end; for i1 := 0 to AttachCount - 1 do begin StrDispose(Attachments[i1].lpszPathName); StrDispose(Attachments[i1].lpszFileName); end; if Assigned(MapiMessage.lpszSubject) then StrDispose(MapiMessage.lpszSubject); if Assigned(MapiMessage.lpszNoteText) then StrDispose(MapiMessage.lpszNoteText); if Assigned(Receip.lpszAddress) then StrDispose(Receip.lpszAddress); if Assigned(Receip.lpszName) then StrDispose(Receip.lpszName); MapiLogOff(MAPI_Session, Handle, 0, 0); end; end; |
#2
|
||||
|
||||
Por favor, utiliza TAG's.
__________________
Germán Estévez => Web/Blog Guía de estilo, Guía alternativa Utiliza TAG's en tus mensajes. Contactar con el Clubdelphi P.D: Más tiempo dedicado a la pregunta=Mejores respuestas. Última edición por Neftali [Germán.Estévez] fecha: 16-04-2010 a las 17:04:37. |
#3
|
||||
|
||||
A mi también me ha salido ese error hoy a ver si aparece el problema.
__________________
Intentando hacer algo con Delphi 7 y Firebird 1.5 |
|
|
Temas Similares | ||||
Tema | Autor | Foro | Respuestas | Último mensaje |
Problema al enviar Mail | jcarteagaf | Varios | 10 | 09-05-2008 22:03:35 |
enviar mail | mjjj | Varios | 4 | 29-04-2008 03:50:17 |
Enviar e-mail | D-MO | PHP | 5 | 10-01-2006 19:21:08 |
enviar mail | amadis | API de Windows | 2 | 06-05-2005 04:02:02 |
Enviar mail con Gmail | Sotrono | Internet | 2 | 17-04-2005 21:19:05 |
|