请高手代为编码utf8。gb2312转utf8有没有？utf8转gb2312倒是有，如何反过来呀

Question

我有一个utf8转gb2312的，支持中文，可是要这么多函数，有没有精简版的
如何反过来编gb2312 转utf8呀？
Function gbtoutf80(Salon)
'这个还不对，
  Dim i
  Dim Salon_one
  Dim Salon_unicode
  For i = 1 To Len(Salon)
      Salon_one = Mid(Salon, i, 1)
      Salon_unicode = Salon_unicode & Chr(38)
      Salon_unicode = Salon_unicode & Chr(35)
      Salon_unicode = Salon_unicode & Chr(120)
      Salon_unicode = Salon_unicode & Hex(AscW(Salon_one))
      Salon_unicode = Salon_unicode & Chr(59)
   Next
   gbtoutf80 = Salon_unicode
End Function
Function gbtoutf8()
Dim aa
End Function
'已测试
Function utf8togb(utfstr)
Dim str
str = utfstr
Do
If InStr(str, "%E") > 0 Then
Dim a, b, c As Integer
a = InStr(str, "%E")
b = InStr(a + 1, str, "%")
c = InStr(b + 1, str, "%")
If c > 0 And b = a + 3 And c = a + 6 Then
'MsgBox U8toU(Mid(str, a + 1, 8)) & Chr(13) & Chr(13) & Chr(13) & Chr(13) & Chr(13) & Chr(13) & Chr(13) & Chr(13)
Mid(str, a, 9) = U8toU(Mid(str, a + 1, 8)) & Chr(13) & Chr(13) & Chr(13) & Chr(13) & Chr(13) & Chr(13) & Chr(13) & Chr(13)
str = Replace(str, Chr(13), "")
utf8togb = str
Else
Exit Do
End If
Else
Exit Do
End If
Loop
End Function
Function getutf8(x)
'结果为:%E4%B8%AD%E5%9B%BD,前面有%
        '这个函数是用来得到%号的部分，
        '输入条件是""http://www.google.com/search?hl=en&ie=UTF-8&oe=UTF-8&q=%E4%B8%AD%E5%9B%BD&btnG=Google+Search"
        Dim a, b
        a = Split(x, "&") '定义一个临时数组
        Dim i: i = 0 '临时的指针
        For i = 0 To UBound(a)
            If InStr(a(i), "%") > 0 Then
            b = Split(a(i), "=") '靠！再定义一个临时数组，省事，浪费内存比浪费我的生命强
            getutf8 = b(1)
            Exit For
            End If
        Next
        'getutf8 = Right(getutf8, Len(getutf8) - 1) '去掉左边的%
End Function
Function U8toU(x)
'x像E4%B8%AD,前面无%
Dim a
        '输入一堆有%分隔的字符串，先分成数组，根据utf8规则来判断补齐规则
        '输入:关 E5 85 B3  键  E9 94 AE 字   E5 AD 97
        '输出:关 B9D8  键  BCFC 字   D7D6
        Dim WeiS '要判断第一个编码的位数
        Dim Unicode '二进制的Unicode码
        Dim alpha '定义单个字符
        a = Split(x, "%") '定义一个临时数组
        Dim i: i = 0 '临时的指针
        Dim j: j = 0 '临时的指针
        
        For i = 0 To UBound(a)
            a(i) = c16to2(a(i)) '第一次循环，先转换成2进制再说
        Next
        
        For i = 0 To UBound(a) - 1
                WeiS = InStr(a(i), "0") '判断第一次出现0的位置，
                '可能是1(单字节)，3(3-1字节)，4，5，6，7不可能是2和大于7
                '理论上到7，实际不会超过3。
                
                Unicode = ""
                For j = 1 To WeiS - 1
                    If j = 1 Then
                        a(i) = Right(a(i), Len(a(i)) - WeiS) '第一个去掉最左边的WeiS个
                        Unicode = Unicode & a(i)
                        
                    Else
                        i = i + 1
                        a(i) = Right(a(i), Len(a(i)) - 2) '其余去掉最左边的两个
                        Unicode = Unicode & a(i)
                    End If
                    
                Next
                U8toU = U8toU & ChrW(Int("&H" & c2to16(Unicode))) '总算完了,妈的！！
        Next
End Function
Function c16to2(x)
    '这个函数是用来转换16进制到2进制的，可以是任何长度的，一般转换UTF-8的时候是两个长度，比如A9
    '比如：输入“C2”，转化成“11000010”,其中1100是"c"是10进制的12（1100），那么2（10）不足4位要补齐成（0010）。
    Dim tempstr
    Dim i: i = 0 '临时的指针
    For i = 1 To Len(Trim(x))
        tempstr = c10to2(CInt(Int("&h" & Mid(x, i, 1))))
        Do While Len(tempstr) < 4
            tempstr = "0" & tempstr '如果不足4位那么补齐4位数
        Loop
        c16to2 = c16to2 & tempstr
    Next
