فارسی سازی ایمیل به جیمیل !!!

[alizanganeh]

سلام
در ضمیمه ی این پست یک برنامه ای میذارم که از یکی از بچه های تالار گرفتم
برای ارسال ایمیل هستش که فرستنده باید جیمیل باشه حتما
در کل برنامش عالیه

ولی مشکلش اینه که فارسی رو پشتیبانی نمیکنه
ینی متن ارسالی اگر فارسی باشه مزخرف میفرسته ولی انگلیسی رو عالی میفرسته

میتونید درستش کنید که فارسی هم ارسال کنه؟
خیلی ممنون

95393

[محسن واژدی]

سلام علیکم
پست زیر را بررسی کنید:
http://barnamenevis.org/showthread.php?342201-%D9%85%D8%B4%DA%A9%D9%84-%D9%88%DB%8C%D9%86%D8%B3%D9%88%DA%A9-%D8%AF%D8%B1-%D9%BE%D8%B4%D8%AA%DB%8C%D8%A8%D8%A7%D9%86%DB%8C-%D8%A7%D8%B2-%D8%B2%D8%A8%D8%A7%D9%86-%D9%81%D8%A7%D8%B1%D8%B3%DB%8C&p=1509771&viewfull=1#post1509771

موفق باشید

[alizanganeh]

داش محسن دمت گرم
با کدی که توی تاپیکی که دادی حل شد
خیلی ممنون از لطفت

[alizanganeh]

برای حل این مشکل :

این تابع رو در برنامهتون paste کنید

public Function UTF8_Encode(ByVal sStr As String)
Dim L As Long, lChar As Long, sUTF8 As String
For L& = 1 To Len(sStr)
lChar& = AscW(Mid(sStr, L&, 1))
If lChar& < 128 Then
sUTF8$ = sUTF8$ + Mid(sStr, L&, 1)
ElseIf ((lChar& > 127) And (lChar& < 2048)) Then
sUTF8$ = sUTF8$ + Chr(((lChar& \ 64) Or 192))
sUTF8$ = sUTF8$ + Chr(((lChar& And 63) Or 128))
Else
sUTF8$ = sUTF8$ + Chr(((lChar& \ 144) Or 234))
sUTF8$ = sUTF8$ + Chr((((lChar& \ 64) And 63) Or 128))
sUTF8$ = sUTF8$ + Chr(((lChar& And 63) Or 128))
End If
Next L&
UTF8_Encode = sUTF8$
End Function
'===============================Farsi nevisi
Public Function UTF8_Decode(ByVal sStr As String)
Dim L As Long, sUTF8 As String, iChar As Integer, iChar2 As Integer
sStr = Replace(sStr, "UŒ", UTF8_Encode("?"))
sStr = Replace(sStr, "U‰", UTF8_Encode("?"))
For L = 1 To Len(sStr)
iChar = Asc(Mid(sStr, L, 1))
If iChar > 127 Then
If Not iChar And 32 Then
iChar2 = Asc(Mid(sStr, L + 1, 1))
sUTF8 = sUTF8 & ChrW$(((31 And iChar) * 64 + (63 And iChar2)))
L = L + 1
Else
Dim iChar3 As Integer
iChar2 = Asc(Mid(sStr, L + 1, 1))
iChar3 = Asc(Mid(sStr, L + 2, 1))
'sUTF8 = sUTF8 & ChrW$(((iChar And 15) * 16 * 256) + ((iChar2 And 63) * 64) + (iChar3 And 63))
L = L + 2
End If
Else
sUTF8 = sUTF8 & Chr$(iChar)
End If
Next L
UTF8_Decode = sUTF8
End Function

Public Function EncodeString(StrText As String) As String
On Error Resume Next
Dim I As Integer, bEnc As String
For I = 1 To Len(StrText)
bEnc = bEnc & "%" & Hex(Asc(Mid(StrText, I, 1)))
Next
EncodeString = bEnc
End Function



بعد این کد رو توی دکمه یا هرجایی که دستور ارسال توش هست بنویسید :

Data = UTF8_Decode(Data)


بجای اون 2 تا Data تکست باکس مورد نظر که متنش ارسال میشه یا متغیر یا هر چیز دیگه رو بنویسید
زمان ارسال توی تکست باکس مزخرف مینوسیه و متن صحیح و فارسی برای ایمیل مورد نظر ارسال میشه

موفق باشید