Dim cnnImage As New ADODB.Connection
Dim rsImage As New ADODB.Recordset
Dim strSQL As String
Dim Chunk() As Byte
Dim lngLengh As Long
Dim intChunks As Integer
Dim intFragment As Integer
Const ChunkSize = 1000
Const lngDataFile = 1
Private Sub cmdBrowse_Click()
'选择 JPG OR Bmp 文件
On Error Resume Next
With cmdlFilePath
.Filter = "JPG Files|*.JPG|Bitmaps|*.BMP"
.ShowOpen
txtFilePath.Text = .FileName
End With
End Sub
Private Sub Form_Load()
rsImage.LockType = adLockOptimistic
rsImage.CursorType = adOpenKeyset
cnnImage.Provider = "Microsoft.Jet.OLEDB.4.0"
strSQL = App.Path & "\hsg.mdb"
cnnImage.Open strSQL
strSQL = "Select * From allcai"
rsImage.Open strSQL, cnnImage
If (rsImage.BOF = True) And (rsImage.EOF = True) Then Exit Sub
Call cmdFirst_Click
Combo1.AddItem ("蔬菜类")
Combo1.AddItem ("海鲜类")
Combo1.AddItem ("肉类")
Combo1.AddItem ("汤类")
Combo1.AddItem ("酒水类")
Combo1.AddItem ("其他类")
End Sub
Public Sub ShowPic()
On Error Resume Next
Open "pictemp" For Binary Access Write As lngDataFile
lngLengh = rsImage!picImage.ActualSize
intChunks = lngLengh \ ChunkSize
intFragment = lngLengh Mod ChunkSize
ReDim Chunk(intFragment)
Chunk() = rsImage!picImage.GetChunk(intFragment)
Put lngDataFile, , Chunk()
For i = 1 To intChunks
ReDim Buffer(ChunkSize)
Chunk() = rsImage!picImage.GetChunk(ChunkSize)
'建立图片临时文件
Put lngDataFile, , Chunk()
Next i
Close lngDataFile
FileName = "pictemp"
Picture1.Picture = LoadPicture(FileName)
End Sub
Private Sub Command1_Click()
If Trim(Text1.Text) = "" Or Trim(Text2.Text) = "" Or Trim(Text3.Text) = "" Then
MsgBox "请填写完整", , "系统提示"
Exit Sub
End If
If IsNumeric(Text3.Text) = False Then
MsgBox "价格必需是数字型", , "系统提示"
Exit Sub
End If
If Combo1.Text = "请选择" Then
MsgBox "请选择类别", , "系统提示"
Exit Sub
End If
sql = "select id from allcai where bh='" & Trim(Text1.Text) & "'"
Dim rs As New ADODB.Recordset
mycon.Open
rs.Open sql, mycon, 1, 1
If rs.EOF Then
Else
rs.Close
mycon.Close
MsgBox "对不起,该编号已经存在,请换其他编号", , "系统提示"
Exit Sub
End If
rs.Close
mycon.Close
sql = "insert into allcai(bh,cname,leibie,price) values('" & Trim(Text1.Text) & "','" & Trim(Text2.Text) & "','" & Trim(Combo1.Text) & "'," & Trim(Text3.Text) & ")"
mycon.Open
mycon.Execute sql
mycon.Close
MsgBox "添加成功", , "系统提示"
'保存文件到数据库中
If Trim(txtFilePath.Text) = "" Then
MsgBox "未选择文件.!!", vbInformation + vbSystemModal, "保存出错"
Exit Sub
End If
If (Dir(Trim(txtFilePath.Text)) = "") Then Exit Sub
'以二进制方式打开文件
Open Trim(txtFilePath.Text) For Binary Access Read As lngDataFile
lngLengh = LOF(lngDataFile)
' 文件大小
If lngLengh = 0 Then Close lngDataFile: Exit Sub
intChunks = lngLengh \ ChunkSize
intFragment = lngLengh Mod ChunkSize
'新建记录
rsImage.AddNew
ReDim Chunk(intFragment)
Get lngDataFile, , Chunk()
rsImage!picImage.AppendChunk Chunk()
ReDim Chunk(ChunkSize)
For i = 1 To intChunks
Get lngDataFile, , Chunk()
rsImage!picImage.AppendChunk Chunk()
Next i
rsImage.Update
Close lngDataFile
Call ShowPic
End Sub
