Hiển thị text của đoạn mã hex

hq1922010 · 3/10/18

Em xin chào tất cả mọi người,em có vấn đề này mong các bác cao thủ giúp em,em là tân binh mới tập toẹ có gì các bác chỉ giáo.Em có file excel nhưng cột họ tên là dạng Hex như thế này: (4e47c3942056c4824e2043c6afc6a04e47) trong khi đó đáng lẽ phải là NGÔ VĂN CƯỜNG.Có bác nào cao thủ convert giúp em được không ạ.Em xin cảm ơn.(Convert trên excel chứ không phải dùng soft)

SA_DQ · 3/10/18

Chỉ giáo cái thứ nhất, nè:
Trong file chỉ mỗi dòng dữ liệu hay sao;
Muốn giải mật mã thì dòng mật càng nhiều càng dễ giải mà!

nguoi_ham_hoc · 3/10/18

Bạn muốn quý Thầy, Anh, Chị và các bạn trên GPE này giúp đỡ thì bạn phải đưa file lên để các thành viên ở diễn đàn này xem và giúp đỡ chứ.

hq1922010 · 3/10/18

nguoi_ham_hoc đã viết:
Bạn muốn quý Thầy, Anh, Chị và các bạn trên GPE này giúp đỡ thì bạn phải đưa file lên để các thành viên ở diễn đàn này xem và giúp đỡ chứ.

Dạ dữ liệu dạng thế này,em muốn dịch cột B và cột E

befaint · 4/10/18

batman1 · 4/10/18

hq1922010 đã viết:
Dạ dữ liệu dạng thế này,em muốn dịch cột B và cột E

Với tập tin của bạn:

1. Alt + F11 -> menu insert -> Module -> dán code ở dưới vào Module mới chèn -> chạy sub convert

Tốc độ phải chóng mặt.

2.

Mã:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As LongPtr)
#Else
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
#End If

Function UTF8ByteToUnicodeByte(UTF8() As Byte) As Byte()
Dim b1 As Byte, b2 As Byte, b3 As Byte
Dim index As Long
Dim result() As Byte, code As Long, count As Long, bytesRead As Long
    index = LBound(UTF8)

    ReDim result(0 To (UBound(UTF8) - LBound(UTF8)) * 2)

    Do While index <= UBound(UTF8)
        b1 = UTF8(index)
        bytesRead = 1
        If b1 < &H80 Then
            code = b1
            CopyMemory result(count), code, 2
            count = count + 2
        ElseIf (b1 And &HE0) = &HC0 Then
            If index < UBound(UTF8) Then
                b2 = UTF8(index + 1)
            Else
                b2 = 0
            End If
            If (b2 And &HC0) = &H80 Then
                bytesRead = 2
                code = (b1 And &H1F) * &H40 + (b2 And &H3F)
                CopyMemory result(count), code, 2
                count = count + 2
            End If
        ElseIf (b1 And &HF0) = &HE0 Then
            If index < UBound(UTF8) Then
                b2 = UTF8(index + 1)
            Else
                b2 = 0
            End If
            If (b2 And &HC0) = &H80 Then
                bytesRead = 2
                If index < UBound(UTF8) - 1 Then
                    b3 = UTF8(index + 2)
                Else
                    b3 = 0
                End If
                If (b3 And &HC0) = &H80 Then
                    bytesRead = 3
                    code = (b1 And &HF)
                    code = code * &H1000 + (b2 And &H3F) * &H40 + (b3 And &H3F)
                    CopyMemory result(count), code, 2
                    count = count + 2
                End If
            End If
        End If
        index = index + bytesRead
    Loop

    ReDim Preserve result(0 To count - 1)

    UTF8ByteToUnicodeByte = result
End Function

Sub convert()
Dim s As String, k As Long, r As Long, c As Long, length As Long, lastRow As Long, Arr(), m() As Byte, colName
    colName = Array("B", "E")
   
    lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.count, "B").End(xlUp).Row
    If lastRow < 2 Then Exit Sub
  
    For c = 0 To 1
        Arr = ThisWorkbook.Worksheets("Sheet1").Cells(2, colName(c)).Resize(lastRow).Value
        For r = 1 To UBound(Arr) - 1
            s = Arr(r, 1)
            length = Len(s) \ 2
            ReDim m(1 To length)
            For k = 1 To length
                m(k) = "&H" & Mid(s, (k - 1) * 2 + 1, 2)
            Next k
            m = UTF8ByteToUnicodeByte(m)
            s = m
            Arr(r, 1) = s
        Next r
        ThisWorkbook.Worksheets("Sheet1").Cells(2, colName(c)).Resize(lastRow - 1).Value = Arr
    Next c
