山寨机中的战斗机！	程序优化工程师到底对IT界有没有贡献

图片文件存入数据库的问题（是存文件，不是文件地址）！！！请教啊！！再线守侯！！快啊！

楼主aming112（测试并开发着）2003-12-02 22:27:43 在 VB / 数据库(包含打印，安装，报表) 提问

相关代码如下：
Public Sub SaveInto(ByVal strPath As String)
Dim lngFileLength As Long 'the length of the file
Dim lngBlockCount As Long 'the number of total whole block
Dim lngLastBlock As Integer 'the length of the last block
Dim lngBlockIndex As Long 'the index of each block
Dim ByteGet() As Byte '用于传送数据的二进制数组
Dim FileNum As Integer 'return the file number which the next file will use
Dim strFilepath As String

lngBlockSize = 1
strFilepath = Label1.Caption
FileNum = FreeFile()
Open strFilepath For Binary Access Read As #FileNum
lngFileLength = LOF(FileNum) '返回一个 Long，表示用 Open 语句打开的文件的大小，该大小以字节为单位。
lngBlockCount = lngFileLength / lngBlockSize
lngLastBlock = lngFileLength Mod lngBlockSize
MsgBox "sd" & lngBlockCount & "dsf"
obj.AddNew
obj.Fields("id") = 1
obj.Fields("name") = Trim("assd")
ReDim ByteGet(lngBlockSize)
For lngBlockIndex = 1 To lngBlockCount
Get #FileNum, , ByteGet()
Close #FileNum
obj.Fields("photo").AppendChunk ByteGet()

'运行到这里时显示 3219
’操作在该内容中不被允许

Next
If lngLastBlock > 0 Then
ReDim ByteGet(lngLastBlock)
Get #FileNum, , ByteGet()
obj.Fields("photo").AppendChunk ByteGet()
End If
obj.Update
Close #FileNum
End Sub 问题点数：80、回复次数：20Top

1 楼danielinbiti（金）回复于 2003-12-02 23:00:58 得分 0

可惜没时间，要熄灯了。
可以去
www.vbgood.com
看看相关资料Top

2 楼aming112（测试并开发着）回复于 2003-12-03 07:17:18 得分 0

非常感谢但是在那里也没找到有啊！！Top

3 楼SoHo_Andy（冰）回复于 2003-12-03 08:12:06 得分 0

参考一下下面的例子

将任何文件从数据库中下载到本地:
Public Function LoadFile(ByVal col As ADODB.Field, ByVal FileName As String) As Boolean '获得binary数据
On Error GoTo myerr:
Dim arrBytes() As Byte
Dim FreeFileNumber As Integer
lngsize = col.ActualSize
arrBytes = col.GetChunk(lngsize)
FreeFileNumber = FreeFile
Open FileName For Binary Access Write As #FreeFileNumber
Put #FreeFileNumber, , arrBytes
Close #FreeFileNumber
LoadFile = True
myerr:
If Err.Number <> 0 Then
LoadFile = False
Err.Clear
End If
End Function

'将文件从本地上传到数据库中
Public Function UpLoadFile(ByVal FileName, ByVal col As ADODB.Field) As Boolean
On Error GoTo myerr:
Dim arrBytes() As Byte
Dim FreeFileNumber As Integer
FreeFileNumber = FreeFile
Open FileName For Binary As #FreeFileNumber
n = LOF(FreeFileNumber)
ReDim arrBytes(1 To n) As Byte
Get #FreeFileNumber, , arrBytes
Close #FreeFileNumber
col.AppendChunk (arrBytes)
UpLoadFile = True
myerr:
If Err.Number <> 0 Then
UpLoadFile = False
Err.Clear
End If
End FunctionTop

4 楼yoki（小马哥--鬓微霜，又何妨）回复于 2003-12-03 09:16:37 得分 0

可以改成：
Private Sub SavePictureToDB()
'将BMP图片存入数据库
Dim stm As ADODB.Stream
On Error GoTo EH
Set stm = New ADODB.Stream
With stm
.Type = adTypeBinary
.Open
.LoadFromFile Label1.Caption
End With
With Obj
.AddNew
.Fields("id") = 1
.Fields("name") = Trim("assd")
.Fields("photo") = stm.Read
.Update
End With
Obj.Close
stm.Close
Set stm = Nothing
Exit Sub
EH: MsgBox Err.Description, vbInformation, "Error"
End SubTop

5 楼yoki（小马哥--鬓微霜，又何妨）回复于 2003-12-03 09:20:38 得分 0

也可以参考这个做相应修改：
Public Function GetFromFile(strTable As String, strField As String, strFilter As String, objFileName As String) As Boolean

