三国群英传3奥丁神枪:vb中怎么把richtextbox中的信息以二进制形式存入数据库的某个字段?

来源:百度文库 编辑:杭州交通信息网 时间:2024/04/30 08:42:29
.

RichTextbox 有一个 TextRTF 属性,它的格式是 String ,你可以把它存到一个Memo(备注型)字段中。TextRTF 属性是可读可写的。

何不先存为一个文件,然后将文件存入数据库呢。

Option Explicit

'***************************************************************************************
'函数:将长二进制文件写入数据库的OLE字段
'入口注意:该 Field 应先加以 AddNew or Edit method,函数完成后:
'应加以: Update Method.
'***************************************************************************************
Public Function SaveFileIntoField(theBinaryField As ADODB.Field, TheFileName As String) As Boolean
Const conChunkSize = 16384
Dim FileLength As Long
Dim FragMent As Long
Dim Chunks As Integer
Dim Chunk() As Byte
Dim FileNumber As Integer
Dim Counter As Integer
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On Error GoTo MainErr
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SaveFileIntoField = False
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'取得可用的文件号
FileNumber = FreeFile
Open TheFileName For Binary Access Read As #FileNumber
FileLength = LOF(FileNumber)
If FileLength <> 0 Then
'确定需要分段的次数
Chunks = FileLength \ conChunkSize
'确定最后的不够标准容量的字节大小
FragMent = FileLength Mod conChunkSize
ReDim Chunk(FragMent)
Get FileNumber, , Chunk()
theBinaryField.AppendChunk Chunk()
'确定标准容量的字节大小
ReDim Chunk(conChunkSize)
For Counter = 1 To Chunks
Get #FileNumber, , Chunk()
theBinaryField.AppendChunk Chunk()
Next Counter
End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Close #FileNumber
SaveFileIntoField = True
Exit Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
MainErr:
Select Case Err.Number
Case Else
MsgBox Err.Description, vbInformation
End Select
Close #FileNumber
Err.Clear
End Function