VFP 愛用者社區 首頁 VFP 愛用者社區
本討論區為 Visual Foxpro 愛用者經驗交流的地方, 請多多利用"搜尋"的功能, 先查看看有無前例可循, 如果還有不懂的再發問. 部份主題有附加檔案, 須先註冊成為社區居民才可以下載.
 
 常見問題常見問題   搜尋搜尋   會員列表會員列表   會員群組會員群組   會員註冊會員註冊 
 個人資料個人資料   登入檢查您的私人訊息登入檢查您的私人訊息   登入登入

使用Email技巧

 
發表新主題   回覆主題    VFP 愛用者社區 首頁 -> VFP 討論區
上一篇主題 :: 下一篇主題  
發表人 內容
Ruey



註冊時間: 2003-03-12
文章: 1698
來自: tunglo

第 1 樓

發表發表於: 星期二 三月 18, 2003 7:18 pm    文章主題: 使用Email技巧 引言回覆

從IIS4開始, NT Web 有提供一CDONTS元件, 發送Email, 不過基於以下理由,
1. Cdonts 與多數Smtp Mail Server 不相容.
2. Cdonts 無法接收Email, 而Jmail 有提供Pop3服務, 可以設計Webmail.
3. Cdonts 的Smtp發送Email效率遠不及 Jmail.


*/*CDO.dll comes with Windows 2000 and XP
狐友請注意
這範例只適用在Windows2000和XP


oMSG = CREATEOBJECT("cdo.message")
oMSG.To = "mike.gagnon@slpcanada.com"
oMSG.From = "me"
oMSG.Subject = "Hello Email"
oMSG.TextBody = "This is an easy way to create an email"
oMSG.Send()

*/*Here are some other features of the CDO.Message:

oMSG = createobject("CDO.Message")
oMSG.To = ""mike.gagnon@slpcanada.com"
oMSG.From = "mike.gagnon@slpcanada.com"
oMSG.Subject = "Hello Email"
oMSG.AddAttachment("c:\myfile.txt")
oMSG.AddAttachment("c:\MySecondFile.gif")
oMSG.Send()

*/*Here is a great way to embed your web page in your email:

oMSG = createobject("CDO.Message")
oMSG.To = "mike.gagnon@slpcanada.com"
oMSG.From = "mike.gagnon@slpcanada.com"
oMSG.Subject = "Hello Email"
oMSG.CreateMHTMLBody("http://www.slpcanada.com"Wink
oMSG.Send()

*/*Here is another way to send HTML in your email:

oMSG = createobject("CDO.Message")
oMSG.To = "mike.gagnon@slpcanada.com"
oMSG.From = "mike.gagnon@slpcanada.com"
oMSG.Subject = "Hello Email"
oMSG.HTMLBody = [< b >< P >< FONT COLOR="#CC0000" >Hello In Color< /FONT ><
/b >]
oMSG.Send()




Other than the fact that it opens up your default e-mail program and at that
point YOU CAN attached a file,no. But this one does.

DO FindWindow
LOCAL lcPath, hWindow, lcDelimiter, lcFiles, lcMsgSubj
lcPath = SYS(5) + SYS(2003)
hWindow = GetActiveWindow()
lcDelimiter = ";"
lcFiles = "C:\app.prg" + lcDelimiter+ "C:\app.fxp" && Has to be valid files,
you could use a Getfile() here.
lcMsgSubj = "Files Attached: App.prg,App.fxp."
= MAPISendDocuments (hWindow, lcDelimiter, lcFiles, lcMsgSubj, 0)
SET DEFAULT TO (lcPath)
PROCEDURE FindWindow
DECLARE INTEGER GetActiveWindow IN user32
DECLARE INTEGER MAPISendDocuments IN mapi32;
INTEGER ulUIParam, STRING lpszDelimChar,;
STRING lpszFullPaths, STRING lpszFileNames,;
INTEGER ulReserved
ENDPROC


Ruey 在 星期一 八月 04, 2003 10:05 am 作了第 3 次修改
回頂端
檢視會員個人資料 發送私人訊息
ICTANG



註冊時間: 2003-03-18
文章: 11
來自: Taipei

第 2 樓

發表發表於: 星期三 三月 19, 2003 1:24 pm    文章主題: 引言回覆

前一陣子曾在XP及NT下利用此方法,結果在XP下OK,NT失敗.因為程式最後還是要在NT SERVER中RUN,所以只好還是透過OUTLOOK OBJECT出去.
回頂端
檢視會員個人資料 發送私人訊息
Ruey



註冊時間: 2003-03-12
文章: 1698
來自: tunglo

第 3 樓

發表發表於: 星期三 三月 19, 2003 3:32 pm    文章主題: 引言回覆

JMAIL的郵件程式下載網站:
http://www.dimac.net
線上說明書
http://host.cdesystems.com/faq/jmail_asp_online_manual.htm


屬性 說明
Body 郵件的本文
Charset 郵件的字集, 預設為 "US-ASCII"
ContentType 本文的內容類型
From 寄件者電子郵件
FromName 寄件者姓名
ISOEncodeHeaders 標題字串是否根據 ISO-8859-1 字集來編碼
Logging 是否開啟錯誤紀錄功能
Priority 郵件的優先順序
Subject 郵件的主旨
方法 說明
AddRecipient(郵件, 收件人) 新增郵件的收件人
AddRecipientCC(郵件, 收件人) 新增郵件的副本收件人
AddRecipientBCC(郵件, 收件人) 新增郵件的密件收件人
Send(郵件伺服器位址) 送出郵件

**************************************************
LOCAL jMail


IF ALLTRIM(THISFORM.txtSender.VALUE)="" &&寄信人信箱未填入
ShowMessage("寄信人信箱未填入")
RETURN
ENDIF
IF ALLTRIM(THISFORM.txtRecipient.Value)="&&收信人信箱未填入
ShowMessage("收信人信箱未填入")
RETURN
ENDIF
IF ALLTRIM(THISFORM.txtSubject.VALUE)=""&&主旨未填入
ShowMessage("主旨未填入")
RETURN
ENDIF