'============================================================
'　过程函数名： CommModule.GetFromFile　类型：Function
'　参数：
'　　　　 strTable (String)　　：准备保存图形数据的表名称
'　　　　 strField (String)　　：准备保存图形数据的字段名称
'　　　　 strFilter (String)　：打开表的过滤字符串，用于定位并确保被打开的表的数据的唯一性
'　　　　 objFileName (String) ：准备输入到表里边的图象文件名称
'　返回：如果保存成功，返回True，如果失败，返回False
'-------------------------------------------------------------
'　说明：把图象文件的数据保存到表里边
'-------------------------------------------------------------
'　修订历史：
'=============================================================
Dim recset As ADODB.Recordset
Dim FileData() As Byte
Dim FileNo As Long
Dim FileSize As Long
Dim strSQL As String

strSQL = "Select " & strField & " From " & strTable & " Where " & strFilter & ";"
Set recset = New ADODB.Recordset
recset.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic
GetFromFile = True
If recset(strField).Type <> DB_OLE Or Not IsFileName(objFileName) Then
GetFromFile = False '如果字段不是OLE字段，或者文件不存在，返回错误
GoTo EndGetFromfile
End If
If recset.EOF Then '如果记录不存在，返回错误
GetFromFile = False
GoTo EndGetFromfile
End If
FileSize = GetFileSize(objFileName) '如果被打开的文件大小为零，返回错误
If FileSize <= 0 Then
GetFromFile = False
GoTo EndGetFromfile
End If
ReDim FileData(FileSize) '重新初始化数组
FileNo = FreeFile '获取一个空闲的文件号
Open objFileName For Binary As #FileNo '打开文件
Get #FileNo, , FileData() '读取文件内容到数组
Close #FileNo '关闭文件
recset(strField).Value = FileData() '保存数据
recset.Update '更新数据
Erase FileData '释放内存
EndGetFromfile:
recset.Close '关闭RecordSet
Set recset = Nothing '释放内存
End FunctionTop

6 楼yoki（小马哥--鬓微霜，又何妨）回复于 2003-12-03 09:24:52 得分 0

Private Sub SaveToDB(ByRef Fld As ADODB.Field, DiskFile As String)
Dim byteData() As Byte '定义数据块数组
Dim NumBlocks As Long '定义数据块个数
Dim FileLength As Long '标识文件长度
Dim LeftOver As Long '定义剩余字节长度
Dim SourceFile As Long '定义自由文件号
Dim i As Long '定义循环变量

SourceFile = FreeFile '提供一个尚未使用的文件号
Open DiskFile For Binary Access Read As SourceFile '打开文件
FileLength = LOF(SourceFile) '得到文件长度
If FileLength = 0 Then '判断文件是否存在
Close SourceFile
MsgBox DiskFile & " 无内容或不存在 !"
Else
NumBlocks = FileLength \ BlockSize '得到数据块的个数
LeftOver = FileLength Mod BlockSize '得到剩余字节数
Fld.Value = Null
ReDim byteData(BlockSize) '重新定义数据块的大小
For i = 1 To NumBlocks
Get SourceFile, , byteData() ' 读到内存块中
Fld.AppendChunk byteData() '写入FLD
Next i
ReDim byteData(LeftOver) '重新定义数据块的大小
Get SourceFile, , byteData() '读到内存块中
Fld.AppendChunk byteData() '写入FLD
Close SourceFile '关闭源文件
End If
End SubTop

7 楼yoki（小马哥--鬓微霜，又何妨）回复于 2003-12-03 09:26:22 得分 0

主题：《在VB中存取数据库中的图片》

　　我最近在做一个人事管理的系统，要求把个人信息存入数据库(包括个人的像片)。费了一个多星期时间研究，终于实现，现在提出来和大家共享。
　　一、数据库的设计

　　数据库可以采用微软的Access97或者SQL Server来进行，首先新建一张表，取名为Table，添加三个字段，分别是：姓名 Char型（SQL Server中）文本型（Access中）；编号Char型（SQL Server中）文本型（Access中）；照片image型（SQL Server中）OLE对象（Access中），设计好后存盘。为了可以进行远程调用，我们采用ODBC的方法进行，双击打开控制面板里的ODBC数据源，界面如图1所示：
　　点“系统DSN”选项卡，按“添加”按钮选择对应的数据源驱动程序Access的＊.mdb或者SQL Server，依照添加向导加添加数据源，下面就可以开始程序的编写了。
　　二、程序的编写