End Sub

hq1922010 · 4/10/18

batman1 đã viết:

Với tập tin của bạn:

1. Alt + F11 -> menu insert -> Module -> dán code ở dưới vào Module mới chèn -> chạy sub convert

Tốc độ phải chóng mặt.

2.

Mã:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As LongPtr)
#Else
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)
#End If

Function UTF8ByteToUnicodeByte(UTF8() As Byte) As Byte()
Dim b1 As Byte, b2 As Byte, b3 As Byte
Dim index As Long
Dim result() As Byte, code As Long, count As Long, bytesRead As Long
    index = LBound(UTF8)

    ReDim result(0 To (UBound(UTF8) - LBound(UTF8)) * 2)

    Do While index <= UBound(UTF8)
        b1 = UTF8(index)
        bytesRead = 1
        If b1 < &H80 Then
            code = b1
            CopyMemory result(count), code, 2
            count = count + 2
        ElseIf (b1 And &HE0) = &HC0 Then
            If index < UBound(UTF8) Then
                b2 = UTF8(index + 1)
            Else
                b2 = 0
            End If
            If (b2 And &HC0) = &H80 Then
                bytesRead = 2
                code = (b1 And &H1F) * &H40 + (b2 And &H3F)
                CopyMemory result(count), code, 2
                count = count + 2
            End If
        ElseIf (b1 And &HF0) = &HE0 Then
            If index < UBound(UTF8) Then
                b2 = UTF8(index + 1)
            Else
                b2 = 0
            End If
            If (b2 And &HC0) = &H80 Then
                bytesRead = 2
                If index < UBound(UTF8) - 1 Then
                    b3 = UTF8(index + 2)
                Else
                    b3 = 0
                End If
                If (b3 And &HC0) = &H80 Then
                    bytesRead = 3
                    code = (b1 And &HF)
                    code = code * &H1000 + (b2 And &H3F) * &H40 + (b3 And &H3F)
                    CopyMemory result(count), code, 2
                    count = count + 2
                End If
            End If
        End If
        index = index + bytesRead
    Loop

    ReDim Preserve result(0 To count - 1)

    UTF8ByteToUnicodeByte = result
End Function

Sub convert()
Dim s As String, k As Long, r As Long, c As Long, length As Long, lastRow As Long, Arr(), m() As Byte, colName
    colName = Array("B", "E")
  
    lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.count, "B").End(xlUp).Row
    If lastRow < 2 Then Exit Sub
 
    For c = 0 To 1
        Arr = ThisWorkbook.Worksheets("Sheet1").Cells(2, colName(c)).Resize(lastRow).Value
        For r = 1 To UBound(Arr) - 1
            s = Arr(r, 1)
            length = Len(s) \ 2
            ReDim m(1 To length)
            For k = 1 To length
                m(k) = "&H" & Mid(s, (k - 1) * 2 + 1, 2)
            Next k
            m = UTF8ByteToUnicodeByte(m)
            s = m
            Arr(r, 1) = s
        Next r
        ThisWorkbook.Worksheets("Sheet1").Cells(2, colName(c)).Resize(lastRow - 1).Value = Arr
    Next c
End Sub

Dạ em cảm ạ,em đã có thể convert được ạ,nhưng em muốn nó tự động convert như kiểu dùng hàm excel có được không ah.Tức là dữ liệu ô B sau đó tự động convert sang ô khác?

Bài đã được tự động gộp: 4/10/18

befaint đã viết:
.

em cảm ơn ạ

batman1 · 4/10/18

hq1922010 đã viết:
Dạ em cảm ạ,em đã có thể convert được ạ,nhưng em muốn nó tự động convert như kiểu dùng hàm excel có được không ah.Tức là dữ liệu ô B sau đó tự động convert sang ô khác?

Bài đã được tự động gộp: 4/10/18

em cảm ơn ạ

Dữ liệu chỉ convert 1 lần rồi dùng muôn đời thì sao lại phải dùng công thức cho nặng tập tin?

SA_DQ · 4/10/18

Mình cũng có 1 ý, xin các bạn giúp giải đáp:
Ta có thể viết các hàm để dịch ngược & dịch xuôi 1 đoạn văn bản không nhỉ?

Ví dụ dịch xuôi & ngược đoạn:

"Nước cộng hòa xã hội chủ nghĩa Việt nam"

batman1 · 4/10/18

Cũng cần nói thêm là API có hàm MultiByteToWideChar. Nhưng code tôi đưa là do tôi viết sau khi nghiên cứu unicode, UTF8 nên tôi thích dùng. Mà nó nhanh.

violetfragrance · 4/10/18

Các bạn giúp mình đoạn code để có được dữ liệu Hex như cột B và E như bài 4 với.

hq1922010 · 4/10/18

batman1 đã viết:
Dữ liệu chỉ convert 1 lần rồi dùng muôn đời thì sao lại phải dùng công thức cho nặng tập tin?

DẠ TẠI DỮ LIỆU CỦA EM LÀ NHẬP TỪ QUÉT BARCODE,EM MUỐN NÓ CÓ THỂ HIỂN THỊ NGAY ĐỂ KIỂM TRA ĐÚNG SAI,HOẶC LÀ CÓ THỂ GẮN LÊN NÚT ẤN CỦA FORM KHÔNG Ạ

befaint · 4/10/18

#12 lại có người hỏng bàn phím đây!!!!
-----------

Cho bài #7 và #11

hml89 · 4/10/18

befaint đã viết:
#12 lại có người hỏng bàn phím đây!!!!
-----------

Cho bài #7 và #11

Tôi chưa biết đến cái này, nhưng xem file của bạn thấy rất hay.

befaint · 4/10/18

hml89 đã viết:
Tôi chưa biết đến cái này, nhưng xem file của bạn thấy rất hay.

Không hiểu ý của bạn. Bạn muốn trao đổi gì với mình?

hml89 · 4/10/18

befaint đã viết:
Không hiểu ý của bạn. Bạn muốn trao đổi gì với mình?

ai za! Tui có í đồ gì đâu, người ta đang hâm mộ thôi. Tui chưa gặp cái dạng kiểu chữ như thế này , hôm nay mới gặp, nên thấy rất hay.

batman1 · 4/10/18

hq1922010 đã viết:
DẠ TẠI DỮ LIỆU CỦA EM LÀ NHẬP TỪ QUÉT BARCODE,EM MUỐN NÓ CÓ THỂ HIỂN THỊ NGAY ĐỂ KIỂM TRA ĐÚNG SAI,HOẶC LÀ CÓ THỂ GẮN LÊN NÚT ẤN CỦA FORM KHÔNG Ạ

Thêm hàm UTF8CodeStringToUnicode

Mã:

Function UTF8CodeStringToUnicode(ByVal UTF8CodeString As String) As String
Dim k As Long, m() As Byte
    Application.Volatile
    ReDim m(1 To Len(UTF8CodeString) \ 2)
    For k = 1 To UBound(m)
        m(k) = "&H" & Mid(UTF8CodeString, (k - 1) * 2 + 1, 2)
    Next k
    m = UTF8ByteToUnicodeByte(m)
    UTF8CodeStringToUnicode = m
End Function

Dùng vd.

Mã:

=UTF8CodeStringToUnicode(B2)

Muốn tên ngắn thì tự đổi lại tên hàm và cả trong nội dung của hàm.

batman1 · 4/10/18

SA_DQ đã viết:
Mình cũng có 1 ý, xin các bạn giúp giải đáp:
Ta có thể viết các hàm để dịch ngược & dịch xuôi 1 đoạn văn bản không nhỉ?

Ví dụ dịch xuôi & ngược đoạn:

"Nước cộng hòa xã hội chủ nghĩa Việt nam"

Các hàm tôi viết khi xưa tìm hiểu unicode, UTF8

Mã:

Function UnicodeByteToUTF8Byte(UTF16() As Byte) As Byte()
Dim i As Long
Dim count As Long
Dim uSize As Long
Dim cpoint As Long
Dim tmp() As Byte, result() As Byte
    uSize = (UBound(UTF16) - LBound(UTF16) + 1) \ 2

    For i = 1 To uSize
        CopyMemory cpoint, UTF16((i - 1) * 2 + LBound(UTF16)), 2
        If cpoint < &H80 Then
            ReDim tmp(1 To 1)
            tmp(1) = cpoint
        ElseIf cpoint < &H800 Then
            ReDim tmp(1 To 2)
            tmp(1) = &HC0 + ((cpoint \ &H40) And &H1F)
            tmp(2) = &H80 + (cpoint And &H3F)
        ElseIf (cpoint < &HD800) Or (cpoint > &HDFFF) Then
            ReDim tmp(1 To 3)
            tmp(3) = &H80 + (cpoint And &H3F)
            cpoint = cpoint \ &H40
            tmp(2) = &H80 + (cpoint And &H3F)
            cpoint = cpoint \ &H40
            tmp(1) = &HE0 + (cpoint And &HF)
        End If
        ReDim Preserve result(1 To count + UBound(tmp))
        CopyMemory result(count + 1), tmp(1), UBound(tmp)
        count = count + UBound(tmp)
   Next
   UnicodeByteToUTF8Byte = result
End Function

Function UnicodeToUTF8Byte(ByVal UTF16 As String) As Byte()
Dim uSize As Long
Dim m() As Byte
    uSize = Len(UTF16)
    If uSize = 0 Then Exit Function

    ReDim m(1 To 2 * uSize)
    CopyMemory m(1), ByVal StrPtr(UTF16), 2 * uSize
    
    UnicodeToUTF8Byte = UnicodeByteToUTF8Byte(m)
End Function

Function UnicodeToUTF8(ByVal UniText As String) As String
Dim m() As Byte, n As Long
    m = UnicodeToUTF8Byte(UniText)
    For n = LBound(m) To UBound(m)
        UnicodeToUTF8 = UnicodeToUTF8 & Chr(m(n))
    Next
End Function

Function StringToUTF8String(ByVal text As String) As String
Dim uSize As Long, code As Long, s2 As String, s3 As String, result As String
    uSize = Len(text)
    If uSize = 0 Then Exit Function
    For i = 1 To uSize
        code = AscW(Mid(text, i, 1))
        If code < &H80 Then
'            1 bai UTF-8
            result = result & Chr(code)
        ElseIf code < &H800 Then
'            2 bai UTF-8
            result = result & Chr(&HC0 + ((code \ &H40) And &H1F)) & Chr(&H80 + (code And &H3F))
        ElseIf (code < &HD800) Or (code > &HDFFF) Then
'            3 bai UTF-8
            s3 = Chr(&H80 + (code And &H3F))
            code = code \ &H40
            s2 = Chr(&H80 + (code And &H3F))
            code = code \ &H40
            result = result & Chr(&HE0 + (code And &HF)) & s2 & s3
        End If
    Next
    StringToUTF8String = result
End Function

Function UnicodeByteToUTF8(UTF16() As Byte) As String
Dim m() As Byte, n As Long
    m = UnicodeByteToUTF8Byte(UTF16)
    For n = LBound(m) To UBound(m)
        UnicodeByteToUTF8 = UnicodeByteToUTF8 & Chr(m(n))
    Next
End Function

Function UTF8ByteToUnicodeByte(UTF8() As Byte) As Byte()
Dim b1 As Byte, b2 As Byte, b3 As Byte
Dim index As Long
Dim result() As Byte, code As Long, count As Long, bytesRead As Long
    index = LBound(UTF8)

    ReDim result(0 To (UBound(UTF8) - LBound(UTF8)) * 2)

    Do While index <= UBound(UTF8)
        b1 = UTF8(index)
        bytesRead = 1
        If b1 < &H80 Then
            code = b1
            CopyMemory result(count), code, 2
            count = count + 2
        ElseIf (b1 And &HE0) = &HC0 Then
            If index < UBound(UTF8) Then
                b2 = UTF8(index + 1)
            Else
                b2 = 0
            End If
            If (b2 And &HC0) = &H80 Then
                bytesRead = 2
                code = (b1 And &H1F) * &H40 + (b2 And &H3F)
                CopyMemory result(count), code, 2
                count = count + 2
            End If
        ElseIf (b1 And &HF0) = &HE0 Then
            If index < UBound(UTF8) Then
                b2 = UTF8(index + 1)
            Else
                b2 = 0
            End If
            If (b2 And &HC0) = &H80 Then
                bytesRead = 2
                If index < UBound(UTF8) - 1 Then
                    b3 = UTF8(index + 2)
                Else
                    b3 = 0
                End If
                If (b3 And &HC0) = &H80 Then
                    bytesRead = 3
                    code = (b1 And &HF)
                    code = code * &H1000 + (b2 And &H3F) * &H40 + (b3 And &H3F)
                    CopyMemory result(count), code, 2
                    count = count + 2
                End If
            End If
        End If
        index = index + bytesRead
    Loop

    ReDim Preserve result(0 To count - 1)

    UTF8ByteToUnicodeByte = result
End Function

Function UTF8ByteToUnicode(UTF8() As Byte) As String
Dim m() As Byte, n As Long
    m = UTF8ByteToUnicodeByte(UTF8)
    n = (UBound(m) - LBound(m) + 1) \ 2
    UTF8ByteToUnicode = String(n, &H20)
    CopyMemory ByVal StrPtr(UTF8ByteToUnicode), m(LBound(m)), 2 * n
End Function

Function UTF8ToUnicode(ByVal UTF8 As String) As String
Dim m() As Byte, n As Long, count As Long
    ReDim m(1 To Len(UTF8))
    For n = 1 To Len(UTF8)
        m(n) = Asc(Mid(UTF8, n, 1))
    Next
    
    m = UTF8ByteToUnicodeByte(m)
    n = (UBound(m) - LBound(m) + 1) \ 2
    UTF8ToUnicode = String(n, &H20)
    CopyMemory ByVal StrPtr(UTF8ToUnicode), m(LBound(m)), 2 * n
End Function

Sub UTF8FileToUnicodeFile(ByVal utf_file As String, ByVal unicode_file As String)
Dim m() As Byte
    Open utf_file For Binary As #1
    ReDim m(0 To LOF(1) - 1)
    Get #1, , m
    Close #1

    m = UTF8ByteToUnicodeByte(m)

    Open unicode_file For Binary As #1
    Put #1, , m
    Close #1
End Sub

Sub UnicodeFileToUTF8File(ByVal unicode_file As String, ByVal utf_file As String)
Dim m() As Byte
    Open unicode_file For Binary As #1
    ReDim m(0 To LOF(1) - 1)
    Get #1, , m
    Close #1

    m = UnicodeByteToUTF8Byte(m)

    Open utf_file For Binary As #1
    Put #1, , m
    Close #1
End Sub

violetfragrance · 4/10/18

batman1 đã viết:

Các hàm tôi viết khi xưa tìm hiểu unicode, UTF8

Mã:

Function UnicodeByteToUTF8Byte(UTF16() As Byte) As Byte()
Dim i As Long
Dim count As Long
Dim uSize As Long
Dim cpoint As Long
Dim tmp() As Byte, result() As Byte
    uSize = (UBound(UTF16) - LBound(UTF16) + 1) \ 2

    For i = 1 To uSize
        CopyMemory cpoint, UTF16((i - 1) * 2 + LBound(UTF16)), 2
        If cpoint < &H80 Then
            ReDim tmp(1 To 1)
            tmp(1) = cpoint
        ElseIf cpoint < &H800 Then
            ReDim tmp(1 To 2)
            tmp(1) = &HC0 + ((cpoint \ &H40) And &H1F)
            tmp(2) = &H80 + (cpoint And &H3F)
        ElseIf (cpoint < &HD800) Or (cpoint > &HDFFF) Then
            ReDim tmp(1 To 3)
            tmp(3) = &H80 + (cpoint And &H3F)
            cpoint = cpoint \ &H40
            tmp(2) = &H80 + (cpoint And &H3F)
            cpoint = cpoint \ &H40
            tmp(1) = &HE0 + (cpoint And &HF)
        End If
        ReDim Preserve result(1 To count + UBound(tmp))
        CopyMemory result(count + 1), tmp(1), UBound(tmp)
        count = count + UBound(tmp)
   Next
   UnicodeByteToUTF8Byte = result
End Function

Function UnicodeToUTF8Byte(ByVal UTF16 As String) As Byte()
Dim uSize As Long
Dim m() As Byte
    uSize = Len(UTF16)
    If uSize = 0 Then Exit Function

    ReDim m(1 To 2 * uSize)
    CopyMemory m(1), ByVal StrPtr(UTF16), 2 * uSize
   
    UnicodeToUTF8Byte = UnicodeByteToUTF8Byte(m)
End Function

Function UnicodeToUTF8(ByVal UniText As String) As String
Dim m() As Byte, n As Long
    m = UnicodeToUTF8Byte(UniText)
    For n = LBound(m) To UBound(m)
        UnicodeToUTF8 = UnicodeToUTF8 & Chr(m(n))
    Next
End Function

Function StringToUTF8String(ByVal text As String) As String
Dim uSize As Long, code As Long, s2 As String, s3 As String, result As String
    uSize = Len(text)
    If uSize = 0 Then Exit Function
    For i = 1 To uSize
        code = AscW(Mid(text, i, 1))
        If code < &H80 Then
'            1 bai UTF-8
            result = result & Chr(code)
        ElseIf code < &H800 Then
'            2 bai UTF-8
            result = result & Chr(&HC0 + ((code \ &H40) And &H1F)) & Chr(&H80 + (code And &H3F))
        ElseIf (code < &HD800) Or (code > &HDFFF) Then
'            3 bai UTF-8
            s3 = Chr(&H80 + (code And &H3F))
            code = code \ &H40
            s2 = Chr(&H80 + (code And &H3F))
            code = code \ &H40
            result = result & Chr(&HE0 + (code And &HF)) & s2 & s3
        End If
    Next
    StringToUTF8String = result
End Function

Function UnicodeByteToUTF8(UTF16() As Byte) As String
Dim m() As Byte, n As Long
    m = UnicodeByteToUTF8Byte(UTF16)
    For n = LBound(m) To UBound(m)
        UnicodeByteToUTF8 = UnicodeByteToUTF8 & Chr(m(n))
    Next
End Function

Function UTF8ByteToUnicodeByte(UTF8() As Byte) As Byte()
Dim b1 As Byte, b2 As Byte, b3 As Byte
Dim index As Long
Dim result() As Byte, code As Long, count As Long, bytesRead As Long
    index = LBound(UTF8)

    ReDim result(0 To (UBound(UTF8) - LBound(UTF8)) * 2)

    Do While index <= UBound(UTF8)
        b1 = UTF8(index)
        bytesRead = 1
        If b1 < &H80 Then
            code = b1
            CopyMemory result(count), code, 2
            count = count + 2
        ElseIf (b1 And &HE0) = &HC0 Then
            If index < UBound(UTF8) Then
                b2 = UTF8(index + 1)
            Else
                b2 = 0
            End If
            If (b2 And &HC0) = &H80 Then
                bytesRead = 2
                code = (b1 And &H1F) * &H40 + (b2 And &H3F)
                CopyMemory result(count), code, 2
                count = count + 2
            End If
        ElseIf (b1 And &HF0) = &HE0 Then
            If index < UBound(UTF8) Then
                b2 = UTF8(index + 1)
            Else
                b2 = 0
            End If
            If (b2 And &HC0) = &H80 Then
                bytesRead = 2
                If index < UBound(UTF8) - 1 Then
                    b3 = UTF8(index + 2)
                Else
                    b3 = 0
                End If
                If (b3 And &HC0) = &H80 Then
                    bytesRead = 3
                    code = (b1 And &HF)
                    code = code * &H1000 + (b2 And &H3F) * &H40 + (b3 And &H3F)
                    CopyMemory result(count), code, 2
                    count = count + 2
                End If
            End If
        End If
        index = index + bytesRead
    Loop

    ReDim Preserve result(0 To count - 1)

    UTF8ByteToUnicodeByte = result
End Function

Function UTF8ByteToUnicode(UTF8() As Byte) As String
Dim m() As Byte, n As Long
    m = UTF8ByteToUnicodeByte(UTF8)
    n = (UBound(m) - LBound(m) + 1) \ 2
    UTF8ByteToUnicode = String(n, &H20)
    CopyMemory ByVal StrPtr(UTF8ByteToUnicode), m(LBound(m)), 2 * n
