Câu lạc bộ Visual Basic

.:: Nơi trao đổi về ngôn ngữ Visual Basic ::.
http://caulacbovb.com/forum/

Đọc/Ghi file text có mã Unicode

http://caulacbovb.com/forum/viewtopic.php?f=27&t=151

Trang 1 trên 1

Đọc/Ghi file text có mã Unicode

Đã gửi: T.Bảy 29/03/2008 10:43 am
gửi bởi truongphu
Thủ thuật: Đọc/Ghi file text có mã Unicode
Tác giả: truongphu
Mô tả: Đọc và ghi file text có mã Unicode

Muốn đọc và ghi được Unicode từ file text bạn phải dùng chế độ Binary để đọc và ghi file mới được.

Đọc file:

Mã: Chọn hết

  1. Private Sub Form_Load()
  2. Dim fNum As Long, B() As Byte, fp
  3.     fp = "C:\Mùa Thu Lá Bay.txt"
  4.     fNum = FreeFile()
  5.     Open fp For Binary Access Read As #fNum
  6.         ReDim B(LOF(fNum))
  7.     Get #fNum, , B
  8.     Close #fNum
  9.  
  10.     Dim arr, i As Integer, s As String
  11.     arr = Split(B, vbCrLf)
  12.      For i = 0 To UBound(arr)
  13.             s = s & arr(i) & vbCrLf
  14.      Next i
  15. TextBox1 = s
  16. End Sub

Hoặc

Mã: Chọn hết

  1. Private Sub Command1_Click()
  2. Dim noidung()  As Byte
  3.     Open "C:\1.txt" For Binary Access Read As #1
  4.         ReDim noidung(LOF(1))
  5.         Get #1, , noidung
  6.     Close #1
  7. TextBox1 = noidung
  8. TextBox1 = Right(TextBox1, Len(TextBox1) - 1)
  9. End Sub

Hoặc bằng VB Script

Mã: Chọn hết

  1. Private Sub Command2_Click()
  2. Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\1.txt", 1, , -2)
  3.    TextBox1 = FSO.Readall
  4. End Sub


Ghi file:

Mã: Chọn hết

  1. Private Sub saveTextFile(str As String, fname As String)
  2. On Error Resume Next
  3.     Dim fNum As Long
  4.     Dim B() As Byte
  5.     If bFileExists(fname) Then
  6.         fNum = FreeFile()
  7.         Open fname For Binary Access Read As #fNum
  8.         ReDim B(LOF(fNum))
  9.         Get #fNum, , B
  10.         Close #fNum
  11.        
  12.         Dim arr, i As Integer, s As String
  13.         arr = Split(B, vbCrLf)
  14.         For i = 0 To UBound(arr)
  15.             s = s & arr(i) & vbCrLf
  16.         Next i
  17.         str = s & str
  18.     End If
  19.    
  20.     Kill fname
  21.  
  22.     fNum = FreeFile()
  23.     Open fname For Binary Access Write As #fNum
  24.         B = str
  25.     Put #fNum, , B
  26.    
  27.     Close #fNum
  28. End Sub

Hoặc

Mã: Chọn hết

  1. Private Sub Command3_Click()
  2. Open "C:\2.txt" For Binary As #1
  3.     Put #1, , Trim$(StrConv(TextBox1, vbUnicode))
  4. Close #1
  5. End Sub

Hoặc bằng VB Script

Mã: Chọn hết

  1. Private Sub Command4_Click()
  2. Set FSO = CreateObject("Scripting.FileSystemObject").CreateTextFile("C:\2.txt", True)
  3. Set FSO = Nothing
  4. Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\2.txt", 2, , -1)
  5.           FSO.Write TextBox1
  6. End Sub

Hoặc ghi file từ Clipboard

