View Full Version : سوال: نوشتن در فایل یونیکد و خواندن از فایل یونیکد
R2du-soft
سه شنبه 31 تیر 1393, 23:55 عصر
سلام دوستان
چطور میتونم در خط دوم یک فایل باینری متنی رو ذخیره کنم؟
و چطور میتونم خط دوم یک فایل باینری رو خونده و نمایشش بدم؟
ممنون
ایلیا آخوندزاده
چهارشنبه 01 مرداد 1393, 08:11 صبح
میشه بیشتر توضیح بدید؟
R2du-soft
چهارشنبه 01 مرداد 1393, 09:23 صبح
من یک فایل unicode دارم با محتویات زیر:
; for 16-bit app support
[fonts]
[extensions]
Kill file returned: :3:
No Previous IE40, not an IE40 install.
Add preclean, crypto and maybe DCOM
OS is NT
Installing OLEAUT.exe.
Architecture is Intel.
dispci.dll: ============BEGIN DisplayClassInstaller============
dispci.dll: ============BEGIN OnSelectBestCompatDrv============
dispci.dll: ============END OnSelectBestCompatDrv==============
dispci.dll: DisplayClassInstaller: Returning 0xe000020e for DIF 0x17 and device VMBUS\{DA0A7802-E377-4AAC-8E77-0558EB1073F8}\{5620E0C7-8062-4DCE-AEB7-520C7EF76171}
.
.
.
خط دوم فایلم خالی هست و من میخوام یک متن رو اونجا (توی خط دوم) بنویسم و محتویات فایلم شبیه زیر بشه:
; for 16-bit app support
NOW I WRITE TO LINE TWO!----------------
[fonts]
[extensions]
Kill file returned: :3:
No Previous IE40, not an IE40 install.
Add preclean, crypto and maybe DCOM
OS is NT
Installing OLEAUT.exe.
Architecture is Intel.
dispci.dll: ============BEGIN DisplayClassInstaller============
dispci.dll: ============BEGIN OnSelectBestCompatDrv============
dispci.dll: ============END OnSelectBestCompatDrv==============
dispci.dll: DisplayClassInstaller: Returning 0xe000020e for DIF 0x17 and device VMBUS\{DA0A7802-E377-4AAC-8E77-0558EB1073F8}\{5620E0C7-8062-4DCE-AEB7-520C7EF76171}
.
.
.
بعد با یک پیغام خط دوم این فیل رو نمایش بدم!
R2du-soft
چهارشنبه 01 مرداد 1393, 17:59 عصر
دوستان من واقعا به کمکتون نیاز دارم ، تمام روشهایی که میدونستم رو پیاده کردم اما نشد که نشد!
اساتید پرتوان بشتابید به داد این ناتوان! :لبخند:
Mr.305
چهارشنبه 01 مرداد 1393, 18:50 عصر
اگه منظورت همچین چیزیه
121462
سورشو آماده کردم
Private Sub Command1_Click()
Dim s As Long
s = InStr(2, Text1, vbCrLf, vbBinaryCompare)
Text1.SelStart = s
Text1.SelText = vbCrLf + "here i write the second line2"
End Sub
باید اول فایلت رو باز کنی بعد با استفاده از تابع instr دنبال اولین vbcrlf بگردی بعد نقطه شروع تکست رو همون جا قرار بدی بعد نقطه پیدا شدت رو با تکست مورد نظر و یک خط جدید جایگزین کنی
R2du-soft
چهارشنبه 01 مرداد 1393, 22:27 عصر
ممنون Mr.305 (http://barnamenevis.org/member.php?317506-Mr-305) دوست عزیز
اما فایل من یک فایل تکست در مسیر c:\test.txt هست! نه تکست باکس!
فایل رو ضميمه میکنم:
Mr.305
چهارشنبه 01 مرداد 1393, 22:53 عصر
این کد رو به اول فرم لود اضافه کن
Dim strTemp As String
Dim vrnTemp As Variant
Open "c:\test.txt" For Input As #1
While Not EOF(1)
Line Input #1, vrnTemp
strTemp = strTemp + vrnTemp + vbCrLf
Wend
Text1.Text = strTemp
Close #1
R2du-soft
پنج شنبه 02 مرداد 1393, 00:23 صبح
بعد چطور محتویات رو ذخیره کنم توی فایل؟
هرطور ذخیره میکنم محتویات فایلم تماما تغییر شکل میده!
Mr.305
پنج شنبه 02 مرداد 1393, 03:01 صبح
نمیتونی بندازیش توی ریچ تکست باکس؟فک کنم اونجا تغییری نکنه؟
R2du-soft
پنج شنبه 02 مرداد 1393, 10:36 صبح
جواب نمیده!
نمیدونم چیکار کنم!:عصبانی++:
R2du-soft
پنج شنبه 02 مرداد 1393, 12:49 عصر
یک روش پیدا کردم:
اما بعد از نوشتن محتویات فایل C:\test.txt به چیزی شبیه زی تغییر میکنه!
楗摮睯敒楧瑳祲䔠楤潴敖獲潩 〰
اینم از اون کد:
Private Sub Form_Load()
'Read line:
MsgBox readLine("c:\test.txt", 2)
'Write to line:
Call writeLine("C:\test.txt", 2, "hello world")
End Sub
Public Function readLine(strFilePath As String, lngLineNumber As Long) As String
'if File not Found
If Dir(strFilePath) = "" Then readLine = "File not Found": Exit Function
'If File Found:
Dim FileNo As Integer
FileNo = FreeFile
Dim tempStr As String
Open strFilePath For Input As FileNo
Dim i As Long
For i = 1 To lngLineNumber
Line Input #FileNo, tempStr
Next i
Close #FileNo
readLine = tempStr
End Function
Public Sub writeLine(strFilePath As String, lngLineNumber As Long, strLineText As String)
If Dir(strFilePath) = "" Then Exit Sub
'If File Found:
Dim FileNo As Integer
FileNo = FreeFile
Dim tempLine As Integer
tempLine = 1
Dim tempStr As String
Dim tempData As String
'read the Whole file and place data into tempData
Open strFilePath For Input As FileNo
Do
Line Input #FileNo, tempStr
If tempLine = lngLineNumber Then
If tempLine = 1 Then tempData = strLineText Else tempData = tempData & vbCrLf & strLineText
Else
If tempLine = 1 Then tempData = tempStr Else tempData = tempData & vbCrLf & tempStr
End If
tempLine = tempLine + 1
Loop Until EOF(FileNo)
Close #FileNo
'Write to the file
FileNo = FreeFile
Open strFilePath For Output As FileNo
Print #FileNo, tempData
Close #FileNo
End Sub
vbhamed
شنبه 04 مرداد 1393, 10:31 صبح
سلام
مشكل شما به خاطر اينه كه فايلتون از نوع Unicode هستش و بايد به همون صورت هم خونده و نوشته بشه
ضميمه رو ببينيد
R2du-soft
شنبه 04 مرداد 1393, 14:07 عصر
ممنون Vbhamed جان
مشکل من این بود که نمیخواستم از هیچ ocx یا dll تو برای به صورتی کمکی و کال کردن به توابعش استفاده کنم
Option Explicit
Private Sub Form_Load()
Dim strText As String
Dim vSplit() As String
strText = UnicodeFile_Read_VB("c:\test.txt")
vSplit = Split(strText, vbCrLf)
'Change second line:
vSplit(1) = ";Hello World"
strText = Join(vSplit, vbCrLf)
UnicodeFile_Write_VB "c:\test.txt", strText
MsgBox strText
End Sub
'Purpose: Override Vb6 MsgBox with Unicode aware MsgBox. HelpFile/Context not supported.
Function MsgBox(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String) As VbMsgBoxResult
MsgBox = CreateObject("WScript.Shell").Popup(Prompt, 0&, Title, Buttons)
End Function
'Purpose: Note that sFileName must be ANSI. If SplitDelimeter, will Split into array.
Public Function UnicodeFile_Read_VB(ByVal sFileName As String) As String
Dim FF As Long
Dim b() As Byte
Dim S As String
On Error GoTo ErrHandler
FF = FreeFile
Open sFileName For Binary Access Read As FF
ReDim b(LOF(FF) - 1)
Get FF, , b
Close FF
'Detect file encoding
If b(0) = 255 And b(1) = 254 Then 'UTF-16LE BOM FF FE
S = b
S = Mid$(S, 2) 'Remove BOM
Else
S = StrConv(b, vbUnicode) 'ANSI file
End If
UnicodeFile_Read_VB = S
Exit Function
ErrHandler:
Err.Raise Err.Number, "UnicodeFile_Read_VB", Err.Description
End Function
Public Sub UnicodeFile_Write_VB(ByVal sFileName As String, _
ByVal vVar As String)
Dim FF As Long
Dim b() As Byte
Dim FSO
On Error GoTo ErrHandler
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CreateTextFile sFileName, True, False
FF = FreeFile
Open sFileName For Binary Access Write As #FF
Put #FF, , CInt(&HFEFF) 'UTF16LE BOM
b = vVar
Put #FF, , b
Close #FF
Exit Sub
ErrHandler:
Err.Raise Err.Number, "UnicodeFile_Write_VB", Err.Description
End Sub
vbhamed
شنبه 04 مرداد 1393, 23:38 عصر
سلام
خب تو كدي كه بهتون دادم فقط از يك رفرنس بانك اطلاعاتي استفاده شده كه در اغلب برنامه ها استفاده ميشود ولي در كدي كه خودتون داديد از دو تا dll استفاده كردين
R2du-soft
یک شنبه 05 مرداد 1393, 10:58 صبح
ممنون Vbhamed جان
به نظر شما بهترنش کدومه که بعدا روی ویندوزهای مختلف به مشکل نخورم؟! WScript.Shell که به کارم نیومد حذفش کردم فقط مونده Scripting.FileSystemObject .
به نظرتون به مشکل میخورم؟!
vbhamed
دوشنبه 06 مرداد 1393, 00:53 صبح
سلام
اگر FileSystemObject درست كار ميكنه همونم خوبه، راهي هم كه نمونش رو براتون گذاشتم راه خوبيه
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.