JMail=CREATEOBJECT("JMail.SMTPMail")

IF VARTYPE(jMail) <> "O"
MESSAGEBOX = "JMail is probably NOT installed!"
RETURN .F.
ENDIF


JMail.Logging = .F. &&啟動紀錄檔與否true/false
JMail.Priority=3 &&傳送優先等級分5級
JMail.ContentType = "text" &&設定為HTML傳送格式
JMail.Charset = "big5" &&設定charset為Big
JMail.ContentTransferEncoding = "base64"
JMail.ISOEncodeHeaders = .F.

JMail.ServerAddress="ms11.hinet.net" &&外部郵件伺服器
JMail.Sender= ALLTRIM(THISFORM.txtSender.VALUE) &&寄信人信箱
JMail.AddRecipient(ALLTRIM(THISFORM.txtRecipient.Value))&&即收件人
*JMail.AddRecipientCC("") &&副本收件人的信箱
*JMail.AddRecipientBCC("") &&Recipient 密件副本收件人的信箱

JMail.Subject = ALLTRIM(THISFORM.txtSubject.Value) &&郵件標題
JMail.Body=ALLTRIM(THISFORM.edtBody.Value)&&郵件本體

IF ALLTRIM(THISFORM.txtAttachment.VALUE)<>""
JMail.ContentType = "multipart/mixed"
JMail.AddAttachment(THISFORM.txtAttachment.VALUE) &&附帶檔案
ENDIF


JMail.Execute &&


Ruey 在 星期日 七月 27, 2003 2:51 pm 作了第 2 次修改
回頂端
檢視會員個人資料 發送私人訊息
ICTANG



註冊時間: 2003-03-18
文章: 11
來自: Taipei

第 4 樓

發表發表於: 星期五 三月 21, 2003 2:46 pm    文章主題: 引言回覆

請問JMAIL是從哪裡來的(?.DLL)
回頂端
檢視會員個人資料 發送私人訊息
Ruey



註冊時間: 2003-03-12
文章: 1698
來自: tunglo

第 5 樓

發表發表於: 星期五 三月 21, 2003 3:05 pm    文章主題: 引言回覆

Google上搜尋
回頂端
檢視會員個人資料 發送私人訊息
Ruey



註冊時間: 2003-03-12
文章: 1698
來自: tunglo

第 6 樓

發表發表於: 星期日 七月 13, 2003 8:09 pm    文章主題: 引言回覆

評語:本範例採用mswinsock.winsock作為傳送Email的方式
非Winsock.ocx而是Winsock.DLL
也就是說不需要其他的第三方原件,安裝Windows時已內含
所以傳送時速度快喔......~_~

使用範例
thisform.txtoutput.value=SendSmtpEmail("ms11.hinet.net","aa1@ms11.hinet.net","aa1@ms11.hinet.net","test","ok","d:\main.txt",.NULL.)


===============================================
FUNCTION SendSmtpEmail
* strServ: The SMTP server to use. Can be in the following formats:
* xxx.xxx.xxx.xxx "xxx.xxx.xxx.xxx:port" "xxx.xxx.xxx.xxx port"
* ServerName "servername:port" "servername port"
* strFrom: The email address to provide as the "FROM" address
* strTo: The email address to send the email to.
* strSubj: Subject for the email
* strMsg: The Message to include as the body of the email.
* oFB_Attachments: Comma separated list of files to attach (full path to each file)
* (for backward compatibility, the Feedback object can be passed as this parameter)
* All Attachments+message can be at most 16MB right now, because of VFP string size limit.
* oFeedBack: An object with a method "FeedBack" that expects one string property.
* If not provided, the feedback messages will be output to the console through "?".
* Pass .NULL. (or an object without "Feedback" method) to turn off all feedback.
*
* Updated: April 1, 2004: Fixed RCPT TO handling to properly
* bracket the email address.

LPARAMETERS strServ, strFrom, strTo, strSubj, strMsg, oFB_cAttachments, oFeedBack
#DEFINE crlf chr(13)+chr(10)
#DEFINE TIME_OUT 5

LOCAL Sock, llRet, lnI, laTO[1], lnCnt, lcServ, lnServPort
LOCAL lnTime, lcOutStr, Junk, lcAttachments, loFB, laAtch[1], lnAtchCnt
LOCAL laFiles[1]

lcMsg = strMsg
lcAttachments = oFB_cAttachments
loFB = oFeedback
if TYPE('oFB_cAttachments')='O'
loFB = oFB_cAttachments
lcAttachments = ''
endif

* Load Attachments
if TYPE('lcAttachments')='C' and not empty(lcAttachments)
lnAtchCnt = ALINES( laAtch, StrTran(lcAttachments,',',chr(13)) )
lcMsg = lcMsg + crlf + crlf
for lnI = 1 to lnAtchCnt
if ADIR(laFiles,laAtch[lnI])=0
GiveFeedBack( loFB, "ERROR: Attachment Not Found:"+laAtch[lnI] )
RETURN .F.
endif
lcAtch = FileToStr( laAtch[lnI] )
if empty(lcAtch)
GiveFeedBack( loFB, "ERROR: Attachment Empty/Could not be Read:"+laAtch[lnI] )
RETURN .F.
endif

GiveFeedBack( loFB, "Encoding file: "+laAtch[lnI] )
lcAtch = UUEncode( laAtch[lnI], lcAtch )

lcMsg = lcMsg + lcAtch
lcAtch = '' && free memory
endfor
endif


GiveFeedBack( loFB, "Connecting to Server: "+strServ )

Sock=create('mswinsock.winsock')
** OR
* Sock=create('vfpWinSock')
** to use the winsock emulator class below (wayyyy below!) to avoid
** the licensing issues stemming from OCX's, and to avoid having to
** register MSWINSCK.OCX on the customers' machines.

