Volviendo al tema CDO

[Carlos Mora]

Armando,

la unica vez que he tenido problemas ha sido por culpa de los antivirus, que a veces confunden tu programa con un troyano tratando de hacer spam. Prueba de desactivar el antivirus, y/o registar tu ejecutable como válido. En la página web de harbouradvisor puedes descargar un ejemplo funcional, solo tienes que crear una cuenta en gmail y usarla( la cuenta del ejemplo antes servía, pero como está la contraseña algún imberbe entro a gmail y la cambió, inutilizándola).

Suerte

[jll-fwh]

Hola Armando:

Prueba con Harbour, estoy creando un programa para el envio/recepción de emails con las clases/funciones de harbour, de momento las pruebas que tengo funciona todo perfectamente.

Como todavía tardare días en terminarlo porque estoy liado con otras cosas, puedes probar con harbour, hay dos formas de enviar correos, usando directamente HB_SendMail() o usando tu las clases, en tu caso, es mas facil usar la función directamente.

Prueba y ya me comentas.

El código es el siguiente:

Code: Select all  Expand view

/*---------------------------------------------------------------------------------------*/
/*      Archivo: Proc9998.PRG                                                            */
/*  Descripcion: Pruebas envio de e-mails                                                */
/*        Fecha: Modificada el 27-10-2010                                                */
/*      Release: 1.0                                                                     */
/*        Autor: Jose Javier LLoris Roig                                                 */
/*---------------------------------------------------------------------------------------*/

#Include "FiveWin.CH"

Function SendMail_HB()

   MsgRun( "Enviando correo electrónico a:",;
           "Espere por Favor...",;
           { || SendMail_HBB() } )

Return NIL

STATIC Function SendMail_HBB()

/*
   cServer    -> Required. IP or domain name of the mail server
   nPort      -> Optional. Port used my email server
   cFrom      -> Required. Email address of the sender
   aTo        -> Required. Character string or array of email addresses to send the email to
   aCC        -> Optional. Character string or array of email adresses for CC (Carbon Copy)
   aBCC       -> Optional. Character string or array of email adresses for BCC (Blind Carbon Copy)
   cBody      -> Optional. The body message of the email as text, or the filename of the HTML message to send.
   cSubject   -> Optional. Subject of the sending email
   aFiles     -> Optional. Array of attachments to the email to send
   cUser      -> Required. User name for the POP3 server
   cPass      -> Required. Password for cUser
   cPopServer -> Required. Pop3 server name or address
   nPriority  -> Optional. Email priority: 1=High, 3=Normal (Standard), 5=Low
   lRead      -> Optional. If set to .T., a confirmation request is send. Standard setting is .F.
   lTrace     -> Optional. If set to .T., a log file is created (sendmail.log). Standard setting is .F.
   lNoAuth    -> Optional. Disable Autentication methods
   nTimeOut   -> Optional. Number os ms to wait default 20000 (20s)
   cReplyTo   -> Optional.
*/
   local cServer    := "servidor.SMTP"               // -> Required. IP or domain name of the mail server
   local nPort      := 25                           // -> Optional. Port used my email server
   local cFrom      := "cuentacorreo@correo.com"  // -> Required. Email address of the sender
   local aTo        := "cuentaenvio@correo.com"  // -> Required. Character string or array of email addresses to send the email to
   local aCC        := {}                           // -> Optional. Character string or array of email adresses for CC (Carbon Copy)
   local aBCC       := {}    // -> Optional. Character string or array of email adresses for BCC (Blind Carbon Copy)
   local cBody      := "cuerpo0001"    // -> Optional. El cuerpo del mensaje del correo electrónico como texto o el nombre del archivo HTML del mensaje a enviar.
   local cSubject   := "Asunto...."    // -> Optional. Subject of the sending email
   local aFiles     := {}              // -> Optional. Array of attachments to the email to send
   local cUser      := "usuario"    // -> Required. User name for the POP3 server
   local cPass      := "password"    // -> Required. Password for cUser
   local cPopServer := "servidor.pop.com" //"pop3.ono.com"     //-> Required. Pop3 server name or address
   local nPriority  := 1    //-> Optional. Email priority: 1=High, 3=Normal (Standard), 5=Low
   local lRead      := .f.     //-> Optional. If set to .T., a confirmation request is send. Standard setting is .F.
   local lTrace     := .f.     //-> Optional. If set to .T., a log file is created (sendmail.log). Standard setting is .F.
   local lPopAuth   := .f.
   local lNoAuth    := .f.     //-> Optional. Disable Autentication methods
   local nTimeOut   := 1000    //-> Optional. Number os ms to wait default 20000 (20s)
   local cReplyTo   := ""    //-> Optional.

   IF ! HB_SendMail( cServer,;
                     nPort,;
                     cFrom,;
                     aTo,;
                     aCC,;
                     aBCC,;
                     cBody,;
                     cSubject, ;
                     aFiles,;
                     cUser,;
                     cPass,;
                     cPopServer,;
                     nPriority,;
                     lRead,;
                     lTrace, ;
                     lPopAuth,;
                     lNoAuth,;
                     nTimeOut,;
                     cReplyTo )

      MsgSTOP( "No se ha podido enviar el correo." )

  ELSE
      MsgINFO( "Correo enviado correctamente." )
   END

