菜鸟向高手求助！VB6与SQL Server2000 的扫描图存储问题？

weizhongying 2003-11-06 11:34:51

在做一个工程方面的信息系统，有大量的扫描图需要存储。当只有少量图存入时，速度还可以，当有100张图进入以后（每张图800左右，jpg），存入和调出图的速度就非常慢了。
我的做法是：
在数据库建立附图表：
CREATE TABLE [dbo].[Futu] (
[gc_num] [char] (12) COLLATE Chinese_PRC_CI_AS NOT NULL ,
[pingmt] [image] NULL ,
[poumt] [image] NULL
) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]

VB6中建立存入和显示图的模块：

Const ChunkSize As Long = 100
Const BlockSize As Long = 100
Const TempFile As String = "tempfile.tmp"

Dim byteData() As Byte '定义数据块数组
Dim DiskFile As String '图像文件名
Dim NumBlocks As Long '定义数据块个数
Dim FileLength As Long '标识文件长度
Dim LeftOver As Long '定义剩余字节长度
Dim SourceFile As Long '定义自由文件号
Dim byteChunk() As Byte
Dim i As Long '定义循环变量

'存入平面图
Public Sub SaveImagePingmt(ByVal ImageFile As String, _
Adodc1 As Adodc)

If Adodc1.Recordset.BOF = True Or Adodc1.Recordset.EOF = True Then
Exit Sub
End If
If ImageFile = "" Then
Exit Sub
End If
'提供一个尚未使用的文件号
SourceFile = FreeFile
'打开文件
Open ImageFile 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 '得到剩余字节数
Adodc1.Recordset.Fields("pingmt").Value = Null
ReDim byteData(BlockSize) '重新定义数据块的大小
For i = 1 To NumBlocks
Get SourceFile, , byteData() '读到内存块中
Adodc1.Recordset.Fields("pingmt").AppendChunk byteData() '写入FLD
Next i
ReDim byteData(LeftOver) '重新定义数据块的大小
Get SourceFile, , byteData() '读到内存块中
Adodc1.Recordset.Fields("pingmt").AppendChunk byteData() '写入FLD
Close SourceFile '关闭源文件
Adodc1.Recordset.Update
End If
End Sub

'存入剖面图
Public Sub SaveImagePoumt(ByVal ImageFile As String, _
Adodc1 As Adodc)

If Adodc1.Recordset.BOF = True Or Adodc1.Recordset.EOF = True Then
Exit Sub
End If
If ImageFile = "" Then
Exit Sub
End If
'提供一个尚未使用的文件号
SourceFile = FreeFile
'打开文件
Open ImageFile 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 '得到剩余字节数
Adodc1.Recordset.Fields("poumt").Value = Null
ReDim byteData(BlockSize) '重新定义数据块的大小
For i = 1 To NumBlocks
Get SourceFile, , byteData() '读到内存块中
Adodc1.Recordset.Fields("poumt").AppendChunk byteData() '写入FLD
Next i
ReDim byteData(LeftOver) '重新定义数据块的大小
Get SourceFile, , byteData() '读到内存块中
Adodc1.Recordset.Fields("poumt").AppendChunk byteData() '写入FLD
Close SourceFile '关闭源文件
Adodc1.Recordset.Update
End If
End sub

'显示平面图

Public Sub ShowImagePingmt(Image1 As Image, _
Adodc1 As Adodc)
Erase byteChunk()
FieldSize = Adodc1.Recordset.Fields("pingmt").ActualSize
If FieldSize <= 0 Then
Image1.Picture = LoadPicture("")
Exit Sub
End If
'提供一个尚未使用的文件号
SourceFile = FreeFile
'打开文件
Open TempFile For Binary Access Write As SourceFile
'计算数据块
NumBlocks = FieldSize \ BlockSize
LeftOver = FieldSize Mod BlockSize '得到剩余字节数
'分块读取图像数据，并写入到文件中
If LeftOver <> 0 Then
ReDim byteChunk(LeftOver)
byteChunk() = Adodc1.Recordset.Fields("pingmt").GetChunk(LeftOver)
Put SourceFile, , byteChunk()
End If
For i = 1 To NumBlocks
ReDim byteChunk(BlockSize)
byteChunk() = Adodc1.Recordset.Fields("pingmt").GetChunk(BlockSize)
Put SourceFile, , byteChunk()
Next i
Close SourceFile
'将文件装入到Image1控件中
Image1.Picture = LoadPicture(TempFile)
'删除临时文件
Kill (TempFile)
End Sub