llRet = .F.



lnServPort = 25
lcServ = strServ
do case && Find Port
case ':' $ lcServ
lnAt = at(':',lcServ)
lnServPort = val( Substr(lcServ, lnAt+1) )
lcServ = left( lcServ, lnAt-1 ) && moved below "lnServPort =...."
if lnServPort<=0
lnServPort = 25
endif
case ' ' $ lcServ
lnAt = at(' ',lcServ)
lnServPort = val( Substr(lcServ, lnAt+1) )
lcServ = left( lcServ, lnAt-1 ) && moved below "lnServPort =...."
if lnServPort<=0
lnServPort = 25
endif
endcase

sock.Connect(strServ,lnServPort)
lnTime = seconds()

DO WHILE .T. && Control Loop

if sock.State <> 7 && Connected
GiveFeedBack( loFB, "Waiting to connect..." )
inkey(0.1)
if seconds() - lnTime > TIME_OUT
GiveFeedBack( loFB, "Connect Timed Out")
EXIT && Leave Control Loop
endif
LOOP && Wait to connect
endif

GiveFeedBack( loFB, "Connected." )

if not ReadWrite(sock,"HELO " + alltrim(strServ), 220)
GiveFeedBack( loFB, "Failed HELO" )
EXIT && Leave Control Loop
endif

If Not ReadWrite(sock,"MAIL FROM: " + alltrim(strFrom), 250)
GiveFeedBack( loFB, "Failed MAIL" )
EXIT
endif

lnCnt = aLines(laTo, ChrTran(strTo,' ,;',chr(13)))
* once for each email address
for lnI = 1 to lnCnt
if not empty(laTo[lnI])
lcTo = iif( '<' $ laTo[lnI], laTo[lnI], '<' + alltrim(laTo[lnI]) + '>' )
If Not ReadWrite(sock,"RCPT TO: " + lcTo, 250)
GiveFeedBack( loFB, "RCPT Failed" )
EXIT && Leave Control Loop
endif
endif
endfor

If Not ReadWrite(sock,"DATA", 250)
GiveFeedBack( loFB, "Failed DATA" )
EXIT && Leave Control Loop
endif
* tran(day(date()))+' '+tran(month(date()))+' '+tran(year(date()));
* + ' ' +tran(hour(datetime()))+':'+tran(minute(datetime()))+':'+tran(sec(datetime())) +crlf

lcOutStr = "DATE: " + GetSMTPDateTime() +crlf;
+ "FROM: " + alltrim(strFrom) + CrLf ;
+ "TO: " + alltrim(strTo) + CrLf ;
+ "SUBJECT: " + alltrim(strSubj) ;
+ crlf ;
+ crlf ;
+ lcMsg
* remove any inadvertant end-of-data marks:
lcOutStr = StrTran(lcOutStr, crlf+'.'+crlf, crlf+'. '+crlf)
* Place end of data mark on end:
lcOutStr = lcOutStr + crlf + "."
If Not ReadWrite(sock,lcOutStr, 354 )

GiveFeedBack( loFB, "Failed DATA (Cont'd)" )
EXIT && Leave Control Loop
ENDIF

If Not ReadWrite(sock,"QUIT", 250)
GiveFeedBack( loFB, "Failed QUIT" )
EXIT && Leave Control Loop
endif

GiveFeedBack( loFB, "Email Sent!" )
llRet = .T.
EXIT && Leave Control Loop
ENDDO

* Do cleanup code.
Junk = repl(chr(0),1000)
if sock.state = 7 && Connected
sock.GetData(@Junk)
endif
sock.close
sock = .null.
RETURN llRet
*--------------------------------------------------
Function GiveFeedback( oFB, cMsg )
if VarType(oFB)='O' or IsNull(oFB)
if NOT IsNull(oFB) and PEMStatus(oFB,'Feedback',3)='Method'
RETURN oFB.Feedback( cMsg )
else
RETURN .T. && Hide Feedback
endif
else
?cMsg
endif
ENDFUNC
*--------------------------------------------------
FUNCTION GetSMTPDateTime
* Wed, 12 Mar 2003 07:54:56 -0500
LOCAL lcRet, ltDT, lnBias
ltDT = DateTime()
if 'UTIL' $ set('PROC')
lnBias = GetTimeZone('BIAS') && In Util.prg
else
lnBias = -5 && EST
endif
lcBias = iif( lnBias<0, '+', '-' )
lnBias = abs(lnBias)
lcBias = lcBias+PadL(Tran(lnBias/60),2,'0')+PadL(Tran(lnBias%60),2,'0')
lcRet = LEFT( CDOW(ltDT), 3 )+', '+Str( Day(ltDt), 2 ) + ' ' + LEFT( CMONTH(ltDT), 3);
+' '+TRAN( Year(ltDT) )+' '+PadL(Tran(hour(ltDT)),2,'0')+':';
+PadL(Tran(Minute(ltDT)),2,'0')+':';
+PadL(Tran(Sec(ltDT)),2,'0')+' ';
+lcBias
RETURN lcRet
ENDFUNC
*--------------------------------------------------
Function ReadWrite( oSock, cMsgOut, iExpectedCode )
LOCAL cMsgIn, iCode, lnTime
lnTime = seconds()

do while oSock.BytesReceived = 0
* ?"Waiting to Receive data..."
inkey(0.2)
if seconds() - lnTime > TIME_OUT
* ?"Timed Out"
return .F.
endif
enddo

cMsgIn = repl(chr(0),1000)
oSock.GetData(@cMsgIn)
*?"expected:",iExpectedCode
*
*?"resp:",cMsgIn
iCode = Val(Left(cMsgIn, 3))
*?"Got:",icode
If iCode = iExpectedCode
oSock.SendData( cMsgOut + CrLf )
Else
* ?"Failed; Code="+cMsgin
* ?"Code="+tran(iCode)
RETURN .F.
Endif
RETURN .T.
FUNCTION GetTimeZone( pcFunc )
* Purpose: Return the Time Zone bias or description
* Input: pcFunc = "BIAS" or Missing... return the bias in Minutes
* ( GMT = LocalTime + Bias )
* pcFunc = "NAME" ... Return the time zone name.
* Author: William GC Steinford
***********************************************************

