发信人: johnnyxu()
整理人: chedong(1999-07-04 09:24:09), 站内信件
|
VB Tips(7) -- 设计数据库图象存取DLL
假设SQL Server数据库表中有一Image字段用来存放图像内容，如果要
在VB的Image控件或在Web页中显示图像，必须先将Image内容从表中取出，
保存为磁盘文件，返回文件名及路径。为了避免同一图像的反复存取，将取
出的图像文件保存到一特定目录中，如果该目录中已有此图像文件，则无须
从表从取出，而直接读取该文件即可。
' ImageLoader功能：
' 1. 将Binary/Text文件内容保存到SQL Server的Image/Text字段
' 2. 取出SQL Server的Image/Text字段内容到Binary/Text文件中
' 要求的数据库表结构:
' Image/Text字段 保存Binary/Image/Text文件内容
' Varchar字段 保存文件名(无路径)，可选
Private mImageFilePath As String ' 文件所在的目录
Const BLOCKSIZE = 4096
' 设置存放文件的目录, 只写属性
Public Property Let ImageFilePath(ByVal vFilePath As String)
mImageFilePath = vFilePath
End Property
' 如果文件已存在，则返回文件名，包括全路径；只读属性
' 如果不存在，则将Image/Text列的内容从表中取中，保存到新的文件中，
' 返回该文件名，包括全路径
' 输入参数：Fld Image/Text字段
' vImageFile 文件名，包含文件最初所在的目录
' 返回值: 位于特定目录下的文件名
Public Property Get ImageFile(ByRef Fld As ADODB.Field, ByVal vImageFi
le _
As String) As String
Dim NumBlocks As Long
Dim LeftOver As Long
Dim byteData() As Byte ' 用于处理Image 字段
Dim strData As String ' 用于处理Text 字段
Dim DestFileNum As Integer
Dim I As Integer
Dim FldSize As Long
Dim tmpImageFile As String
'取得文件名，移去文件路径
tmpImageFile = Mid(vImageFile, PosA(vImageFile, "\") + 1)
FldSize = Fld.ActualSize
' 判断文件是否存在于特定的目录中，如果不存在，则将Image/Text列的内
容保存到
' 该目录下的一个新的文件中
If Dir(mImageFilePath & tmpImageFile) = "" Then
'文件不存在,
DestFileNum = FreeFile
Open mImageFilePath & tmpImageFile For Binary As DestFileNum
NumBlocks = FldSize \ BLOCKSIZE
LeftOver = FldSize Mod BLOCKSIZE
Select Case Fld.Type
Case adLongVarBinary 'Image 字段
byteData() = Fld.GetChunk(LeftOver)
Put DestFileNum, , byteData()
For I = 1 To NumBlocks
byteData() = Fld.GetChunk(BLOCKSIZE)
Put DestFileNum, , byteData()
Next I
Case adLongVarChar 'Text 字段
strData = String(BLOCKSIZE, 32)
For I = 1 To NumBlocks
strData = Fld.GetChunk(BLOCKSIZE)
Put DestFileNum, , strData
Next I
strData = String(LeftOver, 32)
strData = Fld.GetChunk(LeftOver)
Put DestFileNum, , strData
End Select
Close DestFileNum
End If
ImageFile = mImageFilePath & tmpImageFile
End Property
' 将Binary/Text文件内容保存到Image/Text字段
' 输入参数：Fld Image/Text字段
' FldDesc 文件名字段，不包含路径，可选
' DiskFile 文件名，包含文件最初所在的目录
Public Sub SaveToDB(ByRef Fld As ADODB.Field, DiskFile As String, _
Optional ByRef FldDesc As ADODB.Field)
Dim strData As String '用于处理Text字段
Dim byteData() As Byte '用于处理Image字段
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
Select Case Fld.Type
Case adLongVarBinary 'Image 字段
ReDim byteData(NumBlocks)
For I = 1 To NumBlocks
Get SourceFile, , byteData()
Fld.AppendChunk byteData()
Next I
ReDim byteData(LeftOver)
Get SourceFile, , byteData()
Fld.AppendChunk byteData()
Case adLongVarChar 'Text 字段
strData = String(BLOCKSIZE, 32)
For I = 1 To NumBlocks
Get SourceFile, , strData
Fld.AppendChunk strData
Next I
strData = String(LeftOver, 32)
Fld.AppendChunk strData
End Select
Close SourceFile
If Not IsMissing(FldDesc) Then FldDesc.Value = Mid(DiskFile, P
osA(DiskFile, "\") + 1)
End If
End Sub
Private Sub Class_Initialize()
mImageFilePath = "C:\"
End Sub
Private Function PosA(Str1 As String, Char As String) As Integer
For I = Len(Str1) To 1 Step -1
tmp = Mid(Str1, I, 1)
If tmp = Char Then
PosA = I
Exit Function
End If
Next
PosA = 0
End Function
在VB中将以上代码封装到DLL中，可以方便地存取数据库图像字段。
John
[email protected]
--
※ 来源:．月光软件站 http://www.moon-soft.com．[FROM: 202.109.33.145]
|
|