Seperti telah dijelaskan di posting terdahulu, BLOB atau Binary Large Object Bitmap merupakan tipe data biner yang digunakan untuk menyimpan objek berupa file ke dalam suatu database. Di MS Access kita juga bisa membuat sebuah database yang digunakan khusus untuk menyimpan objek berupa file. Ikuti caranya pada pembahasan berikut ini.
Untuk mudahnya, kita akan membuat sebuah database. Namailah database itu blob.accdb. Database blob.accdb ini hanya akan berisi sebuah tabel yang akan digunakan untuk mengelola data yang berupa file. apa pun tipe file nya. Oleh karena itu supaya database blob.accdb ini informatif, maka kita akan membuat sebuah tabel, sebutlah nama tabel itu tblBlob. Berikut ini adalah field beserta propertinya yang ada dalam tblBlob.
Ikuti langkah-langkah di bawah ini:
Selanjutnya, kita menuliskan kode VBA melalui modul. Ada dua modul yang harus dibuat. Modul yang pertama berkaitan dengan form frmBlob, yang merupakan class module. Sedangkan modul yang kedua merupakan standard module yang berisi kode VBA khusus untuk menyimpan data BLOB yang dilakukan melalui form frmBlob beserta class module Form_frmBlob. Kita beri nama standard module itu mdlBlob.
Untuk mudahnya, kita akan membuat sebuah database. Namailah database itu blob.accdb. Database blob.accdb ini hanya akan berisi sebuah tabel yang akan digunakan untuk mengelola data yang berupa file. apa pun tipe file nya. Oleh karena itu supaya database blob.accdb ini informatif, maka kita akan membuat sebuah tabel, sebutlah nama tabel itu tblBlob. Berikut ini adalah field beserta propertinya yang ada dalam tblBlob.
- Field Name: blobId
- Field Description: Nomor urut BLOB object
- Properti:
- Caption: BlobId
- Type: Long Integer (Autonumber)
- Field Name: blobObjek
- Field Description: Sisipkan sebuah objek BLOB di sini
- Properti:
- Caption: Objek BLOB
- Type: OLE Object
- Field Name: blobMeta
- Field Description: Metadata dari objek BLOB
- Properti:
- Caption: Meta Data
- Type: Text
- Field Name: blobNamaFile
- Field Description: Nama file orisinil dari objek BLOB
- Properti:
- Caption: Nama File
- Type: Text
- Field Name: blobNamaEkstensi
- Field Description: Nama ekstensi orisinil dari objek BLOB
- Properti:
- Caption: Nama Ekstensi
- Type: Text
- Field Name: blobUkuran
- Field Description: Ukuran file orisinil dari objek BLOB
- Properti:
- Caption: Ukuran
- Type: Long Integer (Number)
- Field Name: blobDeskripsi
- Field Description: Deskripsi ringkas dari objek BLOB
- Properti:
- Caption: Deskripsi
- Type: Text
Ikuti langkah-langkah di bawah ini:
- Simpanlah form yang baru saja dibuat dengan nama frmBlob.
- Hapuslah tipe form control Bound Object Frame yang bernama blobObjek.
- Sisipkan sebuah tipe control Image untuk mengganti Bound Object Frame dengan menekan tombol Image di Group Control. Properti control itu adalah sbb:
- Name=blobData
- Control Source= untuk sementara, control ini dikosongkan (unbound). Control Source ini akan diisi expression builder saat kita membahas cara membaca data tipe BLOB.
Design view setelah pergantian control adalah sbb:
- Pada bagian Form Header, sisipkan sebuah text box control dan 2 buah tombol perintah. Propertinya adalah sbb:
- Text Box, Name= txtNameFile, label untuk text box ini, Caption=Upload File
- Button (Form Control), Name=cmdUpload, Caption=Upload File Baru
- Button (Form Control), Name=cmdPilihFile, Caption=Pilih File, Picture=Open Folder
- Pada bagian Form Footer, sisipkan beberapa tombol perintah berikut ini:
- Button (Form Control), Name=cmdSimpan, Caption=Simpan
- Button (Form Control), Name=cmdSimpanTambahBaru, Caption=Simpan, Tambah Data Baru
- Button (Form Control), Name=cmdTambahBaru, Caption=Tambah Data Baru
- Button (Form Control), Name=cmdHapus, Caption=Hapus
- Hapus semua properti Control Source yang terhubung (bound) ke tabel tblBlob sehingga semua Control Source tidak terisi atau Unbound. Jadi nama-nama control berikut ini tidak mempunyai nilai Control Source: blobId, blobMeta, blobNamaFile, blobNamaEkstensi, blobUkuran, dan blobDeskripsi. Selain itu, properti Record Source dari form frmBlob juga Unbound.
- Langkah terakhir, untuk melindungi metadata file dari pengeditan yang tidak perlu, aturlah properti Enabled=False untuk control berikut ini: blobId, blobMeta, blobNamaFile, blobNamaEkstensi, dan blobUkuran.
Selanjutnya, kita menuliskan kode VBA melalui modul. Ada dua modul yang harus dibuat. Modul yang pertama berkaitan dengan form frmBlob, yang merupakan class module. Sedangkan modul yang kedua merupakan standard module yang berisi kode VBA khusus untuk menyimpan data BLOB yang dilakukan melalui form frmBlob beserta class module Form_frmBlob. Kita beri nama standard module itu mdlBlob.
Berikut ini adalah kode VBA yang ada di form Form_frmBlob:
Option Compare Database Private Const constStrTableName As String = "tblBlob" Private Const constPrimaryKeyFieldName As String = "blobId" Private strLocalSql As String Private Sub cmdHapus_Click() Dim strKriteria As Variant Dim strPesan As String strKriteria = Me.blobId strPesan = "Data dengan Id nomor " & strKriteria & " akan dihapus?" If MsgBox(strPesan, vbYesNo, "Hapus Data BLOB") = vbYes Then daoDbs.Execute "DELETE * FROM " & constStrTableName & " WHERE " & constPrimaryKeyFieldName & "=" & strKriteria MsgBox "Data dengan Id nomor " & strKriteria & " telah dihapus.", vbInformation Me.blobNamaFile = vbNullString Me.blobNamaEkstensi = vbNullString Me.blobUkuran = vbNullString Me.blobId = vbNullString Me.blobDeskripsi = vbNullString Me.blobMeta = vbNullString End If End Sub Private Sub cmdPilihFile_Click() Me.txtNamaFile = kotakFileDialog(Nz(Me.txtNamaFile, "")) Me.txtNamaFile.SetFocus End Sub Private Sub cmdSimpan_Click() Dim rs As DAO.Recordset Dim strKriteria As Variant Dim strSql As String Cancel = False If IsNull(Me.blobNamaFile) Then MsgBox "Tidak ada file yang disimpan.", vbExclamation Cancel = True Exit Sub End If strKriteria = Me.blobId strSql = strLocalSql & " WHERE " & constPrimaryKeyFieldName & "=" & strKriteria Set rs = daoDbs.OpenRecordset(strSql, dbOpenDynaset) rs.Edit rs!blobDeskripsi = Me.blobDeskripsi rs.Update rs.Close Set rs = Nothing End Sub Private Sub cmdSimpanTambahBaru_Click() cmdSimpan_Click If Not Cancel Then cmdPilihFile_Click End Sub Private Sub cmdTambahBaru_Click() cmdPilihFile_Click End Sub Private Sub cmdUpload_Click() Dim rs As DAO.Recordset Dim strPathFile As String Dim oleBlobData As Variant If IsNull(Me.txtNamaFile) Then MsgBox "Tidak ada nama file untuk di-upload.", vbExclamation Me.txtNamaFile.SetFocus Exit Sub End If If Me.txtNamaFile = "" _ Or Not adaNamaFile(Me.txtNamaFile) Then MsgBox "Tidak ada nama file untuk di-upload.", vbExclamation Me.txtNamaFile.SetFocus Exit Sub End If Set rs = daoDbs.OpenRecordset(constStrTableName, dbOpenTable) rs.AddNew If CLng(simpanBlob(Me.txtNamaFile, rs, "blobObjek")) > constBlobMaxSize Then MsgBox "Ukuran file lebih besar dari yang dipersyaratkan.", vbExclamation Exit Sub End If oleBlobData = simpanBlob(Me.txtNamaFile, rs, "blobObjek") rs!blobNamaFile = uraiPathFile(Me.txtNamaFile)(0) rs!blobNamaEkstensi = uraiPathFile(Me.txtNamaFile)(2) rs!blobUkuran = CLng(oleBlobData) rs.Update rs.Bookmark = rs.LastModified Me.blobId = rs!blobId If folderTemporer = "" Then Exit Sub strPathFile = folderTemporer & rs!blobNamaFile Me.blobNamaFile = rs!blobNamaFile Me.blobNamaEkstensi = rs!blobNamaEkstensi Me.blobUkuran = rs!blobUkuran Me.blobData.Requery rs.Close Set rs = Nothing End Sub Private Sub Form_Open(Cancel As Integer) strLocalSql = "SELECT * FROM " & constStrTableName Set daoDbs = CurrentDb() End Sub
Berikut ini adalah kode VBA yang ada di modul mdlBlob:
Option Compare Database Option Explicit Const BlockSize = 32768 Const UNIQUE_NAME = &H0 Const constSeparatorCharacter As String = "," Public Const constBlobMaxSize As Long = 20000000 Private Declare Function GetTempPathA Lib "kernel32" _ (ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As Long Const dbOpenTable = DB_OPEN_TABLE Const acSysCmdInitMeter = SYSCMD_INITMETER Const acSysCmdUpdateMeter = SYSCMD_UPDATEMETER Const acSysCmdRemoveMeter = SYSCMD_REMOVEMETER Public daoDbs As DAO.Database Function simpanBlob(Source As String, T As Recordset, _ sField As String) As Variant Dim intNumBlocks As Integer, intSourceFile As Integer, i As Integer Dim lngFileLength As Long, lngLeftOver As Long, lngFileSize As Long Dim strFileData As String Dim varRetVal As Variant On Error GoTo Err_simpanBlob intSourceFile = FreeFile Open Source For Binary Access Read As intSourceFile lngFileLength = LOF(intSourceFile) If lngFileLength = 0 Or lngFileLength > constBlobMaxSize Then simpanBlob = lngFileLength Exit Function End If intNumBlocks = lngFileLength \ BlockSize lngLeftOver = lngFileLength Mod BlockSize varRetVal = SysCmd(acSysCmdInitMeter, "Reading BLOB", _ lngFileLength \ 1000) strFileData = String$(lngLeftOver, 32) Get intSourceFile, , strFileData T(sField).AppendChunk (strFileData) varRetVal = SysCmd(acSysCmdUpdateMeter, lngLeftOver / 1000) strFileData = String$(BlockSize, 32) For i = 1 To intNumBlocks Get intSourceFile, , strFileData T(sField).AppendChunk (strFileData) varRetVal = SysCmd(acSysCmdUpdateMeter, BlockSize * i / 1000) Next i varRetVal = SysCmd(acSysCmdRemoveMeter) Close intSourceFile simpanBlob = lngFileLength Exit Function Err_simpanBlob: simpanBlob = -Err Exit Function End Function Function uraiPathFile(strFilePath As String) As Variant Dim objFSO As Object Set objFSO = CreateObject("Scripting.FileSystemObject") uraiPathFile = Array(objFSO.GetFileName(strFilePath), _ objFSO.GetBaseName(strFilePath), _ objFSO.GetExtensionName(strFilePath) _ ) Set objFSO = Nothing End Function Function buatFolderTemporer() As String Dim objFSO As Object, objFolder As Object Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.createFolder(folderPathTemporer & "blob") Set objFolder = Nothing Set objFSO = Nothing End Function Function folderTemporer() As String Dim strTempFolder As String Dim objFSO As Object, objFolder As Object Set objFSO = CreateObject("Scripting.FileSystemObject") folderTemporer = "" If Not objFSO.FolderExists(folderPathTemporer & "blob") Then buatFolderTemporer strTempFolder = tambahkanBackslash(folderPathTemporer & "blob") folderTemporer = strTempFolder Set objFSO = Nothing End Function Function tambahkanBackslash(s As String) As String If Len(s) > 0 Then If Right$(s, 1) <> "\" Then tambahkanBackslash = s + "\" Else tambahkanBackslash = s End If Else tambahkanBackslash = "\" End If End Function Function kotakFileDialog(Optional strFileName As String = "", Optional boolAllowMultiSelect As Boolean = False) As String 'aktifkan Microsoft Office Object Library di Tools > References... (minimum versi 12.0) Dim fd As Office.FileDialog Dim vrtSelectedItem As Variant, itemFile() As String, i As Integer Set fd = Application.FileDialog(msoFileDialogFilePicker) With fd .AllowMultiSelect = boolAllowMultiSelect .Title = "Memilih File" .Filters.Clear .ButtonName = "Pilih" If .Show Then If .AllowMultiSelect Then ReDim Preserve itemFile(.SelectedItems.Count - 1) i = 0 For Each vrtSelectedItem In .SelectedItems itemFile(i) = vrtSelectedItem i = i + 1 Next vrtSelectedItem kotakFileDialog = Join(itemFile, ",") Else kotakFileDialog = .SelectedItems.Item(1) End If Else If strFileName <> "" Then kotakFileDialog = strFileName End If End With Set fd = Nothing End Function Function adaNamaFile(strFileName As String) As Boolean Dim objFSO As Object, objFolder As Object Set objFSO = CreateObject("Scripting.FileSystemObject") adaNamaFile = False If objFSO.FileExists(strFileName) Then adaNamaFile = True Set objFSO = Nothing End Function Function folderPathTemporer() As String Dim objFSO As Object Set objFSO = CreateObject("Scripting.FileSystemObject") folderPathTemporer = pathTemporer Set objFSO = Nothing End Function Private Function pathTemporer() As String Dim sTmp As String Dim i As Integer i = GetTempPathA(0, "") sTmp = Space(i) Call GetTempPathA(i, sTmp) pathTemporer = tambahkanBackslash(Left$(sTmp, i - 1)) End Function
Untuk memperoleh contoh aplikasi BLOB, silakan ikuti petunjuk di bawah ini:
- Ikuti blog Access Terapan di Facebook dengan mem-follow atau me-like FB page di https://www.facebook.com/AccessTerapan atau follow Google Blog Follower.
- Kirim email ke admin yanto.e.subroto@gmail.com untuk diikutsertakan menjadi anggota grup Access Terapan.
- Sebagai tanda bukti keanggotaan, admin grup Access Terapan akan mengirimkan email ke alamat yang dituju.
- Selanjutnya, silakan download file blobSimpan.zip.File ini berisi 3 objek Access.
- Tabel yang bernama tblBlob, khusus untuk menyimpan data BLOB beserta properti/metadata
- Form yang bernama frmBlob, khusus untuk antarmuka antara user dengan tblBlob. Di dalamnya berisi class modul Frm_frmBlob.
- Modul yang bernama mdlBlob, digunakan untuk memporses upload file ke dalam database di tblBlob.
- Bukalah form frmBlob dalam format Form View.
- Sebagai uji coba lakukan upload file (apa saja terserah), yang penting tidak boleh melebihi batas maksimum ukuran file yang dipersyaratkan pada deklarasi konstanta Public Const constBlobMaxSize.
sangat bermanfaat
ReplyDeletesaya mencoba langkah demi langkah, tapi LongBinaryData yang tersimpan di OLE Object, ketika saya coba melakukan debug.print untuk melihat isinya, hasilnya bukan binary, tapi hasilnya seperti ini
/ ©Ë¨7¸ô¥ kSÍÕ ¾eÇ 8S....dst
itu kenapa ya?
mohon pencerahannya
Itu kode biner kalau data ole didebug. Saat di form, data blob dapat berupa gambar atau hanya nama file. Untuk membukanya, harus menggunakan aplikasi yg didefault Windows.
Delete