View Full Version : سوال: خواندن یک فایل یونیکد و حذف یک سطر از آن
R2du-soft
چهارشنبه 28 خرداد 1393, 11: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, 01: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, 12:00 عصر
دوستان با اضافه کردن کد:
sNewText = Left$(sNewText, 2) + StrConv(Mid$(sNewText, 3), vbUnicode)
به جای یک خط کدی که در پست بالا گفتم مشکل اضافه شدن حروف به ابتدای فایل text برطرف میشه .
اما در هر دو کد یک مشکل وجود داره ، اگر درون فایلمون که فرمتش UNICODE هست حروف فارسی باشه ، اون حروف فارسی رو به یکسری کد تبدیل میکنه.
کسی میدونه این مشکل رو چطور برطرف کنم؟
R2du-soft
پنج شنبه 29 خرداد 1393, 14: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 دوبار نوشته بشن! (اضافه کردن این خط مشکل ایجاد نمیکنه و فقط از مشکل احتمالی که در بعضی شرایط پیش میاد جلوگیری میکنه.)
من این کد رو در اصل کد اضافه کردم.
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.