Welcome To The Home Of The Visual FoxPro Experts  
home. signup. forum. archives. search. google. articles. downloads. faq. members. weblogs. file info. rss.
 From: Ahsan Rana
  Where is Ahsan Rana?
 Lahore
 Pakistan
 Ahsan Rana
 To: Don Higgins
  Where is Don Higgins?
 Peoria
 Illinois - United States
 Don Higgins
 Tags
Subject: RE: CDO Configuration
Thread ID: 249156 Message ID: 249173 # Views: 9 # Ratings: 0
Version: Visual FoxPro 7 Category: Other
Date: Wednesday, December 30, 2009 5:13:35 AM         
   


> I use this code and it works great, it has two options. 1 is regular CDO that works fine for local email accounts ( Not Yahoo or MSN types ) and one Sergy made for Yahoo type accounts. His website is: http://www.berezniker.com/
>
> It is driven by a database called Comset.dbf If you need a copy let me know.
>
> It is a form Method and is easy to impliment.
>
>
>
> 
> ********************************************************************
> *** Name.....: QuickQuote.TEXT_MESSAGE
> *** Author...: Don Higgins
> *** Date.....: 12/17/2008
> *** Notice...: Common Sense Software
> *** Compiler.: Visual FoxPro 09.00.0000.2412 for Windows
> *** Function.: Very simple Text Message or Email from within Profit Trak Software
> *** Returns..: Nothing, just sends out texts and emails
> ********************************************************************
> *
> * Parameter List:
> * a) is whatever needs to be emailed or texted
> * b) File Attachment?
> * c) Email?  If so then TRUE
> *
> *
> * uses Comset.dbf file for settings and phone numbers
> ********
> 
> 
> Lparameters tcMessage, tcAttachedFile, tcEmail
> 
> 
> 
> 
> **** Begin CDO Version  *******
> Local lcSchema, loConfig, loMsg, loError, lcErr, lcTextBody, lcRecipient1, lcRecipient2, lcRecipient3, ;
> 	lcLogin, lcPassword, lcSMTPPort, lcSMTPServer, lcAllRecipients, lcBCC, lcCC, lcEmail_Address, lcAttachedFile, ;
> 	lcSalesno, lcSalesName, lcDealerName, lnSendVia, lcWait_Window_Message, lcTextAddress, myPriority, lcFullFileName
> 
> myPriority="H"
> lnSendVia = 1
> lcFullFileName = "Valued_Customer_Proposal.pdf"
> lcFullFileName = Fullpath(lcFullFileName)
> 
> * Check to see if this is an email
> * if not use text field
> If tcEmail = .T.
> 	lcRecipient1 = Alltrim(Payment.email)
> Else
> 	* get customer's email from payment.dbf field email.
> 	* FIRST try to get their text address
> 	* if not there use payment.email
> 	lcTextAddress = Alltrim(Payment.textadd)
> 	* if it is not empty then everything is GREAT!
> 	If .Not. Empty( lcTextAddress )
> 		* Text address is good
> 		lcRecipient1 = lcTextAddress
> 	Else
> 		lcRecipient1 = Alltrim(Payment.email)
> 	Endif
> Endif
> 
> 
> 
> * salesperson name below
> * get number from payment.dbf
> * then look up name from sales.dbf
> lcSalesno = Payment.salesno
> * open sales
> Do openit In Main With "data\sales"
> Locate For salesno = lcSalesno
> lcSalesName = Alltrim(sales.salesname)
> * lcSalesName = LOWER(Alltrim(sales.salesname))
> * Now remove ANY Spaces between first and last name or errors happen
> * lcSalesName = CHRTRAN(lcSalesName,' ','')
> 
> * now chrtran the dealership name to remove spaces and reduce to lower()
> Thisform.Dealership_name = Lower(Thisform.Dealership_name)
> lcDealerName = Chrtran(Thisform.Dealership_name,' ','')
> 
> 
> * put it together with @ symbol and dealer name
> *lcEmail_Address = lcSalesName + "@" + lcDealerName
> 
> 
> 
> 
> 
> * did we get a message?  If not get out now
> Do Case
> 
> 	Case Pcount() = 0
> 		* how this could happen is beyond me but get out now
> 		Return
> 
> 	Case Pcount() = 1
> 		* we have a message but no attached file to send
> 		lcTextBody = Alltrim( tcMessage )
> 		lcAttachedFile = ""
> 		llEmail = .F.
> 
> 	Case Pcount() = 2
> 		* we have a message and an attached file
> 		lcTextBody = Alltrim( tcMessage )
> 		lcAttachedFile = tcAttachedFile
> 		llEmail = .F.
> 
> 	Case Pcount() = 3
> 		* we have a message and an attached file and it is an email
> 		lcTextBody = Alltrim( tcMessage )
> 		lcAttachedFile = tcAttachedFile
> 		llEmail = .T.
> 
> Endcase
> 
> lcWait_Window_Message = "Sent " + Iif(llEmail = .F.,"Text ","Email ") + " Message to their Phone..."
> 
> * Open Comset.dbf and get setup information
> Do openit In Main With "data\comset"
> 
> * up to 3 recipients
> * these will be phone numbers @ vtext.com for example
> * they can also be email addresses
> * if there is no rec1 then get the hell out also
> * no reason to continue if there isnt anyone to send
> If Empty(lcRecipient1)
> 	Wait Window "Ummmmm..... There is NO Phone Number to Text or Email - Exiting Now " Timeout 5000
> 	Return
> Endif
> * OK we have at least one so lets get going
> * 2nd person now.  Use Blind Carbon Copy for simplicity
> lcRecipient2 = Alltrim(comset.rec2)
> If .Not. Empty(lcRecipient2)
> 	* if not empty then do nothing except set variable for bcc
> 	lcBCC = lcRecipient2
> Else
> 	lcBCC = ""
> Endif
> 
> * 3rd person now
> * uses Carbon Copy property
> lcRecipient3 = Alltrim(comset.rec3)
> If .Not. Empty(lcRecipient3)
> 	lcCC = lcRecipient3
> Else
> 	lcCC = ""
> Endif
> 
> 
> 
> 
> * Now the setup info for the important stuff
> lcLogin = comset.login
> lcPassword = comset.pword
> lcSMTPPort = comset.smtpport
> lcSMTPServer = comset.servr
> ***
> *
> *  OK comset.sendvia is numberic and will be as follows:
> * 1 = Normal CDO
> * 2 = Sergieo CDO Class
> * This determines how the code sends emails and texts
> lnSendVia = comset.sendvia
> * Make sure it is a valid number
> If lnSendVia = 0
> 	lnSendVia = 1
> Endif
> 
> 
> * Email Address - from sender area
> * If it is blank put mine in
> lcEmail_Address = Alltrim(comset.emailname)
> If Empty(Alltrim( lcEmail_Address ))
> 	lcEmail_Address = "don@crew-chief.com"
> Endif
> 
> 
> * close comset - can't afford corrupted files
> Select comset
> Use
> 
> 
> 
> * OK check for the attached file does in fact exist on the system
> llExist = .F.
> Do fndfile In Main With lcAttachedFile
> If llExist = .T.
> 	* file exists move on now - everyone is happy, happy, happy!
> Else
> 	* Wait Window "File is Not Valid..."
> 	* Danger will robinson
> 	* file does not exist
> 	* make the local variable empty then
> 	lcAttachedFile = ""
> 	*Wait Window "File: " + Alltrim( lcAttachedFile ) + " Does not exist...." Timeout 5000
> Endif
> 
> 
> Do Case
> 	Case lnSendVia = 1  && Regular CDO sending code
> 
> 		lcErr = ""
> 		lcSchema = "http://schemas.microsoft.com/cdo/configuration/"
> 
> 		loConfig = Createobject("CDO.Configuration")
> 
> 		With loConfig.Fields
> 			.Item(lcSchema + "smtpserver") = Alltrim(lcSMTPServer)  &&"mail.crew-chief.com"
> 			.Item(lcSchema + "smtpserverport") = (lcSMTPPort)  &&587 && yr  smtp port &&
> 			.Item(lcSchema + "sendusing") = 2
> 			.Item(lcSchema + "smtpauthenticate") = .T.
> 			.Item(lcSchema + "smtpusessl") = .F.
> 			.Item(lcSchema + "sendusername") = Alltrim(lcLogin)
> 			.Item(lcSchema + "sendpassword") = Alltrim( lcPassword )
> 
> 			*.Fields("urn:schemas:httpmail:importance").Value = Icase(myPriority="H",2,myPriority="L",0,1)
> 			*.Fields("urn:schemas:mailheader:importance").Value = Icase(myPriority="H","High",myPriority="L","Low","Normal")
> 
> 			.Update
> 
> 		Endwith
> 
> 		loMsg = Createobject ("CDO.Message")
> 
> 
> 		With loMsg
> 			.Configuration = loConfig
> 
> 			.From = lcEmail_Address   &&"don@crew-chief.com"
> 
> 			.To 	= lcRecipient1
> 			.bcc 	= lcBCC
> 			.cc		= lcCC
> 
> 			*    .DSNOptions=2   & if u define this setting mails are not save at sender end
> 
> 			.Subject = "From: " + Alltrim(Proper(Thisform.Dealership_name))
> 
> 			.TextBody = ( lcTextBody )
> 
> 			* Set Step On
> 
> 			* Only send if llExist = .t. ( look above for this )
> 			If llExist = .T.
> 					* don't need attachments if this is an text
> 				If tcEmail = .T.
> 					.AddAttachment(lcFullFileName)  &&'c:\coprofit\valued_customer_proposal.pdf')
> 					* &lcFullFileName
> 				Endif
> 			Endif
> 
> 			*
> 			.Send()
> 			*
> 
> 		Endwith
> 
> 		If Vartype(loMsg)='O'
> 			Wait Window (lcWait_Window_Message)  Nowait
> 		Else
> 			Messagebox('Error: Could Not Send - Something in your information is incorrect.  Contact us to get help', 16 , "Failed due to error")
> 		Endif
> 
> 		Release lcMessage,lcSchema,loConfig,loMsg,loError,lcErr
> 		loMsg = .Null.
> 
> 
> 
> 
> 
> 
> 
> 
> 
> 	Case lnSendVia = 2
> 		* Sergey's class.  Download cdo2000.prg at http://www.berezniker.com/
> 
> 		* Replace addresses with real ones before running the code
> 
> 		loMail = Newobject("Cdo2000", "Cdo2000.fxp")
> 
> 		With loMail
> 
> 			.cServer = Alltrim(lcSMTPServer)   && "smtp.mail.yahoo.com"
> 			.nServerPort = (lcSMTPPort)   &&465
> 			.lUseSSL = .T.
> 
> 			.nAuthenticate = 1 	&& cdoBasic
> 			*.cUserName = "yourYahooAccount@Yahoo.com"
> 			*.cPassword = "yourYahooPassword"
> 			.cUserName = Alltrim(lcLogin)  &&"crewchiefpro50@yahoo.com"
> 			.cPassword = Alltrim( lcPassword )
> 
> 
> 			* The From address has to be one the registered identities (Yahoo accounts),
> 			*.cFrom = "yourYahooAccount@Yahoo.com"
> 
> 
> 			.cFrom = .cUserName
> 
> 			*.cTo = "somebody@otherdomain.com, somebodyelse@otherdomain.com"
> 
> 			.cTo = lcRecipient1  &&"don@crew-chief.com;crewchiefpro@live.com"
> 
> 
> 			.cSubject = "From: " + Alltrim(Proper(Thisform.Dealership_name))
> 
> 			* Uncomment next lines to send HTML body
> 			*.cHtmlBody = "<b>This is an HTML body<br>" + ;
> 			*		"It'll be displayed by most email clients</b>"
> 
> 			.cTextBody =  ( lcTextBody )
> 
> 			* Attachments are optional
> 			.cAttachment = lcAttachedFile
> 
> 		Endwith
> 
> 		If loMail.Send() > 0
> 			For i=1 To loMail.GetErrorCount()
> 				*MESSAGEBOX("Error: " +  i, loMail.Geterror(i),0,"Error Message )
> 				@ 2,1 Say i
> 				@ 3,1 Say loMail.Geterror(i)
> 			Endfor
> 		Else
> 			Wait Window (lcWait_Window_Message)  Nowait
> 		Endif
> 
> 		* clear any reference to the object
> 		Release loMail
> 		loMail = .Null.
> 
> 
> Endcase
> 
> 
> * return to payment just to be sure
> Select Payment
> 
> Return
> 
> 
> 
> 
> 

>
>
>
>
>
>
> > Hi Expert
> >
> > Following is the Code I use to Configure CDO Messaging but it does not configure. Can any one help me to Configure it. Afterward I try with Outlook Express. Now system successfully sending mail but it takes about one minute for each mail. My Mail sending code is also hereunder:
> >
> > LOCAL loConfig AS CDO.Configuration, loFlds AS Object, loMsg AS CDO.Message
> >
> > loConfig = CREATEOBJECT("CDO.Configuration")
> > loFlds = loConfig.Fields
> >
> > WITH loFlds
> > *- Set the CDOSYS configuration fields to use port 25 on the SMTP server.
> > .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
> >
> > *- Enter name or IP address of remote SMTP server.
> > .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
> > .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 && 467
> >
> > *- Assign timeout in seconds
> > .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 20
> > .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = .t. && .f.
> > .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "ahsanrana59@gmail.com"
> > .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") ="abc"
> > *!* .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "username"
> > *!* .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") ="password"
> > .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
> >
> > .Update()
> > ENDWITH
> >
> > **************************************************
> >
> > DECLARE SHORT InternetGetConnectedState In WinInet.Dll ;
> > INTEGER @lpdwFlags, Integer dwReserved
> > LOCAL lConnected
> > lConnected = .F.
> > lpdwFlags = 0
> > IF InternetGetConnectedState (@lpdwFlags, 0) = 1
> > lConnected = .T.
> > ENDIF
> >
> > IF lConnected = .T.
> > oMSG = CREATEOBJECT("CDO.Message")
> > oMSG.To = Thisform.txtEmailAdd.Value
> > oMSG.From = Thisform.txtSender.Value
> > oMSG.Subject = Thisform.txtSubject.Value
> > oMSG.TextBody = ALLTRIM(Thisform.Edit1.Value)
> > IF !EMPTY(Thisform.txtAttachment.Value)
> > oMsg.AddAttachment(Thisform.txtAttachment.Value)
> > ENDIF
> > oMSG.Send()
> > WAIT WINDOW 'Message to '+ALLTRIM(nm)+' successfully delivered' NOWAIT
> > ENDIF
> >
> > Rgds:
> > Ahsan Rana
>
>
>
> Don Higgins
>
>
>
> http://www.youtube.com/watch?v=dcuFx85o8XU
>


Thnx Peoria

Should be greatfull if you send it for my guidence.

Rgds:
Ahsan Rana

ENTIRE THREAD

CDO Configuration Posted by Ahsan Rana @ 12/29/2009 4:41:10 PM
RE: CDO Configuration Posted by Mike Gagnon @ 12/29/2009 5:46:32 PM
RE: CDO Configuration Posted by Ahsan Rana @ 12/30/2009 5:19:21 AM
RE: CDO Configuration Posted by Mike Gagnon @ 12/30/2009 12:31:25 PM
RE: CDO Configuration Posted by Ahsan Rana @ 12/30/2009 4:22:24 PM
RE: CDO Configuration Posted by Don Higgins @ 12/29/2009 11:50:32 PM
RE: CDO Configuration Posted by Ahsan Rana @ 12/30/2009 5:13:35 AM
RE: CDO Configuration Posted by M. Akram Bhatti @ 12/30/2009 7:26:42 AM
RE: CDO Configuration Posted by Ahsan Rana @ 12/30/2009 4:34:00 PM
RE: CDO Configuration Posted by M. Akram Bhatti @ 12/30/2009 6:02:06 PM
RE: CDO Configuration Posted by Ahsan Rana @ 12/30/2009 6:40:41 PM
RE: CDO Configuration Posted by Mike Gagnon @ 12/30/2009 11:10:02 PM
RE: CDO Configuration Posted by Ahsan Rana @ 12/31/2009 4:11:44 AM
RE: CDO Configuration Posted by Mike Gagnon @ 12/31/2009 12:39:07 PM
RE: CDO Configuration Posted by Ahsan Rana @ 12/31/2009 7:12:30 PM
RE: CDO Configuration Posted by Mike Gagnon @ 1/1/2010 1:17:44 PM
RE: CDO Configuration Posted by Ahsan Rana @ 1/3/2010 6:20:24 AM
RE: CDO Configuration Posted by Mike Gagnon @ 1/3/2010 6:26:42 AM
RE: CDO Configuration Posted by Ahsan Rana @ 1/3/2010 2:26:19 PM
RE: CDO Configuration Posted by Mike Gagnon @ 1/3/2010 5:53:29 PM
RE: CDO Configuration Posted by Ahsan Rana @ 1/3/2010 6:31:31 PM
RE: CDO Configuration Posted by Mike Gagnon @ 1/4/2010 1:56:16 AM
RE: CDO Configuration Posted by Digant Vora @ 12/31/2009 6:54:22 AM
RE: CDO Configuration Posted by Mike Gagnon @ 12/31/2009 12:41:17 PM
RE: CDO Configuration Posted by khubaib khalid @ 1/4/2010 2:40:21 PM
RE: CDO Configuration Posted by Ahsan Rana @ 1/4/2010 4:53:03 PM
RE: CDO Configuration Posted by khubaib khalid @ 1/4/2010 5:03:36 PM