Minh Tiên > 18-09-13, 05:19 PM
quanghoasla > 18-09-13, 11:41 PM
paulsteigel > 19-09-13, 09:21 AM
Function ToUnicode(txtString As String, Optional isReversed As Boolean = False, Optional isISO As Boolean = False) As String
    ' This function will do the conversion of text string into unicode
    Dim iStr As String, repTxt As String, mText As String
    Dim i As Long, j As Long
    Dim iUnicode As Variant ' array to keep unicode char set
    Dim iTCVN As Variant ' array to keep TCVN char set
    Dim iProcList() As String ' array to keep what to convert
    
    'parse the parameter into this local variable
    iStr = txtString
    mText = txtString
    
    iUnicode = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, _
        7845, 7847, 7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, _
        7877, 7879, 237, 236, 7881, 297, 7883, 243, 242, 7887, 245, 7885, 244, 7889, 7891, _
        7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 250, 249, 7911, 361, 7909, _
        432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, 7925, 273, 193, 192, 195, _
        258, 194, 212, 416, 431, 272)
    
    iTCVN = Array(184, 181, 182, 183, 185, 168, 190, 187, 188, 189, 198, 169, 202, 199, 200, _
        201, 203, 208, 204, 206, 207, 209, 170, 213, 210, 211, 212, 214, 221, 215, 216, 220, _
        222, 227, 223, 225, 226, 228, 171, 232, 229, 230, 231, 233, 172, 237, 234, 235, 236, _
        238, 243, 239, 241, 242, 244, 173, 248, 245, 246, 247, 249, 253, 250, 251, 252, 254, _
        174, 193, 192, 195, 161, 162, 164, 165, 166, 167)
    
    ' Reenlarge the array
    ReDim iProcList(1, 133)
    ' process the vowel only and covert to asc code
    For i = 1 To Len(mText)
        repTxt = Mid(mText, i, 1)
        If AscW(repTxt) > 122 Then
            iStr = Replace(iStr, repTxt, "[" & AscW(repTxt) & "]")
            mText = Replace(mText, repTxt, " ")
            ' write the processed list
            iProcList(1, j) = "[" & AscW(repTxt) & "]"
            If isISO Then
                iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
            Else
                If isReversed Then
                    iProcList(0, j) = GetElementNo(AscW(repTxt), iUnicode)
                Else
                    iProcList(0, j) = GetElementNo(AscW(repTxt), iTCVN)
                End If
            End If
            j = j + 1
        End If
    Next
    If j = 0 Then
        ToUnicode = txtString
        Exit Function
    End If
    ReDim Preserve iProcList(1, j - 1)
    ' now convert to unicode
    For i = 0 To UBound(iProcList, 2)
        If isReversed Then
            iStr = Replace(iStr, iProcList(1, i), ChrW(iTCVN(Val(iProcList(0, i)))))
        Else
            If isISO Then
                iStr = Replace(iStr, iProcList(1, i), "&#" & iUnicode(Val(iProcList(0, i))) & ";")
            Else
                iStr = Replace(iStr, iProcList(1, i), ChrW(iUnicode(Val(iProcList(0, i)))))
            End If
        End If
    Next
fExit:
    ToUnicode = iStr
End Function
Private Function GetElementNo(iTxt As Long, iObj As Variant) As String
    Dim i As Long
    For i = 0 To UBound(iObj)
        If iTxt = iObj(i) Then
            GetElementNo = CStr(i)
            Exit For
        End If
    Next
End Function 
quanghoasla > 19-09-13, 03:11 PM
paulsteigel > 19-09-13, 03:40 PM
Minh Tiên > 20-09-13, 06:01 PM
Minh Tiên > 31-10-14, 02:40 PM
Minh Tiên > 02-11-14, 12:52 PM
tranthanhan1962 > 04-11-14, 01:30 AM