#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
***********************************
// 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
}
#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
***********************************
*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
*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
#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"
Return to FiveWin para Harbour/xHarbour
Users browsing this forum: No registered users and 25 guests