早上好。
我在vb6中有一个程序,它有一个名为Image3的控件,现在让这个控件成为一个图像,我必须浏览一张图片,最好是.jpg
文件因为我现在将它保存在我的SQL中我不会需要这样做,因为在不久的将来系统会变慢,因为肯定会保存很多图像。对我而言,最好的方法是将其转换为字符串,反之亦然。老实说,我不想问这个问题,因为它是可搜索的,我看到的代码适合它IO.MemoryStream
我的问题是我无法在参考文献中看到它。现在我尝试下载一个新的,但VB6不接受它。
有人可以用这个照亮我吗?将图像转换为字符串的其他方法。
我这样做的原因是我将使用在我的select命令中转换为字符串的图像,因为内存流是图像的唯一性。
一般情况下,我不想再次上传相同的图片。
TYSM
答案 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,按钮和模块即可使用