Mã: Chọn hết

  1. Private Const CF_UNICODETEXT As Long = 13
  2. Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
  3. Private Declare Function CloseClipboard Lib "user32.dll" () As Long
  4. Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
  5. Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
  6. Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As
  7.  
  8. Long) As Long
  9. Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
  10. Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
  11. Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
  12.  
  13. Private Function Get_clipboard() As String
  14.     Dim myStrPtr As Long, myLen As Long, myLock As Long, myData As String
  15.  
  16.     OpenClipboard 0&
  17.  
  18.     If IsClipboardFormatAvailable(CF_UNICODETEXT) = 0 Then MsgBox "Clipboard Text is not available now": Exit
  19.  
  20. Function
  21.  
  22.     myStrPtr = GetClipboardData(CF_UNICODETEXT)
  23.  
  24.     If myStrPtr = 0 Then
  25.         MsgBox "Failed to get Clipboard Text"
  26.     Else
  27.         myLock = GlobalLock(myStrPtr)
  28.         myLen = GlobalSize(myStrPtr)
  29.         myData = String$(myLen \ 2 - 1, vbNullChar)
  30.         lstrcpy StrPtr(myData), myLock
  31.         GlobalUnlock myStrPtr
  32.     End If
  33.  
  34.     CloseClipboard
  35.  
  36.     Get_clipboard = myData
  37. End Function
  38.  
  39. Private Sub Command5_Click()
  40. Open "C:\2.txt" For Binary As #1
  41.     Put #1, , Trim$(StrConv(Get_clipboard, vbUnicode))
  42. Close #1
  43. End Sub

Re: Đọc được Unicode từ file text

Đã gửi: CN 20/04/2008 3:25 pm
gửi bởi Giang Hồ
Ngoài cách đọc ở dạng Binary còn có thể dùng Object để đọc và ghi cũng dc


Mã: Chọn hết

  1. Private Sub UniReadText(ByVal sFileName As String)
  2. Dim txt
  3.    Dim objStream As Object
  4.    Set objStream = CreateObject("Scripting.FileSystemObject").OpenTextFile(sFileName, 1, False, -2)
  5.       If (Not objStream Is Nothing) Then
  6.          With objStream
  7.             Open sFileName For Input As #1 ' Mo file.
  8.             Do While Not EOF(1)
  9.                 Line Input #1, txt
  10.                 txt = .ReadLine 'Doc tung dong
  11.             Loop
  12.             Close #1
  13.          .Close
  14.          End With
  15.          Set objStream = Nothing
  16.       End If
  17. End Sub
  18.  
  19.  
  20. Private Sub UniWriteText(ByVal sFileName As String)
  21. Dim txt As String
  22. txt = "caulacbovb.com"
  23. Dim i As Integer
  24. Dim objStream As Object
  25.       Set objStream = CreateObject("Scripting.FileSystemObject").OpenTextFile(sFileName, 2, True, -1)
  26.       If (Not objStream Is Nothing) Then
  27.          With objStream
  28.             .Write txt 'Ghi vao file
  29.             .Close
  30.          End With
  31.          Set objStream = Nothing
  32.       End If
  33. End Sub

Re: Đọc được Unicode từ file text

Đã gửi: CN 20/04/2008 9:18 pm
gửi bởi truongphu
Được đấy!

Cấu trúc thông thường là:

Mã: Chọn hết

  1.   Dim objStream, ff
  2.    Set objStream = CreateObject("Scripting.FileSystemObject")
  3.     Set ff = objStream.OpenTextFile("e:\win\desktop\aaa.txt", 1, False, -2)

Sẽ không chạy! do đọc không được mã Unicode
(đính chính hôm nay 21/4: chạy được, cái mới là Giang hồ viết gọn hơn)

vậy mà Giang Hồ viết:

Mã: Chọn hết

  1. Set objStream = CreateObject("Scripting.FileSystemObject").OpenTextFile("e:\win\desktop\aaa.txt", 1, False, -2)

Lại chạy êm, đọc được Unicode.
Đây là điều hôm nay tôi mới học.
Cảm ơn Giang Hồ

Re: Đọc được Unicode từ file text