　　运行VB，新建一个工程。本程序采用ADO控件和动态链接库访问数据库，需要加入ADO的运行库，单击“工程\引用”菜单，出现引用对话框，选择Microsoft ActiveX Data Objects2.0 Library并确定。
　　添加一个Form，四个Label控件，两个TextBox控件，一个PictureBox控件，一个ADODC控件，三个CommandButton控件，一个CommandDialog控件，如果ADODC和CommandDialog控件没有出现在工具框上，请单击菜单“工程\部件”。点“控件”选项卡，在其中选中Microsoft ADO Data Control 6.0(OLEDB)和Microsoft Common Dialog Control 6.0两项按“确定”按钮。
　　下面是以上各个控件的一些属性：
　　Form1.MaxButton=False
　　Label1.Caption=姓名：
　　Label2.Caption=编号：
　　Label3.Name= ResName
　　Label3.BackColor= ＆H80000009＆
　　Label3.BorderStyle=1－Fixed Single
　　Label3.DataField=姓名
　　Label3.DataSource= AdoCtr
　　Label4.Name= ResNumb
　　Label4.BackColor= ＆H80000009＆
　　Label4.BorderStyle=1－Fixed Single
　　Label4.DataField=编号
　　Label4.DataSource= AdoCtr
　　Text1.Name= Names
　　Text2.Name= Numb
　　CommonDialog1.Name= CDlg
　　Adodc1.Name=AdoCtr
　　CommonButton1.Name=PreView
　　CommonButton1.Caption=预览
　　CommonButton2.Name=Save
　　CommonButton2.Caption=保存
　　CommonButton3.Name= Update
　　CommonButton3.Caption=更新
　　PictureBox1.Name= PicBox
　　PictureBox1.AutoSize=False
　　PictureBox1.AutoRedraw=False
　　PictureBox1.DataField=照片
　　PictureBox1.DataSource=AdpCtr
　　下面是程序代码：
　　′此工程需有Microsoft ActiveX Data Object 2.1 Library(msado15.dll)
　　Dim Constr As String ′ODBC路径
　　Dim FileName As String ′图片文件名
　　Const BLOCKSIZE = 4096 ′每次读写块的大小
　　Dim ADOCon As New ADODB.Connection ′ADODB Connection对象
　　Dim ADORst As New ADODB.Recordset ′ADODB Recordset 对象
　　Dim ADOFld As ADODB.Field ′ADODB Field 对象
－－－－－－－－－－－－－－－－－－－－－－－－
　　Private Sub SaveToDB(ByRef Fld As ADODB.Field, DiskFile As String)
　　Dim byteData() As Byte ′定义数据块数组
　　Dim NumBlocks As Long ′定义数据块个数
　　Dim FileLength As Long ′标识文件长度
　　Dim LeftOver As Long′定义剩余字节长度
　　Dim SourceFile As Long ′定义自由文件号
　　Dim i As Long ′定义循环变量
　　SourceFile = FreeFile ′提供一个尚未使用的文件号
　　Open DiskFile For Binary Access Read As SourceFile ′打开文件
　　FileLength = LOF(SourceFile) ′得到文件长度
　　If FileLength = 0 Then ′判断文件是否存在
　　Close SourceFile
　　MsgBox DiskFile ＆ ″ 无内容或不存在 !″
　　Else
　　NumBlocks = FileLength \ BLOCKSIZE ′得到数据块的个数
　　LeftOver = FileLength Mod BLOCKSIZE ′得到剩余字节数
　　Fld.Value = Null
　　ReDim byteData(BLOCKSIZE) ′重新定义数据块的大小
　　For i = 1 To NumBlocks
　　Get SourceFile, , byteData() ′ 读到内存块中
　　Fld.AppendChunk byteData() ′写入FLD
　　Next i
　　ReDim byteData(LeftOver) ′重新定义数据块的大小
　　Get SourceFile, , byteData() ′读到内存块中
　　Fld.AppendChunk byteData() ′写入FLD
　　Close SourceFile ′关闭源文件
　　End If
　　End Sub
　　－－－－－－－－－－－－－－－－－－－－－－
　　Private Sub Form_Load()
　　 Constr = ″DSN=image″ ′定义ODBC连接
　　 ADOCon.Open Constr ′创建一个连接
　　 ADORst.Open ″table″, ADOCon, adOpenDynamic, adLockOptimistic
　　′打开一个ADO动态集表名为table
　　 Set AdoCtr.Recordset = ADORst ′将动态集赋给ADO控件
　　End Sub
　　－－－－－－－－－－－－－－－－－－－－－－
　　Private Sub Form_Unload(Cancel As Integer)
　　′记得关闭打开的数据集，释放资源
　　ADORst.Close
　　ADOCon.Close
　　Set ADORst = Nothing
　　Set ADOCon = Nothing
　　End Sub
　　－－－－－－－－－－－－－－－－－－－－－－
　　Private Sub PreView_Click()
　　′显示打开文件的公用对话框，选择需要加入数据库的图片
　　CDlg.Filter = ″位图(＊.bmp)|＊.bmp″
　　CDlg.ShowOpen
　　FileName = CDlg.FileName
　　PicBox.Picture = LoadPicture(FileName) ′预览图片
　　End Sub
　　－－－－－－－－－－－－－－－－－－－－－－
　　Private Sub Save_Click()
　　ADORst.AddNew ′新增纪录
　　ADORst(″姓名″).Value = Names.Text ′给动态集的第一个字段赋值
　　ADORst(″编号″).Value = Numb.Text ′给动态集的第二个字段赋值
　　Set ADOFld = ADORst(″照片″) ′给ADODB.Field对象赋值
　　Call SaveToDB(ADOFld, FileName) ′调用子程序，给第三个字段（image）赋值
　　ADORst.Update
　　End Sub
　　－－－－－－－－－－－－－－－－－－－－－－
　　Private Sub Update_Click()
　　′重新打开纪录集，刷新纪录
　　ADORst.Close
　　ADOCon.Close
　　Set ADORst = Nothing
　　Set ADOCon = Nothing
　　ADOCon.Open Constr
　　ADORst.Open ″table″, ADOCon, adOpenDynamic, adLockOptimistic
　　Set AdoCtr.Recordset = ADORst
　　End Sub
　　程序运行后的结果如图2。
　　本程序在VB6.0／Windows98／WindowsNT下编译通过。Top

