form1.frm

有关vb编码转换的代码

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3075
   ClientLeft      =   60
   ClientTop       =   465
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3075
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   1560
      TabIndex        =   4
      Text            =   "Text2"
      Top             =   2640
      Width           =   1695
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1560
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   2160
      Width           =   1695
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   855
      Left            =   840
      TabIndex        =   0
      Top             =   840
      Width           =   1815
   End
   Begin VB.Label Label2 
      Caption         =   "GBK"
      Height          =   255
      Left            =   600
      TabIndex        =   3
      Top             =   2640
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "UTF8"
      Height          =   255
      Left            =   720
      TabIndex        =   1
      Top             =   2160
      Width           =   975
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
 Private Sub command1_click()
        Text1.Text = (UTF8EncodeURI("汉字"))
        Text2.Text = (GBKEncodeURI("汉字"))
    End Sub


    Function UTF8EncodeURI(szInput)
        Dim wch, uch, szRet
        Dim x
        Dim nAsc, nAsc2, nAsc3

        If szInput = "" Then
            UTF8EncodeURI = szInput
            Exit Function
        End If

        For x = 1 To Len(szInput)
            wch = Mid(szInput, x, 1)
            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
                    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

        UTF8EncodeURI = szRet
    End Function

    Function GBKEncodeURI(szInput)
        Dim i As Long
        Dim x() As Byte
        Dim szRet As String

        szRet = ""
        x = StrConv(szInput, vbFromUnicode)
        For i = LBound(x) To UBound(x)
            szRet = szRet & "%" & Hex(x(i))
        Next
        GBKEncodeURI = szRet
    End Function