Đã gửi: T.Hai 21/04/2008 12:58 pm
gửi bởi truongphu
Hồi tối qua thiếu tỉnh táo và cẩn thận nên có bài viết trên, hôm nay xin đính chính với đoạn code sau:

Mã: Chọn hết

  1. Private Function ReadFileUni(FileName As String) As String
  2. Dim FSO
  3.    Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile(FileName, 1, , -2)
  4.    ReadFileUni = FSO.Readall
  5.    Set FSO = Nothing
  6. End Function
  7. '''''''''''''''''
  8. Private Function WriteFileUni(FileName As String, Unistr As String)
  9. Dim FSO As Object    'tao 1 file mo'i rôi mo'i ghi vào
  10.       Set FSO = CreateObject("Scripting.FileSystemObject").CreateTextFile(FileName, True)
  11.       Set FSO = Nothing
  12.       Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile(FileName, 2, , -1)
  13.           FSO.Write Unistr
  14.       Set FSO = Nothing
  15. End Function

:D : rất gọn phải không các bạn?

Re: Đọc được Unicode từ file text

Đã gửi: T.Hai 21/04/2008 6:08 pm
gửi bởi VBNewbie
Sao em chạy bị lỗi .

Re: Đọc được Unicode từ file text

Đã gửi: T.Hai 21/04/2008 8:48 pm
gửi bởi truongphu
Gởi VBNewbie
Lẽ ra tôi không viết dòng nầy, vì như các người khác, thế là OK (vì dễ quá mà! :D )
Tuy nhiên, trước đây, tôi cũng như bạn!
1- Ví dụ: khi bạn dùng dòng sau đây: "e:\win\desktop\aaa.txt" thì bảo đảm phải có đĩa e, phải có folder "win" và dưới nó là desktop, và phải có aaa.txt
2- tập tin aaa.txt bạn phải lưu dưới dạng Unicode chứ không phải dạng UTF8! và nội dung bạn phải gõ: "Bạn trương phú
Nhờ bạn trả lời...hi hi!"
3- Và sau đây là code (cũng như trên) để bạn vui: Phải có 1 TextBox1 hổ trợ Unicode (form 2.0) và set font = arial hay tahoma

Mã: Chọn hết

  1. Private Function ReadFileUni(FileName As String) As String
  2. Dim FSO
  3.    Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile(FileName, 1, , -2)
  4.    ReadFileUni = FSO.Readall
  5.    Set FSO = Nothing
  6. End Function
  7.  
  8. Private Function WriteFileUni(FileName As String, Unistr As String)
  9. Dim FSO As Object    'tao 1 file mo'i rôi mo'i ghi vào
  10.       Set FSO = CreateObject("Scripting.FileSystemObject").CreateTextFile(FileName, True)
  11.       Set FSO = Nothing
  12.       Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile(FileName, 2, , -1)
  13.           FSO.Write Unistr
  14.       Set FSO = Nothing
  15. End Function
  16.  
  17. Private Sub Form_Load()
  18. Dim aa
  19. TextBox1 = ReadFileUni("e:\win\desktop\aaa.txt")
  20. aa = WriteFileUni("e:\win\desktop\bbb.txt", TextBox1)
  21. End Sub
  22.  

Mong bạn vừa ý

Re: Đọc được Unicode từ file text

Đã gửi: T.Ba 22/04/2008 11:28 am
gửi bởi VBNewbie
Bạn chỉ mình cái cách Binary đó bạn có thể làm 1 project cho minh được không vì ở trên bạn khai biến bị lỗi tùm lum. Mong bạn khai báo rõ ràng hơn.
Thanks !

Re: Đọc được Unicode từ file text

Đã gửi: T.Bảy 17/05/2008 8:38 pm
gửi bởi VBNewbie
Xin lỗi bác nha ! Con hok bik pác lớn tuổi !
Pác bik cái đọc bằng Binary thi chỉ con với, còn đọc bằng 2 cách trên chỉ đọc được Unicode mà hok đọc dc UTF-8. Thank you !

Re: Đọc được Unicode từ file text

Đã gửi: T.Sáu 30/05/2008 3:49 pm
gửi bởi truongphu
Đã lâu không coi lại bài nầy, xin lỗi VBNewbie
Cách

Mã: Chọn hết

  1. Open fp For Binary Access Read As #fNum
  2.         ReDim B(LOF(fNum))
  3.     Get #fNum, , B
  4.     Close #fNum
không hổ trợ file text UTF-8. (Muốn thể hiện tiếng Việt còn phải qua một lần chuyển mã nữa!)

Bạn dùng thêm một Richtextbox để thể hiện nội dung file với cách đọc từng dòng

Mã: Chọn hết

  1. Private Sub Form_Load()
  2. Dim B$, fp$, TextLine$
  3.     fp = "C:\Mùa Thu Lá Bay1.txt"
  4.     Open fp For Input As #1
  5.     Do While Not EOF(1)
  6.             Line Input #1, TextLine
  7.         B = B & TextLine & vbCr
  8.    Loop
  9. RichTextBox1 = B
  10. End Sub

Re: Đọc được Unicode từ file text

Đã gửi: T.Bảy 14/06/2008 7:51 pm
gửi bởi VBNewbie
Thank bác truongphu ! Nhưng con thử sài hàm chuyển từ UTF8 - Unicode nhưng bị lỗi !

Re: Đọc được Unicode từ file text

Đã gửi: T.Năm 01/01/2009 10:01 am
gửi bởi VBNewbie
Hik ai chỉ cách tạo file text UTF-8 zới ! Em đang bí !

File TXT là UTF-8

Đã gửi: T.Sáu 02/01/2009 3:02 pm
gửi bởi truongphu
C1- Đọc file:
Dùng lệnh Open... For Input As... như bình thường, tuy nhiên ta phải chuyển mã từ UTF-8 sang Unicode với hàm tương ứng
* Form1 cần Command1 và TextBox1 (MS Form 2.0, Font Arial, Multiline=true). File txt utf8 là C:\3.txt

Mã: Chọn hết

  1. Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
  2. Private Const CP_UTF8 = 65001
  3.  
  4. Private Sub Command1_Click()
  5. Dim zz$
  6. Open "C:\3.txt" For Input As #1
  7.     Do While Not EOF(1)
  8.             Line Input #1, aa
  9.             zz = zz & aa & vbCrLf
  10.     Loop
  11.     Close #1
  12.     TextBox1 = UTF82Unicode(zz)
  13. End Sub
  14.  
  15. Private Function UTF82Unicode(ByVal sUTF8 As String) As String
  16. Dim UTF8Size&, BufferSize&, BufferUNI$, LenUNI&, bUTF8() As Byte
  17. If LenB(sUTF8) = 0 Then Exit Function
  18. bUTF8 = StrConv(sUTF8, vbFromUnicode)
  19. UTF8Size = UBound(bUTF8) + 1
  20. BufferSize = UTF8Size * 2
  21. BufferUNI = String$(BufferSize, vbNullChar)
  22. LenUNI = MultiByteToWideChar(CP_UTF8, 0, bUTF8(0), UTF8Size, StrPtr(BufferUNI), BufferSize)
  23. If LenUNI Then UTF82Unicode = Left$(BufferUNI, LenUNI)
  24. End Function


C2- Ghi file:
Có thể gõ UTF8 từ bàn phím (chọn mã) hoặc phải chuyển đổi từ Unicode sang UTF8. Quá trình ghi file bình thường với Open... For Output As...
* Form1 cần Command1 và TextBox1 (MS Form 2.0, Font Arial, Multiline=true). File txt utf8 là C:\3.txt

Mã: Chọn hết

  1. Dim a() As String, b() As String
  2.  
  3. Private Sub Command1_Click()
  4. Dim zz$, qq As Boolean
  5. If TextBox1 = "" Then Exit Sub
  6. For i = 1 To Len(TextBox1)
  7.     For u = 0 To 133
  8.         If Mid(TextBox1, i, 1) = ChrW(b(u)) Then
  9.             zz = zz & a(u)
  10.             qq = True
  11.             Exit For
  12.         End If
  13.     Next
  14.     If qq = False Then zz = zz & Mid(TextBox1, i, 1)
  15.     qq = False
  16. Next
  17.  
  18. Open "C:\3.txt" For Output As #1
  19. Print #1, zz
  20. Close #1
  21. End Sub
  22.  
  23. Private Sub Form_Load()
  24. Dim C As String, d As String
  25. a = Split("Á@á@À@à @Ả@ả@Ã@ã@Ạ@ạ@Ă@ă@Ắ@ắ@Ằ@ằ@Ẳ@ẳ@Ẵ@ẵ@Ặ@ặ@Â@â@Ấ@ấ@Ầ@ầ@Ẩ@ẩ@Ẫ@ẫ@Ậ@ậ@
  26. Đ@Ä‘@É@é@È@è@Ẻ@ẻ@Ẽ@ẽ@Ẹ@ẹ@Ê@ê@Ế@ế@Ề@ề@Ể@ể@Ễ@á»…@Ệ@ệ@Í@í@ÃŒ@ì@Ỉ@ỉ@Ĩ@Ä©@Ị@ị@Ó@ó@Ã’@ò@Ỏ@ỏ@Õ@õ@Ọ@ọ@Ô@ô@Ố@ố@á»’@ồ@á»”@ổ@á»–@á»—@Ộ@á»™@Æ @Æ¡@Ớ@á»›@Ờ@ờ@Ở@ở@á»@ỡ@Ợ@ợ@Ú@ú@Ù@ù@Ủ@ủ@Ũ@Å©@Ụ@ụ@Ư@Æ°@Ứ@ứ@Ừ@ừ@Ử@á»­@á»®@ữ@á»°@á»±@Ý@ý@Ỳ@ỳ@Ỷ@á»·@Ỹ@ỹ@á»´@ỵ", "@")
  27. C =
  28. "193@225@192@224@7842@7843@195@227@7840@7841@258@259@7854@7855@7856@7857@7858@7859@7860@7861@7862@7863@194@226@7844@7845@7846@7847@7848@7849@7850@7851@7852@7853@272@273@201@233@200@232@7866@7867@7868@7869@7864@7865@202@234@7870@7871@7872@7873@7874@7875@7876@7877@7878@7879@205@237@204@236@7880@7881@296@297@7882@7883@211@243@210@242@7886@7887@213@245@7884@7885@212@244@7888@7889@7890@7891@7892@7893@7894@7895@7896@7897@416@417@7898@7899@7900@7901@7902@7903"
  29. d =
  30. "@7904@7905@7906@7907@218@250@217@249@7910@7911@360@361@7908@7909@431@432@7912@7913@7914@7915@7916@7917@7918@7919@7920@7921@221@253@7922@7923@7926@7927@7928@7929@7924@7925"
  31. b = Split(C & d, "@")
  32. End Sub

Nếu trong phần ghi file UTF8 có trắc trở vì code dài, xin load project
http://www.caulacbovb.com/forum/download/file.php?id=4015

Re: Đọc được Unicode từ file text

Đã gửi: T.Bảy 03/01/2009 12:36 pm
gửi bởi truongphu
Bổ sung:
Đọc từng dòng với file TXT unicode
Cần TextBox1 (MS Form 2.0 font: arial Multiline=true)

Mã: Chọn hết

  1.  Dim MyFile
  2.   Dim fso As New FileSystemObject
  3.   Set MyFile = fso.OpenTextFile("c:\unicode.txt", 1, , -2)
  4.   Do While Not MyFile.AtEndOfStream
  5.     TextBox1 = TextBox1 & MyFile.ReadLine & vbCrLf
  6.   Loop

Viết từng dòng với file TXT unicode

Mã: Chọn hết

  1.  Dim MyFile
  2.   Dim fso As New FileSystemObject
  3.   Set MyFile = fso.OpenTextFile("c:\unicode.txt", ForAppending, , -2)
  4.   MyFile.WriteLine "Mùa Thu Lá Bay"
  5.   MyFile.WriteBlankLines(1)
  6.   MyFile.WriteLine "Mùa Thu Lá Bay Anh Ðã Ði rôi"

Re: Đọc/Ghi file text có mã Unicode

Đã gửi: T.Sáu 27/04/2012 3:44 pm
gửi bởi coelsman
Bác Phú ơi, sao cháu làm cái code hệt của bác sao nó lỗi vậy nè:
Mã: [Chọn hết] [Mở rộng/Thu hẹp] [Tải về]
  1. Option Explicit
  2.  
  3. Private Function ReadFileUni(FileName As String) As String
  4.     Dim FSO
  5.     Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile(FileName, 1, , -2)
  6.     ReadFileUni = FSO.Readall
  7.     Set FSO = Nothing
  8. End Function
  9.  
  10. Private Function WriteFileUni(FileName As String, Unistr As String)
  11.     Dim FSO As Object
  12.     Set FSO = CreateObject("Scripting.FileSystemObject").CreateTextFile(FileName, True)
  13.     Set FSO = Nothing
  14.     Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile(FileName, 2, , -1)
  15.     FSO.Write Unistr
  16.     Set FSO = Nothing
  17. End Function
  18.  
  19. Private Sub Form_Load()
  20.     Dim aa
  21.     Text1 = ReadFileUni(App.Path & "aaa.txt")
  22.     aa = WriteFileUni(App.Path & "bbb.txt", Text1)
  23. End Sub
GeSHi © Codebox Plus


Nó báo lỗi "File not found" ở trong hàm ReadFileUni, dòng
Mã: [Chọn hết] [Mở rộng/Thu hẹp] [Tải về]
  1. Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile(FileName, 1, , -2)
GeSHi © Codebox Plus


Dạ file aaa.txt cháu tạo ra từ trước rồi bác ạ, font Arial, Unicode. Cháu nhìn code ở Sub FormLoad cháu nghĩ là file bbb.txt sẽ copy nội dung từ file aaa.txt thông qua Text1 đúng ko ợ?
Cháu giờ còn gà lắm ợ, đang loay hoay mãi mà ko hiển thị nổi nội dung file txt ra text bác ợ.

Re: Đọc/Ghi file text có mã Unicode

Đã gửi: T.Bảy 28/04/2012 9:49 am
gửi bởi truongphu
coelsman đã viết:Nó báo lỗi "File not found" ở trong hàm ReadFileUni, dòng
Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile(FileName, 1, , -2)


Dòng trên là nguyên mẫu của hàm, không thể sai được, vậy lỗi xẩy ra khi ta gọi đối số của nó.
Đối số của hàm ReadFileUni là: (FileName)
vậy sai ở cách gọi đối số FileName
cách suy luận lỗi là như thế.

Xem lại bạn gọi đối số ở Form_Load
coelsman đã viết:Text1 = ReadFileUni(App.Path & "aaa.txt")


Thấy lỗi chưa? App.Path & "aaa.txt"
chưa thấy thì ngẫm một lát :D

Re: Đọc/Ghi file text có mã Unicode

Đã gửi: T.Hai 29/07/2013 10:42 am
gửi bởi Thao Nguyen
cho mình hỏi cái này, mình đang làm 1 form đăng nhập vào hệ thống gồm 4 textbox, txtTenServer, txtTenCSDL, txtTenDangNhap, txtMatKhau, khi mình đăng nhập lần đầu thì phải điền dữ liệu vào các text, khi đăng nhập lại lần 2 thì dữ liệu được lưu vào file txt, khi đó nó tự load dữ liệu lên, mình chỉ điền mật khẩu thôi, mấy bạn chỉ mình code ghi và đọc file txt trong vb nha. cám ơn mọi người nhiều lắm viết bằng vb net
Múi giờ UTC+07:00
Trang 1 trên 1
Powered by phpBB® Forum Software © phpBB Limited
https://www.phpbb.com/