نمایش تکست فایل با متن فارسی از یک آدرس اینترنتی درون تکست باکس
سلام دوستان خوبید؟
عزیزان یه سوال دارم
میخوام یه تکست باکس رو که تمام متن توش فارسی هست و روی نت هست رو درون یک تکست باکس نمایش بدم
من از این دستور برای نمایش استفاده میکنم:
Text2.Text = GetWebContents("http://google.com/L.txt")
این دستور متن رو نمایش میده ولی اگر متن فارسی باشه به صورت حروف fgjkiofh نشونش میده.
زبان تکست باکس رو هم روی عربی گزاشتم ولی حروفی مثل (گ.چ.پ.ژ) رو نشون نمیده.
دوستان لطفا کمک کنید.
ممنون
خط API مربوط به GetWebContents رو هم قرار بدین بی زحمت
کد های زیر رو تو پروژت قرار بده :
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
بعد کد های زیر رو تو روالت بنویس :
Text2.Text = GetWebContents("http://google.com/L.txt")
text2.text=utf8_decode(text2.text)
ممنون داداش اون مشکل حل شد ولی مشکلات دیکه اضافه شد بهش!!!
1 سوال : داداش اگه خط
text2.text=utf8_decode(text2.text)
رو بزاریم همه چیز میشه علامت ????? و اگه برش داریم همه چیز درسته حتی گ چ پ ژ !!!!
و مشکلی که ایجاد میشه اینه
خاصیت multiline تکست باکس از بین میره و هر خط سرجاش نشون داده نمیشه !
نمیشه اینارو درستش کرد؟!
ممنون
اول گزینه زیر رو از references علامت بزنید:
Microsoft WinHTTP Services,version 5.1
بعد از تابع API زیر استفاده کنید:
Private Declare Function InternetOpen _
Lib "wininet.dll" _
Alias "InternetOpenA" (ByVal sAgent As String, _
ByVal lAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl _
Lib "wininet.dll" _
Alias "InternetOpenUrlA" (ByVal hOpen As Long, _
ByVal sUrl As String, _
ByVal sHeaders As String, _
ByVal lLength As Long, _
ByVal lFlags As Long, _
ByVal lContext As Long) As Long
Private Declare Function InternetReadFile _
Lib "wininet.dll" (ByVal hFile As Long, _
ByVal sBuffer As String, _
ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle _
Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private WithEvents HttpSocket As WinHttp.WinHttpRequest
Public Function GetWebContents(ByVal sUrl As String) As String
Dim hOpen As Long
Dim hOpenUrl As Long
Dim bDoLoop As Boolean
Dim bRet As Boolean
Dim sReadBuffer As String * 2048
Dim lNumberOfBytesRead As Long
Dim sBuffer As String
hOpen = InternetOpen("vb", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
hOpenUrl = InternetOpenUrl(hOpen, sUrl, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
bDoLoop = True
While bDoLoop
sReadBuffer = vbNullString
bRet = InternetReadFile(hOpenUrl, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
DoEvents
Wend
If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
If hOpen <> 0 Then InternetCloseHandle (hOpen)
GetWebContents = sBuffer
End Function
سپس یک تکست باکس در فرم قرار بدید
بعد از کد زیر ، درون دکمه تا فرم لودتون استفاده کنید:
Text1.Text = GetWebContents("http:/google.com/B.txt")
آخرین ویرایش به وسیله R2du-soft : پنج شنبه 17 اسفند 1391 در 01:17 صبح
میشه بپرسم دقیقا می خوای چیکار کنی ؟
اگه می خوای محتویات یک فایل متنی رو نمایش بدی راه های آسون تری هم هست .
مثل: inet که این مشکلات هم بوجود نمیاره.
ho3ein.3ven جان ، داداش دقیقا من میخوام کار زیر رو انجام بدم:
یک فایل با پسوند txt رو که توش متن فارسی هست و حروفی مثل (گ چ پ ژ) هم توش هست و فایل متنی خط به خط هست رو میخوام عینا از آدرس ایترنتی بخونم و توی تکست باکس نمایش بدم.
من مشکلی با خوندن فایل انگلیسی و نمایشش ندارم ولی وقتی تکستم محتویاتش زبان فارسی میشه بدبخت میشم!!!!
میشه کاریش کرد؟!
ممنون عزیز
بله . چرا نشه .
اول کامپوننت internet transfer control رو به پروژتون اضافه کنید .
بعد کد های زیر رو بنویس :
text1.Text = Inet1.OpenURL("http://www.google.com")
text1.Text = utf8_decode(text1.Text)
فونت تکست باکست هم آریال بزار که از کاراکتر های فارسی پشتیبانی کنه.
موفق باشید.
داداش باز همونطور میشه!!!
محتویات نمایش داده میشه اما خط به خط نیست (multi line) نیست.
آخرین ویرایش به وسیله R2du-soft : پنج شنبه 17 اسفند 1391 در 23:47 عصر
مشکل multi line با استفاده از label به جای textbox حل شد.
ممنون
سلام
احتمالا به خاطر اينه كه در فايل روي اينترنت به جاي كاراكترهاي Enter (دو كاراكتر 10 و 13) فقط از يكيش استفاده شده
بعد از دريافت متن، با دستور Replace هر چي كاراكتر شماره 10 هست يعني Chr$(10) رو به vbCrLf تبديل كنيد بايد مشكل حل بشه
شايد هم لازم باشه به جاي Chr$(10) كاراكتر Chr$(13) رو به vbCrLf تبديل كنيد
اگر من و شما هر كدوم يك چيز ياد داشته باشيم و به هم ياد بديم، حالا هر كدوم دو تا چيز ياد داريم !http://www.ArminaCo.com
ممکنه چیزی که آقا حامد میگه باشه ولی شایدم خاصیت MultiLine تکست باکستو TRUE نکردی.
موفق و سربلند باشید
MMD
سلام ، نه ذدوستان
خاصیت Multi Line رو true کردم
و همینطور توی متنی که میاد هیچ کدی مثل 10 یا Chr$(10) نمیاد! فقط و فقط همه چیز پشت سر هم نمایش داده میشه!!!!!!
منظور آقا حامد نیست که بین حروف بنویسه CHr(13) منظورش اینه که کد اسکی شماره 13 یا 10 بین حروف هست که شما با تابع Replace امتحان کن.
آدرس اون فایلی رو که می خوای از اینترنت دریافت کنی رو اینجا بزار البته اگه مقدور هست.
با لیبل تست کنید درسته اما با تکست باکس نه!!!!
http://www.r2du-soft.ir/download/r2d...Design_2/L.txt
الان محتویات این فایل زبان فارسی هست و متن کاملش:
با سلام و خسته نباشيد
گ
چ
پ
ژ
گچ
پژ
با تشکر
!!!
ممنون داداش ho3ein.3ven عزیز
این خط کد رو اضافه کن به برنامت :
Text1.Text = Replace(Text1.Text, Chr(10), vbCrLf)
قوانین ایجاد تاپیک در تالار
پاسخ با نقل قول