End Function
Function c2to16(x)
        '2进制到16进制的转换，每4个0或1转换成一个16进制字母，输入长度当然不可能不是4的倍数了
            
        Dim i: i = 1 '临时的指针
        For i = 1 To Len(x) Step 4
            c2to16 = c2to16 & Hex(c2to10(Mid(x, i, 4)))
        Next
End Function
Function c2to10(x)
        '单纯的2进制到10进制的转换，不考虑转16进制所需要的4位前零补齐。
        '因为这个函数很有用！以后也会用到，做过通讯和硬件的人应该知道。
        '这里用字符串代表二进制
            Dim mysign: mysign = Sgn(CInt(x)) '定义mysign这个东西，首先判断正负符号
            x = Abs(CInt(Int(x)))
            c2to10 = 0
            If x = "0" Then Exit Function '如果是0的话直接得0就完事
            Dim i: i = 0 '临时的指针
            For i = 0 To Len(x) - 1 '否则利用8421码计算，这个从我最开始学计算机的时候就会，好怀念当初教我们的谢道建老先生啊！
                If Mid(x, Len(x) - i, 1) = "1" Then c2to10 = c2to10 + 2 ^ (i)
            Next
            If mysign = -1 Then c2to10 = -1 * c2to10 '加上正负符号
End Function
Function c10to2(x) '10进制到2进制的转换
    '这个函数在计算16位到2位转换时候用到了，
    '没有做在16位里面是因为这个函数只是单纯10-2转换，不涉及16进制由4个2进制补齐空位，将来可以用到任何地方
    '比如输入2，输出“10”而不是“0010”
    '首先判断正负符号
    Dim mysign: mysign = Sgn(x) '定义一个符号标记
        x = Abs(x)
        '然后判断有几位,至少一位
        Dim WeiS: WeiS = 1
        Do
            If x < 2 ^ WeiS Then
                Exit Do
            Else
                WeiS = WeiS + 1
            End If
        Loop
        Dim tempnum: tempnum = x '定义一个临时的数字
        Dim i: i = 0 '临时的指针
        For i = WeiS To 1 Step -1
            If tempnum >= 2 ^ (i - 1) Then
                tempnum = tempnum - 2 ^ (i - 1)
                c10to2 = c10to2 & "1"
            Else
                c10to2 = c10to2 & "0"
            End If
        Next
    If mysign = -1 Then c10to2 = "-" & c10to2 '加上正负符号
End Function

Answer 1

vb如何做？
PHP:GB码转换成UTF 
    很早以前找到一个把GB码转化为UTF-8的函数，配合一个GB到UNICODE的对照表（gb2312.txt），用于在GD中输出汉字。后来发现在欲输出的内容中含有西文字符时，会出现混乱。后来找到了修改后的代码，解决了问题。现将两个函数做一对比分析如下。首先，这是一个UNICODE到UTF-8编码转换的函数，这一部分修改前后没有变化：
function u2utf8($c)
{
for($i=0;$i<count($c);$i++)
$str="";
if ($c < 0x80) {
$str.=$c;
}
else if ($c < 0x800) {
$str.=(0xC0 | $c>>6);
$str.=(0x80 | $c & 0x3F);
}
else if ($c < 0x10000) {
$str.=(0xE0 | $c>>12);
$str.=(0x80 | $c>>6 & 0x3F);
$str.=(0x80 | $c & 0x3F);
}
else if ($c < 0x200000) {
$str.=(0xF0 | $c>>18);
$str.=(0x80 | $c>>12 & 0x3F);
$str.=(0x80 | $c>>6 & 0x3F);
$str.=(0x80 | $c & 0x3F);
}
return $str;
}这里完全是按照UTF-8编码的规则，通过判断字符属于不同的UNICODE编码段范围，进行不同的移位和位与操作，以转化为UTF-8编码。关于该规则可参考http://www.utf8.org/上的说明。这是修改前的GB转化为UTF-8编码的函数，其中调用了上面的u2utf8函数。
function gb2utf8($gb)     /* Program writen by sadly www.phpx.com  */
{
if(!trim($gb))
return $gb;
$filename="gb2312.txt";
$tmp=file($filename);
$codetable=array();
while(list($key,$value)=each($tmp))
$codetable[hexdec(substr($value,0,6))]=substr($value,7,6);
$utf8="";
while($gb)
{
if (ord(substr($gb,0,1))>127)
{
$this=substr($gb,0,2);
$gb=substr($gb,2,strlen($gb));
$utf8.=u2utf8(hexdec($codetable[hexdec(bin2hex($this))-0x8080]));
}
else
{
$gb=substr($gb,1,strlen($gb));
$utf8.=u2utf8(substr($gb,0,1));
}
}$ret="";
for($i=0;$i<strlen($utf8);$i+=3)
$ret.=chr(substr($utf8,$i,3));return $ret;
}
函数中while循环部分，把汉字逐个按照“对照表”转化为UNICODE，再通过u2utf8函数转化为UTF-8。但从中可以看出，while循环结束后，又用一个for循环，把每三个字节合成了一个UTF-8字符（见http://www.utf8.org/上的规则说明，每个汉字的UTF-8编码为三字节），没有考虑到其中的西文字符（西文字符的UTF-8编码为一字节）。所以，如果欲输出的内容中不论是开始时出现西文字符，或是汉字当中穿插西文字符，转化为UTF-8后，都会被按照“每三个字节截取”的方式截开，导致乱码。
以下是修改后的函数：
function gb2utf8($gb)    /* Program writen by sadly   modified by agun */
{
if(!trim($gb))
return $gb;
$filename="gb2312.txt";
$tmp=file($filename);
$codetable=array();
while(list($key,$value)=each($tmp))
$codetable[hexdec(substr($value,0,6))]=substr($value,7,6);$ret="";
$utf8="";
while($gb)
{
if (ord(substr($gb,0,1))>127)
{
$this=substr($gb,0,2);
$gb=substr($gb,2,strlen($gb));
$utf8=u2utf8(hexdec($codetable[hexdec(bin2hex($this))-0x8080]));
for($i=0;$i<strlen($utf8);$i+=3)
$ret.=chr(substr($utf8,$i,3));
}
else
{
$ret.=substr($gb,0,1);
$gb=substr($gb,1,strlen($gb));
}
}
return $ret;
}修改后的函数将 GB转化为UNICODE、UNICODE转化为UTF-8、几个字节合成一个UTF-8字符，这三个步骤在一个循环里完成，尤其是几个字节合成一个UTF-8字符这一步骤，放在判断了字符属于西文还是属于汉字的条件分支里，据此决定截取一个字节还是三个字节。于是结果正确了！

