VB6
VB6代碼示例
Attribute VB_Name = "UTF8"
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Const CP_UTF8 = 65001
Private Const CP_ACP As Long = 0
'接口類型：達信通語音通知接口。
'賬戶注冊：請通過該地址開通賬戶http://sms.wx96.com/register.html
'注意事項：
'（1）調試期間，請仔細閱讀接口文檔；
'（2）請使用APIID（查看APIID請登錄用戶中心->語音通知->帳戶及簽名設置->APIID）及 APIkey來調用接口
'（3）該代碼僅供接入達信通語音通知接口參考使用，客戶可根據實際需要自行編寫；
Public Function toUTF8(szInput)
Dim wch, uch, szRet
Dim x
Dim nAsc, nAsc2, nAsc3
'如果輸入參數為空，則退出函數
If szInput = "" Then
toUTF8 = szInput
Exit Function
End If
'開始轉換
For x = 1 To Len(szInput)
'利用mid函數分拆GB編碼文字
wch = Mid(szInput, x, 1)
'利用ascW函數返回每一個GB編碼文字的Unicode字符代碼
'注：asc函數返回的是ANSI 字符代碼，注意區別
nAsc = AscW(wch)
If nAsc < 0 Then nAsc = nAsc + 65536
If (nAsc And &HFF80) = 0 Then
szRet = szRet & wch
Else
If (nAsc And &HF000) = 0 Then
uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
Else
'GB編碼文字的Unicode字符代碼在0800 - FFFF之間采用三字節模版
uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
End If
End If
Next
toUTF8 = szRet
toUTF8 = Replace(toUTF8, Chr(13) + Chr(10), "%0D%0A")
toUTF8 = Replace(toUTF8, " ", "%20")
toUTF8 = Replace(toUTF8, "+", "%2B")
End Function
Public Function Utf8ToUnicode(ByRef Utf() As Byte) As String
Dim lRet As Long
Dim lLength As Long
Dim lBufferSize As Long
lLength = UBound(Utf) - LBound(Utf) + 1
If lLength <= 0 Then Exit Function
lBufferSize = lLength * 2
Utf8ToUnicode = String$(lBufferSize, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(Utf(0)), lLength, StrPtr(Utf8ToUnicode), lBufferSize)
If lRet <> 0 Then
Utf8ToUnicode = Left(Utf8ToUnicode, lRet)
End If
End Function
Public Function URLEncode(vstrIn)
strReturn = ""
Dim i
For i = 1 To Len(vstrIn)
ThisChr = Mid(vstrIn, i, 1)
If Abs(Asc(ThisChr)) < &HFF Then
strReturn = strReturn & ThisChr
Else
innerCode = Asc(ThisChr)
If innerCode < 0 Then
innerCode = innerCode + &H10000
End If
Hight8 = (innerCode And &HFF00) \ &HFF
Low8 = innerCode And &HFF
strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
strReturn = Replace(strReturn, Chr(32), "%20")
strReturn = Replace(strReturn, "+", "%2B")
strReturn = Replace(strReturn, " ", "+")
strReturn = Replace(strReturn, vbCrLf, "%0D%0A")
strReturn = Replace(strReturn, "#", "%23")
URLEncode = strReturn
End Function