End Function

Function UTF8ToUnicode(ByVal UTF8 As String) As String
Dim m() As Byte, n As Long, count As Long
    ReDim m(1 To Len(UTF8))
    For n = 1 To Len(UTF8)
        m(n) = Asc(Mid(UTF8, n, 1))
    Next
   
    m = UTF8ByteToUnicodeByte(m)
    n = (UBound(m) - LBound(m) + 1) \ 2
    UTF8ToUnicode = String(n, &H20)
    CopyMemory ByVal StrPtr(UTF8ToUnicode), m(LBound(m)), 2 * n
End Function

Sub UTF8FileToUnicodeFile(ByVal utf_file As String, ByVal unicode_file As String)
Dim m() As Byte
    Open utf_file For Binary As #1
    ReDim m(0 To LOF(1) - 1)
    Get #1, , m
    Close #1

    m = UTF8ByteToUnicodeByte(m)

    Open unicode_file For Binary As #1
    Put #1, , m
    Close #1
End Sub

Sub UnicodeFileToUTF8File(ByVal unicode_file As String, ByVal utf_file As String)
Dim m() As Byte
    Open unicode_file For Binary As #1
    ReDim m(0 To LOF(1) - 1)
    Get #1, , m
    Close #1

    m = UnicodeByteToUTF8Byte(m)

    Open utf_file For Binary As #1
    Put #1, , m
    Close #1
End Sub

Bạn có thể chỉ giúp hàm nào dịch xuôi hàm nào dịch ngược được không?

batman1 · 4/10/18

violetfragrance đã viết:
Các bạn giúp mình đoạn code để có được dữ liệu Hex như cột B và E như bài 4 với.

Bạn tự viết được mà.

Trước hết khái niệm. Mỗi một ký tự trong bảng mã Unicode được gán cho một con số gọi là điểm mã (code point). Hay nói ngắn gọn là mã.
Ví dụ ký tự "a" có mã là bao nhiêu? Trong Excel bạn nhập công thức

Mã:

=CODE("a")

thì sẽ thấy kết quả là 97. Ở dạng hex thì là 61 - trong Delphi viết là $61, trong VBA là &H61

Mỗi một ký tự / chuỗi ký tự có thể được biểu diễn dưới dạng những mã khác nhau. Vd. cùng một chuỗi có thể mã hóa dùng VNI, TCVN3, Windows 1258 (vietnamese), unicode, UTF8 v...v

vd. Lấy chuỗi "NGUYỄN VĂN DƯƠNG"

Nếu ta biểu diễn chuỗi trên ở dạng UTF8, giả sử thành chuỗi str1, và dán vào notepad thì notepad phát hiện ra ngay đó là "NGUYỄN VĂN DƯƠNG" được mã bằng UTF8. Nhưng nếu dán vào ô trong Excel thì là chuỗi "đầu trâu mặt ngựa", tức "khó đọc". Nhưng cái này không quan trọng.

Chuỗi str1 sẽ có một số bai: 4e (= 78 thập phân), 47 (= 71), ...

Và người ta đã ghép các bai 4e, 47, ... để tạo ra chuỗi nhìn thấy ở B2. Tức trong B2 không phải là chuỗi UTF8 str1 mà là chuỗi tạo từ các bai của chuỗi str1.

Biết được "triết lý" rồi thì bạn tự làm được thôi.

Tôi có đính kèm code của các hàm. Vd. bạn dùng hàm StringToUTF8String để chuyển chuỗi của bạn (unicode) thành UTF8, giả sử là chuỗi str1. Sau đó bạn đọc từng bai (ở dạng hex, tức vd. không phải là 97 mà là 61) của chuỗi str1 rồi ghép chúng với nhau thôi.

Hiển thị text của đoạn mã hex

Thành viên mới

/(hông là gì!

Thành viên hoạt động

Thành viên mới

File đính kèm

|||||||||||||

File đính kèm

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

/(hông là gì!

Thành viên gạo cội

Thành viên mới

Thành viên mới

|||||||||||||

File đính kèm

Thành viên tiêu biểu

|||||||||||||

Thành viên tiêu biểu

Thành viên gạo cội

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Facebook

Group