Đọc/Ghi file text có mã Unicode
Đã gửi: T.Bảy 29/03/2008 10:43 am
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:
Hoặc
Hoặc bằng VB Script
Ghi file:
Hoặc
Hoặc bằng VB Script
Hoặc ghi file từ Clipboard
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
- Private Sub Form_Load()
- Dim fNum As Long, B() As Byte, fp
- fp = "C:\Mùa Thu Lá Bay.txt"
- fNum = FreeFile()
- Open fp For Binary Access Read As #fNum
- ReDim B(LOF(fNum))
- Get #fNum, , B
- Close #fNum
-
- Dim arr, i As Integer, s As String
- arr = Split(B, vbCrLf)
- For i = 0 To UBound(arr)
- s = s & arr(i) & vbCrLf
- Next i
- TextBox1 = s
- End Sub
Hoặc
Mã: Chọn hết
- Private Sub Command1_Click()
- Dim noidung() As Byte
- Open "C:\1.txt" For Binary Access Read As #1
- ReDim noidung(LOF(1))
- Get #1, , noidung
- Close #1
- TextBox1 = noidung
- TextBox1 = Right(TextBox1, Len(TextBox1) - 1)
- End Sub
Hoặc bằng VB Script
Mã: Chọn hết
- Private Sub Command2_Click()
- Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\1.txt", 1, , -2)
- TextBox1 = FSO.Readall
- End Sub
Ghi file:
Mã: Chọn hết
- Private Sub saveTextFile(str As String, fname As String)
- On Error Resume Next
- Dim fNum As Long
- Dim B() As Byte
- If bFileExists(fname) Then
- fNum = FreeFile()
- Open fname For Binary Access Read As #fNum
- ReDim B(LOF(fNum))
- Get #fNum, , B
- Close #fNum
-
- Dim arr, i As Integer, s As String
- arr = Split(B, vbCrLf)
- For i = 0 To UBound(arr)
- s = s & arr(i) & vbCrLf
- Next i
- str = s & str
- End If
-
- Kill fname
-
- fNum = FreeFile()
- Open fname For Binary Access Write As #fNum
- B = str
- Put #fNum, , B
-
- Close #fNum
- End Sub
Hoặc
Mã: Chọn hết
- Private Sub Command3_Click()
- Open "C:\2.txt" For Binary As #1
- Put #1, , Trim$(StrConv(TextBox1, vbUnicode))
- Close #1
- End Sub
Hoặc bằng VB Script
Mã: Chọn hết
- Private Sub Command4_Click()
- Set FSO = CreateObject("Scripting.FileSystemObject").CreateTextFile("C:\2.txt", True)
- Set FSO = Nothing
- Set FSO = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\2.txt", 2, , -1)
- FSO.Write TextBox1
- End Sub
Hoặc ghi file từ Clipboard
Mã: Chọn hết
- Private Const CF_UNICODETEXT As Long = 13
- Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
- Private Declare Function CloseClipboard Lib "user32.dll" () As Long
- Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
- Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
- Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As
-
- Long) As Long
- Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
- Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
- Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
-
- Private Function Get_clipboard() As String
- Dim myStrPtr As Long, myLen As Long, myLock As Long, myData As String
-
- OpenClipboard 0&
-
- If IsClipboardFormatAvailable(CF_UNICODETEXT) = 0 Then MsgBox "Clipboard Text is not available now": Exit
-
- Function
-
- myStrPtr = GetClipboardData(CF_UNICODETEXT)
-
- If myStrPtr = 0 Then
- MsgBox "Failed to get Clipboard Text"
- Else
- myLock = GlobalLock(myStrPtr)
- myLen = GlobalSize(myStrPtr)
- myData = String$(myLen \ 2 - 1, vbNullChar)
- lstrcpy StrPtr(myData), myLock
- GlobalUnlock myStrPtr
- End If
-
- CloseClipboard
-
- Get_clipboard = myData
- End Function
-
- Private Sub Command5_Click()
- Open "C:\2.txt" For Binary As #1
- Put #1, , Trim$(StrConv(Get_clipboard, vbUnicode))
- Close #1
- End Sub