Simpan Photo/Gambar database access vb 6

Disini saya tidak akan menjelaskan bagaimana melakukan koneksi ke database access, intinya aplikasi Anda sudah siap menjalankan perintah SELECT, INSERT, UPDATE, dan DELETE. Jika Anda masih kesulitan bisa dilihat disini.

Untuk kasus disini kita akan menyimpan data karawan dengan tiga field saja, lihat gambar berikut :

Khusus untuk field foto tipe yang dipilih adalah OLE Object, kita langsung aja copy paste kode berikut di module :

	Option Explicit

	Public Const CHUNK_SIZE As Long = 16384

	Dim rsImage As ADODB.Recordset

	Dim i As Long
	Dim lsize As Long

009	Dim iChunks As Long
010	Dim nFragmentOffset As Long

011	Dim lchunks As Long
012

013	Dim nHandle As Integer
014	Dim varChunk() As Byte

015
016	Public Function fileExists(ByVal strNamaFile As String) As Boolean

017	If Not (Len(strNamaFile) > 0) Then fileExists = False: Exit Function
018

019	If Dir$(strNamaFile, vbNormal) = "" Then
020	fileExists = False

021	Else
022	fileExists = True

023	End If
024	End Function

025
026	Public Sub closeRecordset(ByVal vRs As ADODB.Recordset)

027	On Error Resume Next
028

029	If Not (vRs Is Nothing) Then
030	If vRs.State = adStateOpen Then

031	vRs.Close
032	Set vRs = Nothing

033	End If
034	End If

035	End Sub
036

037	Public Function addImageToDB(ByVal query As String, ByVal imageName As String, ByVal imageField As String) As Boolean
038	On Error GoTo errHandle

039
040	Set rsImage = New ADODB.Recordset

041	rsImage.Open query, conn, adOpenKeyset, adLockOptimistic
042	If Not rsImage.EOF Then

043	nHandle = FreeFile
044	Open imageName For Binary Access Read As nHandle

045	lsize = LOF(nHandle)
046	If nHandle = 0 Then Close nHandle

047
048	lchunks = lsize / CHUNK_SIZE

049	nFragmentOffset = lsize Mod CHUNK_SIZE
050

051	ReDim varChunk(nFragmentOffset)
052	Get nHandle, , varChunk()

053	rsImage(imageField).AppendChunk varChunk()
054

055	ReDim varChunk(CHUNK_SIZE)
056	For i = 1 To lchunks

057	Get nHandle, , varChunk()
058	rsImage(imageField).AppendChunk varChunk()

059	DoEvents
060	Next

061	rsImage.Update
062	End If

063	Call closeRecordset(rsImage)
064

065	addImageToDB = True
066

067	Exit Function
068	errHandle:

069	addImageToDB = False
070	End Function

071
072	Public Function getImageFromDB(ByVal query As String) As IPictureDisp

073	Dim sFile As String
074

075	On Error GoTo errHandle
076

077	Set rsImage = New ADODB.Recordset
078	rsImage.Open query, conn, adOpenForwardOnly, adLockReadOnly

079	If Not rsImage.EOF Then
080	If Not IsNull(rsImage(0).Value) Then

081	nHandle = FreeFile
082

083	sFile = App.Path & "\output.bin"
084	If fileExists(sFile) Then Kill sFile

085	DoEvents
086

087	Open sFile For Binary Access Write As nHandle
088

089	lsize = rsImage(0).ActualSize
090	iChunks = lsize \ CHUNK_SIZE

091	nFragmentOffset = lsize Mod CHUNK_SIZE
092

093	varChunk() = rsImage(0).GetChunk(nFragmentOffset)
094	Put nHandle, , varChunk()

095	For i = 1 To iChunks
096	ReDim varChunk(CHUNK_SIZE) As Byte

097
098	varChunk() = rsImage(0).GetChunk(CHUNK_SIZE)

099	Put nHandle, , varChunk()
100	DoEvents

101	Next
102	Close nHandle

103
104	Set getImageFromDB = LoadPicture(sFile, , vbLPColor)

105
106	Else

107	Set getImageFromDB = Nothing
108	End If

109
110	Else

111	Set getImageFromDB = Nothing
112	End If

113	Call closeRecordset(rsImage)
114

115	Exit Function
116	errHandle:

117	Set getImageFromDB = Nothing
118	End Function

Untuk di form cukup dengan kode sederhana berikut :

01	Private Sub cmdSimpan_Click()
02	'untuk format gambar bisa JPG atau BMP

03	strSql = "INSERT INTO mhs (nim, nama) VALUES ('" & txtNIM.Text & "', '" & txtNama.Text & "')"
04	conn.Execute strSql

05
06	If fileExists(txtLokasiFoto.Text) Then

07	strSql = "SELECT nim, foto FROM mhs WHERE nim = '" & txtNIM.Text & "'"
08	If Not addImageToDB(strSql, txtLokasiFoto.Text, "foto") Then MsgBox "Foto mahasiswa gagal disimpan !"