*!* typedef struct _TIME_ZONE_INFORMATION {
*!* LONG Bias; 2: 1- 2
*!* WCHAR StandardName[ 32 ]; 64: 3- 66
*!* SYSTEMTIME StandardDate; 16: 67- 82
*!* LONG StandardBias; 2: 83- 84
*!* WCHAR DaylightName[ 32 ]; 64: 85-148
*!* SYSTEMTIME DaylightDate; 16:149-164
*!* LONG DaylightBias; 2:165-166
*!* } TIME_ZONE_INFORMATION, *PTIME_ZONE_INFORMATION;
*!* typedef struct _SYSTEMTIME {
*!* WORD wYear;
*!* WORD wMonth;
*!* WORD wDayOfWeek;
*!* WORD wDay;
*!* WORD wHour;
*!* WORD wMinute;
*!* WORD wSecond;
*!* WORD wMilliseconds;
*!* } SYSTEMTIME, *PSYSTEMTIME;
LOCAL lcTZInfo, lcDesc
lcTZInfo = num2dword(0);
+repl(chr(0),64)+repl(num2Word(0),8 )+num2dword(0);
+repl(chr(0),64)+repl(num2Word(0),8 )+num2dword(0)
DECLARE INTEGER GetTimeZoneInformation IN kernel32.dll;
STRING @ lpTimeZoneInformation
#DEFINE TIME_ZONE_ID_INVALID 0xFFFFFFFF
#DEFINE TIME_ZONE_ID_UNKNOWN 0
#DEFINE TIME_ZONE_ID_STANDARD 1
#DEFINE TIME_ZONE_ID_DAYLIGHT 2
lcRes = GetTimeZoneInformation( @lcTZInfo )
lnBias = Buf2DWord( lcTZInfo )
lcDesc = "Unknown"
do case
case lcRes=TIME_ZONE_ID_STANDARD
lcDesc = substr( lcTZInfo, 3, 64 )
lcDesc = StrConv( lcDesc, 6 ) && 6=Unicode(wide)->DoubleByte
lcDesc = strTran( lcDesc, chr(0), '' )
case lcRes=TIME_ZONE_ID_DAYLIGHT
lcDesc = substr( lcTZInfo, 3, 64 )
lcDesc = StrConv( lcDesc, 6 )
lcDesc = strTran( lcDesc, chr(0), '' )
endcase
if varType(pcFunc)='C' and pcFunc='NAME'
RETURN lcDesc
endif

RETURN lnBias
ENDFUNC
* * *
* dword is compatible with LONG
FUNCTION num2Long( lnValue )

