网页功能: 加入收藏 设为首页 网站搜索  
用VB6读写数据库中的图片
发表日期:2003-07-21作者:[] 出处:  

1,以人名和相关图片为例说明,数据库为Access,有如下字段:Name char,picture OLE object,FileLength

Number。当为ms sql时,将picture改为lob即可。

2,示例包含control:commom dialog,picture,listbox。

源码如下:

Option Explicit

Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As

String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long,

ByVal lpBuffer As String) As Long

Private Const MAX_PATH = 260

Private m_DBConn As ADODB.Connection

Private Const BLOCK_SIZE = 10000

注释: Return a temporary file name.

Private Function TemporaryFileName() As String

Dim temp_path As String

Dim temp_file As String

Dim length As Long

注释: Get the temporary file path.

temp_path = Space$(MAX_PATH)

length = GetTempPath(MAX_PATH, temp_path)

temp_path = Left$(temp_path, length)

注释: Get the file name.

temp_file = Space$(MAX_PATH)

GetTempFileName temp_path, "per", 0, temp_file

TemporaryFileName = Left$(temp_file, InStr(temp_file, Chr$(0)) - 1)

End Function

Private Sub Form_Load()

Dim db_file As String

Dim rs As ADODB.Recordset

注释: Get the database file name.

db_file = App.Path

If Right$(db_file, 1) <> "" Then db_file = db_file & ""

db_file = db_file & "dbpict.mdb"

注释: Open the database connection.

Set m_DBConn = New ADODB.Connection

m_DBConn.Open _

"Provider=Microsoft.Jet.OLEDB.4.0;" & _

"Data Source=" & db_file & ";" & _

"Persist Security Info=False"

注释: Get the list of people.

Set rs = m_DBConn.Execute("SELECT Name FROM People ORDER BY Name", , adCmdText)

Do While Not rs.EOF

lstPeople.AddItem rs!Name

rs.MoveNext

Loop

rs.Close

Set rs = Nothing

End Sub

Private Sub Form_Resize()

lstPeople.Height = ScaleHeight

End Sub

注释: Display the clicked person.

Private Sub lstPeople_Click()

Dim rs As ADODB.Recordset

Dim bytes() As Byte

Dim file_name As String

Dim file_num As Integer

Dim file_length As Long

Dim num_blocks As Long

Dim left_over As Long

Dim block_num As Long

Dim hgt As Single

picPerson.Visible = False

Screen.MousePointer = vbHourglass

DoEvents

注释: Get the record.

Set rs = m_DBConn.Execute("SELECT * FROM People WHERE Name=注释:" & _

lstPeople.Text & "注释:", , adCmdText)

If rs.EOF Then Exit Sub

注释: Get a temporary file name.

file_name = TemporaryFileName()

注释: Open the file.

file_num = FreeFile

Open file_name For Binary As #file_num

注释: Copy the data into the file.

file_length = rs!FileLength

num_blocks = file_length / BLOCK_SIZE

left_over = file_length Mod BLOCK_SIZE

For block_num = 1 To num_blocks

bytes() = rs!Picture.GetChunk(BLOCK_SIZE)

Put #file_num, , bytes()

Next block_num

If left_over > 0 Then

bytes() = rs!Picture.GetChunk(left_over)

Put #file_num, , bytes()

End If

Close #file_num

注释: Display the picture file.

picPerson.Picture = LoadPicture(file_name)

picPerson.Visible = True

Width = picPerson.Left + picPerson.Width + Width - ScaleWidth

hgt = picPerson.Top + picPerson.Height + Height - ScaleHeight

If hgt < 1440 Then hgt = 1440

Height = hgt

Kill file_name

Screen.MousePointer = vbDefault

End Sub

Private Sub mnuRecordAdd_Click()

Dim rs As ADODB.Recordset

Dim person_name As String

Dim file_num As String

Dim file_length As String

Dim bytes() As Byte

Dim num_blocks As Long

Dim left_over As Long

Dim block_num As Long

person_name = InputBox("Name")

If Len(person_name) = 0 Then Exit Sub

dlgPicture.Flags = _

cdlOFNFileMustExist Or _

cdlOFNHideReadOnly Or _

cdlOFNExplorer

dlgPicture.CancelError = True

dlgPicture.Filter = "Graphics Files|*.bmp;*.ico;*.jpg;*.gif"

On Error Resume Next

dlgPicture.ShowOpen

If Err.Number = cdlCancel Then

Exit Sub

ElseIf Err.Number <> 0 Then

MsgBox "Error " & Format$(Err.Number) & _

" selecting file." & vbCrLf & Err.Description

Exit Sub

End If

注释: Open the picture file.

file_num = FreeFile

Open dlgPicture.FileName For Binary Access Read As #file_num

file_length = LOF(file_num)

If file_length > 0 Then

num_blocks = file_length / BLOCK_SIZE

left_over = file_length Mod BLOCK_SIZE

Set rs = New ADODB.Recordset

rs.CursorType = adOpenKeyset

rs.LockType = adLockOptimistic

rs.Open "Select Name, Picture, FileLength FROM People", m_DBConn

rs.AddNew

rs!Name = person_name

rs!FileLength = file_length

ReDim bytes(BLOCK_SIZE)

For block_num = 1 To num_blocks

Get #file_num, , bytes()

rs!Picture.AppendChunk bytes()

Next block_num

If left_over > 0 Then

ReDim bytes(left_over)

Get #file_num, , bytes()

rs!Picture.AppendChunk bytes()

End If

rs.Update

Close #file_num

lstPeople.AddItem person_name

lstPeople.Text = person_name

End If

End Sub

我来说两句】 【加入收藏】 【返加顶部】 【打印本页】 【关闭窗口
中搜索 用VB6读写数据库中的图片
本类热点文章
  在VB应用程序中调用Excel2000
  在VB中使用水晶报表的一种简易编程方法
  BOM表查询的VB实现方法
  如何將Excel的文件导入Access文件
  把DataGrid的数据快速写入EXCEL
  Visual Basic 导出到 Excel 提速之法
  DataGrid 控件的使用
  VB中DataCombo和DataList 控件的使用
  ADO三大对象的属性、方法、事件及常数
  VB中MSHFlexGrid控件的应用
  VB+ADO检测数据库并发操作和处理并解决..
  用VB+WORD模版+数据库来制作格式合同..
最新分类信息我要发布 
最新招聘信息

关于我们 / 合作推广 / 给我留言 / 版权举报 / 意见建议 / 广告投放  
Copyright ©2003-2019 Lihuasoft.net webmaster(at)lihuasoft.net
网站编程QQ群   京ICP备05001064号 页面生成时间:0.00421