请问VB中如何存取ORACLE数据库的CLOB类型的字段？

Question

在vb中的处理 
在vb中处理大对象，一般可以用OO4O(oracle objects for ole)来处理大对象。这里介绍一种不用0040处理大对象blob的方法。 
下面这段程序可以将一个文件（文本文件，doc文件，图象文件等）保存到数据库中，并可以将其从数据库读出  
需要两个commandbutton  
cmd1 名称 cmdsave caption 保存  
cmd2 名称 cmdread caption 读取  
一个cmddialog控件  
同时需要创建一张表t_demo(字段id 类型 number,;字段text 类型 blob;) 
exmple 3. 
Option Explicit 
Dim rn As ADODB.Connection 
Public Function CreateDataSource(DataSource As String, UserID As String, Password As String) As Boolean 
On Error GoTo DbConErr: 
Set rn = New ADODB.Connection 
With rn 
.ConnectionString = "Provider=OraOledb.Oracle.1;" & _ 
"password=" & Password & ";" & _ 
"User ID =" & UserID & ";" & _ 
"Data Source=" & DataSource & ";" & _ 
"Locale Identifier=2052" 
.Open 
End With 
CreateDataSource = True 
Exit Function 
DbConErr: 
CreateDataSource = False 
End Function Private Sub cmdRead_Click() 
Dim rs As New ADODB.Recordset 
rs.ActiveConnection = rn 
rs.LockType = adLockOptimistic 
rs.CursorLocation = adUseClient 
rs.Source = "select * from t_demo" 
rs.Open 
ComDlgDir.DialogTitle = "保存文件" 
ComDlgDir.Filter = "*.*" 
ComDlgDir.ShowSave 
Call BlobToFile(rs.Fields("text"), ComDlgDir.filename) 
Set rs = Nothing 
Exit Sub 
Set rs = Nothing 
End Sub Private Sub cmdsave_Click() 
Dim rs As New ADODB.Recordset 
rs.ActiveConnection = rn 
rs.LockType = adLockOptimistic 
rs.CursorLocation = adUseClient 
rs.Source = "select * from t_demo" 
rs.Open 
rs.AddNew  
ComDlgDir.DialogTitle = "选取文件" 
ComDlgDir.ShowOpen  
rs.Fields("id").Value = 1 
If ComDlgDir.filename <> "" Then 
Call FileToBlob(rs.Fields("text"), ComDlgDir.filename) 
rs.Update 
End If  
Set rs = Nothing 
Exit Sub 
Set rs = Nothing  
End Sub Private Sub Form_Load() 
If Not CreateDataSource("sid", "systemp", "manager") Then 
MsgBox "Connection failure!" 
End If 
End Sub fld As ADODB.Field, filename As String, Optional ChunkSize As Long = 8192) 
Dim fnum As Integer, bytesleft As Long, bytes As Long 
Dim tmp() As Byte 
If (fld.Attributes And adFldLong) = 0 Then 
Err.Raise 1001, , "field doesn't support the GetChunk method." 
End If 
If Dir$(filename) = "" Then Err.Raise 53, , "File not found" 
fnum = FreeFile  
Open filename For Binary As fnum 
bytesleft = LOF(fnum) 
Do While bytesleft 
bytes = bytesleft 
If bytes > ChunkSize Then bytes = ChunkSize 
ReDim tmp(1 To bytes) As Byte 
Get fnum, , tmp 
fld.AppendChunk tmp 
bytesleft = bytesleft - bytes 
Loop 
Close #fnum 
End Sub Sub BlobToFile(fld As ADODB.Field, filename As String, Optional ChunkSize As Long = 8192) 
Dim fnum As Integer, bytesleft As Long, bytes As Long 
Dim tmp() As Byte 
If (fld.Attributes And adFldLong) = 0 Then 
Err.Raise 1001, , "field doesn't support the GetChunk method." 
End If 
If Dir$(filename) <> "" Then Kill filename 
fnum = FreeFile 
Open filename For Binary As fnum 
bytesleft = fld.ActualSize 
Do While bytesleft 
bytes = bytesleft 
If bytes > ChunkSize Then bytes = ChunkSize 
tmp = fld.GetChunk(bytes) 
Put #fnum, , tmp 
bytesleft = bytesleft - bytes 
Loop 
Close #fnum 
End Sub