RETURN num2Dword(lnValue)
ENDFUNC
FUNCTION num2dword (lnValue)
#DEFINE m0 256
#DEFINE m1 65536
#DEFINE m2 16777216
LOCAL b0, b1, b2, b3
b3 = Int(lnValue/m2)
b2 = Int((lnValue - b3*m2)/m1)
b1 = Int((lnValue - b3*m2 - b2*m1)/m0)
b0 = Mod(lnValue, m0)
RETURN Chr(b0)+Chr(b1)+Chr(b2)+Chr(b3)
ENDFUNC
* * *
* word is compatible with Integer
FUNCTION num2word (lnValue)
RETURN Chr(MOD(m.lnValue,256)) + CHR(INT(m.lnValue/256))
ENDFUNC
* * *
FUNCTION buf2word (lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
Asc(SUBSTR(lcBuffer, 2,1)) * 256
ENDFUNC
* * *
FUNCTION buf2Long (lcBuffer)
RETURN buf2Dword(lcBuffer)
ENDFUNC
FUNCTION buf2dword(lcBuffer)
RETURN Asc(SUBSTR(lcBuffer, 1,1)) + ;
Asc(SUBSTR(lcBuffer, 2,1)) * 256 +;
Asc(SUBSTR(lcBuffer, 3,1)) * 65536 +;
Asc(SUBSTR(lcBuffer, 4,1)) * 16777216
ENDFUNC
**************************************************************************************
Function UUEncode( strFilePath, pcFileData )
* Converted by wgcs From VB code at http://www.vbip.com/winsock/winsock_uucode_02.asp
* strFilePath: Specify the full path to the file to load and UU-encode.
* pcFileData: an optional parameter. Specify this, and strFilePath is not loaded,
* but just the filename from strFilePath is used for the encoding label.
*
LOCAL strFileName, strFileData, i, j, lEncodedLines, ;
strTempLine, lFileSize, strResult, strChunk

*Get file name
strFileName = JustFName(strFilePath)
if type('pcFileData')='C'
strFileData = pcFileData
else
strFileData = FileToStr(strFilePath)
endif

*Insert first marker: "begin 664 ..."
strResult = "begin 664 " + strFileName + chr(10)

*Get file size
lFileSize = Len(strFileData)
lEncodedLines = int(lFileSize / 45) + 1

For i = 1 To lEncodedLines
*Process file data by 45-bytes cnunks

*reset line buffer
strTempLine = ""

If i = lEncodedLines Then
*Last line of encoded data often is not
*equal to 45
strChunk = strFileData
StrFileData = ''
else
strChunk = LEFT( strFileData, 45 )
StrFileData = SubStr( strFileData, 46 )
endif

* Thanks to "AllTheTimeInTheWorld" on Tek-Tips.com, it was recognized that
* the length calculation should be after the correction of the last line
* with the blankspace symbols:
* *Add first symbol to encoded string that informs
* *about quantity of symbols in encoded string.
* *More often "M" symbol is used.
* strTempLine = Chr(Len(strChunk) + 32)

If i = lEncodedLines And (Len(strChunk) % 3<>0) Then
*If the last line is processed and length of
*source data is not a number divisible by 3,
*add one or two blankspace symbols
strChunk = strChunk + Space( 3 -(Len(strChunk) % 3) )
endif

*Now that we know the final length of the last string,
*Add first symbol to encoded string that informs
*about quantity of symbols in encoded string.
*More often "M" symbol is used.
strTempLine = Chr(Len(strChunk) + 32)


*!* For j = 1 To Len(strChunk) Step 3
*!* *Break each 3 (8-bits) bytes to 4 (6-bits) bytes
*!* *
*!* *1 byte
*!* strTempLine = strTempLine + ;
*!* Chr(Asc(SubStr(strChunk, j, 1)) / 4 + 32)
*!* *2 byte
*!* strTempLine = strTempLine + ;
*!* Chr((Asc(SubStr(strChunk, j, 1)) % 4) * 16 ;
*!* + Asc(SubStr(strChunk, j + 1, 1)) / 16 + 32)
*!* *3 byte
*!* strTempLine = strTempLine + ;
*!* Chr((Asc(SubStr(strChunk, j + 1, 1)) % 16) * 4 ;
*!* + Asc(SubStr(strChunk, j + 2, 1)) / 64 + 32)
*!* *4 byte
*!* strTempLine = strTempLine + ;
*!* Chr(Asc(SubStr(strChunk, j + 2, 1)) % 64 + 32)

*!* EndFor

* Faster method:
For j = 1 To Len(strChunk) Step 3
*Break each 3 (8-bits) bytes to 4 (6-bits) bytes
ln1 = Asc(SubStr(strChunk, j, 1))
ln2 = Asc(SubStr(strChunk, j + 1, 1))
ln3 = Asc(SubStr(strChunk, j + 2, 1))
*1 byte
strTempLine = strTempLine + Chr(ln1 / 4 + 32) ;
+ Chr((ln1 % 4) * 16 + ln2 / 16 + 32) ;
+ Chr((ln2 % 16) * 4 + ln3 / 64 + 32) ;
+ Chr(ln3 % 64 + 32)
EndFor


*add encoded line to result buffer
strResult = strResult + strTempLine + chr(10)
EndFor
*add the end marker
strResult = strResult + "*" + chr(10) + "end" + chr(10)
*asign return value
return strResult

Function UUDecode(strUUCodeData)
* Converted by wgcs From VB code at http://www.vbip.com/winsock/winsock_uucode_04.asp
LOCAL lnLines, laLines[1], lcOut, lnI, lnJ
LOCAL strDataLine, intSymbols, strTemp

*Remove first marker

If Left(strUUCodeData, 6) = "begin "
strUUCodeData = SubStr(strUUCodeData, AT(chr(10),strUUCodeData) + 1)
EndIf

*Remove marker of the attachment's end
If Right(strUUCodeData, 5) = "end" + chr(13)+chr(10)
* Remove last 10 characters: CR,LF,*,CR,LF,E,N,D,CR,LF
strUUCodeData = Left(strUUCodeData, Len(strUUCodeData) - 10)
endif
strTemp = ""

*Break decoded data to the strings

*From now each member of the array vDataLines contains
*one line of the encoded data
lnLines = alines(laLines, strUUCodeData)

For lnI = 1 to lnLines
*Decode data line by line
strDataLine = laLines[lnI]

*Extract the number of characters in the string
*We can figure it out by means of the first string character
intSymbols = Asc(Left(strDataLine, 1))

*which we delete because of its uselessness
strDataLine = SubStr(strDataLine, 2, intSymbols)

*Decode the string by 4 bytes portion.
*From each byte remove two oldest bits.
*From remain 24 bits make 3 bytes
For lnJ = 1 To Len(strDataLine) Step 4
*1 byte
strTemp = strTemp + Chr( (Asc(SubStr(strDataLine, lnJ, 1)) - 32) * 4 ;
+(Asc(SubStr(strDataLine, lnJ+1, 1)) - 32) / 16 )
*2 byte
strTemp = strTemp + Chr( (Asc(SubStr(strDataLine, lnJ+1, 1)) % 16) * 16 ;
+(Asc(SubStr(strDataLine, lnJ+2, 1)) - 32) / 4 )
*3 byte

strTemp = strTemp + Chr( (Asc(SubStr(strDataLine, lnJ+2, 1)) % 4) * 64 ;
+ Asc(SubStr(strDataLine, lnJ+3, 1)) - 32)
ENDFOR
*Write decoded string to the file
lcOut = lcOut + strTemp

*Clear the buffer in order to receive the next
*line of the encoded data
strTemp = ""
ENDFOR

RETURN lcOut
ENDFUNC

_________________
#############################
快樂媽咪系列幸福宅配,喝十全雞湯~原來幸福那麼簡單!!

學會VFP使用者社區的搜尋,Code才會更有趣~
#############################


Ruey 在 星期五 八月 01, 2003 2:04 pm 作了第 2 次修改
回頂端
檢視會員個人資料 發送私人訊息
Ruey



註冊時間: 2003-03-12
文章: 1698
來自: tunglo

第 7 樓

發表發表於: 星期日 七月 20, 2003 4:06 pm    文章主題: 引言回覆

節錄此篇中一部分 揭開 Winsock 的神秘面紗
http://vfp.sunyear.com.tw/viewtopic.php?t=147

用 Winsock 發送的接收 e-mail
在寫程式時, 許多開發者需要從程式發送或接收 e-mail. 最流行的方案是通過 Outlook Express. 但有可能電腦中沒有該 e-mail 工具. 咋個辦?
在示例 4 中我們將分析一個簡單的允許從程式內發送 e-mail 的方法.
從 Conectar 命令按鈕中, 運行方法 .Conecta_Pop(). 該方法連接到 POP 伺服器交等待一個伺服器的 +OK 回應. 伺服器處理身份鑒定, 發送用戶名和口令, 並回到命令按鈕.
現在調用 .checa_msg() 方法. 它發送 STAT 命令到伺服器, 並等待伺服器的 +OK 資訊. 稍過片刻, 收件箱中的 e-mail 被發送.
使用命令 RETR n, 其中 n 是希望的資訊號, 我們必須處理下載各個資訊(譯者注: 一個資訊就是一個郵件).
你可以向該方法傳遞一個 .t. 參數, 它將刪除用 DELE n 命令刪除資訊 (再次重申 n 是要處理的資訊號).
再次回到命令按鈕, 我們可以看到 .Conecta_Smtp(). 方法被調用. 該方法連接到 SMTP 伺服器並等待回應. 接著, 它用 HELO nome_da_esta玢o 命令來處理 SMTP 伺服器上的身份識別.
現在我們調用 .envia_msg() 方法. 在該方法中, 顯示 e-mail 頭並且我們必須發送 RSET 命令來開始發送 e-mail 到伺服器. 各收件人用 RCPT TO: endere鏾_email 命令發送. 伺服器將不檢查該位址.
在所有位址都發送後, 為了準備伺服器接收 e-mail, 另一個命令 DATA 將被發送.
該過程以 8K 的包發送.
最後, 我們發送命令 CHR(13)+CHR(10) +"." + CHR(13)+CHR(10) 到伺服器, 通知資訊發送完畢.
看看要發送和接收一個 e-mail 有多容易吧?
一些 SMTP 伺服器要求身份鑒定. 身份鑒定可以用兩種方法進行:
作為一個用戶用他的口令連接到 POP 伺服器, 然後立即斷開. (我們在檢查新的郵件時已經這樣做了).
用 UUCODE Base 64 加密口令識別你自己到 SMTP 伺服器. 我們將不討論這個細節, 因為我們必須寫一個演算法這樣我們的示例將太複雜. 但是, 對於使用 Visual FoxPro 7 的開發者, 這只需用一個 VFP 自身的函數: STRCONV (dados,13) 或 STRCONV (dados,14).




轉貼紅狐網站 廖大
補充用Winsock控件發信Email
使用控件有:Winsock控件,CommandButton 控件,TextBox 控件
編程步驟如下:
1.聲明變量
2.把如下代碼加到Command1的Command1_Click事件:
Private Sub Command1_Click()
Winsock1.LocalPort = 0 '設置本地使用的端口
Winsock1.Protocol = sckTCPProtocol '設置Winsock控件使用的協議,TCP或UDP。
Winsock1.RemoteHost="smtp.21cn.com" '設置發送Email的服務器
Winsock1.RemotePort = 25 '設置要連接的遠程端口號
Winsock1.Connect '返回與遠程計算机的連接。
End Sub
這里要注意的是:Winsock1.RemotePort的值,80為HTTP,21為FTP,25為SMTP。

3.把如下代碼加到Winsock1的Connect事件:
Private Sub Winsock1_Connect() ''當一個 Connect 操作完成時發生
first = "mail from:" + Chr(32) + "yingzi007@21cn.com" + vbCrLf '發信人地址
Second = "rcpt to:" + Chr(32) + "yingzi007@21cn.com" + vbCrLf '收信人地址
DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
Third = "Date:" + Chr(32) + DateNow + vbCrLf '開始發信時間
Fourth = "From:" + Chr(32) + "VB 小園" + vbCrLf '發信人姓名
Fifth = "To:" + Chr(32) + "Jimven"+ vbCrLf '收信人姓名
Sixth = "Subject:" + Chr(32) +"VB 小園更新通知" + vbCrLf '發信的主題
Seventh = "VB 小園已經更新" + vbCrLf '發信的內容
Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf
Eighth = Fourth + Third + Ninth + Fifth + Sixth
Winsock1.SendData ("HELO www.21cn.com" + vbCrLf) '開始發送
Winsock1.SendData (first)
Winsock1.SendData (Second)
Winsock1.SendData ("data" + vbCrLf)
Winsock1.SendData (Eighth + vbCrLf)
Winsock1.SendData (Seventh + vbCrLf)
Winsock1.SendData ("." + vbCrLf)
Winsock1.SendData ("quit" + vbCrLf)
End Sub

4.把如下代碼加到Winsock1的DataAmival事件:
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) '接受數据時產生
On Error Resume Next '在錯誤處理程序結束后,恢復原有的運行
Dim webData As String
Winsock1.GetData webData, vbString '取得發信后的反饋信息,可以檢查是否錯誤
Text1.Text = Text1.Text + webData
'Debug.Print Text1.Text
End Sub

