【发布时间】:2017-01-29 11:34:12
【问题描述】:
使用:
- MS-SQL Server 2014
- MS-Access 2013 带有链接到 SQL 的 ODBC 表 服务器数据库
- “SQL Server”ODBC 驱动程序(10.00.10586.00,Microsoft 公司,SQLSRV32.DLL)
- 道
我们有一个 Access 数据库,其中将 ODBC 表链接到 SQL Server 2014 数据库,在 Access 应用程序中的表单后面使用 VBA 代码将文件上传到 SQL Server blob (varbinary[max]) 列,然后下载来自同一 blob 列的文件。
但是我们发现,在检索之前从 blob 列上传的文件时,保存的文件在文件末尾添加了一些额外的字节。
Beyond Compare 中两个文件的比较屏幕截图如下:
如果有人可以检查并指出代码中的错误,我将不胜感激。代码如下:
Function ReadBLOB(SourceFileName As String, TableName As String, FieldName As String, _
IDFieldName As String, IDFieldValue As Variant)
Dim NumBlocks As Integer, SourceFile As Integer, i As Integer
Dim FileLength As Long
Dim LeftOver As Long
Dim FileData() As Byte
Dim RetVal As Variant
Dim BlockSize As Long
Dim s As String
On Error GoTo Err_ReadBLOB
BlockSize = 32767
' Open the source file.
SourceFile = FreeFile
Open SourceFileName For Binary Access Read As SourceFile
' Get the length of the file.
FileLength = LOF(SourceFile)
If FileLength = 0 Then
ReadBLOB = 0
Exit Function
End If
' Calculate the number of blocks to read and leftover bytes.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
Dim T As dao.Recordset
If TypeName(IDFieldValue) = "String" Then
IDFieldValue = "'" & IDFieldValue & "'"
End If
s = "SELECT [" & FieldName & "] FROM [" & TableName & "] WHERE [" & IDFieldName & "] = " & IDFieldValue
Set T = CurrentDb.OpenRecordset(s, dbOpenDynaset, dbSeeChanges)
T.Edit
' Read the 1st block of data (upto Leftover in size), writing it to the table.
'FileData = String$(LeftOver, 32)
ReDim FileData(LeftOver)
Get SourceFile, , FileData
T(FieldName).AppendChunk (FileData)
' Read the remaining blocks of data, writing them to the table.
'FileData = String$(BlockSize, 32)
ReDim FileData(BlockSize)
For i = 1 To NumBlocks
Get SourceFile, , FileData
T(FieldName).AppendChunk (FileData)
Next i
' Update the record and terminate function.
T.Update
Close SourceFile
ReadBLOB = FileLength
Exit Function
Err_ReadBLOB:
ReadBLOB = -Err
MsgBox Err.Description
Exit Function
End Function
Function WriteBLOB2(TableName As String, FieldName As String, IDFieldName As String, _
IDFieldValue As Variant, DestinationFileName As String) As Long
Dim NumBlocks As Integer, DestFile As Integer, i As Integer
Dim FileLength As Long, LeftOver As Long
Dim FileData() As Byte
Dim RetVal As Variant
Dim BlockSize As Long
Dim s As String
Dim f As String
On Error GoTo Err_WriteBLOB
BlockSize = 32767
Dim T As dao.Recordset
If TypeName(IDFieldValue) = "String" Then
IDFieldValue = "'" & IDFieldValue & "'"
End If
s = "SELECT [" & FieldName & "] FROM [" & TableName & "] WHERE [" & IDFieldName & "] = " & IDFieldValue
Set T = CurrentDb.OpenRecordset(s, dbOpenSnapshot, dbSeeChanges)
If T.RecordCount = 0 Then
WriteBLOB2 = 0
Exit Function
End If
' Get the size of the field.
FileLength = T(FieldName).FieldSize()
If FileLength = 0 Then
WriteBLOB2 = 0
Exit Function
End If
' Calculate number of blocks to write and leftover bytes.
NumBlocks = FileLength \ BlockSize
LeftOver = FileLength Mod BlockSize
' Remove any existing destination file.
DestFile = FreeFile
Open DestinationFileName For Output As DestFile
Close DestFile
' Open the destination file.
Open DestinationFileName For Binary As DestFile
' Write the leftover data to the output file.
FileData = T(FieldName).GetChunk(0, LeftOver)
Put DestFile, , FileData
' Write the remaining blocks of data to the output file.
For i = 1 To NumBlocks
' Reads a chunk and writes it to output file.
FileData = T(FieldName).GetChunk((i - 1) * BlockSize + LeftOver, BlockSize)
Put DestFile, , FileData
Next i
' Terminates function
Close DestFile
WriteBLOB2 = FileLength
Exit Function
Err_WriteBLOB:
WriteBLOB2 = -Err
MsgBox Err.Description
Exit Function
End Function
Public Sub ClearSQLBlob2(TableName As String, FieldName As String, _
IDFieldName As String, IDFieldValue As Variant)
If TypeName(IDFieldValue) = "String" Then
IDFieldValue = "'" & IDFieldValue & "'"
End If
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE [" & TableName & "] SET [" & FieldName & "] = NULL WHERE [" & IDFieldName & "] = " & IDFieldValue
DoCmd.SetWarnings True
End Sub
【问题讨论】:
-
这将有助于从您的问题中删除所有非必要代码,尤其是所有那些
SysCmd电话。 -
您是否 100% 确定 blob 列中的值包含原始数据?还是在上传过程中数据已经损坏?最后附加了哪些值?
-
@erg:文件在上传过程中损坏。我通过使用 blob 编辑器程序从数据库下载原始文件进行了检查。但这就是我问这个问题的原因。
标签: sql-server vba odbc dao ms-access-2013