Return NIL

 

Para compilar debes de enlazar las siguientes librerias ( yo uso FWH1109 ).

echo $(HBDIR)\lib\hbtip.lib + >> b32.bc
echo $(HBDIR)\lib\hbpcre.lib + >> b32.bc
echo $(HBDIR)\lib\ws2_32.lib + >> b32.bc

Si quieres cuando termine el programa y funcione todo OK, te paso lo fuentes.

Por cierto, no depende de microsoft para nada.

Te dejo unos pantallazoa, todavía me falta bastante, ESTO ES SOLO UN ESQUELETO, UNA BASE, a partir de ahora es cuando empiezo el programa.






Si tienes MSN, agregame y te puedo ayudar ONLINE: fwh-jll@hotmail.es

Espero que te sirva.
Un saluo
JLL

[Armando Picon]

JLL (Jose Javier)

Gracias por el ejemplo. El "pantallazo" indica que tiene una gran apariencia, me gusta sobre todo el poder enviar imágenes en el correo. Voy a intentar adaptar el codigo a mis necesidades.

También te hago conocer que logré, con el codigo de Anserkk y ACuellar más el mio propio, volver a enviar correo sin formato alguno desde un equipo con XP SP3. Luego debo probarlo en una laptop con Win 7 64Bits. Finalmente debo volver a integrarlo en una aplicación que acabo de entregar (sin la opción de enviar email que queda como pendiente). El paso siguiente es dar formato al texto contenido en el cuerpo del correo. Llegando a este punto me parece que ya podré entregarlo al foro para que le sirva a alguien.

Mientras tanto; voy a iniciar pruebas separadas con tu codigo para que en el futuro pueda reemplazar el codigo que actualmente está apoyado en CDOSYS de Microsoft.

[Bayron]

[Armando Picon]

JLL, Anserkk, ACuellar

Probé el codigo para enviar correos, con apoyo de CDOSYS de Microsoft, tanto en equipo con XP-SP3 y WIN 7 - 64bits. Funciona muy bien. Como digo solamente falta que el texto del mensaje sea hecho con formato para que sea más adecuado. Asi como está funciona y cumple el cometido.

Este el codigo final que puede ser adaptado a las necesidades de quien lo vaya a usar.

/*
eMailCDO.prg File

Funcion: fEmail(cTo)
Utilizado para enviar email con apoyo de la librería CDOSYS de Microsoft.
Compilado en base a una rutina original proporcionada pOr Manuel Mercado y modificaciones
de Anserkk, ACuellar, Jose Javier LLoris (JLL) a los cuales les agradezco el inmenso apoyo
desinteresadamente proporcionado.
*
Econ. Armando Picón S
Fecha: 03 de Noviembre del 2011
Lima - Perú
Pendiente: 1. Convertir cBody a texto con formato
*
*/
#include "FiveWin.ch"
*#include "FGet.ch"
#include "Fileio.ch"
*
#define WS_3DLOOK 4
#define CLR_HBROWN nRGB( 205, 192, 176 )
#define CLR_NBLUE nRGB( 142, 171, 194 )
*
STATIC oDlg, oFont, oFont2
STATIC nLine := 1
//--------------------------------------------------------------------------------------------------------------------//
Function fEmail(cTo) // Recibe como parametro el correo electronico del cliente
*
local hBorland //:= LoadLibrary("SgemBW32.DLL")
Local oDlg, oFont, oFont2, oFont3
Local oGet1, oGet2, oGet3, oGet4, oGet5
Local oBt1, oBt2, oBt3, oIni
Local cnPort := 25
Local cNombre := ""
local cBcc := SPACE(600),;
cSubject:= SPACE(120),;
cAttach := SPACE(600),;
cBody := SPACE(800)
Local hIniFile
local xcTo :=Space(80)
local lClear := .F.
local nIError := 0
local cHost := ""
*
*
PUBLIC cMailServer,; //:= PadR( "smtp.gmail.com", 60 ), ; // servidor de correo
cFrom ,; //:= PadR( "remitente@gmail.com", 60 ), ; // remitente
nPort ,; //:= 465, ; // puerto usado por el servidor de correo
cUser ,; //:= Space( 60 ), ; // nombre de usuario para autenticación
cPass //:= Space( 30 ) // contraseña para autenticación