8 楼GuiltyGear（罪恶装备）回复于 2003-12-03 09:40:43 得分 0

Const BLOCK_SIZE = 4096

Public Sub SavePicToDataBase(ByRef TheRecordset As Recordset, ByRef TheDataField As Field, ByRef PrograssBarA As ProgressBar, PictureFile As String)

Dim ByteFile() As Byte
Dim strFileName As String
Dim LngFileLen As Long,LngFileH As Long
Dim BlocksNum As Long,LastLeft As Long
Dim I As Long

LngFileH = FreeFile
Open PictureFile For Binary Access Read As LngFileH
LngFileLen = LOF(LngFileH)
If LngFileLen = 0 Then
Close LngFileH
Else
BlocksNum = LngFileLen \ BLOCK_SIZE
LastLeft = LngFileLen Mod BLOCK_SIZE
ReDim ByteFile(BLOCK_SIZE)
For I = 1 To BlocksNum
Get LngFileH, , ByteFile()
TheDataField.AppendChunk ByteFile()
Next I
ReDim ByteFile(LastLeft)
Get LngFileH, , ByteFile()
TheDataField.AppendChunk ByteFile()
Close LngFileH
End If
End Sub

以前写数据库的时候做了一个模块，现在把里面的一个过程拿出来Top

9 楼Maconel（Maconel）回复于 2003-12-03 10:30:40 得分 0

就是把图片当成文本文件来读取，然后存到数据库中吧Top

10 楼aming112（测试并开发着）回复于 2003-12-03 11:06:54 得分 0

谢谢各位了！！小弟在此非常感激。但是你们是否真正的使用过还是书上的OR转帖的，因为就是不行啊。当我写数据时它说更新多步OLE对象时出错！！请大家帮忙 UP 一下！！Top

11 楼lvlvlvlylyly（那森）回复于 2003-12-03 20:04:40 得分 0

On the Project menu, click to select References, and then set a reference to the Microsoft ActiveX Data Objects 2.5 Object Library.

你有没有在工程里面添加“引用”？Top

12 楼aming112（测试并开发着）回复于 2003-12-03 22:28:44 得分 0

当然，我肯定引用了的啥。Top

13 楼lben58（）回复于 2003-12-03 22:32:09 得分 0

去:http://www.china-askpro.com/msg14/qa39.shtmlTop

14 楼aming112（测试并开发着）回复于 2003-12-03 22:39:56 得分 0

非常感谢！！
我去看看！！Top

15 楼aming112（测试并开发着）回复于 2003-12-03 22:45:22 得分 0

这个列子我看过了，那是用的是ACCESS本地数据库，而且是ACCESS95建立的，我想用SQL SERVER做数据库。Top

16 楼Maconel（Maconel）回复于 2003-12-04 13:58:40 得分 0

我试成功了，不过我数据库不是很熟，所以在数据库使用方面苯了点，呵呵，不过是可以存取图片的，是sql，要的话给你发过去Top

17 楼aming112（测试并开发着）回复于 2003-12-04 15:21:33 得分 0

楼上这位大哥，谢谢你发给我嘛。我的信箱:
aming112@163.com
分是肯定要给的。Top

18 楼taosihai1only（无招胜有招）回复于 2003-12-04 15:27:14 得分 0

www.china-askpro.com/msg14/qa39.shtmlTop

19 楼aming112（测试并开发着）回复于 2003-12-04 22:16:37 得分 0

上面这位好心的同志，请不要发和别人一样的回复。Top

20 楼Maconel（Maconel）回复于 2003-12-05 12:21:01 得分 80

发过去了Top