读取文件然后将文件写入 SQL 服务器 BLOB 列的代码,生成具有不同字节的文件
Code to read and then write a file into a SQL Server BLOB column producing files with different bytes
使用:
- MS-SQL 服务器 2014
- MS-Access 2013,带有链接到 SQL 的 ODBC 表
服务器数据库
- "SQL Server" ODBC 驱动程序(10.00.10586.00,Microsoft
公司,SQLSRV32.DLL)
- DAO
我们有一个 Access 数据库,其中包含链接到 SQL Server 2014 数据库的 Access 数据库,Access 应用程序中的表单后面有 VBA 代码,用于将文件上传到 SQL 服务器blob (varbinary[max]) 列,稍后从同一 blob 列下载文件。
但是我们发现,在检索之前从 blob 列上传的文件时,保存的文件在文件末尾添加了一些额外的字节。
Beyond Compare 中 2 个文件比较的屏幕截图如下:
如果有人能检查并指出代码中的错误,我将不胜感激。代码如下:
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
我认为问题是:
除非您的模块中有 Option Base 1
声明,否则数组是从零开始的。
所以如果LeftOver
= 2,
ReDim FileData(LeftOver)
实际上会声明一个数组FileData(0 To 2)
,它包含3个字节。因此下面的 Get
将读取 3 个字节,但您希望它读取 2 个字节。
全尺寸数组也是如此。
最后你从文件中读取了 NumBlocks + 1
字节太多,剩下的将是 00
字节。
解决方法:使用
ReDim FileData(1 To LeftOver)
ReDim FileData(1 To BlockSize)
编辑:请注意,您必须检查大小写 LeftOver = 0
。
使用:
- MS-SQL 服务器 2014
- MS-Access 2013,带有链接到 SQL 的 ODBC 表 服务器数据库
- "SQL Server" ODBC 驱动程序(10.00.10586.00,Microsoft 公司,SQLSRV32.DLL)
- DAO
我们有一个 Access 数据库,其中包含链接到 SQL Server 2014 数据库的 Access 数据库,Access 应用程序中的表单后面有 VBA 代码,用于将文件上传到 SQL 服务器blob (varbinary[max]) 列,稍后从同一 blob 列下载文件。
但是我们发现,在检索之前从 blob 列上传的文件时,保存的文件在文件末尾添加了一些额外的字节。
Beyond Compare 中 2 个文件比较的屏幕截图如下:
如果有人能检查并指出代码中的错误,我将不胜感激。代码如下:
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
我认为问题是:
除非您的模块中有 Option Base 1
声明,否则数组是从零开始的。
所以如果LeftOver
= 2,
ReDim FileData(LeftOver)
实际上会声明一个数组FileData(0 To 2)
,它包含3个字节。因此下面的 Get
将读取 3 个字节,但您希望它读取 2 个字节。
全尺寸数组也是如此。
最后你从文件中读取了 NumBlocks + 1
字节太多,剩下的将是 00
字节。
解决方法:使用
ReDim FileData(1 To LeftOver)
ReDim FileData(1 To BlockSize)
编辑:请注意,您必须检查大小写 LeftOver = 0
。