Cari Blog Ini

Minggu, 17 Februari 2013

Menyimpan file gambar di database SQL Server & vb6

Mungkin ini sudah jadul, tapi saya yakin masih ada rekan2 kita yg masih susah dalam mengolah data type image di database Sql nya...
mudah2an trik ini bisa membantu rekan2 yg lagi susah untuk hal ini...

silahkan pelajari dan fungsi2 dibawah ini ...



'*** Untuk Menghapus fot dari field
Private Sub cmddelfoto_Click()
   If MsgBox("Anda yakin akan menghapus Foto ini?", vbQuestion + vbYesNo, "Hapus") = vbNo Then
     Exit Sub
   End If
   strSQL = "update FBARANG set foto =null  Where Kode=" & cStrSQL(txtKode.Text)
   gConn.Execute strSQL, , adCmdText
   Image1.Picture = Nothing
   CommonDialog1.FileName = ""
End Sub

Public Function LoadPictureFromDB(rs As ADODB.Recordset)
On Error GoTo procNoPicture

'If Recordset is Empty, Then Exit
If rs Is Nothing Then
  GoTo procNoPicture
End If

Set strstream = New ADODB.Stream
strstream.Type = adTypeBinary
strstream.Open

strstream.Write rs.Fields("FOTO").Value


strstream.SaveToFile App.Path & "\Temp.bmp", adSaveCreateOverWrite
Image1.Picture = LoadPicture(App.Path & "\Temp.bmp")
Kill (App.Path & "\Temp.bmp")
LoadPictureFromDB = True

procExitFunction:
Exit Function
procNoPicture:
LoadPictureFromDB = False
GoTo procExitFunction
End Function

Public Function SavePictureToDB(rs As ADODB.Recordset, _
sFileName As String)

On Error GoTo procNoPicture
Dim oPict As StdPicture

Set oPict = LoadPicture(sFileName)
Image1.Picture = LoadPicture(sFileName)

'Exit Function if this is NOT a picture file
If oPict Is Nothing Then
MsgBox "file gambar tidak Valid!", vbOKOnly, "Oops!"
SavePictureToDB = False
GoTo procExitSub
End If


procExitSub:
Exit Function
procNoPicture:
SavePictureToDB = False
GoTo procExitSub
End Function

Private Function SaveImage()
If Not CommonDialog1.FileName = "" Then
  Dim mStream As New ADODB.Stream
 
  strSQL = "update FBARANG set foto =null  Where Kode=" & cStrSQL(txtKode.Text)
  gConn.Execute strSQL, , adCmdText
 
  Set rs2 = Nothing
  Set rs2 = New ADODB.Recordset
  rs2.Open "Select * from FBARANG where Kode=" & cStrSQL(txtKode.Text), gConn, adOpenKeyset, adLockOptimistic
  With mStream
    .Type = adTypeBinary
    .Open
    .LoadFromFile CommonDialog1.FileName
    rs2("FOTO").Value = .Read
    rs2.Update
  End With
  Set mStream = Nothing
  Set rs2 = Nothing
 
End If
End Function

1 komentar: