Function ToUTF8(ByVal UTF16 As Long) As Byte()
   ' Convert a 16bit UTF-16BE to 2 or 3 UTF-8 bytes
   Dim bArray() As Byte
   If UTF16 < &H80 Then
      ReDim bArray(0)  ' one byte UTF-8
      bArray(0) = UTF16  ' Use number as is
   ElseIf UTF16 < &H800 Then
      ReDim bArray(1)  ' two byte UTF-8
      bArray(1) = &H80 + (UTF16 And &H3F)  ' Least Significant 6 bits
      UTF16 = UTF16 \ &H40  ' Shift UTF16 number right 6 bits
      bArray(0) = &HC0 + (UTF16 And &H1F)  ' Use 5 remaining bits
   Else
      ReDim bArray(2)  ' three byte UTF-8
      bArray(2) = &H80 + (UTF16 And &H3F)  ' Least Significant 6 bits
      UTF16 = UTF16 \ &H40  ' Shift UTF16 number right 6 bits
      bArray(1) = &H80 + (UTF16 And &H3F)  ' Use next 6 bits
      UTF16 = UTF16 \ &H40  ' Shift UTF16 number right 6 bits again
      bArray(0) = &HE0 + (UTF16 And &HF)  ' Use 4 remaining bits
   End If
   ToUTF8 = bArray  ' Return UTF-8 bytes in an array
End Function


Function ToUTF16(bArray) As Long
   ' Convert 2 or 3 UTF-8 bytes to a 16bit UTF-16BE
   Dim IntUB
   IntUB = UBound(bArray)  ' Find out how many bytes UTF-8 takes
   Select Case IntUB
   Case 0  ' one byte UTF-8. Note that bArray starts with index=0
      ToUTF16 = bArray(0)  ' Use number as is
   Case 1  ' two byte UTF-8
      ToUTF16 = (bArray(0) And &H1F) * &H40 + (bArray(1) And &H3F)
   Case 2  ' three byte UTF-8
      ToUTF16 = (bArray(0) And &HF) * &H1000 + (bArray(1) And &H3F) * &H40 + (bArray(2) And &H3F)
   End Select
End Function

Function UpperUniChar(Ch) As String
   ' Return the Uppercase for a given vowel or dd
   Dim Pos  ' Position of character in Unicode vowel list
   ' Locate the character in list of Unicode vowels
   Pos = InStr(UVowels, Ch)
   If (Pos > 67) Then
      UpperUniChar = Ch  ' It's already uppercase - leave it alone
   ElseIf (Pos > 0) Then
      ' It's a Lowercase Unicode Vowel - so get the corresponding Uppercase vowel in the list
      UpperUniChar = Mid(UVowels, Pos + 67, 1)
   Else
      ' It's just a normal ANSI character
      UpperUniChar = UCase(Ch)
   End If
End Function

Function ToUniDecimal(UniString As String) As String
   ' Return the HTML equivalent string of a Unicode string
   Dim i As Integer  ' Must declare as integer for CopyMemory to work
   Dim TLen, TStr
   Dim b1 As Byte
   Dim b2 As Byte
   Dim UTF16 As Long
   TLen = Len(UniString)  ' Get Length of input Unicode string
   If TLen = 0 Then Exit Function  ' Get out if null string
   ' Iterate through each character in the string
   For i = 1 To TLen
      If IsUniChar(Mid(UniString, i, 1)) Then
         ' Cast the String character to 2 bytes
         CopyMemory b1, ByVal StrPtr(UniString) + ((i - 1) * 2), 1
         CopyMemory b2, ByVal StrPtr(UniString) + ((i - 1) * 2) + 1, 1
         ' Combine the 2 bytes into the Unicode UTF-16
         UTF16 = b2  ' assign b2 to UTF16 before multiplying by 256 to avoid overflow
         UTF16 = UTF16 * 256 + b1
         ' Convert UTF-16 to format ✏ for HTML
         TStr = TStr & "&#" & Trim(CStr(UTF16)) & ";"
      Else
         ' Get here if it;s an ANSI character
         TStr = TStr & Mid(UniString, i, 1)
      End If
   Next
   ToUniDecimal = TStr  ' Return the HTML string
