对SQL SERVER数据库进行存取WORD文档的操作
解决方案 »
- 高手,求助,用vb6 在日文系统下开发的程序,如何能在中文系统下运行,高分求解。
- 【问】如何右键TreeView空白处弹出菜单时,不会失去选定项目?
- 关于mshflexgrid光标选定的问题
- 【叶帆开源区】XP界面窗体制作(可放缩、可缩小到托盘)
- 选项卡控件TabStrip怎么在设计状态在各页间切换?
- 求助 : 如何在列表框中显示多个数据啊?
- 紧急求救一个C/S项目的实现方法,客户端输出在线人数的采样曲线
- Internet Transfer控件的ftp实现怎么做?
- 关于MSHFlexgrid1的用应,改怎么设置,在线等待QQ:147376918
- 播放视频的时候如何能够实现倒放???
- 水晶报表找不到数据库的问题
- epson lq300k ,lq1600k系列打印机能否实现程序控制自动退纸?
'/以流放问数据库中的二进制字段时的读/写标志
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
数据库中存放图像的字段是二进制类型(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控件显示图像
'**
'** 使用 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 SubSub 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 SubPrivate Sub Command1_Click()
Call s_ReadFile
End SubPrivate Sub Command2_Click()
Call s_SaveFile
End Sub
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 SubPrivate 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 SubPrivate 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