'假定表:tbl1,字段:F1
Option Compare Database
Option Explicit
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Function ReadFile(ByVal strFile As String) As Boolean
On Error GoTo Doerr
Dim lngFileNum As Long
Dim varFile As Variant
Dim rst As New ADODB.Recordset
Dim strSql As String
Dim str As String
Dim lngLen As Long
Dim bytFile() As Byte
Dim lngI As Long, lngMax As Long
lngFileNum = FreeFile
Open strFile For Binary As lngFileNum
lngLen = LOF(lngFileNum) / 2
ReDim bytFile(lngLen * 2)
Do Until EOF(lngFileNum)
Get lngFileNum, , bytFile(lngI)
lngI = lngI + 1
Loop
lngMax = lngI
str = Space(lngLen)
CopyMemory ByVal StrPtr(str), bytFile(0), lngLen * 2
strSql = "tbl1"
rst.Open strSql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTable
If rst.EOF Then rst.AddNew
rst.Fields(0).AppendChunk str
Debug.Print rst.Fields(0).ActualSize
rst.Update
rst.Close
Close lngFileNum
Complete:
GoTo Quit
Doerr:
Errexit:
Debug.Print Err.Description
Quit:
End Function
Public Function writeFile(ByVal strFile As String) As Boolean
On Error GoTo Doerr
Dim lngFileNum As Long
Dim rst As New ADODB.Recordset
Dim strSql As String
Dim str As String
Dim lngLen As Long
Dim bytFile() As Byte
Dim lngI As Long
Set rst = New ADODB.Recordset
strSql = "tbl1"
rst.Open strSql, CurrentProject.Connection, adOpenStatic, adLockReadOnly, adCmdTable
lngLen = rst.Fields(0).ActualSize / 2
str = rst.Fields(0).GetChunk(lngLen * 2)
ReDim bytFile(lngLen * 2)
rst.Close
CopyMemory bytFile(0), ByVal StrPtr(str), lngLen * 2
lngFileNum = FreeFile
Open strFile For Binary As lngFileNum
For lngI = 0 To lngLen * 2
Put lngFileNum, , bytFile(lngI)
Next
Close lngFileNum
Complete:
GoTo Quit
Doerr:
Errexit:
Debug.Print Err.Description
Quit:
End Function