我看到一篇文章如下，谁有现成的unicode字符串转换成UTF-8字符串的函数，谢谢 --UTF-8是和Unicode一一对应的，其实现很简单
--
-- 7位的Unicode: 0 _ _ _ _ _ _ _
--11位的Unicode: 1 1 0 _ _ _ _ _ 1 0 _ _ _ _ _ _
--16位的Unicode: 1 1 1 0 _ _ _ _ 1 0 _ _ _ _ _ _ 1 0 _ _ _ _ _ _
--21位的Unicode: 1 1 1 1 0 _ _ _ 1 0 _ _ _ _ _ _ 1 0 _ _ _ _ _ _ 1 0 _ _ _ _ _ _
--大多数情况是只使用到16位以下的Unicode:
--"你"的gb码是：0xC4E3 ,unicode是0x4F60
--我们还是用上面的例子
-- --例１：0xC4E3的二进制：
-- -- 1 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1
-- -- 由于只有两位我们按照两位的编码来排，但是我们发现这行不通，
-- -- 因为第７位不是0因此，返回"?"
-- --
-- --例２：0x4F60的二进制：
-- -- 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 0
-- -- 我们用UTF-8补齐，变成：
-- -- 11100100 10111101 10100000
-- -- E4--BD-- A0
-- -- 于是返回0xE4,0xBD,0xA0
我也看到有关这方面的资料,nchar等在win2000里是unicode类型。
我看到某单位的ERP数据库，打开后全是乱码，问了问说是用的阿拉伯语的原因。由于我对这一块一点也不了解。我也想把我的数据库设成阿拉伯语，但我怎么设置，数据库里的数据也不是乱码。
WideCharToMultiByte
可以实现
Charset = "UTF-8"
strmIn.LoadFromFile
strmOut.SaveToFile
Option Explicit
Sub Command1_Click()
Dim strData As String
Dim strPass As String
Dim strURL As String
Dim v As Variant, i As Long
Dim b() As Byte
strURL = "http://cosmo.mm.com/GW/invokeAction?u8&Action=DesktopTask&Class=doc.Document&Task=Create&File="
'Created from the byte dumps you posted.
v = Array(67, 0, 58, 0, 92, 0, 84, 0, 69, 0, 77, 0, 80, 0, 92, 0, 176, 101, 143, 137, 50, 0, 46, _
0, 100, 0, 111, 0, 99, 0)
ReDim b(0 To UBound(v))
For i = 0 To UBound(v)
b(i) = v(i)
Next
'Uncomment next line to test
'strPass = ActiveDocument.FullName
strURL = fUTFEncodedURL(b)
End SubPublic Function fUTFEncodedURL(bFile() As Byte) As Variant Dim bData() As Byte
Dim strData As String
Dim strURL As String
Dim v As Variant
Dim i As Long
strURL = "http://cosmo.mm.com/GW/invokeAction?u8&Action=DesktopTask&" & _
"Class=doc.Document&Task=Create&File="
v = WideCharToUTF8(bFile)
ReDim bData(LBound(v) To UBound(v))
For i = LBound(v) To UBound(v)
bData(i) = v(i)
Next
strData = fURLEncode(bData)
strURL = strURL & strData
Debug.Print strURL
fUTFEncodedURL = strURLEnd Function
Public Function WideCharToUTF8(bToEncode() As Byte) As Variant Dim b() As Byte
Dim bRet() As Byte
Dim lngW As Long 'long to avoid signed integer.
Dim i As Long, j As Long
Dim lngByteCount As Long
Dim lngLastPointer As Long
lngLastPointer = 1
For i = 0 To UBound(bToEncode) - 1 Step 2
lngW = bToEncode(i + 1) * CLng(256) + bToEncode(i)
' Debug.Print lngW
If lngW < &H80 Then
lngByteCount = lngByteCount + 1
ReDim Preserve bRet(1 To lngByteCount)
bRet(lngByteCount) = CByte(lngW)
lngLastPointer = lngByteCount + 1
ElseIf lngW < &H800 Then
lngByteCount = lngByteCount + 2
ReDim Preserve bRet(1 To lngByteCount)
bRet(lngLastPointer) = &HC0 Or ShiftRight(lngW, 6)
bRet(lngLastPointer + 1) = &H80 Or lngW And &H3F
lngLastPointer = lngByteCount + 1
ElseIf lngW < &H10000 Then
lngByteCount = lngByteCount + 3
ReDim Preserve bRet(1 To lngByteCount)
bRet(lngLastPointer) = &HE0 Or ShiftRight(lngW, 12)
bRet(lngLastPointer + 1) = &H80 Or ShiftRight(lngW, 6) And &H3F
bRet(lngLastPointer + 2) = &H80 Or lngW And &H3F
lngLastPointer = lngByteCount + 1
ElseIf lngW < &H200000 Then
lngByteCount = lngByteCount + 4
ReDim Preserve bRet(1 To lngByteCount)
bRet(lngLastPointer) = &HF0 Or ShiftRight(lngW, 18)
bRet(lngLastPointer + 1) = &H80 Or ShiftRight(lngW, 12) And &H3F
bRet(lngLastPointer + 2) = &H80 Or ShiftRight(lngW, 6) And &H3F
bRet(lngLastPointer + 3) = &H80 Or lngW And &H3F
lngLastPointer = lngByteCount + 1 End If
Next
WideCharToUTF8 = bRet
End Function
Function ShiftLeft(ByVal value As Long, ByVal times As Long) As Long
' we need to create a mask of 1's corresponding to the
' times in VALUE that will be retained in the result
Dim mask As Long, signBit As Long
' return zero if too many times
If times >= 32 Then Exit Function
' return the value if zero times
If times = 0 Then ShiftLeft = value: Exit Function
' this extracts the bit in Value that will become the sign bit
mask = Power2(31 - times)
' this calculates the sign bit of the result
signBit = CBool(value And mask) And &H80000000
' this clears all the most significant times,
' that would be lost anyway, and also clears the sign bit
value = value And (mask - 1)
' do the shift to the left, without risking an overflow
' and then add the sign bit
ShiftLeft = (value * Power2(times)) Or signBit
End FunctionFunction ShiftRight(ByVal value As Long, ByVal times As Long) As Long
' we need to create a mask of 1's corresponding to the
' digits in VALUE that will be retained in the result
Dim mask As Long, signBit As Long
' return zero if too many times
If times >= 32 Then Exit Function
' return the value if zero times
If times = 0 Then ShiftRight = value: Exit Function
' evaluate the sign bit in advance
signBit = (value < 0) And Power2(31 - times)
' create a mask with 1's for the digits that will be preserved
If times < 31 Then
' if times=31 then the mask is zero
mask = Not (Power2(times) - 1)
End If
' clear all the digits that will be discarded, and
' also clear the sign bit
value = (value And &H7FFFFFFF) And mask
' do the shift, without any problem, and add the sign bit
ShiftRight = (value \ Power2(times)) Or signBit
End Function
Function Power2(ByVal exponent As Long) As Long
Static res(0 To 31) As Long
Dim i As Long
' rule out errors
If exponent < 0 Or exponent > 31 Then Err.Raise 5
' initialize the array at the first call
If res(0) = 0 Then
res(0) = 1
For i = 1 To 30
res(i) = res(i - 1) * 2
Next
' this is a special case
res(31) = &H80000000
End If
' return the result
Power2 = res(exponent)
End FunctionPublic Function fURLEncode(strtoencode() As Byte) As String
Dim strTemp As String
Dim lngLen As Long
Dim intASC As Integer
Dim i As Long
For i = LBound(strtoencode) To UBound(strtoencode)
intASC = strtoencode(i)
'Is the character in the list of valid chars? Use alphanumerics only to be very very safe.
If InStr(1, "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ", Chr(intASC)) Then
'$-_.!*'(),
strTemp = strTemp & Chr(intASC)
Else
If intASC < 16 Then
strTemp = strTemp & "%0" & Hex(intASC)
Else
strTemp = strTemp & "%" & Hex(intASC)
End If
End If
Next i
fURLEncode = strTempEnd Function