End Function

Public Function ReadTextFile(FileName) As String 
   ' Write a Unicode String to UTF-16LE Text file
   ' Remember to Project | References "Microsoft Scripting Runtime" to support
   ' FileSystemObject & TextStream
   Dim Fs As FileSystemObject 
   Dim TS As TextStream 
   ' Create a FileSystem Object
   Set Fs = CreateObject("Scripting.FileSystemObject") 
   ' Open TextStream for Input.
   ' TriStateTrue means Read Unicode UTF-16LE
   Set TS = Fs.OpenTextFile(FileName, ForReading, False, TristateTrue) 
   ReadTextFile = TS.ReadAll  ' Read the whole content of the text file in one stroke
   TS.Close  ' Close the Text Stream
   Set Fs = Nothing  ' Dispose FileSystem Object
End Function
 
Public Sub WriteTextFile(FileName, StrOutText) 
   ' Read a Unicode String from UTF-16LE Text file
   ' Remember to Project | References "Microsoft Scripting Runtime" to support
   ' FileSystemObject & TextStream
   Dim Fs As FileSystemObject 
   Dim TS As TextStream 
   ' Create a FileSystem Object
   Set Fs = CreateObject("Scripting.FileSystemObject") 
   ' Open TextStream for Output, create file if necesssary
   ' TriStateTrue means Write Unicode UTF-16LE
   Set TS = Fs.OpenTextFile(FileName, ForWriting, True, TristateTrue) 
   TS.Write StrOutText  ' Write the whole StrOutText string in one stroke
   TS.Close  ' Close the Text Stream
   Set Fs = Nothing  ' Dispose FileSystem Object
End Sub

Dim MyUnicodeText As clsUnicodeText 
Set MyUnicodeText = New clsUnicodeText 
' Read Unicode Text from file txtFileName and display in TextBox1  
TextBox1.Text = MyUnicodeText.ReadUnicode(txtFileName) 

Listing của Class clsUnicodeText như sau:

Option Explicit 
Private mDOMTextFile As DOMDocument 
Private mXMLPath As String 
Public Function ReadUnicode(TXMLPath) 
   Dim objTextFileRoot As IXMLDOMElement 
   Set mDOMTextFile = New DOMDocument 
   mXMLPath = TXMLPath 
   mDOMTextFile.Load mXMLPath 
   'start at the root element of the XML
   Set objTextFileRoot = mDOMTextFile.documentElement 
   ReadUnicode = objTextFileRoot.nodeTypedValue 
End Function 

Public Sub WriteUnicode(OutText, Optional TXMLPath) 
   Dim tDOMNode As IXMLDOMElement  ' Temporary Node for DOM
   If IsMissing(TXMLPath) Then 
      ' Save the information on the screen by creating a new element and add its children to the DOM object
      mDOMTextFile.documentElement.Text = OutText 
      ' Update the XML file
      mDOMTextFile.save mXMLPath 
   Else 
      Set mDOMTextFile = New DOMDocument 
      ' Create a Node called "Text" in DOM
      Set tDOMNode = mDOMTextFile.createElement("Text") 
      ' Make it the Root Node
      mDOMTextFile.appendChild tDOMNode 
      ' Assign Output Text to Root Node
      mDOMTextFile.documentElement.Text = OutText 
      ' Update the XML file
      mDOMTextFile.save TXMLPath 
   End If 
End Sub