'显示剖面图
Public Sub ShowImagePoumt(Image1 As Image, _
Adodc1 As Adodc)
Erase byteChunk()
FieldSize = Adodc1.Recordset.Fields("poumt").ActualSize
If FieldSize <= 0 Then
Image1.Picture = LoadPicture("")
Exit Sub
End If
'提供一个尚未使用的文件号
SourceFile = FreeFile
'打开文件
Open TempFile For Binary Access Write As SourceFile
'计算数据块
NumBlocks = FieldSize \ BlockSize
LeftOver = FieldSize Mod BlockSize '得到剩余字节数
'分块读取图像数据，并写入到文件中
If LeftOver <> 0 Then
ReDim byteChunk(LeftOver)
byteChunk() = Adodc1.Recordset.Fields("poumt").GetChunk(LeftOver)
Put SourceFile, , byteChunk()
End If
For i = 1 To NumBlocks
ReDim byteChunk(BlockSize)
byteChunk() = Adodc1.Recordset.Fields("poumt").GetChunk(BlockSize)
Put SourceFile, , byteChunk()
Next i
Close SourceFile
'将文件装入到Image1控件中
Image1.Picture = LoadPicture(TempFile)
'删除临时文件
Kill (TempFile)
End Sub

VB6中通过调用以上模块存储显示图像
Private Sub Command1_Click()
Dim DiskFile As String

CommonDialog1.Filter = "JPEG文件(*.jpg)|*.jpg|BMP文件(*.bmp)|*.bmp|TIF文件(*.tif)|*.tif"
CommonDialog1.ShowOpen
CommonDialog1.DefaultExt = ""

DiskFile = CommonDialog1.FileName

If DiskFile = "" Then
'MsgBox "请选择图像文件"
'Unload Me
Exit Sub
End If

'存储并显示图像

FrmFT_Xs.Adodc1.RecordSource = "select * from futu where gc_num='" & Trim(FrmFT_Cz.Txt_num.Text) & "' "
FrmFT_Xs.Adodc1.Refresh

Call SaveImagePingmt(DiskFile, FrmFT_Xs.Adodc1)
Call ShowImagePingmt(FrmFT_Xs.Image1, FrmFT_Xs.Adodc1)

' 处理滚动条移动
FrmFT_Xs.HScroll1.Height = 350
FrmFT_Xs.HScroll1.Left = 0
FrmFT_Xs.HScroll1.Top = 10000
FrmFT_Xs.HScroll1.Width = 15010

FrmFT_Xs.VScroll1.Height = 10000
FrmFT_Xs.VScroll1.Top = 0
FrmFT_Xs.VScroll1.Left = 15010
FrmFT_Xs.VScroll1.Width = 350

'设置水平滚动条的有效状态
If FrmFT_Xs.Image1.Width < 15010 Then
FrmFT_Xs.HScroll1.Visible = False
Else
FrmFT_Xs.HScroll1.Visible = True
If FrmFT_Xs.Image1.Width - 14900 < 32767 Then
FrmFT_Xs.HScroll1.Max = FrmFT_Xs.Image1.Width - 14900
Else
FrmFT_Xs.HScroll1.Max = 32767
End If
End If
'设置竖直滚动条的有效状态
If FrmFT_Xs.Image1.Height < 10000 Then
FrmFT_Xs.VScroll1.Visible = False
Else
FrmFT_Xs.VScroll1.Visible = True
FrmFT_Xs.VScroll1.Max = FrmFT_Xs.Image1.Height - 9890
End If

FrmFT_Xs.Show
FrmFT_Xs.Caption = "工程 " & Trim(FrmFT_Cz.Txt_num.Text) & " 平面图添加成功"

End Sub

敬请指导或提出其他有效方法的建议！感谢！！！

...全文