• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Đọc file text utf8, unicode, ancii với unicode Path

Các thủ thuật liên quan đến xử lý chuỗi và thời gian
Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Đọc file text utf8, unicode, ancii với unicode Path

Gửi bàigửi bởi truongphu » T.Bảy 23/07/2011 5:48 pm

Thủ thuật: Đọc file text utf8, unicode, ancii với đường dẫn unicode
Tác giả: truongphu + andylam1992
Mô tả: VB6 có 2 khuyết điểm khó khắc phục là:
* Khó đọc trực tiếp utf-8, phải nhờ function chuyển mã.
* Thao tác với đường dẫn unicode khó khăn
Bài viết nầy: code kèm Project nhằm giải quyết dứt điểm 2 vấn đề trên
1- Chuyển unicode path về dạng short path (andylam1992) để có thể dùng với các lệnh mở file cổ điển VB6, đương nhiên phải dùng control hổ trợ unicode trước để nhận file, đó là UserAccounts.CommonDialog
2- Dùng ADODB.Stream thay vì dùng Scripting.FileSystemObject vì Scripting.FileSystemObject chỉ hổ trợ unicode.
3- Tự động nhận Charset của file là một trong 3: utf8, unicode hay ancii



Code như sau:
  1. Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameW" (ByVal lpszLongPath As Long, ByVal lpszShortPath As Long, ByVal nBufferLength As Long) As Long
  2. Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
  3. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  4.  
  5. Private Function get_path(ByVal mPathName As String) As String
  6. Dim pPathName&, RetVal&, pBuffer&, Buffer$
  7.     pPathName = StrPtr(mPathName)
  8.     Buffer = Space(8096) ' andylam1992
  9.    pBuffer = StrPtr(Buffer)
  10.     RetVal = GetShortPathName(pPathName, pBuffer, Len(Buffer))
  11.     If RetVal > 0 Then
  12.         get_path = LPWSTRtoBSTR(pBuffer)
  13.     End If
  14. End Function
  15.  
  16. Private Function LPWSTRtoBSTR(ByVal lpwsz As Long) As String
  17. Dim cChars&
  18.     cChars = lstrlenW(lpwsz) 'andylam1992
  19.    LPWSTRtoBSTR = String$(cChars, 0)
  20.     Call CopyMemory(ByVal StrPtr(LPWSTRtoBSTR), ByVal lpwsz, cChars * 2)
  21. End Function
  22.  
  23. Private Sub Command1_Click()
  24. Const adReadAll = -1
  25. Const adTypeText = 2
  26.         'truongphu
  27. With CreateObject("UserAccounts.CommonDialog")
  28.     .Filter = "Text File|*.txt|All Files|*.*"
  29.     .FilterIndex = 1
  30.     .InitialDir = App.Path
  31.     Filepath = .ShowOpen
  32.     If Filepath = 0 Then
  33.         Exit Sub
  34.     Else
  35.         Label1 = .FileName
  36.     End If
  37. End With
  38.  
  39. Dim mm$
  40. Open get_path(Label1) For Input As #1
  41.     Line Input #1, mm
  42. Close #1
  43.  
  44.      With CreateObject("ADODB.Stream")
  45.         Select Case Left(mm, 2)
  46.             Case "ï»": .Charset = "utf-8"
  47.             Case "ÿþ": .Charset = "unicode"
  48.             Case Else: .Charset = "us-ascii"
  49.         End Select
  50.         .Type = 2
  51.         .Open
  52.         .LoadFromFile Label1
  53.         Label3 = .Size & " bytes, Charset = " & .Charset
  54.         TextBox1 = .ReadText(-1)
  55.     End With
  56.  
  57. End Sub


Kèm Project:
Tập tin đính kèm
Ðoc file text UTF-8 Unicode ANCII.rar
(2.74 KiB) Đã tải 700 lần


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Quay về “[VB] Chuỗi và Thời gian”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.2 khách