Function UTF8ToUniStr(BArray) As String 
   ' Convert a byte stream of UTF-8 to Unicode String
   Dim i As Long 
   Dim TopIndex As Long 
   Dim TwoBytes(1) As Byte 
   Dim ThreeBytes(2) As Byte 
   Dim AByte As Byte 
   Dim TStr As String 
   TopIndex = UBound(BArray)  ' Number of bytes equal TopIndex+1
   If TopIndex = 0 Then Exit Function  ' get out if there's nothing to convert
   i = 0  ' Initialise pointer
   ' Iterate through the Byte Array
   Do While i <= TopIndex 
      AByte = BArray(i)  ' fetch a byte
      If AByte = &HE1 Then 
         ' Start of 3 byte UTF-8 group for a character
         ' Copy 3 byte to ThreeBytes
         ThreeBytes(0) = BArray(i): i = i + 1 
         ThreeBytes(1) = BArray(i): i = i + 1 
         ThreeBytes(2) = BArray(i): i = i + 1 
         ' Convert Byte array to UTF-16 then Unicode
         TStr = TStr & ChrW(ToUTF16(ThreeBytes)) 
      ElseIf (AByte >= &HC3) And (AByte <= &HC6) Then 
         ' Start of 2 byte UTF-8 group for a character
         TwoBytes(0) = BArray(i): i = i + 1 
         TwoBytes(1) = BArray(i): i = i + 1 
         ' Convert Byte array to UTF-16 then Unicode
         TStr = TStr & ChrW(ToUTF16(TwoBytes)) 
      Else 
         ' Normal ANSI character - use it as is
         TStr = TStr & Chr(AByte): i = i + 1  ' Increment byte array index
      End If 
   Loop 
   UTF8ToUniStr = TStr  ' Return the resultant string
End Function

void CADOTestDlg::Convert_String(BYTE *string_in, wchar_t *string_out)
{
	int i, scnt = strlen((char*)string_in);
	wchar_t unicode;
	i = 0;
	while (i <scnt) 
	{ // duyet tung byte
		if (0xc2<= string_in[i] && string_in[i] <= 0xe0 &&
		0x80<= string_in[i+1] && string_in[i+1] <= 0xbf)
		{
		// 2byte
		unicode = (string_in[i++] & 0x3f)<<6;
		unicode += (string_in[i++] & 0x3f);
		*string_out= unicode;
		}
		else 
			if (0xe0<= string_in[i] && string_in[i] <= 0xef &&
				0x80<= string_in[i+1] && string_in[i+1] <= 0xbf &&
				0x80<= string_in[i+2] && string_in[i+2] <= 0xbf) 
			{
			// 3byte
				unicode = (string_in[i++] & 0x0f)<<12;
				unicode += ((string_in[i++] & 0x3f)<<6);
				unicode += (string_in[i++] & 0x3f);
				*string_out = unicode;
			} 
			else 
				{ // 1byte
					*string_out = string_in[i++];
				}
				string_out++;
		}
		// chua ma ket thuc chuoi
	*string_out = 0;
}

_CommandPtr pCommand;

HRESULT hr = pCommand.CreateInstance (__uuidof (Command));
pCommand->ActiveConnection = m_pConn;
pCommand->CommandText = "Sxlect * From Student";
_RecordsetPtr pRecordset;

hr = pRecordset.CreateInstance (__uuidof (Recordset));
pRecordset->CursorLocation = adUseClient;
pRecordset->Open ((IDispatch *) pCommand, vtMissing, adOpenForwardOnly,adLockReadOnly, adCmdUnknown);
CString strContent;
m_ctrlList.ResetContent ();
wchar_t unicode_string[256];
while (!pRecordset->GetadoEOF ())
	{
	strContent = (char *) (_bstr_t) pRecordset->Fields->GetItem ("Name")->Value;
	strContent += " / " ;
	strContent += (char *) (_bstr_t) pRecordset->Fields->GetItem ("SocialSecNo")->Value;
	BYTE * temp=0;
	for(int i=0;i< strContent.GetLength() ;i++)
	{
		temp[i]=strContent.GetAt(i);
	}
	Convert_String(temp,unicode_string);
	m_ctrlList.SetItemData (m_ctrlList.AddString (unicode_string), (DWORD) pRecordset->Fields->GetItem ("StudentNo")->Value.lVal);
	Recordset->MoveNext ();
	}

pRecordset->Close ();

BYTE * temp=0;
 for(int i=0;i< strContent.GetLength() ;i++)
 {
 	temp[i]=strContent.GetAt(i);
 }

strContent = (char *) (_bstr_t) pRecordset->Fields->GetItem ("Name")->Value;

strContent = (LPCTSTR) (_bstr_t) pRecordset->Fields->GetItem ("Name")->Value;