_________________
#############################
快樂媽咪系列幸福宅配,喝十全雞湯~原來幸福那麼簡單!!

學會VFP使用者社區的搜尋,Code才會更有趣~
#############################


Ruey 在 星期日 七月 27, 2003 1:32 pm 作了第 1 次修改
回頂端
檢視會員個人資料 發送私人訊息
Ruey



註冊時間: 2003-03-12
文章: 1698
來自: tunglo

第 8 樓

發表發表於: 星期日 七月 27, 2003 1:27 pm    文章主題: 引言回覆

轉貼紅狐網站 廖大
利用Outlook傳送郵件

#DEFINE MAILITEM 0
#DEFINE IMPORTANCELOW 0
#DEFINE IMPORTANCENORMAL 1
#DEFINE IMPORTANCEHIGH 2

oOutLookObject = CreateObject("Outlook.Application")
oEmailItem = oOutLookObject.CreateItem(MAILITEM)

WITH oEmailItem
.Recipients.Add("ljl@hanyu.com.tw")
objOutlookRecip = .Recipients.Add("h8922149@ms12.hinet.net")
objOutlookRecip.Type = 2 &&副本
.Subject = "測試資料"
.Importance = IMPORTANCENORMAL
.Body = "這是測試vfp送出的資料,此資料由vfp送出"
.Attachments.Add("c:\a.txt")
.Send
ENDWITH

