مشکل در لود فایل تکست

[ms-ninja]

با سلام

من برنامه ای برای چاپ اطلاعات یک فایل تکست در تکست باکس نوشتم


Dim txt As String

Private Sub Form_Load()
Text1.Text = vbNullString
Open "C:\Users\Administrator\Documents\NODROON\dat.txt" For Input As #1
txt = Input(LOF(1), 1)
Close
Text1.Text = txt
End Sub



ولی یک مشکل دارم . تمام سطر ها رو جلوی هم قرار داده میشه

[SlowCode]

خاصیت multiline تکست باکس رو true کن.

[علیرضا.ا]

از منوی propertis تکست باکس رو روی multiline بزار....

[m.4.r.m]

از این کد استفاده کن مشکلت حل میشه

Dim FSO As FileSystemObject
Dim TS As TextStream
Dim TempS As String
Dim Final As String
Set FSO = New FileSystemObject
Set TS = FSO.OpenTextFile("C:\Test.txt", ForReading)
'Use this for reading everything in one shot
Final = TS.ReadAll
'OR use this if you need to process each line
Do Until TS.AtEndOfStream
TempS = TS.ReadLine
Final = Final & TempS & vbCrLf
Text1.Text = Final
Loop
TS.Close

البیه اگه دیدی فقط یک خط می ندازه حالت Multiline رو برابر True کن در ضمن از رفرنس ها گزینه Microsoft Script RunTime رو فعال کن

[ms-ninja]

ممنون یادم اومد یهو :لبخند:

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


Dim txt As String

Private Sub Form_Load()
Text1.Text = vbNullString
Open (App.Path & "dat.txt") For Input As #1
txt = Input(LOF(1), 1)
Close
Text1.Text = txt
End Sub

[Mr'Jamshidy]

بابا این کارا دیگه چیه وقتی راه به این آسونی وجود داره؟

Function LoadFile(ByVal FileName As String) As String
If Trim$(Dir$(FileName, vbArchive Or vbHidden Or vbReadOnly Or vbSystem)) = vbNullString Then Exit Function 'File Do Not Exist

Dim tmpString As String, FF As Integer

tmpString = String(FileLen(FileName), vbNullChar)

FF = FreeFile()
Open FileName For Binary As FF
Get FF, , tmpString
Close FF

LoadFile = tmpString
End Function

Private Sub Form_Load()
MsgBox LoadFile("C:\Test.txt")
End Sub

[ms-ninja]

مشکل رو حل کردم فقط یه / کم داشت :لبخند: سوتی ها رو میبینی تورو خدا :قهقهه:

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




یک ماه 1،500 تومان

سه ماه 3،500 تومان

شش ماه 6،500 تومان

یک ساله 11،000 تومان



فونت tahoma هست

برنامه های دیگه من هم فارسی دارن و خوبه همه چیز ولی اینجا :متفکر:

[SlowCode]

بابا این کارا دیگه چیه وقتی راه به این آسونی وجود داره؟

Function LoadFile(ByVal FileName As String) As String
If Trim$(Dir$(FileName, vbArchive Or vbHidden Or vbReadOnly Or vbSystem)) = vbNullString Then Exit Function 'File Do Not Exist

Dim tmpString As String, FF As Integer

tmpString = String(FileLen(FileName), vbNullChar)

FF = FreeFile()
Open FileName For Binary As FF
Get FF, , tmpString
Close FF

LoadFile = tmpString
End Function

Private Sub Form_Load()
MsgBox LoadFile("C:\Test.txt")
End Sub
:قهقهه:
باز این پسره پیدا شد.

آقای جمشیدی کدی که شما نوشتی کار رو راه میندازه ولی سرعتش خیلی پایینه، دلیلش هم اینه که:
فایل رو باینری باز کردی،در صورتی که نیازی بهش نیست، به همین خاطر از تابع string استفاده کردی که اونم تو زمان تاثیر میذاره.

یه کد ساده نوشتم:


Function LoadFile(ByVal FileName As String) As String
Open FileName For Input As #1
While Not (EOF(1))
Input #1, txt
content = content & txt
Wend
LoaFile = condtent
Close #1
End Function


یا به این صورت:

Function LoadFile(ByVal FileName As String) As String
Open FileName For Input As #1
LoadFile = Input(LOF(1), 1)
Close #1
End Function

تو حلقه صدتایی کد شما 220 میلی ثانیه شد و کد من 32 میلی ثانیه:لبخند:

یه نکته هم بگم، سرعت خواندن فایل تو حلقه یکم بیشتر از خواندن یکجا هست.

[ms-ninja]

الان مشکل با فارسی نشون ندادنه

[niksalehi]

از ماژول utf8 استفاده کنید.


Option Explicit
Public Const VK_CONTROL As Long = &H11
Public Const VK_TAB = 9
Public Const KEYEVENTF_EXTENDEDKEY = &H1
Public Const KEYEVENTF_KEYUP = &H2
Public Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Public Declare Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long

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("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 & 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

[ms-ninja]

تو این ماژول چی رو باید فراخوانی کنم

[علیرضا.ا]

از کامپونت codejock استفاده کن
خعلی ساده و راحت:لبخند:

[Mr'Jamshidy]

:قهقهه:
باز این پسره پیدا شد.

آقای جمشیدی کدی که شما نوشتی کار رو راه میندازه ولی سرعتش خیلی پایینه، دلیلش هم اینه که:
فایل رو باینری باز کردی،در صورتی که نیازی بهش نیست، به همین خاطر از تابع string استفاده کردی که اونم تو زمان تاثیر میذاره.

یه کد ساده نوشتم:


Function LoadFile(ByVal FileName As String) As String
Open FileName For Input As #1
While Not (EOF(1))
Input #1, txt
content = content & txt
Wend
LoaFileB = condtent
Close #1
End Function


یا به این صورت:

Function LoadFile(ByVal FileName As String) As String
Open FileName For Input As #1
LoadFileB = Input(LOF(1), 1)
Close #1
End Function

تو حلقه صدتایی کد شما 220 میلی ثانیه شد و کد من 32 میلی ثانیه:لبخند:

یه نکته هم بگم، سرعت خواندن فایل تو حلقه یکم بیشتر از خواندن یکجا هست.

قربونت من همیشه همه جا هستم (کم پیدام ولی نا پیدا نیستم)

بلاخره هر کس یک نظری داره
ولی من همیشه از همین روش استفاده میکنم هیچ وقت هم به مشکل بر نخوردم


از کامپونت codejock استفاده کن
خعلی ساده و راحت:لبخند:

:متفکر:

[ms-ninja]

با کدجاک همون مشکله

[ms-ninja]

کسی از دوستان نمیدونه این مشکل چطور رفع میشه

[ms-ninja]

بفرمایید آقای Mr'Jamshidy این هم سورس

[m.4.r.m]

بیا عزیز اینو من تست کردم کامل جواب داد شما همون Function مربوط به utf رو درون ماژول بریز و این کد رو درون باتون یا فرم لود برنامت قرار بده
در ضمن از Refrence ها Microsoft Scripting Runtime رو فعال کن .

Private Sub Command1_Click()
Dim FSO As FileSystemObject
Dim TS As TextStream
Dim TempS As String
Dim Final As String
Set FSO = New FileSystemObject
Set TS = FSO.OpenTextFile(App.Path & "\dat.txt", ForReading)

Do Until TS.AtEndOfStream
Label1.Caption = UTF8_Decode(TS.ReadAll)
Loop
TS.Close
End Sub