Answer 2

直接用windows的api widechartomultibyte也可以
只用调用一个函数。

Answer 3

直接用windows的api widechartomultibyte也可以
只用调用一个函数。
============================================
Win9x系统不行。

Answer 4

'将字符串转换为UTF-8编码字符串
Public Function UTF8Encoding(ByRef szString As String) As String
       Dim szChar   As String
       Dim szTemp   As String
       Dim szCode   As String
       Dim szHex    As String
       Dim szBin    As String
       Dim iCount1  As Integer
       Dim iCount2  As Integer
       Dim iStrLen1 As Integer
       Dim iStrLen2 As Integer
       Dim lResult  As Long
       Dim lAscVal  As Long
       szString = Trim$(szString)
       iStrLen1 = Len(szString)
       For iCount1 = 1 To iStrLen1
           szChar = Mid$(szString, iCount1, 1)
           lAscVal = AscW(szChar)
           If lAscVal >= &H0 And lAscVal <= &HFF Then
              If (lAscVal >= &H30 And lAscVal <= &H39) Or _
                 (lAscVal >= &H41 And lAscVal <= &H5A) Or _
                 (lAscVal >= &H61 And lAscVal <= &H7A) Then
                 szCode = szCode & szChar
              Else
                 szCode = szCode & "%" & Hex(AscW(szChar))
              End If
           Else
              szHex = Hex(AscW(szChar))
              iStrLen2 = Len(szHex)
              For iCount2 = 1 To iStrLen2
                  szChar = Mid$(szHex, iCount2, 1)
                  Select Case szChar
                         Case Is = "0"
                              szBin = szBin & "0000"
                         Case Is = "1"
                              szBin = szBin & "0001"
                         Case Is = "2"
                              szBin = szBin & "0010"
                         Case Is = "3"
                              szBin = szBin & "0011"
                         Case Is = "4"
                              szBin = szBin & "0100"
                         Case Is = "5"
                              szBin = szBin & "0101"
                         Case Is = "6"
                              szBin = szBin & "0110"
                         Case Is = "7"
                              szBin = szBin & "0111"
                         Case Is = "8"
                              szBin = szBin & "1000"
                         Case Is = "9"
                              szBin = szBin & "1001"
                         Case Is = "A"
                              szBin = szBin & "1010"
                         Case Is = "B"
                              szBin = szBin & "1011"
                         Case Is = "C"
                              szBin = szBin & "1100"
                         Case Is = "D"
                              szBin = szBin & "1101"
                         Case Is = "E"
                              szBin = szBin & "1110"
                         Case Is = "F"
                              szBin = szBin & "1111"
                         Case Else
                  End Select
              Next iCount2
              szTemp = "1110" & Left$(szBin, 4) & "10" & Mid$(szBin, 5, 6) & "10" & Right$(szBin, 6)
              For iCount2 = 1 To 24
                  If Mid$(szTemp, iCount2, 1) = "1" Then
                     lResult = lResult + 1 * 2 ^ (24 - iCount2)
                  Else
                     lResult = lResult + 0 * 2 ^ (24 - iCount2)
                  End If
              Next iCount2
              szTemp = Hex(lResult)
              szCode = szCode & "%" & Left$(szTemp, 2) & "%" & Mid$(szTemp, 3, 2) & "%" & Right$(szTemp, 2)
           End If
           szBin = vbNullString
           lResult = 0
       Next iCount1
       UTF8Encoding = szCode
End Function

Answer 5

api widechartomultibyte
实际代码如何？