This is my modified cdosys functions, you may to define a dbf to save config, for config use femail( cAlias ) parameter can be an alias or data object like dolphin query o tdabase object.
use config alias ... new ... shared ......
use config alias ...... new shared.
TO send mail use function Envia_Email( cFgAlias, cTo , cBcc, cSubJect, cAttach ) ..
Code: Select all
#INCLUDE "FIVEWIN.CH"
#include "recursos.ch"
#include "CdoSys.ch"
#include "hbcompat.ch"
#ifndef _CDOSYS_CH
#define _CDOSYS_CH
#define cdoSMTPServer "http://schemas.microsoft.com/cdo/configuration/smtpserver"
#define cdoSMTPServerPort "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
#define cdoSendUsing "http://schemas.microsoft.com/cdo/configuration/sendusing"
#define cdoSMTPPickupFolder "http://schemas.microsoft.com/cdo/configuration/smtpserverpickupdirectory"
#define cdoSMTPAuthenticate "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
#define cdoSendUserName "http://schemas.microsoft.com/cdo/configuration/sendusername"
#define cdoSendPassword "http://schemas.microsoft.com/cdo/configuration/sendpassword"
#define cdoSMTPUseSSL "http://schemas.microsoft.com/cdo/configuration/smtpusessl"
#define cdoSMTPConnectionTimeout "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
#endif
//20Us3rP4l3rm011
#define NTRIM(n) ( LTrim( Str( n ) ) )
#define WS_3DLOOK 4
#define CLR_HBROWN nRGB( 205, 192, 176 )
#define CLR_NBLUE nRGB( 142, 171, 194 )
//----------------------------------------------------------//
FUNCTION str_replace(cString, cFind, cReplace )
Local cStr,nPos,nTot,cToc1,cToc2
nPos := AT( upper(cFind), upper(cString) )
nTot := len( cFind )
if nPos > 0
cToc1 := Substr( cString, 1, nPos-1 )
cToc2 := Substr( cString, nPos + nTot + 1 )
cStr := cToc1+cReplace+cToc2
else
cStr := cString
endif
Return cStr
//--------------------------------------//
Function fEmail_config( cFgAlias )
Local oDlg, aCtl[ 22 ], oFont,lOk:=.f.
Local cMailServer := PadR( "tuservidordecorreo.com", 60 ), ; // servidor de correo
cFrom := PadR( "tucuenta@tuservidor.com", 60 ), ; // remitente
cTo := PadR( "", 180 ), ; // destinatario (uno o varios separados con comas)
cBCC := PadR( "", 180 ), ; // copias ocultas a (uno o varios separados con comas)
cAttach := PadR( "", 2048 ), ;// archivo anexo (uno o varios separados con comas)
cSubject := "Informes Vencimiento Documentos "+Dtoc(Date())+" "+time(), ; // asunto
cBody := "Notificacion automatica de Vencimientos "+CRLF+CRLF+"Sistema de Control", ; // cuerpo del mensaje
nPort := 25 ,; //465, ; // puerto usado por el servidor de correo // 465 si es Gmail
cUser := Space( 60 ), ; // nombre de usuario para autenticación
cPass := Space( 30 ) // contraseña para autenticación
IF valtype( cFgAlias )=="C"
cMailServer := ( cFgAlias )->CSERVER
cFrom := ( cFgAlias )->CFROM
cTo := ( cFgAlias )->CTO
cBCC := ( cFgAlias )->CCC
cSubJect := ( cFgAlias )->CSUBJECT
nPort := ( cFgAlias )->NPORT
cUser := ( cFgAlias )->CUSER
cPass := ( cFgAlias )->CPASS
cBody := ( cFgAlias )->CBODY
Else
cMailServer := cFgAlias:CSERVER
cFrom := cFgAlias:CFROM
cTo := cFgAlias:CTO
cBCC := cFgAlias:CCC
cSubJect := cFgAlias:CSUBJECT
nPort := cFgAlias:NPORT
cUser := cFgAlias:CUSER
cPass := cFgAlias:CPASS
ENDIF
// DEFINE FONT oFont NAME "Arial" SIZE 0, -16
oFont := TFont():New( GetDefaultFontName(), 0, GetDefaultFontHeight(),, )
DEFINE DIALOG oDlg FROM 0, 0 TO 455, 703 PIXEL FONT oFontb ;
COLORS CLR_BLUE, CLR_HBROWN ;
TITLE "Configuracion Servidor de Envio de Informes para empresas" ;
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 206, 11 PIXEL
@ 10,294 SAY aCtl[ 3 ] PROMPT "Puerto:" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN SIZE 30, 11 PIXEL
@ 10,320 GET aCtl[ 4 ] VAR nPort OF oDlg ;
FONT oFont UPDATE PICTURE "@K ####" ;
COLORS CLR_BLUE, CLR_WHITE SIZE 24, 11 PIXEL
@ 24, 5 SAY aCtl[ 5 ] PROMPT "Remitente:" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN SIZE 70, 11 PIXEL
@ 24, 80 GET aCtl[ 6 ] VAR cFrom OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS CLR_BLUE, CLR_WHITE SIZE 264, 11 PIXEL
@ 39, 5 SAY aCtl[ 7 ] PROMPT "Destinatario:" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN SIZE 70, 11 PIXEL
@ 39, 80 GET aCtl[ 8 ] VAR cTo OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS CLR_BLUE, CLR_WHITE SIZE 264, 11 PIXEL
@ 54, 5 SAY aCtl[ 9 ] PROMPT "Copia para:" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN SIZE 70, 11 PIXEL
@ 54, 80 GET aCtl[ 10 ] VAR cBCC OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS CLR_BLUE, CLR_WHITE SIZE 264, 11 PIXEL
@ 69, 5 SAY aCtl[ 11 ] PROMPT "Adjuntar:" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN SIZE 70, 11 PIXEL
@ 69, 80 GET aCtl[ 12 ] VAR cAttach OF oDlg PICTURE "@K" ;
FONT oFont UPDATE ;
COLORS CLR_BLUE, CLR_WHITE SIZE 253, 11 PIXEL // ACTION fAddAttach( aCtl[ 12 ] ) ; // descomentar para FWH 8.12 o posterior
@ 69,333 BUTTON "..." OF oDlg SIZE 10, 10 PIXEL ACTION fAddAttach( aCtl[ 12 ] )
@ 84, 5 SAY aCtl[ 13 ] PROMPT "Asunto:" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN SIZE 70, 11 PIXEL
@ 84, 80 GET aCtl[ 14 ] VAR cSubject OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS CLR_BLUE, CLR_WHITE SIZE 264, 11 PIXEL
@ 99, 5 SAY aCtl[ 15 ] PROMPT "Autenticación: Usuario:" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN SIZE 80, 11 PIXEL
@ 99, 87 GET aCtl[ 16 ] VAR cUser OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS CLR_BLUE, CLR_WHITE SIZE 118, 11 PIXEL
@ 99,213 SAY aCtl[ 17 ] PROMPT "Contraseña:" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_BLUE, CLR_HBROWN SIZE 44, 11 PIXEL
@ 99,259 GET aCtl[ 18 ] VAR cPass OF oDlg PASSWORD ;
FONT oFont UPDATE PICTURE "@K";
COLORS CLR_BLUE, CLR_WHITE SIZE 85, 11 PIXEL
@118, 6 SAY aCtl[ 19 ] PROMPT "Cuerpo del mensaje" OF oDlg ;
SIZE 100, 11 PIXEL ;
FONT oFont COLORS CLR_BLUE, CLR_HBROWN
@126, 10 GET aCtl[ 20 ] VAR cBody OF oDlg ;
FONT oFont MULTILINE UPDATE ;
COLORS CLR_BLUE, CLR_WHITE SIZE 330, 72 PIXEL
@208,213 BUTTON aCtl[ 21 ] PROMPT "&Grabar" OF oDlg ;
FONT oFont SIZE 53, 16 PIXEL ;
ACTION ( lok:=.t.,oDlg:End() )
@208,292 BUTTON aCtl[ 22 ] PROMPT "&Salir" OF oDlg ;
FONT oFont SIZE 53, 16 PIXEL ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED ;
VALID ( oFont:End(), .T. )
IF lok == .t.
IF valtype( cFgAlias ) == "C"
( cFgAlias )->( NET_READ() )
( cFgAlias )->CSERVER := cMailServer
( cFgAlias )->CFROM := cFrom
( cFgAlias )->CTO := cTo
( cFgAlias )->CCC := cBCC
( cFgAlias )->CSUBJECT := cSubJect
( cFgAlias )->NPORT := nPort
( cFgAlias )->CUSER := cUser
( cFgAlias )->CPASS := cPass
( cFgAlias )->CBODY := cBody
( cFgAlias )->( DBRUNLOCK() )
ELSE
cFgAlias:CSERVER := cMailServer
cFgAlias:CFROM := cFrom
cFgAlias:CTO := cTo
cFgAlias:CCC := cBCC
cFgAlias:CSUBJECT:= cSubJect
cFgAlias:NPORT := nPort
cFgAlias:CUSER := cUser
cFgAlias:CPASS := cPass
cFgAlias:CBODY := cBody
cFgAlias:Save()
Endif
if msgnoyes("Desea Comprobar el envio ahora ?")
Envia_Email( cFgAlias, cTo , cBcc, cSubJect, cAttach )
//fSendMail( cMailServer, cFrom, cTo, cSubject, cBody, cAttach, cBCC, cUser, cPass, nPort )
Endif
ENDIF
Return Nil
//--------------------------------------------------------------------------------------------//
Function Envia_Email( cFgAlias, cTo1, cBcc1, cSubject1, cAttach1, cBody1,cDatos )
Local cMailServer,;
cFrom ,;
cTo ,;
cBCC ,;
cSubJect ,;
nPort ,;
cUser ,;
cPass ,;
cBody
IF valtype( cFgAlias ) == "C"
cMailServer := ( cFgAlias )->CSERVER
cFrom := ( cFgAlias )->CFROM
cTo := ( cFgAlias )->CTO
cBCC := ( cFgAlias )->CCC
cSubJect := ( cFgAlias )->CSUBJECT
nPort := ( cFgAlias )->NPORT
cUser := ( cFgAlias )->CUSER
cPass := ( cFgAlias )->CPASS
cBody := ( cFgAlias )->CBODY
else
cMailServer := cFgAlias:CSERVER
cFrom := cFgAlias:CFROM
cTo := cFgAlias:CTO
cBCC := cFgAlias:CCC
cSubJect := cFgAlias:CSUBJECT
nPort := cFgAlias:NPORT
cUser := cFgAlias:CUSER
cPass := cFgAlias:CPASS
cBody := cFgAlias:CBODY
ENDIF
DEFAULT cTo1 := cTo
DEFAULT cSubject1 := cSubject
DEFAULT cBody1 := cBody
DEFAULT cAttach1 := ""
DEFAULT cBcc1 := cBcc
fSendMail( cMailServer, cFrom, cTo1, cSubject1, cBody1, cAttach1, cBCC1, cUser, cPass, nPort, cDatos )
Return
//---------------------------------------------------------------------------------------------//
Function fSendMail( cMailServer, cFrom, cTo, cSubject, cBody, cAttach, cBCC, cUser, cPass, nPort, cDatos )
Local oCfg, oMsg, oError, nEle, cToken, ;
aAttach := {}, ;
lAuth := ! Empty( cUser ) .and. ! Empty( cPass ), ;
nSendOpt := 2 // send using: 1 = pickup folder 2 = port
Default nPort := 25, ;
cSubject := "", ;
cBody := "", ;
cDatos := "Sin datos que mostrar",;
cBcc :="",;
cUser :="",;
cPass :=""
cBody := str_replace( cBody, "\DATOS\", cDatos )
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 := 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 )
//:MDNRequested := .T. // confirmacion de recibido
//:HTMLBody := strHTML
For nEle := 1 To Len( aAttach )
:AddAttachment( AllTrim( aAttach[ nEle ] ) ) // := AllTrim( aAttach[ nEle ] )
Next
If ! Empty( cBCC )
:BCC := Trim( cBCC )
EndIf
:Send()
End With
Catch oError
CursorArrow()
cErrores:= "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 +" "+ if( ! Empty( oError:FileName ),;
": " + oError:FileName ,;
if( !Empty( oError:Operation ),;
": " + oError:Operation ,;
"" ) )+CRLF
n := 2 // we don't disscard any info again !
while ( n < 74 )
if ! Empty( ProcName( n ) )
cErrores := CRLF+cErrores+" Called from: " + ProcFile( n ) + " => " + Trim( ProcName( n ) ) + ;
"(" + NTRIM( ProcLine( n ) ) + ")"
endif
n++
end
??? cErrores
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 ), 2048 ) )
EndIf
oGet:cText( cAttach )
Return Nil
//-----------------------------------------------------------------------------------------------//