精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● 数据库技术>>VisualBasic专题>>VB Tips(7) -- 设计数据库图象存取DLL

主题:VB Tips(7) -- 设计数据库图象存取DLL
发信人: 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]

[关闭][返回]