FiveTech Support Forums

FiveWin / Harbour / xBase community
Board indexAll discussionsLogin (GitHub)
Board index FiveWin para Harbour/xHarbour Volviendo al tema CDO
Armando Picon
Posts: 446
Joined: Mon Dec 26, 2005 09:11 PM
Volviendo al tema CDO
Posted: Fri Oct 28, 2011 07:58 PM

Amigos

Tengo una peque帽a traba, supongo que debe ser simple pero me est谩 complicando. En varias aplicaciones he utilizado CDO para enviar correos y siguen funcionando en los equipos de los clientes. El caso es que, recientemente, para un cliente nuevo, he vuelto a querer dotarle al modulo de clientes esta funcionalidad. Compile y enlaz茅 la aplicaci贸n y... no pasa nada. Estoy recibiendo una completa negaci贸n de ejecuci贸n de la aplicaci贸n.

Si lo compilo como una aplicaci贸n independiente de correo, cuando no me niega la ejecuci贸n el programa "casca" con un mensaje de "DISP_E_MEMBERNOTFOUND y no s茅 porqu茅. He comparado el codigo de las aplicaciones donde funciona y son iguales, salvo algunas modificaciones para adecuarlo a los requerimientos del nuevo programa.

Adicionalmente; el c贸digo original de CDOSYS que tuve, a partir de cuya adecuaci贸n hice el programa de correos, fue borrado de mi USB de trabajo.

Por otra parte he cambiado el desarrollo de aplicaciones a una Laptop con Window 7-64bits y es donde empec茅 a tener las dificultades. He intentado volver a compilar y enlazar en el equipo antiguo con XP SP3 y tambi茅n obtengo la misma respuesta (o me niega ejecutar la aplicaci贸n o me d谩 el mensajito de marras)

Resumiendo. Estoy atascado y no le encuentro soluci贸n. Por esas cosas... 驴tiene algui茅n codigo que haya sido probado en Win 7-64bits, que enlaze y funcione sin trabas? De ser as铆, 驴pueden compartirlo conmigo? Se los agradecer茅 mucho.

Saludos y gracias por adelantado.

Armando

Nota. Mi correo es "apic1002002@yahoo.es"

FWH + BCC582 + WorkShop 4.5 + Resource Hacker + Mingw
Mis nuevas herramientas
Comunicacion via WhatsApp (+51) 957549 665
Comunicaci贸n via Correo: apic1002002 at yahoo dot es; apic1002002@gmail.com
jll-fwh
Posts: 408
Joined: Fri Jan 29, 2010 08:14 PM
Re: Volviendo al tema CDO
Posted: Fri Oct 28, 2011 11:27 PM

Hola armando:

Pon tu codigo y veremos donde tienes el problema, yo uso CDO para el envio de emails con WIN7 64bits sin problemas.

El problema no vendra de FWH ni SO, creo que tu problema estara en que en algun sitio tendras alguna variable inicializada diferente o en su defecto que las cuentas necesitan identificarse en el servidor.

Si quieres probar algo para saber por donde van los tiros, crea una cuenta GMAIL, y que la salida del SMTP sea smtp.gmail.com puerto 465, y luego lo pruebas en los distintos equipos, asi sabremos si el problema viene de ahi o de codigo.

P.D Cuando tenga un hueco quiero cambiar la gestion de correo a las clases/funciones de harbour a ver si funcionan mejor y no hay problemas a la hora de actualizar FWH. De momento a ver si podemos ayudarte sobre CDO.

Si quieres esta semana terminare las modificaciones que crean los e-mails con formato RTF y lo envia en formato HTML, te la envio por si te interesa.

Un saludo
JLL

Libreria: FWH/FWH1109 + Harbour 5.8.2 + Borland C++ 5.8.2
Editor de Recursos: PellecC
ADA, OURXDBU
S.O: XP / Win 7 /Win10
Blog: http://javierlloris.blogspot.com.es/
e-mail: javierllorisprogramador@gmail.com
Armando Picon
Posts: 446
Joined: Mon Dec 26, 2005 09:11 PM
Re: Volviendo al tema CDO
Posted: Sat Oct 29, 2011 12:49 AM

JLL
Encantado de recibir tu apoyo. Este CDO se esta poniendo "canija". Funciona normalmente lo que hice anteriormente para clientes pero el mismo codigo ahora "nada de nada". Como alguna vez afirm茅 "cosa de inform谩tica".
Saludos
Armando

Nota. Tengo cuenta de gmail, de yahoo y de hotmail. A todos ellos accedo desde linux mediante un cliente de correo y por eso conozco todas las coordenadas de acceso para SMTP y para POP.

FWH + BCC582 + WorkShop 4.5 + Resource Hacker + Mingw
Mis nuevas herramientas
Comunicacion via WhatsApp (+51) 957549 665
Comunicaci贸n via Correo: apic1002002 at yahoo dot es; apic1002002@gmail.com
jll-fwh
Posts: 408
Joined: Fri Jan 29, 2010 08:14 PM
Re: Volviendo al tema CDO
Posted: Sat Oct 29, 2011 01:01 AM

Publica la parte de c贸digo que crea el objeto CDO a ver si vemos algo diferente.

un saludo
JLL

Libreria: FWH/FWH1109 + Harbour 5.8.2 + Borland C++ 5.8.2
Editor de Recursos: PellecC
ADA, OURXDBU
S.O: XP / Win 7 /Win10
Blog: http://javierlloris.blogspot.com.es/
e-mail: javierllorisprogramador@gmail.com
Armando Picon
Posts: 446
Joined: Mon Dec 26, 2005 09:11 PM
Re: Volviendo al tema CDO
Posted: Sat Oct 29, 2011 02:35 AM
JLL

Aqui va el codigo que viene funcionando en clientes y que ahora no puedo hacerlo funcionar:

Code (fw): Select all Collapse
#include "FiveWin.ch"
#include "CdoSys.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 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
STATIC nLine := 1
//--------------------------------------------------------------------------------------------------------------------//

*Function fEmail(cMailServer, cFrom, cnPort, cUser, cPass )
Function fEmail(cTo) 聽// Recibe como par谩metro el correo electr贸nico del cliente

聽 聽*local hBorland 聽 聽:= LoadLibrary("SgemBW32.DLL")
聽 聽 Local oDlg, oFont, oFont2, oFont3
聽 聽 Local oGet1, oGet2, oGet3, oGet4, oGet5
聽 聽 Local oBt1, oBt2, oBt3
聽 聽 Local cnPort:=25
聽 聽 Local cNombre:= ""
聽 聽 local cBcc := SPACE(600),;
聽 聽 聽 聽 聽 cSubject:=SPACE(120),;
聽 聽 聽 cAttach:=SPACE(600),;
聽 聽 聽 cBody 聽:=SPACE(800)
聽 聽 *
聽 聽 IF cto == NIL
聽 聽 聽 聽cTo 聽:= PadR( cTo, 180 )
聽 聽 ELSE
聽 聽 聽 聽cNombre 聽 聽 := SayGetClien() 聽 聽// forma parte de mis librerias
聽 聽 聽 聽cTo 聽:= PadR( "_destinatarios@hotmail.com", 180 )
聽 聽 ENDIF
聽 聽 *
聽 聽 IF !FILE( "emailCdo.ini" )
聽 聽 聽 聽CreaIni()
聽 聽 ENDIF
聽 聽 *
聽 聽 ReadIni() // proporciona los valores static
聽 聽 *
聽 聽 INI oIni FILENAME ( "./emailCdo.ini" )
聽 聽 聽 聽 GET cMailServer 聽 聽SECTION 'SETUPMAIL' ENTRY 'MailServer' 聽 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
聽 聽 聽 聽 GET cFrom 聽 聽 聽 聽 聽SECTION 'SETUPMAIL' ENTRY 'remitente' 聽 聽OF oIni
聽 聽 ENDINI

聽 聽DEFINE FONT oFont 聽NAME "Arial" SIZE 0, -16
聽 聽DEFINE FONT oFont2 NAME "Arial" SIZE 0, -10
聽 聽DEFINE FONT oFont3 NAME "Arial" SIZE 0, -14
聽 聽nPort := cnPort
聽 聽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贸nco 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" ;
聽 聽 聽 聽 聽 聽 聽 聽 COLORS CLR_BLUE, CLR_WHITE //SIZE 264, 11 PIXEL

聽 聽 聽 聽REDEFINE GET oGet2 聽VAR cBCC OF oDlg 聽 聽 聽; 聽 聽 聽 聽 聽 聽 聽 // con copia a
聽 聽 聽 聽 聽 聽 聽 聽 ID 102 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 FONT oFont2 聽UPDATE 聽PICTURE "@KS60" ;
聽 聽 聽 聽 聽 聽 聽 聽 COLORS CLR_BLUE, CLR_WHITE //SIZE 264, 11 PIXEL

聽 聽 聽 聽REDEFINE GET oGet3 聽VAR cSubject OF oDlg 聽 ; 聽 聽 聽 聽 聽 聽 // Asunto
聽 聽 聽 聽 聽 聽 聽 聽 ID 103 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽;
聽 聽 聽 聽 聽 聽 聽 聽 FONT oFont2 聽UPDATE PICTURE "@KS60" 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 COLORS CLR_BLUE, CLR_WHITE

聽 聽 聽 聽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
聽 聽 聽 聽 聽 聽 聽 聽 MEMO 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 ID 105 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽;
聽 聽 聽 聽 聽 聽 聽 聽 FONT oFont3 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 UPDATE 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽;
聽 聽 聽 聽 聽 聽 聽 聽 COLORS CLR_BLUE, CLR_WHITE
聽 聽 聽 聽 oGet5:bKeydown := { |KeyStroke| IIF( KeyStroke==VK_RETURN, ;
聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽(oGet5:cText(cBody+=CRLF),;
聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 oGet5:GoBottom()),;
聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 oGet5:Paste(KeyStroke) ) }

聽 聽 聽 聽REDEFINE BTNBMP oBt1 ID 108 聽 聽 聽;
聽 聽 聽 聽 聽 聽 聽 聽 RESOURCE "Attach" 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 OF oDlg 聽 聽 聽 聽 聽 聽 聽 聽 ; 聽 聽 聽 聽 聽 // buscar anexos
聽 聽 聽 聽 聽 聽 聽 聽 ACTION fAddAttach( oGet4 )

聽 聽 聽 聽REDEFINE BTNBMP oBt2 ID 106 聽 聽 聽; 聽 聽 聽 聽 聽 // enviar el mensaje
聽 聽 聽 聽 聽 聽 聽 聽 OF oDlg 聽 聽 聽 聽 聽 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 RESOURCE "SendMail" 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 FONT oFont2 聽 聽 聽 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 ACTION ( fSendMail( cTo, cBCC, cSubject, cBody, cAttach ),;
聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 oGet5:cText(cBody:=SPACE(800)),;
聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 oGet5:Setfocus(),;
聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 oGet5:refresh(), oBt2:refresh() 聽)

聽 聽 聽 聽REDEFINE BUTTON oBt3 聽ID 2 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 OF oDlg 聽 聽 聽 聽 聽 聽 聽 聽 ; 聽 聽 聽 聽 聽 // Salir sin hacer nada
聽 聽 聽 聽 聽 聽 聽 聽 FONT oFont2 聽 聽 聽 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 ACTION oDlg:End()

