使用VBA在MySQL Blob中存储字节数组

时间:2010-07-30 21:01:23

标签: mysql vba bytearray blob

有人有一些VBA代码将字节数组存储到MySQL blob列中吗?

3 个答案:

答案 0 :(得分:2)

这是一些代码。需要引用Microsoft Active Data Objects 2.x库。它使用MySQL的OLE DB提供程序(可能需要在客户端计算机上安装它)。

Sub StoreBLOB(data() As Byte, key As Double)
'stores the BLOB byte array into the row identified by the key
'requires reference to Microsoft Active Data Objects 2.x Library

On Error GoTo handler:

    Dim con As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim conStr As String
    Dim strSQL As String

    'have it return only the record you want to store your blob
    strSQL = strSQL & "SELECT * FROM YOURTABLE WHERE KEY = " & key

    'setup connection
    conStr = conStr & "Provider=MySQLProv;"
    conStr = conStr & "Data Source=mydb;"
    conStr = conStr & "User Id=myUsername;"
    conStr = conStr & "Password=myPassword;"

    con.ConnectionString = conStr
    con.Open

    rs.Open strSQL, con, adOpenDynamic, adLockOptimistic

    If rs.RecordCount > 1 Then
        Err.Raise 1001, "StoreBLOB", "Too many records returned from dataset.  Check to make sure you have the right key value"
    Else
        Err.Raise 1002, "StoreBLOB", "No Records found that match the key"
    End If

    rs.Fields("BLOBFIELDNAME").Value = data
    rs.Update 'store the contents to the database

    rs.Close
    con.Close
    Set rs = Nothing
    Set con = Nothing

Exit Sub
handler:
    Err.Raise 1003, "StoreBLOB", "Unexpected Error in StoreBLOB.  Check that server is running"
End Sub

答案 1 :(得分:0)

假设您使用ADO访问mysql,那就是KB article on the subject

答案 2 :(得分:0)

我有一些代码,我在VBA中复制了 mysql_real_escape_string_quote C函数,以便可以转义必要的字符并像常规文本一样构建SQL:< / p>

Function mysql_real_escape_string_quote(toStr() As Byte, fromStr() As Byte, length As Long, quote As String) As Long
    mysql_real_escape_string_quote = 0
    Dim CharMap() As Byte: CharMap = StrConv(String(256, 0), vbFromUnicode)
    CharMap(0) = Asc("0"): CharMap(39) = Asc("'"): CharMap(34) = Asc(""""): CharMap(8) = Asc("b"): CharMap(10) = Asc("n"): CharMap(13) = Asc("r"):
    CharMap(9) = Asc("t"): CharMap(26) = Asc("z"): CharMap(92) = Asc("\"): CharMap(37) = Asc("%"): CharMap(95) = Asc("_"):

    Dim i As Long: Dim n As Long: n = 0
    If length > UBound(fromStr) + 1 Then Exit Function
    For i = 0 To length - 1  '---count escapable chars before redim---
        n = n + 1
        If CharMap(fromStr(i)) <> 0 Then n = n + 1
    Next i

    ReDim toStr(n - 1) As Byte
    n = 0
    For i = 0 To length - 1  '---test chars---
        If CharMap(fromStr(i)) = 0 Then
            toStr(n) = fromStr(i)
        Else                        '---escape char---
            toStr(n) = Asc(quote): n = n + 1
            toStr(n) = CharMap(fromStr(i))
        End If
        n = n + 1
    Next i
    mysql_real_escape_string_quote = n
End Function

Function mysql_real_escape_string(InputString As String) As String
    mysql_real_escape_string = ""
    Dim toStr() As Byte: Dim fromStr() As Byte
    fromStr = StrToChar(InputString)
    If mysql_real_escape_string_quote(toStr, fromStr, UBound(fromStr) + 1, "\") = 0 Then Exit Function
    mysql_real_escape_string = StrConv(toStr(), vbUnicode)
End Function

Function StrToChar(str As String) As Byte()
    Dim ans() As Byte
    ans = StrConv(str, vbFromUnicode)
    ReDim Preserve ans(Len(str)) As Byte
    ans(Len(str)) = 0
    StrToChar = ans
End Function

Sub testit()
    Dim toStr() As Byte: Dim fromStr() As Byte
    fromStr = StrToChar("hello world's")
    MsgBox (mysql_real_escape_string_quote(toStr, fromStr, UBound(fromStr) + 1, "\"))
    MsgBox (mysql_real_escape_string("hello world's"))
    For i = 0 To UBound(toStr)
        Debug.Print i & " " & toStr(i)
    Next i
End Sub

它已针对大量数据进行了优化,而没有大量的条件条件( ifs )。