把EXE文件存入到表的字段中，再从表中读出存到硬盘

时　间:2004-11-16 14:23:50
作　者:huanghai   ID：32  城市：苏州
摘　要:把EXE文件存入到ACCESS的表的字段中，再从表中读出存到硬盘
正　文:

'假定表：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