PDA

View Full Version : حل مشکل آدرس یاب



ershad_tb
دوشنبه 15 مهر 1392, 00:39 صبح
سلام من یه آدرس یاب دارم مشکلی که داره اینه پیغام مدیرش فارسی نمیشه نوشت فقط خارجی رو نشان میدهد میشه کاری کرد فارسی هم ساپورت کنه ؟

پیغام لینکی هست که به صورت txt هست توی هاست گذاشته میشود .

encoding فایل txt هم تمام حالات گذاشتم ولی نشد

ho3ein.3ven
سه شنبه 16 مهر 1392, 23:35 عصر
سلام
توابع زیر را در پروژتون کپی کنید :

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
Public Function UTF8_Decode(ByVal sStr As String)
On Error Resume Next
Dim L As Long, sUTF8 As String, iChar As Integer, iChar2 As Integer

sStr = Replace(sStr, "U^Œ", UTF8_Encode("i'"))

sStr = Replace(sStr, "U`‰", UTF8_Encode("i'"))

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 & IIf(iChar2 = 156, ChrW(1610), 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


و بعد از دریافت متن تابع UTF8_Decode رو به صورت زیر صدا بزنید :
string1 = UTF8_Decode(string1)

ershad_tb
پنج شنبه 18 مهر 1392, 13:28 عصر
این مرحله رو متوجه نشدم این رو باید توی کد ها اعمال کنم ؟ فایل تکست هم encoding رو تمام حالت تست کردم باز نمایش نداد


و بعد از دریافت متن تابع UTF8_Decode رو به صورت زیر صدا بزنید :
string1 = UTF8_Decode(string1)

ershad_tb
شنبه 20 مهر 1392, 16:09 عصر
همچنان جواب رو نگرفتم .