对SQL SERVER数据库进行存取WORD文档的操作

[mhgk1888]

对SQL SERVER数据库进行存取WORD文档的操作

[华芸智森]

'/以流放问数据库中的二进制字段时的读/写标志
Public Enum SmRsType
RsWrite = 1
RsRead = 2
End Enum

'
'读写二进制数据(流)
'函数名:AdoStream
'参数: M_Conn ADODB连接,TabName 目标数据表,FldName 目标字段,WhereStr 更新条件,
' FileName 源文件名或由流生成的文件名,RsStyle 记录集的操作类型.W:File to Recode,R:Recode to File
'返回值:
'例: CALL AdoStream(P_Cnn,"AchGoods","GdsPhoto","Where gdsid='001'","C:\Tmp.Bmp","W")

Public Function AdoStream(M_Conn As ADODB.Connection, _
TabName As String, _
FldName As String, _
Optional WhereStr As String = "", _
Optional Filename As String, _
Optional RsStyle As SmRsType = RsWrite) As String

Dim StrSql As String
Dim TmpFileName As String
Dim Rs As New ADODB.Recordset
Dim AdoSem As New ADODB.Stream
Dim ReturnVal As String
Dim WorkPath As String
Dim RsType As Long
Dim RsStyleStr As String

On Error Resume Next

WorkPath = App.Path
If Right$(WorkPath, 1) <> "\" Then WorkPath = WorkPath & "\"
ReturnVal = ""
AdoSem.Type = adTypeBinary '流数据类型
AdoSem.Open '打开流
'/-----------------------------------------------------------
'将流写入记录集
RsType = RsStyle
RsStyleStr = Choose(RsType, "W", "R")
If RsStyleStr = "W" Then
If Left$(Trim$(UCase$(WhereStr)), Len("where")) <> UCase$("where") Then WhereStr = " Where " & Trim$(WhereStr)
StrSql = "Select Top 1 [" & TabName & "].[" & FldName & "] From [" & TabName & "] " & WhereStr
Set Rs = RsOpen(M_Conn, StrSql, False) '连接式记录集
If Not (Rs.EOF And Rs.BOF) Then
Rs.MoveFirst
AdoSem.LoadFromFile Filename '将文件LOAD到流
DoEvents
Rs.Fields(FldName).AppendChunk AdoSem.Read
Rs.Update
End If
AdoStream = ""
ElseIf RsStyle = "R" Then
'/将流从记录集中取出
If Len(Trim$(Filename)) = 0 Then Filename = "TmpFile.Bmp"
If Len(Trim$(Dir$(TmpFileName, vbNormal + vbHidden))) > 0 Then Kill Filename
If Left$(Trim$(UCase$(WhereStr)), Len("where")) <> UCase$("where") Then WhereStr = " Where " & Trim$(WhereStr)

StrSql = "Select Top 1 [" & TabName & "].[" & FldName & "] From [" & TabName & "] " & WhereStr
Set Rs = RsOpen(M_Conn, StrSql)
If Not (Rs.EOF And Rs.BOF) Then
Rs.MoveFirst
If Not (IsNull(Rs.Fields(FldName))) Then
TmpFileName = WorkPath & Filename
AdoSem.Write Rs.Fields(FldName).GetChunk(Rs.Fields(FldName).ActualSize)
DoEvents
AdoSem.SaveToFile TmpFileName, IIf(Len(Trim$(Dir$(TmpFileName, vbNormal + vbHidden))) > 0, adSaveCreateOverWrite, adSaveCreateNotExist)
AdoStream = TmpFileName
Else
AdoStream = ""
End If
Else
AdoStream = ""
End If
End If
AdoSem.Close: Set AdoSem = Nothing
Rs.Close: Set Rs = Nothing
Err.Clear
End Function

[AKillGodKillBuddha]

使用Stream对象，可以实现对数据库的图像存取。
数据库中存放图像的字段是二进制类型（Access为OLE类型）。
比如，如果用“CommonDialog”控件来选择你硬盘上的图像文件；
用“Picture”控件来显示图像，那么下面的代码供参考：
（已连接数据库，打开了相应的记录集rs）
Dim StmPic As ADODB.Stream
Dim StrPicTemp As String
　　......
　　'保存你所选择的图像
　　Set StmPic = New ADODB.Stream
StmPic.Type = adTypeBinary '指定流是二进制类型
StmPic.Open　　　　　　　　　　 '将数据获取到Stream对象中
StmPic.LoadFromFile (CommonDialog1.FileName) '将选择的图像加载到打开的StmPic中
rs.AddNew
rs.Fields(1).Value = StmPic.Read '从StmPic对象中读取数据
rs.Update
StmPic.Close
　　......
　　'读取显示数据库中的图像
　　Set StmPic = New ADODB.Stream
StrPicTemp = "c:\temp.tmp" '临时文件,用来保存读出的图片
With StmPic
　　　　.Type = adTypeBinary
　　　　.Open
　　　　.Write rs.Fields(1) '写入数据库中的数据至Stream中
　　　　.SaveToFile StrPicTemp, adSaveCreateOverWrite '将Stream中数据写入临时文件中
　　　　.Close
　　End With
　　Picture1.Picture = LoadPicture(StrPicTemp) '用Picture控件显示图像

