Gracias a Carlos Mora descubrí el uso de CDOSYS (Collaboration Data Objects) para el envío de correos, para mí es la mejor herramienta de las que he probado para el envío de correos desde FWH/xHarbour ya que no requiere del uso de sockets ni de aplicaciones intermedias (como Outlook)
Aquí les dejo un pequeño ejemplo funcional de dicha tecnología, que espero les sea de utilidad.
Code: Select all | Expand
#include "FiveWin.ch"#include "TSButton.ch"#include "CdoSys.ch"#define WS_3DLOOK
4#define CLR_HBROWN nRGB
( 205,
192,
176 )#define CLR_NBLUE nRGB
( 142,
171,
194 )//---------------------------------------------------------------------------------------------//Function Main
() Local oDlg, aCtl
[ 20 ], oFont
Local cMailServer := PadR
( "smtp.hotmail.com",
60 ), ;
// servidor de correo cFrom := PadR
( "[email protected]",
60 ), ;
// remitente cTo := PadR
( "[email protected]",
180 ), ;
// destinatario (uno o varios separados con comas) cBCC := PadR
( "[email protected]",
180 ), ;
// copias ocultas a (uno o varios separados con comas) cAttach := PadR
( "c:\fwh\bitmaps\fivewin.bmp",
180 ), ;
// archivo anexo (uno o varios separados con comas) cSubject := Space
( 60 ), ;
// asunto cBody := Space
( 500 ), ;
// cuerpo del mensaje nPort :=
25, ;
// puerto usado por el servidor de correo cUser := Space
( 60 ), ;
// nombre de usuario para autenticación cPass := Space
( 30 ) // contraseña para autenticación DEFINE FONT oFont
NAME "Arial" SIZE 0,
-16 DEFINE DIALOG oDlg
FROM 0,
0 TO 455,
703 PIXEL ;
COLORS CLR_BLUE, CLR_HBROWN ;
TITLE "CDOSYS Collaboration Data Objects for Windows 2000" ;
STYLE nOR
( DS_MODALFRAME, WS_POPUP, WS_CAPTION, WS_SYSMENU, WS_3DLOOK
) @
10,
5 SAY aCtl
[ 1 ] PROMPT "Servidor de Correo:" OF oDlg ;
FONT oFont
UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN
SIZE 70,
11 PIXEL @
10,
80 GET aCtl
[ 2 ] VAR cMailServer
OF oDlg ;
FONT oFont
UPDATE PICTURE "@K" ;
COLORS CLR_BLUE, CLR_WHITE
SIZE 264,
11 PIXEL @
24,
5 SAY aCtl
[ 3 ] PROMPT "Remitente:" OF oDlg ;
FONT oFont
UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN
SIZE 70,
11 PIXEL @
24,
80 GET aCtl
[ 4 ] VAR cFrom
OF oDlg ;
FONT oFont
UPDATE PICTURE "@K" ;
COLORS CLR_BLUE, CLR_WHITE
SIZE 264,
11 PIXEL @
39,
5 SAY aCtl
[ 5 ] PROMPT "Destinatario:" OF oDlg ;
FONT oFont
UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN
SIZE 70,
11 PIXEL @
39,
80 GET aCtl
[ 6 ] VAR cTo
OF oDlg ;
FONT oFont
UPDATE PICTURE "@K" ;
COLORS CLR_BLUE, CLR_WHITE
SIZE 264,
11 PIXEL @
54,
5 SAY aCtl
[ 7 ] PROMPT "Copia para:" OF oDlg ;
FONT oFont
UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN
SIZE 70,
11 PIXEL @
54,
80 GET aCtl
[ 8 ] VAR cBCC
OF oDlg ;
FONT oFont
UPDATE PICTURE "@K" ;
COLORS CLR_BLUE, CLR_WHITE
SIZE 264,
11 PIXEL @
69,
5 SAY aCtl
[ 9 ] PROMPT "Adjuntar:" OF oDlg ;
FONT oFont
UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN
SIZE 70,
11 PIXEL @
69,
80 GET aCtl
[ 10 ] VAR cAttach
OF oDlg
PICTURE "@K" ;
FONT oFont
UPDATE Action fAddAttach
( aCtl
[ 10 ] ) ;
COLORS CLR_BLUE, CLR_WHITE
SIZE 264,
11 PIXEL @
84,
5 SAY aCtl
[ 11 ] PROMPT "Asunto:" OF oDlg ;
FONT oFont
UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN
SIZE 70,
11 PIXEL @
84,
80 GET aCtl
[ 12 ] VAR cSubject
OF oDlg ;
FONT oFont
UPDATE PICTURE "@K" ;
COLORS CLR_BLUE, CLR_WHITE
SIZE 264,
11 PIXEL @
99,
5 SAY aCtl
[ 13 ] PROMPT "Autenticación: Usuario:" OF oDlg ;
FONT oFont
UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN
SIZE 80,
11 PIXEL @
99,
87 GET aCtl
[ 14 ] VAR cUser
OF oDlg ;
FONT oFont
UPDATE PICTURE "@K" ;
COLORS CLR_BLUE, CLR_WHITE
SIZE 118,
11 PIXEL @
99,
213 SAY aCtl
[ 15 ] PROMPT "Contraseña:" OF oDlg ;
FONT oFont
UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN
SIZE 44,
11 PIXEL @
99,
259 GET aCtl
[ 16 ] VAR cPass
OF oDlg ;
FONT oFont
UPDATE PICTURE "@K";
COLORS CLR_BLUE, CLR_WHITE
SIZE 85,
11 PIXEL @
118,
6 STATIC aCtl
[ 17 ] BBOX
OF oDlg
SIZE 338,
83 PIXELS
UPDATE ;
FONT oFont COLORS CLR_WHITE, CLR_NBLUE, CLR_BLUE ;
LABEL
"Cuerpo del mensaje" ALIGN DT_CENTER
@
126,
10 GET aCtl
[ 18 ] VAR cBody
OF oDlg ;
FONT oFont MULTILINE
UPDATE ;
COLORS CLR_BLUE, CLR_WHITE
SIZE 330,
72 PIXEL @
208,
213 SBUTTON aCtl
[ 19 ] PROMPT "&Enviar" OF oDlg CRYSTAL ;
FONT oFont
SIZE 53,
16 PIXEL ;
COLORS CLR_BLUE, CLR_NBLUE ;
ACTION fSendMail
( cMailServer, cFrom, cTo, cSubject, cBody, cAttach, cBCC, cUser, cPass, nPort
) @
208,
292 SBUTTON aCtl
[ 20 ] PROMPT "&Salir" OF oDlg CRYSTAL ;
FONT oFont
SIZE 53,
16 PIXEL ;
COLORS CLR_BLUE, CLR_NBLUE
ACTIVATE DIALOG oDlg
CENTERED ;
VALID ( oFont:
End(), .T.
)Return Nil//---------------------------------------------------------------------------------------------//Function fSendMail
( cMailServer, cFrom, cTo, cSubject, cBody, cAttach, cBCC, cUser, cPass, nPort
) Local oCfg, oMsg, oError, ;
lAuth := ! Empty
( cUser
) .and. ! Empty
( cPass
), ;
nSendOpt :=
2 // send using: 1 = pickup folder 2 = port 3 = remote mail server Default nPort :=
25, ;
cSubject :=
"", ;
cBody :=
"" CursorWait
() Try oCfg := CreateObject
( "CDO.Configuration" ) With Object oCfg:
Fields :
Item( cdoSMTPServer
):
Value := Trim
( cMailServer
) :
Item( cdoSMTPServerPort
):
Value := nPort
:
Item( cdoSendUsing
):
Value := nSendOpt
If lAuth
:
Item( cdoSMTPAuthenticate
):
Value :=
1 :
Item( cdoSendUserName
):
Value := Trim
( cUser
) :
Item( cdoSendPassword
):
Value := Trim
( cPass
) :
Item( cdoSMTPUseSSL
):
Value :=
1 EndIf :
Update() End With
oMsg := CreateObject
( "CDO.Message" ) With Object oMsg
:
Configuration := oCfg
:
From := Trim
( cFrom
) :
To := Trim
( cTo
) :
Subject := Trim
( cSubject
) :
TextBody := Trim
( cBody
) If ! Empty
( cAttach
) :
AddAttachment := Trim
( cAttach
) EndIf 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
Un abrazo.
PD a Carlos Mora.- Porqué no continúas con tu Blog Harbour Advisor? me pareció excelente su presentación además que tienes un magífico estilo en la redacción de tus temas. Gracias nuevamente.
Me pasa como a la gran mayoría, la falta de tiempo. Además no he tenido mucho feedback, solo un par de mensajes de agradecimiento, y otros tantos reclamando la "propiedad intelectual" de lo que escribí, lo que me quita bastante las ganas.