RELEASE oEmailItem
RELEASE oOutLookObject

_________________
#############################
快樂媽咪系列幸福宅配,喝十全雞湯~原來幸福那麼簡單!!

學會VFP使用者社區的搜尋,Code才會更有趣~
#############################
回頂端
檢視會員個人資料 發送私人訊息
Ruey



註冊時間: 2003-03-12
文章: 1698
來自: tunglo

第 9 樓

發表發表於: 星期日 七月 27, 2003 1:43 pm    文章主題: 引言回覆

SendMail 範例 ㄚ貴(守門員)也可以叫我看門狗(轉貼)


*將vfp所附的sendmail.scx範例程式內的container物件拿來用,其中有cmdMail,oleMmess,olemSess三個物件,將下列程式寫在cmdMail的Cilck event內*MAPIIF !this.parent.signon() && Use the custom method RETURN ENDIF IF this.parent.LogSession && Check if the user was able to login thisform.ctrMapiBtn.OleMMess.sessionid this.parent.OleMMess.sessionid=this.parent.OleMSess.sessionid this.parent.OleMMess.compose *電子郵件信箱 this.parent.OleMMess.RECIPindex=this.parent.OleMMess.RECIPcount this.parent.OleMMess.RECIPdisplayname='test@ms1.hinet.net' this.parent.OleMMess.RECIPtype=1 &&收件人(正本) this.parent.OleMMess.RECIPindex=this.parent.OleMMess.RECIPcount this.parent.OleMMess.RECIPdisplayname='test1@ms1.hinet.net' this.parent.OleMMess.RECIPtype=2 &&副本 this.parent.OleMMess.RECIPindex=this.parent.OleMMess.RECIPcount this.parent.OleMMess.RECIPdisplayname='test2@ms1.hinet.net' this.parent.OleMMess.RECIPtype=3 &&密件副本 RECIPtype=2 副本 *郵件主旨 this.parent.OleMMess.msgsubject="test SendMail" *內容 this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+repl('*',10)+' 申請維修一覽表 '+space(22)+'列印日期: '+right(dtoc(date()),8)+' '+time()+space(4)+CHR(13)+CHR(10) this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+repl('=',75)+CHR(13)+CHR(10) this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+space(40)+'已印'+space(3)+'產生'+space(3)+'電話'+space(1)+'重複'+space(2)+'正常'+CHR(13)+CHR(10) this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+' 序 撥入日期 撥入時間 客戶電話 申告原因 派工單 派工單 重複 派工 客戶 區域'+CHR(13)+CHR(10) this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+repl('=',75)+CHR(13)+CHR(10)*!* select serv*!* scan*!* this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+str(recno(),3)+' '+right(dtoc(date_s),8)+' '+left(time_s,2)+':'+substr(time_s,3,2)+':'+right(time_s,2)+' ';*!* +str(tel_h,8)+' '+left(servcod,8)+space(4)+iif(m_prt=.T.,'O','X')+space(6)+iif(m_a=.T.,'O','X')+space(5)+iif(teldbl=.T.,'O','X');*!* +space(4)+iif(m_dbl=.T.,'O','X')+space(3)+iif(nor=.T.,' O ',' X ')+areaname+CHR(13)+CHR(10)*!* endscan*!* this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+repl('=',75)+CHR(13)+CHR(10)*!* this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+'合計: '+alltrim(str(recc()))+' 筆'+CHR(13)+CHR(10)*!* *!* this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+CHR(13)+CHR(10)*!* this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+repl('*',10)+' 申請裝機一覽表 '+CHR(13)+CHR(10)*!* this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+repl('=',40)+CHR(13)+CHR(10)*!* this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+' 序 撥入日期 撥入時間 客戶電話 回電時段'+CHR(13)+CHR(10)*!* this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+repl('=',40)+CHR(13)+CHR(10)*!* select inst*!* scan*!* this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+str(recno(),3)+' '+right(dtoc(date_i),8)+' '+left(time_i,2)+':'+substr(time_i,3,2)+':'+right(time_i,2)+' ';*!* +str(tel_h,8)+' '+left(instcod,4)+CHR(13)+CHR(10)*!* endscan*!* this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+repl('=',40)+space(10)+CHR(13)+CHR(10)*!* this.parent.OleMMess.msgnotetext=this.parent.OleMMess.msgnotetext+'合計: '+alltrim(str(recc()))+' 筆'+CHR(13)+CHR(10) *附件*!* if file('c:維修派工一覽表.xls') and recc('serv')>0*!* this.parent.OleMMess.AttachmentIndex=this.parent.OleMMess.AttachmentCount*!* this.parent.OleMMess.AttachmentPosition=30*!* this.parent.OleMMess.AttachmentPathName='c:維修派工一覽表.xls'*!* endif*!* if file('c:裝機派工一覽表.xls') and recc('inst')>0*!* this.parent.OleMMess.AttachmentIndex=this.parent.OleMMess.AttachmentCount*!* this.parent.OleMMess.AttachmentPosition=31*!* this.parent.OleMMess.AttachmentPathName='c:裝機派工一覽表.xls'*!* endif *索取回條 this.parent.OleMMess.MsgReceiptRequested=.T. *send(0) disable 編輯視窗 send(1)出現郵件編輯視窗 this.parent.OleMMess.send(0)ENDIF

_________________
#############################
快樂媽咪系列幸福宅配,喝十全雞湯~原來幸福那麼簡單!!

學會VFP使用者社區的搜尋,Code才會更有趣~
#############################
回頂端
檢視會員個人資料 發送私人訊息
Ruey



註冊時間: 2003-03-12
文章: 1698
來自: tunglo

第 10 樓

發表發表於: 星期五 八月 01, 2003 11:45 am    文章主題: 引言回覆

這範例會使用Ms OutLook

1.
I've been using ShellExecute for doing interactive email functions within VFP.