[AKillGodKillBuddha]

'http://support.microsoft.com/default.aspx?scid=kb;EN-US;258038

'*************************************************************************
'**
'** 使用 ADODB.Stream 保存/读取文件到数据库
'** 引用 Microsoft ActiveX Data Objects 2.5 Library 及以上版本
'**
'** ----- 数据库连接字符串模板 ---------------------------------------
'** ACCESS数据库
'** iConcStr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
'** ";Data Source=数据库名"
'**
'** SQL数据库
'** iConcStr = "Provider=SQLOLEDB.1;Persist Security Info=True;" & _
'** "User ID=用户名;Password=密码;Initial Catalog=数据库名;Data Source=SQL服务器名"
'**

'保存文件到数据库中
Sub s_SaveFile()
Dim iStm As ADODB.Stream
Dim iRe As ADODB.Recordset
Dim iConcStr As String

'数据库连接字符串
iConcStr = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
";Data Source=F:\csdn_vb\database\保存图片\img.mdb"
Dim iConc As ADODB.Connection
Set iConc = New ADODB.Connection

iConc.Open iConcStr
'读取文件到内容
Set iStm = New ADODB.Stream
With iStm
.Type = adTypeBinary '二进制模式
.Open
.LoadFromFile App.Path + "\com.doc"
End With

'打开保存文件的表
Set iRe = New ADODB.Recordset
With iRe
.Open "select * from img", iConc, 1, 3
.AddNew '新增一条记录
.Fields("photo") = iStm.Read
.Update
End With

'完成后关闭对象
iRe.Close
iStm.Close
End Sub

Sub s_ReadFile()
Dim iStm As ADODB.Stream
Dim iRe As ADODB.Recordset
Dim iConc As String

'数据库连接字符串
iConc = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False" & _
";Data Source=F:\csdn_vb\database\保存图片\img.mdb"

'打开表
Set iRe = New ADODB.Recordset
iRe.Open "img", iConc, adOpenKeyset, adLockReadOnly
iRe.Filter = "id=3" '比如单击datagrid后找到id=3的纪录

'保存到文件
Set iStm = New ADODB.Stream
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write iRe("photo")
.SaveToFile "c:\com.doc"
End With

OLE1.SourceDoc = "c:\\com.doc"
OLE1.Action = 1 'use the old action method
OLE1.SizeMode = vbOLESizeAuttoSize '调节对象大小使其正好充满OLE容器控件

'Picture1.Picture = LoadPicture("c:\tesd.bmp")

'关闭对象
iRe.Close
iStm.Close
End Sub



Private Sub Command1_Click()
Call s_ReadFile
End Sub

Private Sub Command2_Click()
Call s_SaveFile
End Sub

[AKillGodKillBuddha]

一般的数据库都可以,字段类型为OLE类型或者大的二进制类型!!

Option Explicit

Dim cn As New ADODB.Connection, rs As New ADODB.Recordset

'保存
Private Sub Command1_Click()
Dim bteContent() As Byte

Open "C:\aa.bmp" For Binary Access Read As #1
bteContent = InputB(LOF(1), #1)
Close #1

If rs.State = adStateOpen Then rs.Close
rs.Open "select * from tablename", cn, adOpenDynamic, adLockPessimistic
rs.AddNew
rs!Name = "张三"
rs!AGE = 22
rs!SEX = "男"
rs.Fields("PHOTO").AppendChunk bteContent
rs.Update

Erase bteContent
End Sub

'打开
Private Sub Command2_Click()
Dim bteContent() As Byte
If rs.State = adStateOpen Then rs.Close
rs.Open "select * from tablename", cn, adOpenForwardOnly, adLockReadOnly
bteContent = rs.Fields("PHOTO").GetChunk(rs.Fields("PHOTO").ActualSize)

Open "C:\aa.bmp" For Binary Access Write As #1
Put #1, , bteContent
Close #1
Image1.Picture = LoadPicture("C:\aa.bmp")
End Sub

Private Sub Form_Load()
On Error GoTo Errhandle
cn.ConnectionString = "Driver={SQL Server};SERVER=DataServer;DATABASE=zxzx;UID=information;PWD=information*&#"
cn.Open

Exit Sub
Errhandle:
MsgBox Err.Description, vbExclamation
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub