<script language="VBScript"> 'http://www.linuxforum.net/books/UTF-8-Unicode.html Public Function UTF8EncodeChar(z) Dim c : c=AscW(z)'取UNICODE編碼 if c>0 And c<256 Then'Asc編碼直接返回 UTF8EncodeChar=z Exit Function End If If c<0 Then c=c + &H10000&'VBScript的Integer溢出，加上 Dim k : k=CLng(c)'備份一個編碼，后面判斷要用 Dim b() Dim i : i=0 While c>&H0&'將編碼按照6位一組，分組存到字節數組 b 中 ReDim Preserve b(i) b(i)=CByte(c And &H3F&) c=c / &H40& i=i+1 Wend If UBound(b)>0 Then '如果分開的6位組不止一個，除最高一組外，全部加上二進制10000000 For i=0 To UBound(b)-1 b(i)=b(i) + &H80 Next End If i=UBound(b)'根據字符的UNICODE編碼范圍，給最高組加上前綴 If k<=CLng(&H7F&) Then b(i) = b(i) + 0 ElseIf k<=CLng(&H7FF&) Then b(i) = b(i) + &HC0 ElseIf k<=Clng(&HFFFF&) Then b(i) = b(i) + &HE0 ElseIf k<=CLng(&H1FFFFF&) Then b(i) = b(i) + &HF0 ElseIf k<=CLng(&H3FFFFFF&) Then b(i) = b(i) + &HF8 Else b(i) = b(i) + &HFC End If UTF8EncodeChar="" For i=UBound(b) To 0 Step -1'將分組轉換成URL編碼 UTF8EncodeChar=UTF8EncodeChar & "%" & Right("00" & Hex(b(i)),2) Next Erase b End Function Public Function UTF8EncodeString(s) Dim i,l,c : l=Len(s) For i=1 To l UTF8EncodeString=UTF8EncodeString & UTF8EncodeChar(Mid(s,i,1)) Next End Function MsgBox UTF8EncodeString("圪圪 eglic ") </script>
