★★★ 谁有将Word文件存到数据库中成功的例子！★★★

Question

我原来的类模块，Sql7/2000的、ADO的，可用来存二进制文件（Word文档没有问题）VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "FilePic"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'<CSCC>
'--------------------------------------------------------------------------------
'    Component  : FilePic
'    Project    : Person_Manage
'
'    Description: [type_description_here]
'
'    Modified   :
'--------------------------------------------------------------------------------
'</CSCC>
  Option ExplicitPrivate filename As String
Private mFiledName As String
Private WithEvents mRstRule As ADODB.Recordset
Attribute mRstRule.VB_VarHelpID = -1
Private mFileName As StringPrivate mcnnServer As ADODB.Connection'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Person_Manage
' Procedure  :       ServerConnection
' Description:       [type_description_here]
' Created by :       Administrator
' Machine    :       ZHANGPI
' Date-Time  :       2002-07-10-11:36:27
'
' Parameters :       oConnection (ADODB.Connection)
'--------------------------------------------------------------------------------
'</CSCM>
Public Property Let ServerConnection(oConnection As ADODB.Connection)    'If IsObject(oConnection) Then
    Set mcnnServer = New ADODB.Connection
    Set mcnnServer = oConnection
    '    MsgBox mcnnServer.ConnectionString
    ' MsgBox mcnnServer.ConnectionString
    'End IfEnd Property'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Person_Manage
' Procedure  :       SaveToAdo
' Description:       [type_description_here]
' Created by :       Administrator
' Machine    :       ZHANGPI
' Date-Time  :       2002-07-10-11:36:27
'
' Parameters :       oFileName (String)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function SaveToAdo(ByVal oFileName As String) As Boolean    '文件到字段
    On Error Resume Next
SaveToAdo = True
    Dim FL As Long '文件长度
    Dim Chunks As Integer, Fragment As Long
    Dim Chunk() As Byte, i As Integer
    Const ChunkSize As Long = 32768
    mFileName = oFileName
    '如果没有打开新的，就不用保存法规文档字段
    Open mFileName For Binary Access Read As #1
    FL = LOF(1)      '文件中数据的长度    If FL = 0 Then        MsgBox "文件" & mFileName & "长度为0.", vbInformation, "保存错误"
        Close #1
        SaveToAdo = False
        Exit Function    End If    Chunks = FL \ ChunkSize
    Fragment = FL Mod ChunkSize
    ReDim Chunk(Fragment)
    Get #1, , Chunk()
    mRstRule(mFiledName).AppendChunk Chunk()
    ReDim Chunk(ChunkSize)    For i = 1 To Chunks        Get #1, , Chunk()
        mRstRule(mFiledName).AppendChunk Chunk()    Next i    Close #1
    mRstRule.Update
    '这里不须要mRstRule.Update,因为之后有这一语句
    ' mblnWordChange = False
    SaveToAdo = True
    Exit Function
Err_SaveToAdo:
    Close #1
    SaveToAdo = FalseEnd Function'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Person_Manage
' Procedure  :       ReadFromAdo
' Description:       [type_description_here]
' Created by :       Administrator
' Machine    :       ZHANGPI
' Date-Time  :       2002-07-10-11:36:27
'
' Parameters :       oFileName (String)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function ReadFromAdo(ByVal oFileName As String) As Boolean    'On Error Resume Next
    '从字段读到文件
    On Error GoTo Err_ReadFromAdo
    Dim FL As Long '文件长度
    Dim Chunks As Integer, Fragment As Long
    Dim Chunk() As Byte, i As Integer
    Static title As Long
    Dim fileHandle As Long
    
    title = title + 1
    ' Const ChunkSize As Long = 32768
    Dim ChunkSize As Long
    FL = mRstRule(mFiledName).ActualSize
    ChunkSize = FL
    '如果字段'Lvalue'中长度为0，则读取失败    If FL = 0 Then        ReadFromAdo = False
        Exit Function    End If
    
    fileHandle = FreeFile
    filename = oFileName  'mTempFileName & Trim(Str(title))
    Open filename For Binary Access Write As fileHandle
    Chunks = FL \ ChunkSize
    Fragment = FL Mod ChunkSize
    ' ReDim Chunk(Fragment)
    ' Chunk() = mRstRule(mfiledname).GetChunk(Fragment)
    ' Put fileHandle, , Chunk()
    ReDim Chunk(ChunkSize)
    ' For i = 1 To Chunks
    Chunk() = mRstRule(mFiledName).GetChunk(ChunkSize)
    Put fileHandle, , Chunk()
    ' Next i
    Close fileHandle
    ReadFromAdo = True
    Exit Function
Err_ReadFromAdo:
    Close fileHandle
    ReadFromAdo = False
    '    PowerError Err.Number, Err.Source, Err.Description, "读取数据错误"End Function
    
'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Person_Manage
' Procedure  :       OpenRecordSet
' Description:       [type_description_here]
' Created by :       Administrator
' Machine    :       ZHANGPI
' Date-Time  :       2002-07-10-11:36:27
'
' Parameters :       oA0100 (String)
'                    oB0110 (String)
'                    oTypeid (String)
'                    oId (Integer)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function OpenRecordSet(ByVal oA0100 As String, ByVal oB0110 As String, ByVal oTypeid As String, ByVal oId As Integer) As Boolean    On Error GoTo Err_OpenRecordSet
    OpenRecordSet = True
    
    Set mRstRule = New ADODB.Recordset    With mRstRule        Set .ActiveConnection = mcnnServer
        .CursorType = adOpenForwardOnly
        .LockType = adLockPessimistic ' = adLockOptimistic
        .Source = "Select * From AMEDIA Where typeid='" & oTypeid & "' and a0100='" & oA0100 & "' and b0110='" & oB0110 & "' and id=" & oId
        .Open        If .RecordCount <> 1 Then
            .AddNew
            .Fields("typeid").Value = oTypeid
            .Fields("a0100").Value = oA0100
            .Fields("b0110").Value = oB0110
            .Fields("id").Value = oId
        End If        ''
        '            '新建准备    End With
    
    mFiledName = "AMEDIA" 'oFdName
    
    Exit Function
    
Err_OpenRecordSet:
    
    OpenRecordSet = FalseEnd Function'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Person_Manage
' Procedure  :       DeleteRecordSet
' Description:       [type_description_here]
' Created by :       Administrator
' Machine    :       ZHANGPI
' Date-Time  :       2002-07-10-11:36:27
'
' Parameters :       oA0100 (String)
'                    oB0110 (String)
'                    oTypeid (String)
'                    oId (Integer)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function DeleteRecordSet(ByVal oA0100 As String, ByVal oB0110 As String, ByVal oTypeid As String, ByVal oId As Integer) As Boolean    On Error Resume Next
    Dim ss As String
    ss = "delete From AMEDIA Where typeid='" & oTypeid & "' and a0100='" & oA0100 & "' and b0110='" & oB0110 & "' and id=" & oId
    mcnnServer.Execute ss
  
End Function