VB如何批量上传图片到SQL

Question

VB如何批量上传图片到SQL

Answer 1

Private Sub Command2_Click()
    Dim BufferFileArray() As String
    Dim i As Integer
    
    ask = True
    
    With CommonDialog1
        .DialogTitle = "添加多个文件..."
        .Filter = "全部图像文件|*.jpg;*.jpeg;*.gif;*.bmp;*.ico;*.wmf"
        .Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNHideReadOnly
        .InitDir = CurDir
        .MaxFileSize = 32767
        .Filename = ""
        .ShowOpen
        BufferFileArray = Split(.Filename, Chr(0))
    End With
    
    ' If no files are selected
    If UBound(BufferFileArray) = -1 Then Exit Sub
    
    ' If only one file was chosen.
    If UBound(BufferFileArray) = 0 Then
        saveimage CommonDialog1.Filename
        Exit Sub
    End If
    
    ' If multiple files chosen.
    ProgressBar1.Max = UBound(BufferFileArray)
    For i = LBound(BufferFileArray) + 1 To UBound(BufferFileArray)
        ProgressBar1.Value = i
        saveimage CurDir & "\" & BufferFileArray(i)
    Next i
    ProgressBar1.Value = 0
    List1.Selected(List1.ListCount - 1) = True
End SubPrivate Sub saveimage(strImage As String)
    ' Save image to database
    On Error Resume Next
    
    Dim NumBlocks As Integer, SourceFile As Integer, i As Integer
    Dim FileLength As Long, LeftOver As Long
    Dim FileData() As Byte, retval As Variant
    Dim dbs As Database
    Dim rst As Recordset
    Dim strHex As String
    
    Set m_CRC = New clsCRC
    
    Picture1.Cls
    Picture1.Picture = LoadPicture(strImage)
    
    StatusBar1.Panels(2).Text = "导入中" & GetFileName(Replace(strImage, "'", ""))
    
    strHex = Hex(m_CRC.CalculateFile(strImage))
    
    Set dbs = OpenDatabase(srcDB)
    Set rst = dbs.OpenRecordset("SELECT * FROM icons where crc = '" & strHex & "';")
           
    m_CRC.Algorithm = CRC32
    
    If rst.RecordCount = 0 Then
    rst.AddNew
        rst.Fields("title") = GetFileName(Replace(strImage, "'", ""))
        rst.Fields("crc") = strHex
        rst.Fields("size") = FileLen(strImage)
        rst.Fields("width") = Picture1.Width / 15
        rst.Fields("height") = Picture1.Height / 15
        rst.Fields("type") = LCase(GetFileExtension(strImage))
        
        SourceFile = FreeFile
        Open strImage For Binary Access Read As SourceFile
        FileLength = LOF(SourceFile)
            NumBlocks = FileLength \ Blocksize
            LeftOver = FileLength Mod Blocksize 'remainder appended first
            ReDim FileData(LeftOver)
            Get SourceFile, , FileData()
            rst.Fields("BinData").AppendChunk FileData() 'store the first image chunk
            ReDim FileData(Blocksize)
            For i = 1 To NumBlocks
                Get SourceFile, , FileData()
                rst.Fields("BinData").AppendChunk FileData() 'remaining chunks
                DoEvents
            Next i
        Close SourceFile
        rst.Update
        List1.AddItem GetFileName(Replace(strImage, "'", ""))
        List1.ListIndex = List1.ListCount - 1
    Else
        ' duplicate image found
        If ask = True Then response = MsgBox("图像已存在." & vbCrLf & vbCrLf & "源文件: " & GetFileName(Replace(strImage, "'", "")) & vbCrLf & "发现: " & rst.Fields("title") & vbCrLf & vbCrLf & "是否继续?", vbYesNo + vbInformation, "复制")
        If response = 7 Or response = 0 Then
            ask = False
        Else
            ask = True
        End If
    End If
    
    rst.Close
    dbs.Close
    ' Delete the source file if user wants
    If Check1.Value = 1 Then Kill strImage
    StatusBar1.Panels(2).Text = ""
    
    loadtypes
End Sub

Answer 2

kevinzhaoyp  我这里运行时提示 
Set m_CRC = New clsCRC 
无法定义这个类型呀
这个要引用什么吗？