IF cto == NIL /* Cuando no ha recibido un email de entrada */
hBorland := LoadLibrary("SgemBW32.DLL")
BWCCRegister( GetResources() )
cTo := PadR( xcTo, 180 )
*cNombre := ""
ELSE
* cNombre := SayGetClien() // forma parte de mis librerias
cTo := PadR( cto, 180 )
ENDIF
*
IF !FILE( "emailCdo.ini" )
CreaIni()
ENDIF
*
hIniFile := HB_ReadIni( "emailcdo.ini" )
cMailServer :=hIniFile["SETUPMAIL"]["MailServer"]
nPort :=hIniFile["SETUPMAIL"]["puerto"]
cuser :=hIniFile["SETUPMAIL"]["usuario"]
cpass :=hIniFile["SETUPMAIL"]["password"]
cFrom :=hIniFile["SETUPMAIL"]["remitente"]
*
* asegurando que tenemos conexion a Internet mediante Windows Sockets DLL.
nIError := WSAStartup()
IF nIError == 0 // Si hay conexion
*
WSACleanUp() // Limpiamos Windows Sockets DLL
*
DEFINE FONT oFont NAME "Arial" SIZE 0, -16
DEFINE FONT oFont2 NAME "Arial" SIZE 0, -14
DEFINE FONT oFont3 NAME "Arial" SIZE 0, -12
*
DEFINE DIALOG oDlg RESOURCE "Email" ;
COLORS CLR_BLUE, CLR_LIGHTGRAY ;
STYLE nOR( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, WS_3DLOOK )
*
oDlg:lHelpIcon := .F.
oDlg:cCaption := " Mensaje Electrónico " //para - " // +cNombre
oDlg:bKeydown := {|nKey| if( nKey == VK_F12 , ;
(SetupMail(cMailServer, nPort, cUser, cPass, cFrom), ;
oDlg:Setfocus()), Nil) }
*
REDEFINE GET oGet1 VAR cTo OF oDlg ; // Destinatario
ID 101 ;
FONT oFont2 UPDATE PICTURE "@KS60"

REDEFINE GET oGet2 VAR cBCC OF oDlg ; // con copia a
ID 102 ;
FONT oFont2 UPDATE PICTURE "@KS60"

REDEFINE GET oGet3 VAR cSubject OF oDlg ; // Asunto
ID 103 ;
FONT oFont2 UPDATE PICTURE "@KS60"

REDEFINE GET oGet4 VAR cAttach OF oDlg ; // anexos
PICTURE "@KS60" ;
ID 104 ;
FONT oFont2 UPDATE ;
COLORS CLR_BLUE, CLR_WHITE // ACTION fAddAttach( aCtl[ 12 ] ) ; // descomentar para FWH 8.12 o posterior

REDEFINE GET oGet5 VAR cBody OF oDlg ; // cuerpo del mensaje
MULTILINE ;
ID 105 ;
FONT oFont3 ;
UPDATE ;
COLORS CLR_BLACK, CLR_WHITE

oGet5:bKeydown := { |KeyStroke| IIF( KeyStroke==VK_RETURN, ;
(oGet5:cText(cBody+=CRLF),;
oGet5:GoBottom()),;
oGet5:Paste(KeyStroke) ) }

REDEFINE BUTTON oBt1 ;
ID 108 ;
OF oDlg ; // buscar anexos
ACTION fAddAttach( oGet4 )

