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

[Leon1509]

谁有将Word文件存到数据库(Oracle或DB2)中，然后再从数据库中还原为Word文件的成功的例子（ADO）！

原则：
　　1. 数据库一定是DB2或Oracle，DB2最好。
　　2. 一定要用ADO连接。
　　3. 还原后的Word文件要与原文件的内容一样。

请各位大侠帮帮忙！！！一定给分。

[zhang_pi]

我原来的类模块，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 Explicit





Private filename As String
Private mFiledName As String


Private WithEvents mRstRule As ADODB.Recordset
Attribute mRstRule.VB_VarHelpID = -1
Private mFileName As String

Private 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 If

End 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 = False

End 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 = False

End 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