PDA

View Full Version : سوال: خواندن یک فایل یونیکد و حذف یک سطر از آن



R2du-soft
چهارشنبه 28 خرداد 1393, 10:05 صبح
با سلام
دوستان من برای خوندن یک فایل متنی با فرمت ANSI از کد زیر استفاده کردم و جواب داد:



Private Sub Command1_Click()
Dim iFile As Integer
Dim sLine As String, sNewText As String

iFile = FreeFile


Open "C:\1.txt" For Input As #iFile
Do While Not EOF(iFile)
Line Input #iFile, sLine

'If sLine Like "*network*" Then
If sLine Like "*network*" Then
' skip the line

Else
sNewText = sNewText & sLine & vbCrLf
End If
Loop
Close #iFile

iFile = FreeFile
Open "C:\1.txt" For Output As #iFile
sNewText = Mid(sNewText, 1, Len(sNewText) - 1)
Print #iFile, sNewText;
Close #iFile
End Sub




در این کد در فایل 1.txt هر سطری که درونش کلمه network داشته باشه حذف میشه.

من فایلم رو به Unicode تغییر دادم ، و این کد بعد از انجام تغییرات متن فایل رو به چیزی شبیه به 楗摮睯⁳敒楧瑳祲䔠楤潴⁲敖獲潩 〰਍਍䡛 تغییر داد!
خوب حالا چطور بدون اینکه فایلم مشکل پیدا کنه این کار رو انجام بدم؟
لطفا راهنمایی کنید.
ممنون

R2du-soft
پنج شنبه 29 خرداد 1393, 00:09 صبح
دوستان یک خط قبل از خط print کدی قرار دادم که به شکل زیر:




Private Sub Command1_Click()
Dim iFile As Integer
Dim sLine As String, sNewText As String

iFile = FreeFile


Open "C:\1.txt" For Input As #iFile
Do While Not EOF(iFile)
Line Input #iFile, sLine

'If sLine Like "*network*" Then
If sLine Like "*network*" Then
' skip the line

Else
sNewText = sNewText & sLine & vbCrLf
End If
Loop
Close #iFile

iFile = FreeFile
Open "C:\1.txt" For Output As #iFile
sNewText = Mid(sNewText, 1, Len(sNewText) - 1)
sNewText = StrConv(sNewText, vbUnicode)
Print #iFile, sNewText;
Close #iFile
End Sub



کدی که اضافه شده:


sNewText = StrConv(sNewText, vbUnicode)



بعد از ذخیره سازی محتویات فایلم درسته اما در اول اول فایلم چند تا حروف میاد! و با هربار زدن دکمه ای که توش کد بالا (همین پست) هست اون کد اول فایل متنی هم عوض میشه!
چیکار کنم؟

R2du-soft
پنج شنبه 29 خرداد 1393, 11:00 صبح
دوستان با اضافه کردن کد:



sNewText = Left$(sNewText, 2) + StrConv(Mid$(sNewText, 3), vbUnicode)


به جای یک خط کدی که در پست بالا گفتم مشکل اضافه شدن حروف به ابتدای فایل text برطرف میشه .
اما در هر دو کد یک مشکل وجود داره ، اگر درون فایلمون که فرمتش UNICODE هست حروف فارسی باشه ، اون حروف فارسی رو به یکسری کد تبدیل میکنه.
کسی میدونه این مشکل رو چطور برطرف کنم؟

R2du-soft
پنج شنبه 29 خرداد 1393, 13:22 عصر
دوستان مشکل کاملا حل شد:
کد زیر فایل متنی 1.txt رو که در درایو c قرار داره رو باز میکنه و اگه هرچندتا کلمه network پیدا کنه،اون خطی که کلمه network رو پیدا کرده رو حذف میکنه.
این کد فایل متنی با فرمت ANSI و UNICODE رو به خوبی پشتیبانی میکنه و مشکلی هم برای فایلتون پیش نمیاد.



Private Sub Command1_Click()
Dim a$, h$, start As Long, i As Long
a$ = getfileString("c:\1.txt")
h$ = Left$(a$, 2)
If Asc(a$) = &HFF And Asc(Mid$(a$, 2, 1)) = &HFE Then a$ = Mid$(a$, 3) Else h$ = ""
a$ = StrConv(a$, vbFromUnicode)
Do
i = InStr(a$, "network") '----------------------------------------------------
If i > 0 Then
start = i
MoveToFirstCharInLine start, a$
MarkLastPrintableChar i, a$
i = i + 1 ' we move one byte to non printable char
MoveToNextLine i, a$
a$ = Left$(a$, start - 1) + Mid$(a$, i)
Else
Exit Do
End If
Loop
a$ = h$ + StrConv(a$, vbUnicode)
i = FreeFile
Open "c:\1.txt" For Binary As #i
Put #i, , a$
Close #i
End Sub


Private Sub MoveToNextLine(pos As Long, from$)
Dim i As Long, J As Long
i = pos
J = Len(from$) + 1
Do While i < J
If Asc(Mid$(from$, i, 1)) > 31 Then Exit Do
i = i + 1
Loop
pos = i
End Sub

Private Sub MarkLastPrintableChar(pos As Long, from$)
Dim i As Long, J As Long
i = pos + 1
J = Len(from$) + 1
Do While i < J
If Asc(Mid$(from$, i, 1)) < 32 Then Exit Do
i = i + 1
Loop
pos = i - 1
End Sub


Private Sub MoveToFirstCharInLine(pos As Long, from$)
Dim i As Long, J As Long
J = 1
i = pos - 1
Do While i > J
If Asc(Mid$(from$, i, 1)) < 32 Then Exit Do
i = i - 1
Loop
pos = i + 1
End Sub

Private Function getfileString(a$) As String
Dim myfile$
If Dir$(a$) <> "" Then
i = FreeFile
Kill "c:\1.txt"
Open a$ For Binary As #i
myfile$ = Space$(LOF(1))
Get #1, , myfile$
Close #1
End If
getfileString = myfile$
End Function




[ویرایش]: بهتره قبل از باز کردن فایل به صورت باینری (در آخرین خط های برنامه) کد زیر رو اضافه کنید:



Kill "c:\1.txt"

چون اگه یکبار فایل رو حذف نکنید امکان داره در بعضی شرایط چند خط در فایل 1.txt دوبار نوشته بشن! (اضافه کردن این خط مشکل ایجاد نمیکنه و فقط از مشکل احتمالی که در بعضی شرایط پیش میاد جلوگیری میکنه.)
من این کد رو در اصل کد اضافه کردم.