REDEFINE BTNBMP oBt2 ; // enviar el mensaje
ID 256 ;
OF oDlg ;
RESOURCE "enviar" ; /*Tiene que colocar su imagen */
ACTION ( fSendMail( cTo, cBCC, cSubject, cBody, cAttach ),;
oGet5:cText(cBody:=SPACE(800)),;
oGet5:Setfocus(),;
oGet5:refresh(), oBt2:refresh(),;
oGet1:cText(cTo:=SPACE(80)),;
oGet2:cText(cBCC:=SPACE(600)),;
oGet3:cText(cSubject:=SPACE(600)),;
oGet4:cText(cAttach:=SPACE(600)),;
oGet1:refresh(),;
oGet2:refresh(),;
oGet3:refresh(),;
oGet4:refresh()) ;
WHEN !EMPTY(cTo)

REDEFINE BUTTON oBt3 ;
ID 2 ; /* Imagen automática de Borland WorkShop*/
OF oDlg ; // Salir sin hacer nada
ACTION ( lClear := .T., oDlg:End() )

ACTIVATE DIALOG oDlg CENTERED //;
//VALID ( .T. )
*
IF lClear
RELEASE cMailServer, cFrom, nPort, cUser, cPass
ENDIF
*
oFont:End()
oFont2:End()
oFont3:End()
IF cTo==NIL
FreeLibrary(hBorland)
ENDIF
ELSE
MsgAlert("No hay conexion a Internet","Upsss...!")
WSACleanUp() // Limpiamos Windows Sockets DLL
ENDIF
*

Return Nil
************* Si utiliza un archivo de recursos de Borland WorkShop *********
******** descomente la siguiente linea ****************
*DLL32 FUNCTION BWCCRegister( hInst AS LONG ) AS WORD PASCAL LIB "BWCC32.DLL"
***********************************************************************************************
//---------------------------------------------------------------------------------------------//

Function fSendMail( cTo, cBCC, cSubject, cBody, cAttach )

Local oCfg, oMsg, oError, nEle, cToken, ;
aAttach := {}, ;
lAuth := IIF(! Empty( cUser ) .and. ! Empty( cPass ), .T., .F.) ,;
nSendOpt := 2 // send using: 1 = pickup folder 2 = port
*
Default cSubject := "Text de correo con CDO", ;
cBody := "Test de prueba de correo con CDO"
*
IF ! EMPTY( cTo )

If "GMAIL.COM" $ Upper( cMailServer ) .and. ( Empty( cUser ) .or. Empty( cPass ) )
MsgStop( "Con GMail son requeridos nombre de usuario y contraseña", "ATENCION" )
Return Nil
EndIf

CursorWait()

nEle := 1

While ! Empty( cToken := StrToken( cAttach, nEle++, "," ) )
AAdd( aAttach, cToken )
EndDo

Try
oCfg := CreateObject( "CDO.Configuration" )

With Object oCfg:Fields

:Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := allTrim( cMailServer )
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := nPort
:Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := nSendOpt // Remote SMTP = 2, local = 1
If lAuth
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := .T.
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value := .T.
:Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" ):Value := allTrim( cUser )
:Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ):Value := allTrim( cPass )
:Item( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"):Value := 30
EndIf

:Update()

End With

oMsg := CreateObject( "CDO.Message" )

With Object oMsg
:Configuration := oCfg
:From := allTrim( cFrom )
:To := allTrim( cTo )
:Subject := allTrim( cSubject )
:TextBody := allTrim( cBody )

For nEle := 1 To Len( aAttach )
:AddAttachment(AllTrim( aAttach[ nEle ] ) )
Next

If ! Empty( cBCC )
:BCC := Trim( cBCC )
EndIf

:Send()
End With

Catch oError
CursorArrow()
MsgStop( "Could not send the message" + CRLF + "Error: " + cValToChar( oError:GenCode) + CRLF + ;
"SubC: " + cValToChar( oError:SubCode ) + CRLF + "OSCode: " + cValToChar( oError:OsCode ) + CRLF + ;
"SubSystem: " + cValToChar( oError:SubSystem ) + CRLF + "Message: " + oError:Description )

oCfg := Nil
oMsg := Nil
Return Nil
End Try

oCfg := Nil
oMsg := Nil
SndPlaySound( GetWinDir() + "\media\Tada.wav", 0 )
CursorArrow()

ELSE
MsgStop("No hay Destinatario"+CRLF+;
"Envio CANCELADO", "Upsss...!" )
ENDIF
*

Return Nil

//---------------------------------------------------------------------------------------------//

Static Function fAddAttach( oGet )

Local cFile, ;
cAttach := oGet:VarGet()

cFile := cGetFile( "*.*", "Selecciona el archivo" )

If ! Empty( cFile )
cAttach := Lower( PadR( AllTrim( cAttach ) + If( ! Empty( cAttach ), ",", "" ) + AllTrim( cFile ), 180 ) )
EndIf

oGet:cText( cAttach )

Return Nil

********************************************************************************
Static Function SetupMail()
LOCAL oDlg, oBt1, oBt2
Local oGet1, oGet2, oGet3, oGet4, oGet5
local oIni
local lOk := .F.
*
local cxMailServer:=ALLTRIM(cMailServer)+REPLICATE(" ",60-LEN(ALLTRIM(cMailServer)))
local nxPort:=nPort
local cxUser:=ALLTRIM(cUser)+REPLICATE(" ",60-LEN(ALLTRIM(cUser)))
local cxPass:=ALLTRIM(cPass)+REPLICATE(" ",30-LEN(ALLTRIM(cPass)))
local cxFrom:=ALLTRIM(cFrom)+REPLICATE(" ",60-LEN(ALLTRIM(cFrom)))
*
DEFINE DIALOG oDlg RESOURCE "EmailSetup"
REDEFINE GET oGet1 VAR cxMailServer ID 101 OF oDlg
REDEFINE GET oGet2 VAR nxPort ID 102 OF oDlg PICTURE "9999"
REDEFINE GET oGet3 VAR cxUser ID 103 OF oDlg
REDEFINE GET oGet4 VAR cxPass ID 104 OF oDlg
REDEFINE GET oGet5 VAR cxFrom ID 105 OF oDlg

REDEFINE BUTTON oBt1 ID 1 OF oDlg ACTION (lOk := .T., oDlg:end() )
REDEFINE BUTTON oBt2 ID 2 OF oDlg ACTION oDlg:end()
ACTIVATE DIALOG oDlg CENTERED

IF lOk
cMailServer :=ALLTRIM(cxMailServer)
nPort :=nxPort
cUser :=ALLTRIM(cxUser)
cPass :=ALLTRIM(cxPass)
cFrom :=ALLTRIM(cxFrom)
*
WriteIni() // escribe los nuevos valores al archivo INI
*
ENDIF

RETURN NIL

Static FUNCTION CreaIni()
local cText := ""
local nFileHandle
*
nFileHandle := FCreate( "emailCDO.ini", FC_NORMAL )
cText := "[SETUPMAIL]"+CRLF+;
"MailServer = "+"smtp.gmail.com"+CRLF+;
"remitente = "+"apic1002002@gmail.com"+CRLF+;
"puerto = "+"465"+CRLF+;
"usuario = "+"apic1002002@gmail.com"+CRLF+;
"password = "+"123456789"+CRLF // aqui va mi clave en el servidor de gmail
FWrite( nFileHandle, cText )
FClose( nFileHandle )
*
RETURN NIL

STATIC FUNCTION ReadIni()
local oIni

INI oIni FILENAME ( "./emailCdo.ini" )
GET cMailServer SECTION 'SETUPMAIL' ENTRY 'MailServer' OF oIni
GET cFrom SECTION 'SETUPMAIL' ENTRY 'remitente' OF oIni
GET nPort SECTION 'SETUPMAIL' ENTRY 'puerto' OF oIni
GET cuser SECTION 'SETUPMAIL' ENTRY 'usuario' OF oIni
GET cpass SECTION 'SETUPMAIL' ENTRY 'password' OF oIni
ENDINI

RETURN NIL

Static FUNCTION WriteIni()
local oIni
INI oIni FILENAME ( "./emailCdo.ini" )
SET SECTION "SETUPMAIL" ENTRY 'MailServer' TO cMailServer OF oIni
SET SECTION "SETUPMAIL" ENTRY 'remitente' TO cFrom OF oIni
SET SECTION "SETUPMAIL" ENTRY 'puerto' TO nPort OF oIni
SET SECTION "SETUPMAIL" ENTRY 'usuario' TO cUser OF oIni
SET SECTION "SETUPMAIL" ENTRY 'password' TO cpass OF oIni
ENDINI

Return nil
***********************************