如何将图像从Picturebox(VB6中的图像)转换为String(Base64)?

时间:2016-11-21 02:25:40

标签: sql image vb6

早上好。

我在vb6中有一个程序,它有一个名为Image3的控件,现在让这个控件成为一个图像,我必须浏览一张图片,最好是.jpg文件因为我现在将它保存在我的SQL中我不会需要这样做,因为在不久的将来系统会变慢,因为肯定会保存很多图像。对我而言,最好的方法是将其转换为字符串,反之亦然。老实说,我不想问这个问题,因为它是可搜索的,我看到的代码适合它IO.MemoryStream我的问题是我无法在参考文献中看到它。现在我尝试下载一个新的,但VB6不接受它。

有人可以用这个照亮我吗?将图像转换为字符串的其他方法。

我这样做的原因是我将使用在我的select命令中转换为字符串的图像,因为内存流是图像的唯一性。

一般情况下,我不想再次上传相同的图片。

TYSM

1 个答案:

答案 0 :(得分:0)

已经完成了这个问题以及那些想要和我在这里完成相同的人的完整代码。

Private Sub Image3_DblClick()

CommonDialog1.InitDir = App.Path
CommonDialog1.FileName = ""
CommonDialog1.Filter = "Image files|*.jpg;"
CommonDialog1.DialogTitle = "All Picture Files"
CommonDialog1.ShowOpen

If CommonDialog1.FileName <> "" Then

        Dim arrImageByte() As Byte
        Dim bytBuf() As Byte
        Dim fNum As Integer
        Dim rs As New ADODB.Recordset
        Dim strPhotoPath As String
        Dim FileInputData As String
        Dim s As String

        Image3.Picture = LoadPicture(CommonDialog1.FileName)
        strPhotoPath = CommonDialog1.FileName

        ReDim arrImageByte(FileLen(strPhotoPath))
        fNum = FreeFile()
        Open strPhotoPath For Binary As #fNum
        Get #fNum, , arrImageByte
        Close fNum

        Open CommonDialog1.FileName For Binary As #1
        FileInputData = String(LOF(1), 0)
        Get #1, 1, FileInputData
        Close #1

        bytBuf = FileInputData

        s = CryptoBase64.Encode(bytBuf)

        Text8.Text = s

        Close

End If



--------------------------Class Module------------------------------

Option Explicit
Private Const CLASS_EXCEPT_BASE As Long = &H8004E300

Public Enum CryptoBase64ExceptEnum
  cbxGetOSVersFailed = CLASS_EXCEPT_BASE
  cbxNotNT
  cbxWinXPOrLaterReqd
  cbxWinVistaOrLaterReqd
  cbxStringToBinaryFailed
  cbxBinaryToStringFailed
End Enum

Public Enum Base64FormatEnum
  bfmtCrLF = 0
  bfmtLfOnly
  bfmtNone
End Enum

Public Enum OSVersionEnum
  osvWinXP = 501
  osvWinVista = 600
End Enum

Private Const VER_PLATFORM_WIN32_NT As Long = 2

Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
    ' Operating System     Value
    ' Windows 3.1            3
    ' Windows 95             4
    ' Windows 98             4
    ' Windows Me             4
    ' Windows NT 3.51        3
    ' Windows NT 4.0         4
    ' Windows 2000           5
    ' Windows XP             5
    ' Windows .Net Server    5
    ' Windows 2003 Server    5
    ' Windows 2003 R2 Server 5
    ' Windows Vista          6
    ' Windows 2008 Server    6
  dwMinorVersion As Long
    ' Operating System     Value
    ' Windows 3.1            1
    ' Windows 95             0
    ' Windows 98             10
    ' Windows Me             90
    ' Windows NT 3.51        51
    ' Windows NT 4.0         0
    ' Windows 2000           0
    ' Windows XP             1
    ' Windows .Net Server    1
    ' Windows 2003 Server    2
    ' Windows 2003 R2 Server 2
    ' Windows Vista          0
    ' Windows 2008 Server    0
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128

  'Extended information (optional), i.e. OSVERSIONINFOEX:
  wServicePackMajor As Integer
  wServicePackMinor As Integer
  wSuiteMask As Integer
  wProductType As Byte
    ' Operating System     Value
    ' NT Workstation         1
    ' NT Domain Controller   2
    ' NT Server              3
  wReserved As Byte
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Const CRYPT_STRING_BASE64 As Long = 1
Private Const CRYPT_STRING_NOCR As Long = &H80000000
Private Const CRYPT_STRING_NOCRLF As Long = &H40000000

Private Declare Function CryptBinaryToString Lib "Crypt32" Alias "CryptBinaryToStringW" _
 (ByRef pbBinary As Byte, _
  ByVal cbBinary As Long, _
  ByVal dwFlags As Long, _
  ByVal pszString As Long, _
  ByRef pcchString As Long) As Long

Private Declare Function CryptStringToBinary Lib "Crypt32" Alias "CryptStringToBinaryW" _
 (ByVal pszString As Long, _
  ByVal cchString As Long, _
  ByVal dwFlags As Long, _
  ByVal pbBinary As Long, _
  ByRef pcbBinary As Long, _
  ByRef pdwSkip As Long, _
  ByRef pdwFlags As Long) As Long

Private m_OSVersion As OSVersionEnum
Private m_lngBase64Format As Long
Public Property Get Base64Format() As Base64FormatEnum
 If m_lngBase64Format = 0 Then
   Base64Format = bfmtCrLF
 ElseIf m_lngBase64Format = CRYPT_STRING_NOCR Then
   Base64Format = bfmtLfOnly
 Else
   Base64Format = bfmtNone
 End If
End Property
Public Property Let Base64Format(ByVal Format As Base64FormatEnum)
 If Format = bfmtLfOnly Then
   If m_OSVersion < osvWinXP Then
     Err.Raise cbxWinXPOrLaterReqd, "CryptoBase64.Base64Format", "This format is only supported in Windows XP/2003 and later"
   Else
     m_lngBase64Format = CRYPT_STRING_NOCR
   End If
 ElseIf Format = bfmtNone Then
   If m_OSVersion < osvWinVista Then
     Err.Raise cbxWinVistaOrLaterReqd, "CryptoBase64.Base64Format", "This format is only supported in Windows Vista/2008 and later"
   Else
     m_lngBase64Format = CRYPT_STRING_NOCRLF
   End If
 Else
   m_lngBase64Format = 0
 End If
End Property
Public Function Decode(ByRef Base64Buf As String) As Byte()
 Dim lngOutLen As Long
 Dim dwActualUsed As Long
 Dim bytBuf() As Byte

 ' Determine output buffer length required. Note:
 ' StrPtr(vbNullString) is just a way to get a null pointer,
 ' even though we're really talking about a Byte array here.
 CryptStringToBinary StrPtr(Base64Buf), _
                     Len(Base64Buf), _
                     CRYPT_STRING_BASE64, _
                     StrPtr(vbNullString), _
                     lngOutLen, _
                     0&, _
                     dwActualUsed

 ' Convert Base64 to binary.
 ReDim bytBuf(lngOutLen - 1)

 If CryptStringToBinary(StrPtr(Base64Buf), _
                        Len(Base64Buf), _
                        CRYPT_STRING_BASE64, _
                        VarPtr(bytBuf(0)), _
                        lngOutLen, _
                        0&, _
                        dwActualUsed) = 0 Then
   Err.Raise cbxStringToBinaryFailed, "CryptoBase64.Decode", "CryptStringToBinary failed, error " & CStr(Err.LastDllError)
 Else
   Decode = bytBuf
 End If

 'Open App.Path & "\MyTestGif.gif" For Binary As #1
 'Put #1, 1, Decode
 'Close #1


End Function
Public Function Encode(ByRef BinaryBuf() As Byte) As String
 Dim bytBuf() As Byte
 Dim lngOutLen As Long
 Dim strBase64 As String

 'Determine Base64 output String length required.
 CryptBinaryToString BinaryBuf(0), _
                     UBound(BinaryBuf) + 1, _
                     CRYPT_STRING_BASE64 Or m_lngBase64Format, _
                     StrPtr(vbNullString), _
                     lngOutLen

 'Convert binary to Base64.
 Encode = String(lngOutLen, 0)

 If CryptBinaryToString(BinaryBuf(0), _
                        UBound(BinaryBuf) + 1, _
                        CRYPT_STRING_BASE64 Or m_lngBase64Format, _
                        StrPtr(Encode), _
                        lngOutLen) = 0 Then

   Err.Raise cbxBinaryToStringFailed, "CryptoBase64.Encode", "CryptBinaryToString failed, error " & CStr(Err.LastDllError)
    End If
End Function
Public Property Get OSVersion() As OSVersionEnum
 OSVersion = m_OSVersion
End Property
Private Sub Class_Initialize()
 Dim osvinfData As OSVERSIONINFO

 With osvinfData
   .dwOSVersionInfoSize = Len(osvinfData)
   .szCSDVersion = ""

   If GetVersionEx(osvinfData) = 0 Then
     Err.Raise cbxGetOSVersFailed, "CryptoBase64 Initialize", "GetVersionEx failed, error " & CStr(Err.LastDllError)
   End If

   If .dwPlatformId <> VER_PLATFORM_WIN32_NT Then
     Err.Raise cbxNotNT, "CryptoBase64 Initialize", "CryptoAPI is only available on NT-based OSs"
   End If

   m_OSVersion = .dwMajorVersion * 100 + .dwMinorVersion
 End With

 Base64Format = bfmtCrLF
End Sub

只需添加picbox,按钮和模块即可使用