Code: Select all
#Include "FiveWin.ch"
// --- Envio de correo electronico
Function SendEmail(cFrom,cTo,cBCC,cAttach,cSubject,cBody,cUser,cPass)
Local oDlg, aCtl[ 22 ], oFont
//Local cMailServer := PadR( "smtp.gmail.com", 60 ) // servidor de correo
Local cMailServer := PadR( "smtp.pleno.com.br", 60 ) // servidor de correo
//local nPort:=465 // puerto usado por el servidor de correo
local nPort:=587 // puerto usado por el servidor de correo
local WS_3DLOOK:=4
local CLR_HBROWN:=RGB( 205, 192, 176 )
local CLR_NBLUE :=RGB( 142, 171, 194 )
//default cFrom := PadR( "remitente@gmail.com", 60 ) // remitente
default cFrom := PadR( "joao@pleno.com.br", 60 ) // remitente
//default cTo := PadR( "destinatario@hotmail.com", 180 ) // destinatario (uno o varios separados con comas)
default cTo := PadR( "joao@peno.com.br", 180 ) // destinatario (uno o varios separados con comas)
default cBCC := Space( 180 ) // copias ocultas a (uno o varios separados con comas)
default cAttach := Space(180) // archivo anexo (uno o varios separados con comas)
default cSubject := Space( 60 ) // asunto
default cBody := Space( 500 ) // cuerpo del mensaje
default cUser := Space( 60 ) // nombre de usuario para autenticación
default 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_HBLUE, CLR_HBROWN ;
TITLE "Envio de Mail" ;
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_HBLUE, CLR_HBROWN SIZE 70, 11 PIXEL
@ 10, 80 GET aCtl[ 2 ] VAR cMailServer OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS CLR_HBLUE, CLR_WHITE SIZE 206, 11 READONLY PIXEL
@ 10,294 SAY aCtl[ 3 ] PROMPT "Puerto" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_HBLUE, CLR_HBROWN SIZE 30, 11 PIXEL
@ 10,320 GET aCtl[ 4 ] VAR nPort OF oDlg ;
FONT oFont UPDATE PICTURE "@K ####" ;
COLORS CLR_HBLUE, CLR_WHITE SIZE 24, 11 READONLY PIXEL
@ 24, 5 SAY aCtl[ 5 ] PROMPT "Remitente" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_HBLUE, CLR_HBROWN SIZE 70, 11 PIXEL
@ 24, 80 GET aCtl[ 6 ] VAR cFrom OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS CLR_HBLUE, CLR_WHITE SIZE 264, 11 PIXEL
@ 39, 5 SAY aCtl[ 7 ] PROMPT "Destinatario" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_HBLUE, CLR_HBROWN SIZE 70, 11 PIXEL
@ 39, 80 GET aCtl[ 8 ] VAR cTo OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS CLR_HBLUE, CLR_WHITE SIZE 264, 11 PIXEL
@ 54, 5 SAY aCtl[ 9 ] PROMPT "Copia para" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_HBLUE, CLR_HBROWN SIZE 70, 11 PIXEL
@ 54, 80 GET aCtl[ 10 ] VAR cBCC OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS CLR_HBLUE, CLR_WHITE SIZE 264, 11 PIXEL
@ 69, 5 SAY aCtl[ 11 ] PROMPT "Adjuntar" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_HBLUE, CLR_HBROWN SIZE 70, 11 PIXEL
@ 69, 80 GET aCtl[ 12 ] VAR cAttach OF oDlg PICTURE "@K" ;
FONT oFont UPDATE ;
COLORS CLR_HBLUE, CLR_WHITE SIZE 264, 11 PIXEL;
// ACTION fAddAttach( aCtl[ 12 ] )
@ 84, 5 SAY aCtl[ 13 ] PROMPT "Asunto" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_HBLUE, CLR_HBROWN SIZE 70, 11 PIXEL
@ 84, 80 GET aCtl[ 14 ] VAR cSubject OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS CLR_HBLUE, CLR_WHITE SIZE 264, 11 PIXEL
@ 99, 5 SAY aCtl[ 15 ] PROMPT "Autenticación: Usuario" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_HBLUE, CLR_HBROWN SIZE 80, 11 PIXEL
@ 99, 87 GET aCtl[ 16 ] VAR cUser OF oDlg ;
FONT oFont UPDATE PICTURE "@K" ;
COLORS CLR_HBLUE, CLR_WHITE SIZE 118, 11 PIXEL
@ 99,213 SAY aCtl[ 17 ] PROMPT "Contraseña" OF oDlg ;
FONT oFont UPDATE ;
COLORS CLR_HBLUE, CLR_HBROWN SIZE 44, 11 PIXEL
@ 99,259 GET aCtl[ 18 ] VAR cPass OF oDlg PASSWORD ;
FONT oFont UPDATE PICTURE "@K";
COLORS CLR_HBLUE, CLR_WHITE SIZE 85, 11 PIXEL
@117.5,6 SAY aCtl[ 19 ] PROMPT "Cuerpo del mensaje" OF oDlg ;
SIZE 100, 11 PIXEL ;
FONT oFont COLORS CLR_HBLUE, CLR_HBROWN
@ 7,1.5 GET aCtl[ 20 ] VAR cBody OF oDlg ;
FONT oFont MULTILINE UPDATE ;
COLORS CLR_HBLUE, CLR_WHITE SIZE 42, 4.3
@11.5,5 BUTTON aCtl[ 21 ] PROMPT "&Enviar" OF oDlg ;
FONT oFont SIZE 53, 16 PIXEL ;
ACTION fSendMail( cMailServer, cFrom, cTo, cSubject, cBody, cAttach, cBCC, cUser, cPass, nPort )
@11.5,20 BUTTON aCtl[ 22 ] PROMPT "&Salir" OF oDlg ;
FONT oFont SIZE 53, 16 PIXEL ACTION oDlg:End()
ACTIVATE DIALOG oDlg CENTERED ;
VALID ( oFont:End(), .T. )
Return Nil
// --- Enviar un mail
Function fSendMail( cMailServer, cFrom, cTo, cSubject, cBody, cAttach, cBCC, cUser, cPass, nPort )
Local oCfg, oMsg, oError, nEle, cToken, bMens,;
lAuth := ! Empty( cUser ) .and. ! Empty( cPass ), ;
nSendOpt := 1 //2 // send using: 1 = pickup folder 2 = port
memvar aAttach
Default nPort := 25, ;
cSubject := "", ;
cBody := ""
? cMailServer, cFrom, cTo, cSubject, cBody, cAttach, cBCC, cUser, cPass, nPort
if !IsInternet()
//aviso({'ATENCION','No existe conección a internet','Intente más tarde o verifique su problema'})
return .t.
endif
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 .t.
EndIf
CursorWait()
// bMens:=Mensaje('Para: '+cTo,'Espere, enviando un Mail')
aAttach:={}
if !Empty(cAttach)
cAttach:='{"'+StrTran(cAttach,',','","')+'"}'
aAttach:=cAttach
aAttach:=&(aAttach)
endif
nEle := 1
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 := 2 //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 )
For nEle := 1 To Len( aAttach )
:AddAttachment := AllTrim( aAttach[ nEle ] )
Next
If ! Empty( cBCC )
:BCC := Trim( cBCC )
EndIf
:Send()
End With
Catch oError
CursorArrow()
// Eval(bMens)
MsgStop( "No se pudo enviar el e-mail")
oCfg := Nil
oMsg := Nil
Return .t.
End Try
oCfg := Nil
oMsg := Nil
SndPlaySound( GetWinDir() + "\media\Tada.wav", 0 )
CursorArrow()
Eval(bMens)
Return .t.