ذخیره فایل متنی با Encoding = یو تی اف 8 (utf_8)

[aliman12]

دوستان میدونید که یک فایل متنی زمانی که با دستور open باز و بسته میشه مثلا در حالت output با encoding انسی (Anci) ذخیره میشه
بحث من فقط سر حالت output است و زمانیکه که یک فایل وجود نداشته و میخواهیم آنرا ایجاد کنیم
حال چگونه باید کد زیر را تغییر داد تا این فایل متنی با encoding یوتی اف 8 ذخیره و ایجاد شود


Open "C:\5.txt" For Output As #1
Print #1, new1
Close #1

[abolfazl-z]

ابتدا کد های زیر را در قسمت General (بالای همه کد ها ) وارد کن:(این کد را من ننوشتمااااا) تو همین سایت بود(:گیج:)

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

سپس به صورت زیر استفاده کنید:
Open "C:\5.txt" For Output As #1
Print #1,UTF8_Decode( new1)
Close #1

[aliman12]

مرسی ولی سر خط زیر خطا میگیره خودت تست کن متوجه میشی


iChar2 = Asc(Mid(sStr, L + 1, 1))

[arenaw]

سلام یه هفته پیش بحث شد راجع بهش

http://barnamenevis.org/showthread.php?343584-%DA%A9%D8%A7%D8%B1-%D8%A8%D8%A7-utf-8

[just4froum]

سلام یه هفته پیش بحث شد راجع بهش

دنیارو ببین به این زودی یه هفته گذشت. :متعجب::کف::متعجب:

ببخشید ولی مثل این که جناب arenaw لینک را اشتباه دادند.

کار با utf-8 (http://barnamenevis.org/showthread.php?343584-%DA%A9%D8%A7%D8%B1-%D8%A8%D8%A7-utf-8)

[abolfazl-z]

خوب من برنامه اش را برات میفرستم دیگه این رو خودم امتحان کردم فکر نکنم خطا بده:چشمک:

[aliman12]

کد شما فایل را Anci ایجاد میکند :متفکر:

[abolfazl-z]

http://barnamenevis.org/showthread.php?343584-%DA%A9%D8%A7%D8%B1-%D8%A8%D8%A7-utf-8&highlight=utf8

اینجا درباره اش خیلی بحث میشه دوست عزیز:اشتباه:

[M.T.P]

با این کد براحتی می تونید یه فایل txt با Encoding = UTF-8 بسازید.



Dim obStream As Object

Set obStream = CreateObject("adodb.stream")

With obStream
.Charset = "utf-8"
.Mode = 3
.Type = 2
.Open
.WriteText "salam"
.SaveToFile "C:\1.txt"
.Close
End With