7,789
社区成员
发帖
与我相关
我的任务
分享VB+SQL 2000怎么实现文件上传和下载的功能？
我前台用VB6，后台数据库是MS SQL2000，现在想开发一个功能，把本地的WORD文件、PPT文件、TXT等文件存储到DB中（整个内容而不是路径），需要时再打开，但原文件的格式如WORD中的排版格式必须不能变。
各位大侠，怎么实现啊？
各位大侠，怎么实现啊？
...全文
请发表友善的回复…
发表回复
wumy_ld 2004-05-09
- 打赏
- 举报
//读出来后，为什么文件是0字节啊？
我一直都用这些代码处理这个问题，从未出过问题。
我一直都用这些代码处理这个问题，从未出过问题。
mxfeng 2004-05-09
- 打赏
- 举报
学习
banma_2002 2004-05-09
- 打赏
- 举报
读出来后，为什么文件是0字节啊？
lndlwwh830 2004-05-09
- 打赏
- 举报
学习
online 2004-05-09
- 打赏
- 举报
*************************************************************************
'**
'** 使用 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:\My Documents\客户资料1.mdb"
'读取文件到内容
Set iStm = New ADODB.Stream
With iStm
.Type = adTypeBinary '二进制模式
.Open
.LoadFromFile "c:\test.doc"
End With
'打开保存文件的表
Set iRe = New ADODB.Recordset
With iRe
.Open "表", iConc, adOpenKeyset, adLockOptimistic
.AddNew '新增一条记录
.Fields("保存文件内容的字段") = 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=\\xz\c$\Inetpub\zj\zj\zj.mdb"
'打开表
Set iRe = New ADODB.Recordset
iRe.Open "tb_img", iConc, adOpenKeyset, adLockReadOnly
iRe.Filter = "id=64"
'保存到文件
Set iStm = New ADODB.Stream
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write iRe("img")
.SaveToFile "c:\test.doc"
End With
'关闭对象
iRe.Close
iStm.Close
End Sub
'**
'** 使用 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:\My Documents\客户资料1.mdb"
'读取文件到内容
Set iStm = New ADODB.Stream
With iStm
.Type = adTypeBinary '二进制模式
.Open
.LoadFromFile "c:\test.doc"
End With
'打开保存文件的表
Set iRe = New ADODB.Recordset
With iRe
.Open "表", iConc, adOpenKeyset, adLockOptimistic
.AddNew '新增一条记录
.Fields("保存文件内容的字段") = 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=\\xz\c$\Inetpub\zj\zj\zj.mdb"
'打开表
Set iRe = New ADODB.Recordset
iRe.Open "tb_img", iConc, adOpenKeyset, adLockReadOnly
iRe.Filter = "id=64"
'保存到文件
Set iStm = New ADODB.Stream
With iStm
.Mode = adModeReadWrite
.Type = adTypeBinary
.Open
.Write iRe("img")
.SaveToFile "c:\test.doc"
End With
'关闭对象
iRe.Close
iStm.Close
End Sub
wumy_ld 2004-05-09
- 打赏
- 举报
sql server的image字段可以存放这种内容。
以下是操作这个字段的函数：
'存储文件到数据库
Public Function WriteToDB(ByRef col As ADODB.Field, ByVal FileName As String) As Boolean
On Error GoTo ErrMsg
Dim mStream As ADODB.Stream
Set mStream = New ADODB.Stream
WriteToDB = False
mStream.Type = adTypeBinary
mStream.Open
mStream.LoadFromFile FileName
col.Value = mStream.Read
mStream.Close
Set mStream = Nothing
WriteToDB = True
Exit Function
ErrMsg:
MsgBox "存储文件到数据库时出现错误．" & vbCrLf & Err.Description, vbExclamation + vbOKOnly, "提示"
End Function
'设置临时文件（用于把ole字段读到一个文件里面，如果是图片，便可加载到图片框里面）
Public Function ReadDB(col As ADODB.Field, ByRef imgFile As String) As Boolean
On Error GoTo ErrRead
Dim mStream As New ADODB.Stream
ReadDB = False
If col.ActualSize < 200 Then Exit Function
mStream.Type = adTypeBinary
mStream.Open
mStream.Write col.Value
mStream.SaveToFile imgFile, adSaveCreateOverWrite
ReadDB = True
Exit Function
ErrRead:
MsgBox "设置临时文件时出现错误:" & vbCrLf & Err.Description, vbInformation, "提示"
ReadDB = False
End Function
WriteToDB使用示例：
.....
'把图片写入到数据库
strSQL = "select * from " & strTable _
& " where BBID='" & strBBID & "'" _
& " and ReportIndex=" & objControl.Index _
& " and ReportType=" & WPhoto
Set rsTemp = New ADODB.Recordset
rsTemp.Open strSQL, GCon, adOpenDynamic, adLockOptimistic
WriteToDB rsTemp("ReportPhoto"), mstrTempFile
rsTemp.Update
rsTemp.Close
ReadDB使用示例：
...
'检查是否有图片
If Not (IsNull(rsReport("ReportPhoto"))) Then
If Dir(mstrTempFile) <> "" Then Kill mstrTempFile
ReadDB rsReport("ReportPhoto"), mstrTempFile
Set Picture1.Picture = LoadPicture(mstrTempFile)
End If
以下是操作这个字段的函数：
'存储文件到数据库
Public Function WriteToDB(ByRef col As ADODB.Field, ByVal FileName As String) As Boolean
On Error GoTo ErrMsg
Dim mStream As ADODB.Stream
Set mStream = New ADODB.Stream
WriteToDB = False
mStream.Type = adTypeBinary
mStream.Open
mStream.LoadFromFile FileName
col.Value = mStream.Read
mStream.Close
Set mStream = Nothing
WriteToDB = True
Exit Function
ErrMsg:
MsgBox "存储文件到数据库时出现错误．" & vbCrLf & Err.Description, vbExclamation + vbOKOnly, "提示"
End Function
'设置临时文件（用于把ole字段读到一个文件里面，如果是图片，便可加载到图片框里面）
Public Function ReadDB(col As ADODB.Field, ByRef imgFile As String) As Boolean
On Error GoTo ErrRead
Dim mStream As New ADODB.Stream
ReadDB = False
If col.ActualSize < 200 Then Exit Function
mStream.Type = adTypeBinary
mStream.Open
mStream.Write col.Value
mStream.SaveToFile imgFile, adSaveCreateOverWrite
ReadDB = True
Exit Function
ErrRead:
MsgBox "设置临时文件时出现错误:" & vbCrLf & Err.Description, vbInformation, "提示"
ReadDB = False
End Function
WriteToDB使用示例：
.....
'把图片写入到数据库
strSQL = "select * from " & strTable _
& " where BBID='" & strBBID & "'" _
& " and ReportIndex=" & objControl.Index _
& " and ReportType=" & WPhoto
Set rsTemp = New ADODB.Recordset
rsTemp.Open strSQL, GCon, adOpenDynamic, adLockOptimistic
WriteToDB rsTemp("ReportPhoto"), mstrTempFile
rsTemp.Update
rsTemp.Close
ReadDB使用示例：
...
'检查是否有图片
If Not (IsNull(rsReport("ReportPhoto"))) Then
If Dir(mstrTempFile) <> "" Then Kill mstrTempFile
ReadDB rsReport("ReportPhoto"), mstrTempFile
Set Picture1.Picture = LoadPicture(mstrTempFile)
End If
ryuginka 2004-05-09
- 打赏
- 举报
up
lihonggen0 2004-05-09
- 打赏
- 举报
参考：
http://support.microsoft.com/default.aspx?scid=kb;EN-US;258038
http://support.microsoft.com/default.aspx?scid=kb;EN-US;258038
射天狼 2004-05-09
- 打赏
- 举报
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
'保存
Private Sub Command1_Click()
Dim bteContent() As Byte
Open "C:\aa.DOC" 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.DOC" For Binary Access Write As #1
Put #1, , bteContent
Close #1
ShellExecute Me.hwnd, "open", "C:\AA.DOC", vbNullString, vbNullString, 1
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
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
'保存
Private Sub Command1_Click()
Dim bteContent() As Byte
Open "C:\aa.DOC" 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.DOC" For Binary Access Write As #1
Put #1, , bteContent
Close #1
ShellExecute Me.hwnd, "open", "C:\AA.DOC", vbNullString, vbNullString, 1
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
