Volviendo al tema CDO

Volviendo al tema CDO

Postby Armando Picon » Fri Oct 28, 2011 7: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
User avatar
Armando Picon
 
Posts: 446
Joined: Mon Dec 26, 2005 9:11 pm
Location: Lima, Peru

Re: Volviendo al tema CDO

Postby jll-fwh » 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
User avatar
jll-fwh
 
Posts: 408
Joined: Fri Jan 29, 2010 8:14 pm
Location: Meliana - Valencia

Re: Volviendo al tema CDO

Postby Armando Picon » 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
User avatar
Armando Picon
 
Posts: 446
Joined: Mon Dec 26, 2005 9:11 pm
Location: Lima, Peru

Re: Volviendo al tema CDO

Postby jll-fwh » Sat Oct 29, 2011 1: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
User avatar
jll-fwh
 
Posts: 408
Joined: Fri Jan 29, 2010 8:14 pm
Location: Meliana - Valencia

Re: Volviendo al tema CDO

Postby Armando Picon » Sat Oct 29, 2011 2:35 am

JLL

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

Code: Select all  Expand view  RUN
#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: Select all  Expand view  RUN
// 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
User avatar
Armando Picon
 
Posts: 446
Joined: Mon Dec 26, 2005 9:11 pm
Location: Lima, Peru

Re: Volviendo al tema CDO

Postby anserkk » Mon Oct 31, 2011 6: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: Select all  Expand view  RUN
#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
User avatar
anserkk
 
Posts: 1333
Joined: Fri Jun 13, 2008 11:04 am
Location: Kochi, India

Re: Volviendo al tema CDO

Postby jll-fwh » Mon Oct 31, 2011 2: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
User avatar
jll-fwh
 
Posts: 408
Joined: Fri Jan 29, 2010 8:14 pm
Location: Meliana - Valencia

Re: Volviendo al tema CDO

Postby albeiroval » Mon Oct 31, 2011 4:45 pm

Hola JLL,

me gustaria probar el envio de mail con harbour,

gracias,

saludos,

albeiro
Saludos,
Regards,

Albeiro Valencia
www.avcsistemas.com
User avatar
albeiroval
 
Posts: 383
Joined: Tue Oct 16, 2007 5:51 pm
Location: Barquisimeto - Venezuela

Re: Volviendo al tema CDO

Postby Armando Picon » Mon Oct 31, 2011 8: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
User avatar
Armando Picon
 
Posts: 446
Joined: Mon Dec 26, 2005 9:11 pm
Location: Lima, Peru

Re: Volviendo al tema CDO

Postby jll-fwh » Tue Nov 01, 2011 2: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
User avatar
jll-fwh
 
Posts: 408
Joined: Fri Jan 29, 2010 8:14 pm
Location: Meliana - Valencia

Re: Volviendo al tema CDO

Postby nnicanor » Wed Nov 02, 2011 9: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
nnicanor
 
Posts: 302
Joined: Fri Apr 23, 2010 4:30 am
Location: Colombia

Re: Volviendo al tema CDO

Postby carlos vargas » Wed Nov 02, 2011 9: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:
[url]
http://www.donboscocorp.com/carlos/rkmail.dll
http://www.donboscocorp.com/carlos/jmail.zip
[/url]

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: Select all  Expand view  RUN

*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: Select all  Expand view  RUN

*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)
User avatar
carlos vargas
 
Posts: 1721
Joined: Tue Oct 11, 2005 5:01 pm
Location: Nicaragua

Re: Volviendo al tema CDO

Postby Armando Picon » 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
User avatar
Armando Picon
 
Posts: 446
Joined: Mon Dec 26, 2005 9:11 pm
Location: Lima, Peru

Re: Volviendo al tema CDO

Postby lucasdebeltran » 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.
User avatar
lucasdebeltran
 
Posts: 1303
Joined: Tue Jul 21, 2009 8:12 am

Re: Volviendo al tema CDO

Postby acuellar » Thu Nov 03, 2011 1:03 pm

Armando este ejemplo funciona perfecto.
Incluso con corporativo, tambien con texto enriquecido convirtiendolo a HTML
Code: Select all  Expand view  RUN

#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.
User avatar
acuellar
 
Posts: 1645
Joined: Tue Oct 28, 2008 6:26 pm
Location: Santa Cruz-Bolivia

Next

Return to FiveWin para Harbour/xHarbour

Who is online

Users browsing this forum: Google [Bot] and 94 guests