//将picturebox中的文件保存到c:\aa.bmp
SavePicture picMain.Image, "c:\aa.bmp"  
//取得c:\aa.bmp文件的base64编码
getSMData = getBase64("c:\aa.bmp")运行时,cpu使用100% 并且时间较长!
请教高手,能不能部保存文件,或优化代码,多谢

解决方案 »

  1.   

    Private Function Base64_EncodeBin(byteSource) As String
        Dim BASE64_TABLE(1 To 64) As Byte  
        Dim j As Double
        Dim m As Double
        Dim n As Double
        Dim num As Double
        Dim intPos As Double
        Dim BASE64_STR As String
        Dim a() As Byte
        
        BASE64_STR = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
        
        For j = 1 To 64
            BASE64_TABLE(j) = Asc(Mid(BASE64_STR, j, 1))
        Next
        
        n = (UBound(byteSource) - UBound(byteSource) Mod 3)
        num = (n \ 3) * 4
        
        m = 0
        intPos = 0
        
        ReDim a(1 To num) As Byte
        
        For j = 0 To n - 1 Step 3
            m = m + 1
            a(m) = BASE64_TABLE((byteSource(j) \ 4) + 1)
            
            m = m + 1
            a(m) = BASE64_TABLE(((byteSource(j) Mod 4) * 16 + byteSource(j + 1) \ 16) + 1)
            
            m = m + 1
            a(m) = BASE64_TABLE(((byteSource(j + 1) Mod 16) * 4 + byteSource(j + 2) \ 64) + 1)
            
            m = m + 1
            a(m) = BASE64_TABLE((byteSource(j + 2) Mod 64) + 1)
            
            intPos = intPos + 4        If (intPos Mod 76) = 0 Then
               num = num + 2
               ReDim Preserve a(1 To num) As Byte
               m = m + 1
               a(m) = Asc(vbCr)
               m = m + 1
               a(m) = Asc(vbLf)
            End If
            
            DoEvents
            
        Next j
        
        If Not (UBound(byteSource) Mod 3) = 0 Then
             If (UBound(byteSource) Mod 3) = 2 Then
                num = num + 4
                ReDim Preserve a(1 To num) As Byte
                m = m + 1
                a(m) = BASE64_TABLE((byteSource(j) \ 4) + 1)
                If m Mod 76 = 0 Then
                    num = num + 2
                    ReDim Preserve a(1 To num) As Byte
                    m = m + 1
                    a(m) = Asc(vbCr)
                    m = m + 1
                    a(m) = Asc(vbLf)
                End If
                m = m + 1
                a(m) = BASE64_TABLE((byteSource(j) Mod 4) * 16 + byteSource(j + 1) \ 16 + 1)
                If m Mod 76 = 0 Then
                    num = num + 2
                    ReDim Preserve a(1 To num) As Byte
                    m = m + 1
                    a(m) = Asc(vbCr)
                    m = m + 1
                    a(m) = Asc(vbLf)
                End If
                m = m + 1
                a(m) = BASE64_TABLE((byteSource(j + 1) Mod 16) * 4 + 1)
                If m Mod 76 = 0 Then
                    num = num + 2
                    ReDim Preserve a(1 To num) As Byte
                    m = m + 1
                    a(m) = Asc(vbCr)
                    m = m + 1
                    a(m) = Asc(vbLf)
                End If
                m = m + 1
                a(m) = Asc("=")
             ElseIf (UBound(byteSource) Mod 3) = 1 Then
                num = num + 3
                ReDim Preserve a(1 To num) As Byte
                m = m + 1
                a(m) = BASE64_TABLE(byteSource(j) \ 4 + 1)
                If m Mod 76 = 0 Then
                    num = num + 2
                    ReDim Preserve a(1 To num) As Byte
                    m = m + 1
                    a(m) = Asc(vbCr)
                    m = m + 1
                    a(m) = Asc(vbLf)
                End If
                m = m + 1
                a(m) = BASE64_TABLE((byteSource(j) Mod 4) * 16 + 1)
                If m Mod 76 = 0 Then
                    num = num + 2
                    ReDim Preserve a(1 To num) As Byte
                    m = m + 1
                    a(m) = Asc(vbCr)
                    m = m + 1
                    a(m) = Asc(vbLf)
                End If
                m = m + 1
                a(m) = Asc("==")
             End If
        End If
        ReDim Preserve a(1 To m) As Byte     
        Base64_EncodeBin = StrConv(a, vbUnicode)
        
    End Function