聽 聽ACTIVATE DIALOG oDlg CENTERED //;
聽 聽 聽 聽 聽 聽 //VALID ( .T. )

聽 聽oFont:End()
聽 聽oFont2:End()
聽 聽oFont3:End()
* 聽 FreeLibrary(hBorland)

Return Nil
*******************************************************************************
*DLL32 FUNCTION BWCCRegister( hInst AS LONG ) AS WORD PASCAL LIB "SgemBW32.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 "GMAIL.COM" $ Upper( cMailServer ) .and. ( Empty( cUser ) .or. Empty( cPass ) )
聽 聽 聽 MsgStop( "Con GMail son requeridos nombre de usuario y contrase帽a", "Atenci贸n" )
聽 聽 聽 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( cdoSMTPServer ):Value 聽 聽 := allTrim( cMailServer )
聽 聽 聽 聽 聽:Item( cdoSMTPServerPort ):Value := nPort
聽 聽 聽 聽 聽:Item( cdoSendUsing ):Value 聽 聽 聽:= nSendOpt

聽 聽 聽 聽 聽If lAuth
聽 聽 聽 聽 聽 聽 :Item( cdoSMTPAuthenticate ):Value := 1
聽 聽 聽 聽 聽 聽 :Item( cdoSendUserName ):Value 聽 聽 := allTrim( cUser )
聽 聽 聽 聽 聽 聽 :Item( cdoSendPassword ):Value 聽 聽 := allTrim( cPass )
聽 聽 聽 聽 聽 聽 :Item( cdoSMTPUseSSL ):Value := 1
聽 聽 聽 聽 聽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( "No se pudo enviar el mensaje" + CRLF 聽+ "Error: " + cValToChar( oError:GenCode) + CRLF + ;
聽 聽 聽 聽 聽 聽 聽 聽"SubC: " + cValToChar( oError:SubCode ) + CRLF + "OSCode: " + cValToChar( oError:OsCode ) + CRLF + ;
聽 聽 聽 聽 聽 聽 聽 聽"SubSystem: " + cValToChar( oError:SubSystem ) + CRLF + "Mensaje: " + oError:Description )

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

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

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

procedure AppSys 聽// Xbase++ requirement
return

