PDA

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 درست كار مي‌كنه همونم خوبه، راهي هم كه نمونش رو براتون گذاشتم راه خوبيه