I recently had to find an alternative that gave me the same functionality from an end-user perspective since there is a limitation on the length of the string that can be handled by ShellExecute on Win98. (see MSKB Q182985 - notice it's just Outlook Express OR Windows 98, period.)

Here is the syntax I have been using:


DECLARE INTEGER ShellExecute ;
IN SHELL32.DLL ;
INTEGER nWinHandle,;
STRING cOperation,;
STRING cFileName,;
STRING cParameters,;
STRING cDirectory,;
INTEGER nShowWindow

RETURN ShellExecute( 0, "Open", "mailto:" + lcEmail + ;
"?subject=Order Confirmation for Priority No." + ;
STR(tsfile.pr_number,6,0) + "&body=" + lcBody, "", "", 1 )





The 3rd parameter winds up being something like this:

"mailto:randy@randyjean.com?subject=Order Confirmation for Priority No.400270&body=Order Confirmation: %0D%0DTo: David%0DCompany: ASK Law Offices%0D%0DFrom: HEIDI%0DCompany: Priority Posting and Publishing %0D%0DPhone: (714) 573-7777 %0DFax: (714) 573-7755 %0D%0DDate: 10/25/2001%0D%0DSale Date: 11/29/2001%0D%0DComments: Thank you for your order!%0D%0DYour T.S. #9999%0DPriority #400270%0D%0DCounty: Los Angeles%0DNewspaper: Los Angeles Daily Journal%0DRun Dates: 10/26/2001, 11/02/2001, 11/09/2001"

You can try this in IE if you have Windows 98 to see what happens (take out the dbl quotes and paste into address bar)

It works perfectly in Windows 2000.

2.
*// xEmail.prg
*// KIPDOLE
*//Thanks for the carriage return help I couldn't figure it out. This may be of use.
*// Example xEmail([nobody@nobody.com],[nobodycc@nobody.com],[RE: Howdy],[blah blah blah]+CHR(13) + CHR(10) +[hi])

LPARAMETERS sMailto, sCC, sSubject, sBody, sBCC

IF EMPTY(sMailto)
WAIT WINDOW "Email address is needed." NOWAIT
RETURN .T.
ELSE
sMailto = [mailto:] + sMailto + [?]
ENDIF
IF NOT EMPTY(sCC)
sMailto = sMailto + [CC=] + sCC
ENDIF
IF NOT EMPTY(sSubject)
sMailto = sMailto + [&SUBJECT=] + sSubject
ENDIF
IF NOT EMPTY(sBody)
sMailto = sMailto + [&BODY=] + sBody
ENDIF
IF NOT EMPTY(sBCC)
sMailto = sMailto + [&BCC=] + sBCC
ENDIF

DECLARE INTEGER ShellExecute IN "Shell32.dll" ;
INTEGER hwnd, ;
STRING lpVerb, ;
STRING lpFile, ;
STRING lpParameters, ;
STRING lpDirectory, ;
LONG nShowCmd


sMailto = STRTRAN(sMailto,[?&],[?])
sMailto = STRTRAN(sMailto,CHR(13),[%0D])
sMailto = STRTRAN(sMailto,CHR(10),[])

=Shellexecute(0,"Open",sMailto,"","",0)

_________________
#############################
快樂媽咪系列幸福宅配,喝十全雞湯~原來幸福那麼簡單!!

學會VFP使用者社區的搜尋,Code才會更有趣~
#############################
回頂端
檢視會員個人資料 發送私人訊息
Ruey



註冊時間: 2003-03-12
文章: 1698
來自: tunglo

第 11 樓

發表發表於: 星期五 八月 01, 2003 12:10 pm    文章主題: 引言回覆

非常簡單的範例

A free, simple solution is blat.dll, available from http://www.geocities.com/toby_korn/blat/.

The following code is really all you need, though there is much more functionality available (I recommend writing a wrapper to the DLL):

LOCAL lcDll, lcCmd, lnResult
lcDll = "x:\path\blat.dll"
DECLARE INTEGER Send IN (lcDll) STRING blatstring
lcCmd = 'c:\temp\body.txt -t whoever@wherever.com -s "e-mail subject" -f me@whatever.com -server smtp.wherever.com -attach c:\file.txt'
lnResult = Send(lcCmd)


Where body.txt (or whatever you want to call it) contains the body text, -t is the recipient address (comma delimit for multiple), -s is the subject, -f is the sender/from address, -server is the SMTP relay server (must allow relaying from the client), and -attach specifies a file to attach.

If you have questions, you can e-mail me at jared@jarnat.com.

Jared Capson

_________________
#############################
快樂媽咪系列幸福宅配,喝十全雞湯~原來幸福那麼簡單!!

學會VFP使用者社區的搜尋,Code才會更有趣~
#############################
回頂端
檢視會員個人資料 發送私人訊息
lcm



註冊時間: 2004-12-27
文章: 45


第 12 樓

發表發表於: 星期六 十二月 31, 2005 1:24 am    文章主題: 引言回覆

請問jmail可以指定多個收件人嗎????謝謝。
回頂端
檢視會員個人資料 發送私人訊息
lcm



註冊時間: 2004-12-27
文章: 45


第 13 樓

發表發表於: 星期六 十二月 31, 2005 1:27 am    文章主題: 引言回覆

請問jmail可以指定多個收件人嗎????謝謝。
回頂端
檢視會員個人資料 發送私人訊息
從之前的文章開始顯示:   
發表新主題   回覆主題    VFP 愛用者社區 首頁 -> VFP 討論區 所有的時間均為 台北時間 (GMT + 8 小時)
1頁(共1頁)

 
前往:  
無法 在這個版面發表文章
無法 在這個版面回覆文章
無法 在這個版面編輯文章
無法 在這個版面刪除文章
無法 在這個版面進行投票
無法 在這個版面附加檔案
無法 在這個版面下載檔案


Powered by phpBB © 2001, 2005 phpBB Group
正體中文語系由 phpbb-tw 維護製作