Static FUNCTION CreaIni()
聽 聽 *
聽 聽 nFileHandle := FCreate( "email.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 聽 = "+"miclave"+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
***********************************


Este es el contenido del RC

Code (fw): Select all Collapse
// Add this to your resources RC file

//#ifdef __FLAT
//   1 24 "WindowsXP.Manifest"
//#endif

//#ifdef __64__
//   1 24 "WindowsXP.Manifest64"
//#endif 

//Emailm16 BITMAP "Emailm16.bmp"
//Exitm16  BITMAP "Exitm16.bmp"

SendMail        BITMAP "./images/sendmail.bmp"
Attach          BITMAP "./images/zoom.bmp"
Font        BITMAP  "./bmp/font.bmp"
Bold        BITMAP  "./bmp/Bold.bmp"
Italic      BITMAP  "./bmp/Italic.bmp"
Underline   BITMAP  "./bmp/Under.bmp"
Color       BITMAP  "./bmp/Color.bmp"
Left        BITMAP  "./bmp/Left.bmp"
Centro      BITMAP  "./bmp/Center.bmp"
Right       BITMAP  "./bmp/Right.bmp"




eMail DIALOG 33, 11, 368, 375
STYLE WS_OVERLAPPED | WS_VISIBLE | WS_CAPTION | WS_THICKFRAME
FONT 8, "MS Sans Serif"
{
 LTEXT "Destinatario", -1, 17, 14, 43, 8
 LTEXT "C/Copia a:", -1, 17, 30, 43, 8
 LTEXT "Asunto", -1, 17, 43, 43, 8
 LTEXT "Adj/Archivo", -1, 17, 57, 43, 8
 EDITTEXT 101, 61, 13, 288, 12
 EDITTEXT 102, 61, 27, 288, 12
 EDITTEXT 103, 61, 41, 288, 12
 EDITTEXT 104, 61, 55, 271, 12
 EDITTEXT 105, 17, 79, 333, 245, ES_MULTILINE | WS_BORDER | WS_TABSTOP
 CONTROL "", 106, "BorBtn", BS_PUSHBUTTON | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 20, 341, 37, 

25
 CONTROL "Button", 2, "BorBtn", BS_PUSHBUTTON | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 310, 341, 

37, 25
 GROUPBOX " Mensaje", 107, 12, 69, 343, 260, BS_GROUPBOX
 PUSHBUTTON "", 108, 333, 55, 17, 14
}
setup DIALOG 35, 26, 368, 169
STYLE WS_OVERLAPPED | WS_VISIBLE | WS_CAPTION
CAPTION "Parametros de Conexi贸n"
FONT 8, "MS Sans Serif"
{
 LTEXT "Servidor SMTP", -1, 10, 14, 50, 8
 LTEXT "Puerto SMTP", -1, 16, 30, 44, 8
 LTEXT "Usuario", -1, 33, 51, 27, 8
 LTEXT "Clave Acceso", -1, 14, 65, 46, 8
 LTEXT "Remitente", -1, 25, 93, 35, 8
 EDITTEXT 101, 61, 13, 288, 12
 CONTROL "1234", 102, "EDIT", WS_BORDER | WS_TABSTOP, 61, 27, 23, 12
 EDITTEXT 103, 61, 49, 288, 12
 EDITTEXT 104, 61, 63, 288, 12
 EDITTEXT 105, 61, 91, 288, 12
 CONTROL "", 1, "BorBtn", BS_PUSHBUTTON | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 20, 123, 37, 25
 CONTROL "", 2, "BorBtn", BS_PUSHBUTTON | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 310, 123, 37, 25
}
FWH + BCC582 + WorkShop 4.5 + Resource Hacker + Mingw
Mis nuevas herramientas
Comunicacion via WhatsApp (+51) 957549 665
Comunicaci贸n via Correo: apic1002002 at yahoo dot es; apic1002002@gmail.com
anserkk
Posts: 1335
Joined: Fri Jun 13, 2008 11:04 AM
Re: Volviendo al tema CDO
Posted: Mon Oct 31, 2011 06:47 AM
Dear Mr.Armando,

I made some modifications to your code. Please try this code. Tested here with my Gmail A/c and is working fine.

Code (fw): Select all Collapse
#include "FiveWin.ch"
*#include "CdoSys.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 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
STATIC nLine := 1
//--------------------------------------------------------------------------------------------------------------------//

*Function fEmail(cMailServer, cFrom, cnPort, cUser, cPass )
Function fEmail(cTo) 聽// Recibe como par谩metro el correo electr贸nico del cliente

聽 聽*local hBorland 聽 聽:= LoadLibrary("SgemBW32.DLL")
聽 聽 Local oDlg, oFont, oFont2, oFont3
聽 聽 Local oGet1, oGet2, oGet3, oGet4, oGet5
聽 聽 Local oBt1, oBt2, oBt3
聽 聽 Local cnPort:=25
聽 聽 Local cNombre:= ""
聽 聽 local cBcc := SPACE(600),;
聽 聽 聽 聽 聽 cSubject:=SPACE(120),;
聽 聽 聽 cAttach:=SPACE(600),;
聽 聽 聽 cBody 聽:=SPACE(800)
聽 聽 聽 
聽 聽 Local hIniFile 聽 聽 聽
聽 聽 *
聽 聽 cTo:=Space(80)
聽 聽 IF cto == NIL
聽 聽 聽 聽cTo 聽:= PadR( cTo, 180 )
聽 聽 ELSE
* 聽 聽 聽 cNombre 聽 聽 := SayGetClien() 聽 聽// forma parte de mis librerias
聽 聽 聽 聽cTo 聽:= PadR( "xxxxxx@xxsssss.com", 180 )
聽 聽 ENDIF
聽 聽 *
聽 聽 IF !FILE( "emailCdo.ini" )
聽 聽 聽 聽CreaIni()
聽 聽 ENDIF
聽 聽 
/* 聽 聽
聽 聽 *
聽 聽 ReadIni() // proporciona los valores static
聽 聽 *
聽 聽 INI oIni FILENAME ( "emailcdo.ini" )
聽 聽 聽 聽 GET cMailServer 聽 聽SECTION 'SETUPMAIL' ENTRY 'MailServer' 聽 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
聽 聽 聽 聽 GET cFrom 聽 聽 聽 聽 聽SECTION 'SETUPMAIL' ENTRY 'remitente' 聽 聽OF oIni
聽 聽 ENDINI
聽 聽 
*/ 聽 聽
聽 聽 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"] 
聽 聽 

聽 聽DEFINE FONT oFont 聽NAME "Arial" SIZE 0, -16
聽 聽DEFINE FONT oFont2 NAME "Arial" SIZE 0, -10
聽 聽DEFINE FONT oFont3 NAME "Arial" SIZE 0, -14
聽 聽nPort := cnPort
聽 聽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贸nco 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" ;
聽 聽 聽 聽 聽 聽 聽 聽 COLORS CLR_BLUE, CLR_WHITE //SIZE 264, 11 PIXEL

聽 聽 聽 聽REDEFINE GET oGet2 聽VAR cBCC OF oDlg 聽 聽 聽; 聽 聽 聽 聽 聽 聽 聽 // con copia a
聽 聽 聽 聽 聽 聽 聽 聽 ID 102 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 FONT oFont2 聽UPDATE 聽PICTURE "@KS60" ;
聽 聽 聽 聽 聽 聽 聽 聽 COLORS CLR_BLUE, CLR_WHITE //SIZE 264, 11 PIXEL

聽 聽 聽 聽REDEFINE GET oGet3 聽VAR cSubject OF oDlg 聽 ; 聽 聽 聽 聽 聽 聽 // Asunto
聽 聽 聽 聽 聽 聽 聽 聽 ID 103 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽;
聽 聽 聽 聽 聽 聽 聽 聽 FONT oFont2 聽UPDATE PICTURE "@KS60" 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 COLORS CLR_BLUE, CLR_WHITE

聽 聽 聽 聽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
聽 聽 聽 聽 聽 聽 聽 聽 MEMO 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 ID 105 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽;
聽 聽 聽 聽 聽 聽 聽 聽 FONT oFont3 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 UPDATE 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽;
聽 聽 聽 聽 聽 聽 聽 聽 COLORS CLR_BLUE, CLR_WHITE
聽 聽 聽 聽 oGet5:bKeydown := { |KeyStroke| IIF( KeyStroke==VK_RETURN, ;
聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽(oGet5:cText(cBody+=CRLF),;
聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 oGet5:GoBottom()),;
聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 oGet5:Paste(KeyStroke) ) }

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

聽 聽 聽 聽REDEFINE BTNBMP oBt2 ID 106 聽 聽 聽; 聽 聽 聽 聽 聽 // enviar el mensaje
聽 聽 聽 聽 聽 聽 聽 聽 OF oDlg 聽 聽 聽 聽 聽 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 FONT oFont2 聽 聽 聽 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 ACTION ( fSendMail( cTo, cBCC, cSubject, cBody, cAttach ),;
聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 oGet5:cText(cBody:=SPACE(800)),;
聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 oGet5:Setfocus(),;
聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 聽 oGet5:refresh(), oBt2:refresh() 聽)

聽 聽 聽 聽REDEFINE BUTTON oBt3 聽ID 2 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 OF oDlg 聽 聽 聽 聽 聽 聽 聽 聽 ; 聽 聽 聽 聽 聽 // Salir sin hacer nada
聽 聽 聽 聽 聽 聽 聽 聽 FONT oFont2 聽 聽 聽 聽 聽 聽 ;
聽 聽 聽 聽 聽 聽 聽 聽 ACTION oDlg:End()

聽 聽ACTIVATE DIALOG oDlg CENTERED //;
聽 聽 聽 聽 聽 聽 //VALID ( .T. )

聽 聽oFont:End()
聽 聽oFont2:End()
聽 聽oFont3:End()
* 聽 FreeLibrary(hBorland)

Return Nil
*******************************************************************************
*DLL32 FUNCTION BWCCRegister( hInst AS LONG ) AS WORD PASCAL LIB "SgemBW32.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 "GMAIL.COM" $ Upper( cMailServer ) .and. ( Empty( cUser ) .or. Empty( cPass ) )
聽 聽 聽 MsgStop( "Con GMail son requeridos nombre de usuario y contrase帽a", "Atenci贸n" )
聽 聽 聽 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 聽 聽 
/* 聽 聽 聽
聽 聽 聽 聽 聽:Item( cdoSMTPServer ):Value 聽 聽 := allTrim( cMailServer )
聽 聽 聽 聽 聽:Item( cdoSMTPServerPort ):Value := nPort
聽 聽 聽 聽 聽:Item( cdoSendUsing ):Value 聽 聽 聽:= nSendOpt
*/ 聽 聽 聽 聽 
聽 聽 聽 聽 聽MsgInfo(cMailServer+CRLF+str(nPort)+CRLF+Str(nSendOpt))

聽 聽 聽 聽 聽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 聽 聽 聽 聽 
聽 聽 聽 聽 聽
聽 聽 聽 聽 聽
/* 聽 聽 聽 聽 
聽 聽 聽 聽 聽 聽 :Item( cdoSMTPAuthenticate ):Value := .T. // 1
聽 聽 聽 聽 聽 聽 :Item( cdoSendUserName ):Value 聽 聽 := allTrim( cUser )
聽 聽 聽 聽 聽 聽 :Item( cdoSendPassword ):Value 聽 聽 := allTrim( cPass )
聽 聽 聽 聽 聽 聽 :Item( cdoSMTPUseSSL ):Value := .T. 聽// 1
聽 聽 聽 聽 聽 聽 :Item( 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 )
聽 聽 聽 聽 聽
聽 聽 聽 聽 聽MsgInfo(cFrom+CRLF+cTo+CRLF+cSubject+CRLF+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
聽 聽MsgInfo("Email Send successfully")

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

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

procedure AppSys 聽// Xbase++ requirement
return

Static FUNCTION CreaIni()
聽 聽 *
聽 聽 nFileHandle := FCreate( "email.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 聽 = "+"miclave"+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
***********************************


Regards
Anser
jll-fwh
Posts: 408
Joined: Fri Jan 29, 2010 08:14 PM
Re: Volviendo al tema CDO
Posted: Mon Oct 31, 2011 02:06 PM

Hola armando:

No he podido probar eso todav铆a, sino funciona bien la soluci贸n de anserkk, dilo y te paso la funci贸n de HB_Sendmail() que env铆a emails con harbour.

Un saludo
JLL

Libreria: FWH/FWH1109 + Harbour 5.8.2 + Borland C++ 5.8.2
Editor de Recursos: PellecC
ADA, OURXDBU
S.O: XP / Win 7 /Win10
Blog: http://javierlloris.blogspot.com.es/
e-mail: javierllorisprogramador@gmail.com
albeiroval
Posts: 400
Joined: Tue Oct 16, 2007 05:51 PM
Re: Volviendo al tema CDO
Posted: Mon Oct 31, 2011 04:45 PM

Hola JLL,

me gustaria probar el envio de mail con harbour,

gracias,

saludos,

albeiro

Saludos,
Regards,

Albeiro Valencia
www.avcsistemas.com
Armando Picon
Posts: 446
Joined: Mon Dec 26, 2005 09:11 PM
Re: Volviendo al tema CDO
Posted: Mon Oct 31, 2011 08:02 PM

JLL

Voy a probar el c贸digo de Anserkk. Respecto a lo que me indicas... 驴el c贸digo tuyo se apoya en librer铆as de microsoft? La pregunta que hago es porque a ra铆z de esta 煤ltima experiencia he tenido que goglear y he visto que el CDOSYS tiene versiones que var铆an de acuerdo al sistema operativo (de win98Se, de Win2000, de WinXP, de Vista y finalmente de Win 7 -32 y 64bits). Me disgusta mucho esa situaci贸n y me ha colmado la paciencia.

La idea que tengo es que deber铆amos, en Harbour o xHarbour, no depender de esta situaci贸n por lo que si logramos que nuestra clases se independicen de la versi贸n del sistema operativo las perspectivas para los miembros del foro y de los vayan a utilizar estas opciones libres se ver谩n incrementadas exponencialmente.

Visto esto, me agradar铆a que me remitieras el c贸digo que tienes, siempre y cuando no se apoye en Microsoft, como es el caso de CDO.

Saludos

Armando

FWH + BCC582 + WorkShop 4.5 + Resource Hacker + Mingw
Mis nuevas herramientas
Comunicacion via WhatsApp (+51) 957549 665
Comunicaci贸n via Correo: apic1002002 at yahoo dot es; apic1002002@gmail.com
jll-fwh
Posts: 408
Joined: Fri Jan 29, 2010 08:14 PM
Re: Volviendo al tema CDO
Posted: Tue Nov 01, 2011 02:42 AM

Hola Armando:

Por lo poco que he visto de las clases/Funciones de harbour es totalmente transparente al SO.

A mi me pasa lo mismo que a ti respecto al tema de las telecomunicaciones con FW, este ya es el 3 programa que tengo que adaptar para el env铆o y recepci贸n de emails, por eso he decido buscar otra opci贸n. Creo que con las clases/Funciones de harbour funcionara todo perfecto.

Creare un peque帽o programa para este fin y lo publicare para que se pruebe con todos los S.O posibles a ver si encontramos una soluci贸n valida generalizada.

La funci贸n de env铆o ( SMTP ) ya esta clara, ahora estoy haciendo pruebas para poder recibir los correos ( POP3/POP), ya recibo y guardo los ficheros adjuntos recibidos, de momento solo he apreciado ahora mismo que los 煤nicos que no se reciben correctamente son los MAPA DE BITS, todo lo dem谩s es recibido OK, ya lo mirare ma帽ana a ver que tonter铆a es.

P.D Es una lastima que alguna gente del foro no sea tan generosa como otros que lo son mucho, porque por lo que veo 煤ltimamente siempre responden a las preguntas +- los mismo, pero en cambio a aquellos que le han solucionado un problema no aportan sus conocimientos a los dem谩s.

Por ejemplo, seguro que en el caso que hablamos de las clases/funciones de harbour hay gente que ya tiene aplicado todo esto de enviar y recibir correo, pero en cambio no publica ning煤n comentario para que los dem谩s veamos el sol detr谩s de las nubes mas pronto... en fin, cada persona es un mundo.

P.D Si te urge el tema de enviar correos, agregame al MSN y te explico, sino una vez termine las pruebas y cree la base del programa lo publicare en el foro.

Un saludo
JLL
MSN: fwh-jll@hotmail.es

Libreria: FWH/FWH1109 + Harbour 5.8.2 + Borland C++ 5.8.2
Editor de Recursos: PellecC
ADA, OURXDBU
S.O: XP / Win 7 /Win10
Blog: http://javierlloris.blogspot.com.es/
e-mail: javierllorisprogramador@gmail.com
nnicanor
Posts: 302
Joined: Fri Apr 23, 2010 04:30 AM
Re: Volviendo al tema CDO
Posted: Wed Nov 02, 2011 09:16 PM

Con respecto al tema de CDOSYS les comento que he probado con todos los sistemas operativos Windows y no tiene problemas de compatibilidad

WinXP 32 y 64 Bits OK
Windows Vista 32 y 64 Bits OK
Windows 7 32 y 64 bits OK
Windows 8 Dev 32 y 64 Bits OK
Windows Server 2003 32 y 64 OK
Windows Server 2008 32 y 64 OK

cdosys es independiente de la version de FWH que uses.

Compiladores, Harbour 3.1 + BCC63 + xHarbour 1.2.1 y BCC58

Slds

Nicanor Martinez M.
Auditoria y Sistemas Ltda.
MicroExpress Ltda.
FW + FWH + XHARBOUR + HARBOUR + PELLES C + XDEVSTUDIO + XEDIT + BCC + VC_X86 + VCC_X64 + MINGW + R&R Reports + FastReport + Tdolphin + ADO + MYSQL + MARIADB + ORACLE
nnicanor@yahoo.com
carlos vargas
Posts: 1789
Joined: Tue Oct 11, 2005 05:01 PM
Re: Volviendo al tema CDO
Posted: Wed Nov 02, 2011 09:28 PM
bueno compa帽eros de penurias y alegrias, :-) como alternativa, hay controles COM que permiten hacer envios de email, yo use dos hace algunos a帽os con una app en foxpro, los cuales estoy seguro que funcionaran sin problemas con fwh.
bueden bajar los dll aca:
http://www.donboscocorp.com/carlos/rkmail.dll
http://www.donboscocorp.com/carlos/jmail.zip
" rel="noopener">
http://www.donboscocorp.com/carlos/rkmail.dll
http://www.donboscocorp.com/carlos/jmail.zip


el jmail incluye el manual del control.

si busca en google encontraran las documentacion de dichos controles, asi como versiones mas actualizadas.

NOTA: recuerden registrar los controles con regsvr32 para que funcionen.

Code (fw): Select all Collapse
*creacion de variables locales
LOCAL oSMTP
LOCAL cTexto
LOCAL nRecord

*verifica si tabla no esta limpia
IF EOF()
聽 聽 MESSAGEBOX("No existen registros de llamadas a enviar por email!",0+16)
聽 聽 RETURN
ENDIF

*confirma eliminacion de registro de llamada
IF MESSAGEBOX("Desea enviar reporte de llamada por email?",4+32,"Seleccione") <> 6
聽 聽 RETURN
ENDIF

*guarda registro actual
nRecord = RECNO()

*crea objeto SMTP para envio de correo
oSMTP = CREATE('rkMail.SMTP')

*servidor SMTP de corporacion don bosco
oSMTP.AddSMTPHost("mail.cablenet.com.ni")

*datos del remitente
oSMTP.FromAddress = "recepcion@donboscocorp.com"
oSMTP.FromName 聽 聽= "Recepcion de Corporacion Don Bosco"

*asunto del correo
oSMTP.Subject 聽 聽 = "Registro de llamadas del " + dtoc(thisform.fecha.Value)

*datos del receptor principal
oSMTP.AddRecipient ("Guillermo Castillo - Gerencia", "gccm@donboscocorp.com")

*datos de receptores secundarios del correo
oSMTP.AddBCC ("Margarita Rodriguez", "atencion-a-cliente@donboscocorp.com")
oSMTP.AddBCC ("Carlos Vargas", "cvargaz2005@donboscocorp.com")

*acumulacion de registro de llamdas
cTexto = ""
SCAN
聽 聽 cTexto = cTexto + 聽 "Hora...:" + tele->time + CHR(13)+;
聽 聽 聽 聽 聽 聽 聽聽 聽聽 聽 聽 聽 "De.....:" + tele->from + CHR(13)+;
聽 聽 聽 聽 聽 聽 聽聽 聽聽 聽 聽 聽 "Para...:" + tele->to 聽 + CHR(13)+;
聽 聽 聽 聽 聽 聽 聽聽 聽聽 聽 聽 聽 "Mensaje:" + tele->message + CHR(13)+;
聽 聽 聽 聽 聽 聽 聽聽 聽聽 聽 聽 聽 "Atendio:" + IIF(tele->in, "Si", "No" ) + CHR(13) + CHR(13)
ENDSCAN

*asignacion del cuerpo del correo
oSMTP.TextBody = cTexto聽聽 聽 聽 聽 

*adjunto atachment聽 聽 聽 
*oSMTP.AddAttachment("fondo.bmp")

*verificacion de envio de correo
IF !oSMTP.SendMail
聽 聽 *error en envio
聽 聽 WAIT WINDOW TYPE("oSMTP.Response")
聽 聽 WAIT WINDOW oSMTP.Response
聽 聽 MESSAGEBOX(oSMTP.Response,0+16,"Error en envio de correo!")
ELSE
聽 聽 *envio exitoso
聽 聽 MESSAGEBOX("Envio de llamadas por correo exitoso!",0+48,"Informacion")
ENDIF 

*elimina objeto 
oSMTP = NULL

*restura posicion del puntero de la tabla
GOTO (nRecord )

*refresca formulario
thisform.Refresh


Code (fw): Select all Collapse
*creacion de variables locales
LOCAL oSMTP
LOCAL cTexto
LOCAL nRecord
LOCAL cServerSMTP

*constante de fin de linea
#define CRLF Chr(13)+Chr(10)
#define TRUE 聽.t.
#define FALSE .f.

*define nombre de servidor
*cServerSMTP = "mail.cablenet.com.ni"
cServerSMTP = "donboscocorp.com"

*verifica si tabla no esta limpia
IF EOF()
聽 聽 MESSAGEBOX("No existen registros de llamadas a enviar por email!",0+16)
聽 聽 RETURN
ENDIF

*confirma eliminacion de registro de llamada
IF MESSAGEBOX("Desea enviar reporte de llamada por email?",4+32,"Seleccione") <> 6
聽 聽 RETURN
ENDIF

*guarda registro actual
nRecord = RECNO()

*crea objeto SMTP para envio de correo
oSMTP = CREATE('jmail.Message')
WITH oSMTP
聽 聽 *permite manejar errores
聽 聽 .Silent 聽聽 聽聽 聽 = TRUE
聽 聽 .Logging 聽 聽聽 聽 = TRUE
聽 聽 
聽 聽 *email del que envia el mensaje
聽 聽 .From聽 聽聽 聽 聽 聽 = "recepcion1@donboscocorp.com" 聽 
聽 聽 .FromName聽 聽聽 聽 = "Recepcion de Don Bosco Corp"
聽 聽 
聽 聽 *destinatarios del mensaje
聽 聽 .AddRecipient( "cvargaz2005@donboscocorp.com", "Carlos Vargas" 聽 )
聽 聽 .AddRecipient( "recepcion2011@donboscocorp.com","Heidy Perez" )
聽 聽 .AddRecipient( "gcm2011@donboscocorp.com","Guillermo Castillo" )聽 聽 聽 聽 
聽 聽 
聽 聽 *descripcion del mensaje
聽 聽 .Subject聽 聽 聽 聽 = "Registro de llamadas del " + dtoc(thisform.fecha.Value)
聽 聽 
聽 聽 *procesa cada llamada
聽 聽 SCAN
聽 聽 聽 聽 *agrega un mensaje por cada registro
聽 聽 聽 聽 .AppendText ( "Hora...:" + tele->time + CRLF +;
聽 聽 聽 聽 聽 聽 聽聽 聽聽 聽 聽 "De.....:" + tele->from + CRLF +;
聽 聽 聽 聽 聽 聽 聽聽 聽聽 聽 聽 "Para...:" + tele->to 聽 + CRLF +;
聽 聽 聽 聽 聽 聽 聽聽 聽聽 聽 聽 "Mensaje:" + tele->message + CRLF +;
聽 聽 聽 聽 聽 聽 聽聽 聽聽 聽 聽 "Atendio:" + IIF(tele->in, "Si", "No" ) 聽 + CRLF +;
聽 聽 聽 聽 聽 聽 聽聽 聽聽 聽 聽 "---------------------------------------" + CRLF 聽)
聽 聽 ENDSCAN
聽 聽 *nombre del servidor
聽 聽 .MailServerUserName聽= cServerSMTP
聽 聽 .MailServerPassword聽= ""
聽 聽 
聽 聽 *verifica envio del mensaje
聽 聽 IF !.Send( cServerSMTP )
聽 聽 聽 聽 MESSAGEBOX( .log, 0+16, "Depuracion de error en envio" )
聽 聽 ELSE
聽 聽 聽 聽 MESSAGEBOX( "Lista de llamadas enviadas correctamente",0+48, "Envio correcto" )
聽 聽 ENDIF
聽 聽 
ENDWITH

*elimina objeto 
oSMTP = NULL

*restura posicion del puntero de la tabla
GOTO ( nRecord )

*refresca formulario
thisform.Refresh
Salu2

Carlos Vargas

Desde Managua, Nicaragua (CA)
Armando Picon
Posts: 446
Joined: Mon Dec 26, 2005 09:11 PM
Re: Volviendo al tema CDO
Posted: Wed Nov 02, 2011 11:17 PM

Anserkk - JLL

Prob茅 el c贸digo enviado y no funciona para mi. Algo debo estar haciendo mal as铆 voy a tener que seguir d谩ndole al inconveniente hasta conseguir que opere o hasta que consiga otra forma de enviar y recibir correos... pero QUE NO DEPENDA DE LAS DLL de Microsoft.

nnicanor

Aqu铆 hay varios hilos respecto a CDOsys, donde se muestran las dificultades que han experimentado varias personas aunque hay much铆simas m谩s (solo tienes que buscar en Google CDOSYS 64)

http://www.vbforums.com/showthread.php?t=652567

http://forums.iis.net/t/1165790.aspx

http://forums.iis.net/t/1169428.aspx

http://blogs.msdn.com/b/mstehle/archive ... -code.aspx

http://www.ctimls.com/Support/KB/Error% ... _Error.htm

Saludos (y que los bytes les acompa帽en ---parodiando a la "fuerza" de la Guerra de las Galaxias)

Armando

FWH + BCC582 + WorkShop 4.5 + Resource Hacker + Mingw
Mis nuevas herramientas
Comunicacion via WhatsApp (+51) 957549 665
Comunicaci贸n via Correo: apic1002002 at yahoo dot es; apic1002002@gmail.com
lucasdebeltran
Posts: 1303
Joined: Tue Jul 21, 2009 08:12 AM
Re: Volviendo al tema CDO
Posted: Thu Nov 03, 2011 11:26 AM

Armando,

Verifica el tema de los adjuntos.

Prueba a quitar la opci贸n de adjuntos y comprueba si funciona.

O si preparas un ejemplo autocontenido gustosamente lo pruebo.

Un saludo

Muchas gracias. Many thanks.



Un saludo, Best regards,



Harbour 3.2.0dev, Borland C++ 5.82 y FWH 13.06 [producci贸n]



Implementando MSVC 2010, FWH64 y ADO.



Abandonando uso xHarbour y SQLRDD.
acuellar
Posts: 1710
Joined: Tue Oct 28, 2008 06:26 PM
Re: Volviendo al tema CDO
Posted: Thu Nov 03, 2011 01:03 PM
Armando este ejemplo funciona perfecto.
Incluso con corporativo, tambien con texto enriquecido convirtiendolo a HTML
Code (fw): Select all Collapse
#Include "FiveWin.ch"

Function Main()
    Local oEmailCfg,oEmailMsg,oLoc
   
    TRY
       oEmailCfg := CREATEOBJECT( "CDO.Configuration" )
      WITH OBJECT  oEmailCfg:Fields
         :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value :=   "exci.lostajiboshotel.com" //"smtp.gmail.com"
         :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value :=  25 //Gmail=465, Hotmail=25
         :Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2   // Remote SMTP = 2, local = 1
         :Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value :=   .T.
         :Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value :=  .F.
         :Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" ):Value :=  "cuenta@lostajiboshotel.com"
         :Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ):Value :=  "password"
         :Item( "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"):Value := 30
         :Update()
      END WITH
    CATCH oError
      MsgInfo( "No puede crear la configuraci贸n" + ";"  + ;
             "Error: " + TRANSFORM(oError:GenCode, NIL) + ";" + ;
             "SubC: " + TRANSFORM(oError:SubCode, NIL) + ";" + ;
             "OSCode: " + TRANSFORM(oError:OsCode, NIL) + ";" + ;
             "SubSystem: " + TRANSFORM(oError:SubSystem, NIL) + ";" + ;
             "Message: " + oError:Description )
       Return .F.
    END
    oError:=NIL
    ExePath:=cFilePath(GetModuleFileName(GetInstance()))
    Adjunto:=ExePath+"DATA\imagen.jpg"
    cFile:=ExePath+"DATA\TESTRTF.RTF"
    RtfToHTML( cFile,"tmpRTF.HTM", 16, "FFFFFF", "Title", 72 )
    cCuerpo:=MemoRead(cFile)
    TRY
     oEmailMsg := CREATEOBJECT ( "CDO.Message" )
     WITH OBJECT oEmailMsg
        :Configuration =  oEmailCfg
        :From = chr(34)+" Adhemar "+chr(34)+ "<cuenta@lostajiboshotel.com>" 
        :To = "adhemar@hotmail.com" 
        :Subject =  "Envio automatico"
        :ReplyTo =  " " 
        :Sender =  " "  
        :Organization =  "Empresa"   
        :AddAttachment(Adjunto)
        :HTMLBody =  cCuerpo //"<HTML> Hello  </HTML>"
        :Send()
     END WITH
     SysRefresh()
    CATCH oError
        
       MsgInfo( "Could not send message" + ";"  + CRLF+ ;
         "Error: " + TRANSFORM(oError:GenCode, NIL) + ";" + CRLF+;
         "SubC: " + TRANSFORM(oError:SubCode, NIL) + ";" + CRLF+ ;
         "OSCode: " + TRANSFORM(oError:OsCode, NIL) + ";" + CRLF +;
         "SubSystem: " + TRANSFORM(oError:SubSystem, NIL) + ";" +CRLF+ ;
         "Message: " + oError:Description )
       Return .F.
    
    END
    MsgInfo("Correo enviado")

Return
    
DLL32 FUNCTION RtfToHTML( cSource AS LPSTR, ;
                          cDest AS LPSTR, ;
                          nOption AS LONG, ;
                          cBG AS LPSTR, ;
                          cTitel AS LPSTR, ;
                          nDPI AS LONG ) AS LONG ;
                          PASCAL FROM "EXRTF2WEB" LIB "IRUN.DLL"


Espero te sirva

Saludos,

Adhemar
Saludos,



Adhemar C.
Static archive 路 New replies & topics via GitHub Discussions