求救:我的软件中需要把文本转换为UTF8 的URL 编码  下下面这个函数能实现,但是数据量大的时候非常慢!有没有大虾能优化这个代码的算法或者有更好的算法!谢谢
   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

解决方案 »

  1.   

         Public Function URLEncode(strInput As String) As String 
         Dim strOutput As String 
         Dim intAscii As Integer 
         Dim i As Integer 
         
         
         For i = 1 To Len(strInput) 
         intAscii = Asc(Mid(strInput, i, 1)) 
         If ((intAscii < 58) And (intAscii > 47)) Or _ 
         ((intAscii < 91) And (intAscii > 64)) Or _ 
         ((intAscii < 123) And (intAscii > 96)) Then 
         strOutput = strOutput & Chr$(intAscii) 
         Else 
         strOutput = strOutput & _ 
         IIf(intAscii < 16, "%0", "%") & _ 
         Trim$(Hex$(intAscii)) 
         End If 
         Next 
         URLEncode = strOutput 
         End Function 
      

  2.   

    Function UrlEncode(ByVal urlText As String) As String
    Dim i As Long
    Dim ansi() As Byte
    Dim ascii As Integer
    Dim encText As String ansi = StrConv(urlText, vbFromUnicode) encText = ""
         For i = 0 To UBound(ansi)
    ascii = ansi(i) Select Case ascii
    Case 48 To 57, 65 To 90, 97 To 122
    encText = encText & chr(ascii) Case 32
    encText = encText & "+" Case Else
    If ascii < 16 Then
    encText = encText & "%0" & Hex(ascii)
    Else
    encText = encText & "%" & Hex(ascii)
    End If End Select
    Next  i
        
    UrlEncode = encText
    End Function
      

  3.   

    不好意思,看错你的要求了看了你的代码,速度慢很可能是因为字符串连接造成的。
    在VB里,两个很长的字符串连接非常耗费时间,为了优化你的代码,你需要模仿.NET实现一个StringBuilder类,思路是:
    使用一个私有变量保存字符串值,另一个私有变量保存追加字符串的缓存。提供如下方法:Append(string) 用来追加字符串
    GetString,返回字符串。内部实现大致代码:private m_buffer As String '缓存
    private m_data As StringSub Append(string s)
        If len(m_buffer) < 500 Then '假设缓存500个字符,这个可以根据性能调整
             m_buffer = m_buffer & s
        Else
            m_data = m_data & m_buffer
            m_buffer = s
        End If
    End SubSub GetString()
        m_data = m_data & m_buffer
        m_buffer = ""
        GetString = m_data
    End If
      

  4.   

    Option Explicit    
    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 Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)   
      
    Public Function UTF8_Encode(ByVal strUnicode As String) As Byte()   
    'UTF-8 编码   
      
        Dim TLen As Long  
        Dim lngBufferSize As Long  
        Dim lngResult As Long  
        Dim bytUtf8() As Byte  
           
        TLen = Len(strUnicode)   
        If TLen = 0 Then Exit Function  
           
        lngBufferSize = TLen * 3 + 1   
        ReDim bytUtf8(lngBufferSize - 1)   
           
        lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), TLen, bytUtf8(0), lngBufferSize, vbNullString, 0)   
           
        If lngResult <> 0 Then  
            lngResult = lngResult - 1   
            ReDim Preserve bytUtf8(lngResult)   
        End If  
           
        UTF8_Encode = bytUtf8   
    End Function  
      
    Public Function UTF8_Decode(ByRef bUTF8() As Byte) As String  
    'UTF-8 解码   
        Dim lRet As Long  
        Dim lLen As Long  
        Dim lBufferSize As Long  
        Dim sBuffer As String  
        Dim bBuffer() As Byte  
           
        lLen = UBound(bUTF8) + 1   
           
        If lLen = 0 Then Exit Function  
           
        lBufferSize = lLen * 2   
           
        sBuffer = String$(lBufferSize, Chr(0))   
           
        lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(bUTF8(0)), lLen, StrPtr(sBuffer), lBufferSize)   
           
        If lRet <> 0 Then  
            sBuffer = Left(sBuffer, lRet)   
        End If  
           
        UTF8_Decode = sBuffer   
    End Function  
      
    Public Function CreateStringFromByte(ByRef byteArray() As Byte, ByVal ByteLength As Long) As String  
    '字节数组中的数据连接成字符串   
      
        Dim StringData As String  
           
        '** 分配字符串空间   
        StringData = Space(ByteLength)   
        '** 复制字符数组地址内容到字符串地址   
        MoveMemory ByVal StringData, ByVal VarPtr(byteArray(0)), ByteLength   
           
        '** 返回字符串   
        CreateStringFromByte = StringData   
    End Function  
      
    Public Function SaveStringToByteArry(ByRef strString As String) As Byte()   
    '把字符串存入字节数组   
           
        Dim BytArray() As Byte, lngStrLen As Long  
           
        '** 获取字符串的长度(字节)   
        lngStrLen = LenB(StrConv(strString, vbFromUnicode))   
           
        '** 分配数组空间   
        ReDim BytArray(lngStrLen - 1)   
      
        '** 将字符串地址中的内容拷贝到数组   
        MoveMemory ByVal VarPtr(BytArray(0)), ByVal strString, lngStrLen   
           
        SaveStringToByteArry = BytArray   
    End FunctionUTF8编解码
      

  5.   

    用 API 应该比较方便。
    Ding...........^_^
      

  6.   

    哈哈  我已经找到方法了  ,我的数据量比较大,我用导出文本文件 然后用zip压缩 然后上传解压,就不用编码了