Program Birojodoh ini dikembangkan dengan bahasa pemrograman Visual Basic. Pada dasarnya kemampuan program ini adalah mengelola database dalam jumlah yang cukup besar, dalam hal ini adalah mampu untuk menambah, memodifikasi, menghapus dan menampilkan data. Disamping itu, program ini juga mempunyai kemampuan untuk melakukan filter terhadap data yang ingin ditemukan.
Persiapan Database
Untuk penggunaan Database, kita akan memakai Database Microsoft Access 2000. Adapun Himpunan Entitas beserta Atribut yang digunakan dalam perancangan program ini adalah sebagai berikut :
Himpunan Entitas Personal
Daftar Atribut yang dimiliki :
ID, merupakan primary key
Gender, untuk mencatat jenis kelamin.
Namalengkap, untuk mencatat nama lengkap.
Nickname, untuk mencatat nickname.
Alamat, untuk mencatat alamat.
Phone, untuk mencatat nomor telepon.
Mobile, untuk mencatat nomor handphone.
Email, untuk mencatat alamat email.
Tempatlahir, untuk mencatat tempat lahir.
Tanggallahir, untuk mencatat tanggal lahir.
Warnarambut, untuk mencatat warna rambut.
Warnamata, untuk mencatat warna mata.
Tipebadan, untuk menentukan tipe badan.
Tinggi, untuk mencatat tinggi badan.
Berat, untuk mencatat berat badan.
Warganegara, untuk mencatat informasi warga negara.
Suku, untuk mencatat informasi suku.
Agama, untuk mencatat agama.
Pekerjaan, untuk mencatat pekerjaan.
Pendidikan, untuk mencatat pendidikan.
Penghasilan, untuk mencatat penghasilan.
Hobby, untuk mencatat hobby.
Status, untuk menentukan status.
Keterangan, untuk mencatat keterangan tambahan.
Photo, untuk menyimpan photo.
Listing Program
Form Parent
'Each variable must be declared
Option Explicit
Private Sub MDIForm_Load()
'Preparation to connect with database
'Create Connection and Recordset
'Check whether there are records on the database or not
Dim Conn As Connection
Dim Rst As Recordset
Set Conn = CreateObject("ADODB.Connection")
Set Rst = CreateObject("ADODB.Recordset")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=c:\My Documents\Birojodoh.mdb"
Rst.Open "Personal", Conn, 3, 3
mnuAdmin.Enabled = True
mnuAdd.Enabled = True
If Rst.EOF = True Then
mnuModify.Enabled = False
mnuFind.Enabled = False
mnuDelete.Enabled = False
mnuBrowse.Enabled = False
Else
mnuModify.Enabled = True
mnuFind.Enabled = True
mnuDelete.Enabled = True
mnuBrowse.Enabled = True
End If
mnuPrint.Enabled = False
frmAbout.Left = 3500
frmAbout.Top = 2000
frmAbout.Show
Rst.Close
Set Rst = Nothing
Set Conn = Nothing
End Sub
Private Sub mnuAbout_Click()
frmAbout.Left = 3500
frmAbout.Top = 2000
frmAbout.Show
End Sub
Private Sub mnuAdd_Click()
mnuAdd.Enabled = False
mnuModify.Enabled = False
mnuDelete.Enabled = False
mnuBrowse.Enabled = False
mnuFind.Enabled = False
mnuPrint.Enabled = False
frmAdd.Left = 500
frmAdd.Top = 500
frmAdd.Show
End Sub
Private Sub mnuBrowse_Click()
mnuAdd.Enabled = False
mnuModify.Enabled = False
mnuDelete.Enabled = False
mnuBrowse.Enabled = False
mnuFind.Enabled = False
mnuPrint.Enabled = False
frmBrowse.Left = 500
frmBrowse.Top = 500
frmBrowse.Show
End Sub
Private Sub mnuDelete_Click()
mnuAdd.Enabled = False
mnuModify.Enabled = False
mnuDelete.Enabled = False
mnuBrowse.Enabled = False
mnuFind.Enabled = False
mnuPrint.Enabled = False
frmDelete.Left = 500
frmDelete.Top = 500
frmDelete.Show
End Sub
Private Sub mnuExit_Click()
'This is The End of Program
Dim Message As String
Dim ButtonAndIcons As Integer
Dim Title As String
Dim Response As String
Message = "Are You sure that You wish to quit ?"
ButtonAndIcons = vbYesNo + vbQuestion
Title = "Exit Program"
Response = MsgBox(Message, ButtonAndIcons, Title)
If Response = vbYes Then
End
End If
End Sub
Private Sub mnuFind_Click()
mnuAdd.Enabled = False
mnuModify.Enabled = False
mnuDelete.Enabled = False
mnuBrowse.Enabled = False
mnuFind.Enabled = False
mnuPrint.Enabled = False
frmFind.Left = 50
frmFind.Top = 50
frmFind.Show
End Sub
Private Sub mnuModify_Click()
mnuAdd.Enabled = False
mnuModify.Enabled = False
mnuDelete.Enabled = False
mnuBrowse.Enabled = False
mnuFind.Enabled = False
mnuPrint.Enabled = True
frmModify.Left = 500
frmModify.Top = 500
frmModify.Show
End Sub
Private Sub mnuPrint_Click()
On Error GoTo PrintError
frmModify.PrintForm
Printer.EndDoc
PrintError:
End Sub
Form About
Private Sub Command1_Click()
frmParent.mnuAdmin.Enabled = True
Unload Me
End Sub
Form Add
'All variable must be declared
Option Explicit
Dim adNewConn As Connection
Dim adNewRS As Recordset
Private Sub cmdDone_Click()
frmParent.mnuAdd.Enabled = True
If adNewRS.RecordCount = 0 Then
frmParent.mnuModify.Enabled = False
frmParent.mnuDelete.Enabled = False
frmParent.mnuBrowse.Enabled = False
frmParent.mnuFind.Enabled = False
Else
frmParent.mnuModify.Enabled = True
frmParent.mnuDelete.Enabled = True
frmParent.mnuBrowse.Enabled = True
frmParent.mnuFind.Enabled = True
End If
frmParent.mnuPrint.Enabled = False
Unload Me
End Sub
Private Sub cmdInsertpicture_Click()
On Error GoTo DialogError
With CommonDialog1
.CancelError = True
.Filter = "JPG File (*.jpg)|*.jpg|Bitmap File (*.bmp)|*.bmp|GIF File(*.gif)|*.gif|All Files(*.*)|*.*"
.FilterIndex = 1
.DialogTitle = "Select a Picture File"
.ShowOpen
txtPhoto.Text = .FileName
End With
DialogError:
End Sub
Private Sub cmdSave_Click()
'Lets roll with the validation
If frmAdd.txtID = "" Then
MsgBox "Please fill value on ID field", vbOKOnly + vbCritical, "ERROR"
frmAdd.txtID.SetFocus
Else
If frmAdd.cmbGender = "Choose" Then
MsgBox "Please choose value on Gender field", vbOKOnly + vbCritical, "ERROR"
frmAdd.cmbGender.SetFocus
Else
If frmAdd.txtNamalengkap = "" Then
MsgBox "Please fill value on Namalengkap field", vbOKOnly + vbCritical, "ERROR"
frmAdd.txtNamalengkap.SetFocus
Else
If frmAdd.txtAlamat = "" Then
MsgBox "Please fill value on Alamat field", vbOKOnly + vbCritical, "ERROR"
frmAdd.txtAlamat.SetFocus
Else
If frmAdd.txtPhone = "" Then
MsgBox "Please fill value on Phone field", vbOKOnly + vbCritical, "ERROR"
frmAdd.txtPhone.SetFocus
Else
'This means we can start to save data
adNewRS.AddNew
If frmAdd.txtID.Text <> "" Then adNewRS!ID = frmAdd.txtID.Text
adNewRS!Gender = frmAdd.cmbGender.Text
If frmAdd.txtNamalengkap.Text <> "" Then adNewRS!Namalengkap = frmAdd.txtNamalengkap.Text
If frmAdd.txtNickname.Text <> "" Then adNewRS!Nickname = frmAdd.txtNickname.Text
If frmAdd.txtAlamat.Text <> "" Then adNewRS!Alamat = frmAdd.txtAlamat.Text
If frmAdd.txtPhone.Text <> "" Then adNewRS!Phone = frmAdd.txtPhone.Text
If frmAdd.txtMobile.Text <> "" Then adNewRS!Mobile = frmAdd.txtMobile.Text
If frmAdd.txtEmail.Text <> "" Then adNewRS!Email = frmAdd.txtEmail.Text
If frmAdd.txtTempatlahir.Text <> "" Then adNewRS!Tempatlahir = frmAdd.txtTempatlahir.Text
If frmAdd.txtTanggallahir.Text <> "" Then adNewRS!Tanggallahir = frmAdd.txtTanggallahir.Text
If frmAdd.txtWarganegara.Text <> "" Then adNewRS!Warganegara = frmAdd.txtWarganegara.Text
If frmAdd.txtSuku.Text <> "" Then adNewRS!Suku = frmAdd.txtSuku.Text
If frmAdd.txtAgama.Text <> "" Then adNewRS!Agama = frmAdd.txtAgama.Text
adNewRS!Warnarambut = frmAdd.cmbWarnarambut.Text
adNewRS!Warnamata = frmAdd.cmbWarnamata.Text
If frmAdd.txtTipebadan.Text <> "" Then adNewRS!Tipebadan = frmAdd.txtTipebadan.Text
adNewRS!Tinggi = frmAdd.cmbTinggi.Text
adNewRS!Berat = frmAdd.cmbBerat.Text
adNewRS!Pendidikan = frmAdd.cmbPendidikan.Text
If frmAdd.txtPekerjaan.Text <> "" Then adNewRS!Pekerjaan = frmAdd.txtPekerjaan.Text
adNewRS!Penghasilan = frmAdd.cmbPenghasilan.Text
If frmAdd.txtHobby.Text <> "" Then adNewRS!Hobby = frmAdd.txtHobby.Text
If frmAdd.txtStatus.Text <> "" Then adNewRS!Status = frmAdd.txtStatus.Text
If frmAdd.txtKeterangan.Text <> "" Then adNewRS!Keterangan = frmAdd.txtKeterangan.Text
If frmAdd.txtPhoto.Text <> "" Then adNewRS!Photo = Trim(frmAdd.txtPhoto.Text)
adNewRS.Update
MsgBox "Record Saved successfully", vbOKOnly, "Saving Record"
Form_Blank
frmAdd.txtID.SetFocus
End If
End If
End If
End If
End If
End Sub
Private Sub Form_Blank()
With frmAdd
.txtID.Text = ""
.cmbGender.Text = "Male"
.txtNickname = ""
.txtNamalengkap = ""
.txtAlamat = ""
.txtPhone.Text = ""
.txtMobile.Text = ""
.txtEmail.Text = ""
.txtTempatlahir.Text = ""
.txtTanggallahir.Text = ""
.txtWarganegara.Text = ""
.txtSuku.Text = ""
.txtAgama.Text = ""
.cmbWarnarambut.Text = "Hitam"
.cmbWarnamata.Text = "HItam"
.txtTipebadan.Text = ""
.cmbTinggi.Text = "<=145"
.cmbBerat.Text = "<=40"
.cmbPendidikan.Text = "SD"
.txtPekerjaan.Text = ""
.cmbPenghasilan.Text = "<=500.000"
.txtHobby.Text = ""
.txtStatus.Text = ""
.txtKeterangan.Text = ""
.txtPhoto.Text = ""
End With
End Sub
Private Sub Form_Load()
'Preparation to connect with database
'Create Connection and Recordset
Set adNewConn = CreateObject("ADODB.Connection")
Set adNewRS = CreateObject("ADODB.Recordset")
adNewConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=c:\My Documents\Birojodoh.mdb"
adNewRS.Open "Personal", adNewConn, 1, 3
End Sub
Private Sub Form_Unload(Cancel As Integer)
adNewRS.Close
adNewConn.Close
Set adNewRS = Nothing
Set adNewConn = Nothing
End Sub
Form Browse
Private Sub cmdDone_Click()
Unload Me
frmParent.mnuAdd.Enabled = True
frmParent.mnuModify.Enabled = True
frmParent.mnuDelete.Enabled = True
frmParent.mnuBrowse.Enabled = True
frmParent.mnuFind.Enabled = True
frmParent.mnuPrint.Enabled = False
End Sub
Form Delete
'All variable must be declared
Option Explicit
Dim adNewConn As Connection
Dim adNewRS As Recordset
Private Sub cmdCancel_Click()
Unload Me
frmParent.mnuAdd.Enabled = True
frmParent.mnuModify.Enabled = True
frmParent.mnuDelete.Enabled = True
frmParent.mnuBrowse.Enabled = True
frmParent.mnuFind.Enabled = True
frmParent.mnuPrint.Enabled = False
End Sub
Private Sub cmdDelete_Click()
Dim Message As String
Dim ButtonAndIcons As Integer
Dim Title As String
Dim Response As String
Dim strsql As String
If cmbDelete.Text = "Choose Name" Then
Call MsgBox("Please select valid name", vbOKOnly + vbCritical, "ERROR")
Exit Sub
End If
Message = "Are You sure that You want to delete this record ?"
ButtonAndIcons = vbYesNo + vbQuestion
Title = "Confirmation"
Response = MsgBox(Message, ButtonAndIcons, Title)
If Response = vbYes Then
adNewRS.MoveFirst
Do While adNewRS.EOF <> True
If adNewRS!Namalengkap = cmbDelete.Text Then Exit Do
adNewRS.MoveNext
Loop
adNewRS.Delete
Call cmdCancel_Click
Else
Exit Sub
End If
End Sub
Private Sub Form_Load()
'Preparation to connect with database
'Create Connection and Recordset
Set adNewConn = CreateObject("ADODB.Connection")
Set adNewRS = CreateObject("ADODB.Recordset")
adNewConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=c:\My Documents\Birojodoh.mdb"
adNewRS.Open "Personal", adNewConn, 3, 3
Do While adNewRS.EOF <> True
cmbDelete.AddItem adNewRS!Namalengkap
adNewRS.MoveNext
Loop
End Sub
Form Find
Private Sub cmdCancel_Click()
Unload Me
frmParent.mnuAdd.Enabled = True
frmParent.mnuModify.Enabled = True
frmParent.mnuDelete.Enabled = True
frmParent.mnuBrowse.Enabled = True
frmParent.mnuFind.Enabled = True
frmParent.mnuPrint.Enabled = False
End Sub
Private Sub cmdFind_Click()
frmResult.Left = 3350
frmResult.Top = 75
frmResult.Show
frmFind.cmbAgama.Enabled = False
frmFind.cmbBerat.Enabled = False
frmFind.cmbGender.Enabled = False
frmFind.cmbSuku.Enabled = False
frmFind.cmbTinggi.Enabled = False
frmFind.cmbWarganegara.Enabled = False
frmFind.cmdFind.Enabled = False
frmFind.cmdCancel.Enabled = False
End Sub
Form Modify
'All variable must be declared
Option Explicit
Dim adNewConn As Connection
Dim adNewRS As Recordset
Private Sub cmdDone_Click()
Unload Me
frmParent.mnuAdd.Enabled = True
frmParent.mnuModify.Enabled = True
frmParent.mnuDelete.Enabled = True
frmParent.mnuBrowse.Enabled = True
frmParent.mnuFind.Enabled = True
frmParent.mnuPrint.Enabled = False
End Sub
Private Sub cmdChangepicture_Click()
On Error GoTo DialogError
With CommonDialog1
.CancelError = True
.Filter = "JPG File (*.jpg)|*.jpg|Bitmap File (*.bmp)|*.bmp|GIF File(*.gif)|*.gif|All Files(*.*)|*.*"
.FilterIndex = 1
.DialogTitle = "Select a Picture File"
.ShowOpen
txtPhoto.Text = .FileName
End With
DialogError:
End Sub
Private Sub cmdFirst_Click()
adNewRS.MoveFirst
Form_LoadData
End Sub
Private Sub cmdLast_Click()
adNewRS.MoveLast
Form_LoadData
End Sub
Private Sub cmdNext_Click()
If adNewRS.EOF() <> True Then adNewRS.MoveNext
If adNewRS.EOF() <> True Then
Form_LoadData
Else
MsgBox "Whoops... End of File", vbOKOnly + vbCritical, "ERROR"
End If
End Sub
Private Sub cmdPrevious_Click()
If adNewRS.BOF() <> True Then adNewRS.MovePrevious
If adNewRS.BOF() <> True Then
Form_LoadData
Else
MsgBox "Whoops... Begin of File", vbOKOnly + vbCritical, "ERROR"
End If
End Sub
Private Sub cmdUpdate_Click()
'Lets roll with the validation
If frmModify.txtID = "" Then
MsgBox "Please fill value on ID field", vbOKOnly + vbCritical, "ERROR"
frmModify.txtID.SetFocus
Else
If frmModify.cmbGender = "Choose" Then
MsgBox "Please choose value on Gender field", vbOKOnly + vbCritical, "ERROR"
frmModify.cmbGender.SetFocus
Else
If frmModify.txtNamalengkap = "" Then
MsgBox "Please fill value on Namalengkap field", vbOKOnly + vbCritical, "ERROR"
frmModify.txtNamalengkap.SetFocus
Else
If frmModify.txtAlamat = "" Then
MsgBox "Please fill value on Alamat field", vbOKOnly + vbCritical, "ERROR"
frmModify.txtAlamat.SetFocus
Else
If frmModify.txtPhone = "" Then
MsgBox "Please fill value on Phone field", vbOKOnly + vbCritical, "ERROR"
frmModify.txtPhone.SetFocus
Else
'This means we can start to update data
If frmModify.txtID.Text <> "" Then adNewRS!ID = frmModify.txtID.Text
adNewRS!Gender = frmModify.cmbGender.Text
If frmModify.txtNamalengkap.Text <> "" Then adNewRS!Namalengkap = frmModify.txtNamalengkap.Text
If frmModify.txtNickname.Text <> "" Then adNewRS!Nickname = frmModify.txtNickname.Text
If frmModify.txtAlamat.Text <> "" Then adNewRS!Alamat = frmModify.txtAlamat.Text
If frmModify.txtPhone.Text <> "" Then adNewRS!Phone = frmModify.txtPhone.Text
If frmModify.txtMobile.Text <> "" Then adNewRS!Mobile = frmModify.txtMobile.Text
If frmModify.txtEmail.Text <> "" Then adNewRS!Email = frmModify.txtEmail.Text
If frmModify.txtTempatlahir.Text <> "" Then adNewRS!Tempatlahir = frmModify.txtTempatlahir.Text
If frmModify.txtTanggallahir.Text <> "" Then adNewRS!Tanggallahir = frmModify.txtTanggallahir.Text
If frmModify.txtWarganegara.Text <> "" Then adNewRS!Warganegara = frmModify.txtWarganegara.Text
If frmModify.txtSuku.Text <> "" Then adNewRS!Suku = frmModify.txtSuku.Text
If frmModify.txtAgama.Text <> "" Then adNewRS!Agama = frmModify.txtAgama.Text
adNewRS!Warnarambut = frmModify.cmbWarnarambut.Text
adNewRS!Warnamata = frmModify.cmbWarnamata.Text
If frmModify.txtTipebadan.Text <> "" Then adNewRS!Tipebadan = frmModify.txtTipebadan.Text
adNewRS!Tinggi = frmModify.cmbTinggi.Text
adNewRS!Berat = frmModify.cmbBerat.Text
adNewRS!Pendidikan = frmModify.cmbPendidikan.Text
If frmModify.txtPekerjaan.Text <> "" Then adNewRS!Pekerjaan = frmModify.txtPekerjaan.Text
adNewRS!Penghasilan = frmModify.cmbPenghasilan.Text
If frmModify.txtHobby.Text <> "" Then adNewRS!Hobby = frmModify.txtHobby.Text
If frmModify.txtStatus.Text <> "" Then adNewRS!Status = frmModify.txtStatus.Text
If frmModify.txtKeterangan.Text <> "" Then adNewRS!Keterangan = frmModify.txtKeterangan.Text
If frmModify.txtPhoto.Text <> "" Then adNewRS!Photo = Trim(frmModify.txtPhoto.Text)
adNewRS.Update
MsgBox "Record Updated successfully", vbOKOnly, "Updating Record"
End If
End If
End If
End If
End If
End Sub
Private Sub Form_LoadData()
With frmModify
.txtID.Text = adNewRS!ID
.cmbGender.Text = adNewRS!Gender
If adNewRS!Nickname <> "" Then
.txtNickname = adNewRS!Nickname
End If
If adNewRS!Namalengkap <> "" Then
.txtNamalengkap = adNewRS!Namalengkap
End If
If adNewRS!Alamat <> "" Then
.txtAlamat = adNewRS!Alamat
End If
If adNewRS!Phone <> "" Then
.txtPhone.Text = adNewRS!Phone
End If
If adNewRS!Mobile <> "" Then
.txtMobile.Text = adNewRS!Mobile
End If
If adNewRS!Email <> "" Then
.txtEmail.Text = adNewRS!Email
End If
If adNewRS!Tempatlahir <> "" Then
.txtTempatlahir.Text = adNewRS!Tempatlahir
End If
If adNewRS!Tanggallahir <> "" Then
.txtTanggallahir.Text = adNewRS!Tanggallahir
End If
If adNewRS!Warganegara <> "" Then
.txtWarganegara.Text = adNewRS!Warganegara
End If
If adNewRS!Suku <> "" Then
.txtSuku.Text = adNewRS!Suku
End If
If adNewRS!Agama <> "" Then
.txtAgama.Text = adNewRS!Agama
End If
.cmbWarnarambut.Text = adNewRS!Warnarambut
.cmbWarnamata.Text = adNewRS!Warnamata
If adNewRS!Tipebadan <> "" Then
.txtTipebadan.Text = adNewRS!Tipebadan
End If
.cmbTinggi.Text = adNewRS!Tinggi
.cmbBerat.Text = adNewRS!Berat
.cmbPendidikan.Text = adNewRS!Pendidikan
If adNewRS!Pekerjaan <> "" Then
.txtPekerjaan.Text = adNewRS!Pekerjaan
End If
.cmbPenghasilan.Text = adNewRS!Penghasilan
If adNewRS!Hobby <> "" Then
.txtHobby.Text = adNewRS!Hobby
End If
If adNewRS!Status <> "" Then
.txtStatus.Text = adNewRS!Status
End If
If adNewRS!Keterangan <> "" Then
.txtKeterangan.Text = adNewRS!Keterangan
End If
If adNewRS!Photo <> "" Then
.txtPhoto.Text = adNewRS!Photo
End If
End With
End Sub
Private Sub Form_Load()
'Preparation to connect with database
'Create Connection and Recordset
Set adNewConn = CreateObject("ADODB.Connection")
Set adNewRS = CreateObject("ADODB.Recordset")
adNewConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=c:\My Documents\Birojodoh.mdb"
adNewRS.Open "Personal", adNewConn, 3, 3
'Let assume there is record saved in database
'Load the first record
If adNewRS.EOF = True Then
Call MsgBox("No Records has found in the database", vbCritical + vbOKOnly, "ERROR: No Records found")
Exit Sub
Else
adNewRS.MoveFirst
Form_LoadData
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
adNewRS.Close
adNewConn.Close
Set adNewRS = Nothing
Set adNewConn = Nothing
End Sub
Form Picture
Private Sub cmdClose_Click()
Unload Me
frmResult.cmdShowPicture.Enabled = True
frmResult.cmdFirst.Enabled = True
frmResult.cmdLast.Enabled = True
frmResult.cmdNext.Enabled = True
frmResult.cmdPrevious.Enabled = True
frmResult.cmdDone.Enabled = True
End Sub
Form Result
'All variable must be declared
Option Explicit
Public PicStr As String
Dim Conn As Connection
Dim RS As Recordset
Private Sub cmdDone_Click()
Unload Me
frmFind.cmbAgama.Enabled = True
frmFind.cmbBerat.Enabled = True
frmFind.cmbGender.Enabled = True
frmFind.cmbSuku.Enabled = True
frmFind.cmbTinggi.Enabled = True
frmFind.cmbWarganegara.Enabled = True
frmFind.cmdFind.Enabled = True
frmFind.cmdCancel.Enabled = True
End Sub
Private Sub cmdFirst_Click()
RS.MoveFirst
Form_LoadData
End Sub
Private Sub cmdLast_Click()
RS.MoveLast
Form_LoadData
End Sub
Private Sub cmdNext_Click()
If RS.EOF() <> True Then RS.MoveNext
If RS.EOF() <> True Then
Form_LoadData
Else
MsgBox "Whoops... End of File", vbOKOnly + vbCritical, "ERROR"
End If
End Sub
Private Sub cmdPrevious_Click()
If RS.BOF() <> True Then RS.MovePrevious
If RS.BOF() <> True Then
Form_LoadData
Else
MsgBox "Whoops... Begin of File", vbOKOnly + vbCritical, "ERROR"
End If
End Sub
Private Sub Form_LoadData()
With frmResult
.txtID.Text = RS!ID
.txtGender.Text = RS!Gender
If RS!Nickname <> "" Then
.txtNickname = RS!Nickname
End If
If RS!Namalengkap <> "" Then
.txtNamalengkap = RS!Namalengkap
End If
If RS!Alamat <> "" Then
.txtAlamat = RS!Alamat
End If
If RS!Phone <> "" Then
.txtPhone.Text = RS!Phone
End If
If RS!Mobile <> "" Then
.txtMobile.Text = RS!Mobile
End If
If RS!Email <> "" Then
.txtEmail.Text = RS!Email
End If
If RS!Tempatlahir <> "" Then
.txtTempatlahir.Text = RS!Tempatlahir
End If
If RS!Tanggallahir <> "" Then
.txtTanggallahir.Text = RS!Tanggallahir
End If
If RS!Warganegara <> "" Then
.txtWarganegara.Text = RS!Warganegara
End If
If RS!Suku <> "" Then
.txtSuku.Text = RS!Suku
End If
If RS!Agama <> "" Then
.txtAgama.Text = RS!Agama
End If
If RS!Photo <> "" Then PicStr = RS!Photo
End With
End Sub
Private Sub cmdShowPicture_Click()
frmResult.cmdShowPicture.Enabled = False
frmResult.cmdFirst.Enabled = False
frmResult.cmdLast.Enabled = False
frmResult.cmdNext.Enabled = False
frmResult.cmdPrevious.Enabled = False
frmResult.cmdDone.Enabled = False
frmPicture.Show
End Sub
Private Sub Form_Load()
'Preparation to connect with database
'Create Connection and Recordset
Dim strsql As String
Set Conn = CreateObject("ADODB.Connection")
Set RS = CreateObject("ADODB.Recordset")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=c:\My Documents\Birojodoh.mdb"
'query string
strsql = "SELECT * FROM Personal WHERE " & _
"Personal.Gender='" & frmFind.cmbGender.Text & "' AND " & _
"Personal.Warganegara='" & frmFind.cmbWarganegara.Text & "' AND " & _
"Personal.Suku='" & frmFind.cmbSuku.Text & "' AND " & _
"Personal.Agama='" & frmFind.cmbAgama.Text & "' AND " & _
"Personal.Tinggi='" & frmFind.cmbTinggi.Text & "' AND " & _
"Personal.Berat='" & frmFind.cmbBerat.Text & "'" & _
"order by Personal.ID"
RS.Open strsql, Conn, 3, 3
If RS.EOF = True Then
Call MsgBox("No Records has found for your query", vbCritical + vbOKOnly, "ERROR: No Results")
frmResult.txtAgama.BackColor = &H8000000B
frmResult.txtAlamat.BackColor = &H8000000B
frmResult.txtEmail.BackColor = &H8000000B
frmResult.txtGender.BackColor = &H8000000B
frmResult.txtID.BackColor = &H8000000B
frmResult.txtMobile.BackColor = &H8000000B
frmResult.txtNamalengkap.BackColor = &H8000000B
frmResult.txtNickname.BackColor = &H8000000B
frmResult.txtPhone.BackColor = &H8000000B
frmResult.txtSuku.BackColor = &H8000000B
frmResult.txtTanggallahir.BackColor = &H8000000B
frmResult.txtTempatlahir.BackColor = &H8000000B
frmResult.txtWarganegara.BackColor = &H8000000B
frmResult.cmdShowPicture.Enabled = False
frmResult.cmdFirst.Enabled = False
frmResult.cmdLast.Enabled = False
frmResult.cmdNext.Enabled = False
frmResult.cmdPrevious.Enabled = False
Exit Sub
Else
RS.MoveFirst
Call Form_LoadData
End If
End Sub
Catatan:
Silakan dikembangkan dan dimodifikasi sesuai kebutuhan.
by: Wahyu Kurniawan
[ add comment ] | permalink |
( 0 / 0 )Apabila kita pernah membuat atau mengembangkan aplikasi absensi karyawan ataupun aplikasi jadwal/schedule, data berformat time adalah data yang paling sering kita jumpai.
Berikut ini adalah contoh-contoh kasus yang paling sering kita jumpai sehubungan dengan perbandingan dua data berformat time.
* Pengecekan data tidak boleh sama
Data disimpan dalam dua buah textbox, misalnya Text1 dan Text2. Untuk perbandingannya, kita bisa membandingkannya sebagai string.
Contoh:
If Text1=Text2 Then MsgBox "Jam Tidak Boleh Sama..."
* Perbandingan mana yang lebih besar
Untuk kasus yang sama, kita dapat menggunakan function TimeValue untuk mengubah string menjadi data berformat time, karena apabila kita langsung membandingkan, data akan dibaca sebagai string, sehingga jam 7.00 dianggap lebih besar dari 10.00
Jadi perintahnya adalah:
If TimeValue(Text1) > TimeValue(Text2) Then MsgBox "Jam Awal tidak boleh lebih besar dari Jam Akhir"
[ add comment ] | permalink |
( 0 / 0 )Sebagai programmer ataupun pengguna Visual Basic, error ini tentunya tidak asing lagi buat kita. Error ini terjadi apabila kita berusaha untuk menciptakan koneksi atau hubungan terhadap sebuah recordset yang belum diclose ataupun diunload dari memory.
Saya juga kurang jelas, kenapa VB tidak langsung membuat proses menjadi otomatis, jadi apabila dilakukan perintah Open pada recordset yang masih belum diclose, seharusnya VB akan meng-closenya terlebih dahulu sebelum menciptakan koneksi yang baru.
Namun faktanya adalah permintaan membuka koneksi yang baru akan ditolak oleh VB apabila koneksi recordset yang lama masih dalam keadaan terbuka.
Untuk mendeteksi apakah suatu recordset itu masih terbuka atau tidak digunakan properti state.
Lebih jelasnya sebagai berikut:
If Recordset.state=1 then Recordset.close
Recordset.Open StrSQL, conn
Properti State=1 artinya recordset dalam keadaan terbuka, jadi kita close terlebih dahulu, baru kita ciptakan koneksi recordset yang baru dibawahnya. Dengan demikian, Error yang diatas dapat kita hindari.
[ add comment ] | permalink |
( 0 / 0 )*** WARNING ***
Tulisan ini digunakan untuk tujuan pendidikan, jika anda sudah mengetahui bagaimana menginjeksi registry dari VB, mohon jangan dimanfaatkan untuk menginjeksi registry dengan tujuan lainnya, sebagaimana yang program virus biasa lakukan.
Jika anda tidak pernah belajar atau tahu tentang registry sebelumnya, mohon jangan mencoba trik berikut, karena saya tidak bertanggung jawab atas kesalahan pengetikan/pengcopyan yang anda lakukan ataupun apa yang terjadi pada komputer anda.
*** WARNING ***
Pernahkah kita berpikir bagaimana sebuah program yang beredar di internet mempunyai serial number yang harus kita isi sebelum kita dapat menjalankan program tersebut? Penggunaan Serial Number untuk proteksi program masih menjadi trend dari kebanyakan program yang baru direlease. Walaupun kemudian ternyata metode tersebut sudah tidak dapat 100% melindungi pemakaian program ilegal dengan banyaknya crack ataupun keygen untuk mengenerate serial number tersebut. Sebenarnya bagaimanakah Serial Number itu bisa dibuat?
Saya berpikiran, jika seandainya program aplikasi yang kita buat selalu dilindungi serial number, tentunya walaupun customer kita mempunyai master ataupun installer programnya, selama dia tidak tahu serial numbernya, dia tidak akan dapat menginstall program di komputer yang berbeda.
Berikutnya saya mencoba untuk membuat sebuah program yang saya integrasikan dengan program yang sudah saya buat, sehingga customer harus memasukkan serial number sebelum dia dapat menggunakan program. Karena alasan keamanan, serial number ini saya masukkan ke dalam badan program, jadi tidak saya simpan di database. Jadi user biasa akan kesulitan mengintip serial number ini.
Berikut adalah penggalan kodenya:
Private Sub Command1_Click()
RegKunci(1) = "ZEZEX-JKLMN-QPORC-SOSOP-ABABC"
ExpRegKunci(1) = "15/08/2009"
cocok = False
fTanggal = Now
For i = 1 To 1
If Text1.text = RegKunci(i) Then
If fTanggal < ExpRegKunci(i) Then
cocok = True
Exit For
End If
End If
Next
If cocok Then
'inject registry
sKeyVal = String$(1024, 0)
sKeyValSize = 1024
sKeyVal = Format(Date + 180, "dd/mm/yyyy")
'create key
rc = RegCreateKey(HKEY_CURRENT_USER, KeyName, hKey)
'then create key value
rc = RegSetValueEx(hKey, SubKeyName, 0, REG_SZ, ByVal sKeyVal, sKeyValSize)
rc = RegCloseKey(hKey)
MsgBox "Program berhasil diregistrasi ke sistem anda", vbInformation, PesanMessageBox
Unload Me
Else
MsgBox "Maaf Serial Number Anda salah / invalid" & vbCrLf & vbCrLf & "Silakan hubungi:" & vbCrLf & vbCrLf & "Candra Wahyu Kurniawan ph. 081330995038", vbCritical, PesanMessageBox
End
End If
End Sub
Saat program diinisialisasi pertama kali, dia akan meminta user untuk memasukkan serial number. Serial Number apabila salah dimasukkan maka program akan langsung berhenti. Jadi hal ini cukup bermanfaat, karena orang yang bermaksud mengcopy program ini tidak akan bisa menjalankan programnya jika dia tidak mengetahui serial numbernya.
Mungkin tidak secanggih proteksi Serial Number yang ada di pasaran. Mungkin bahkan mereka menggunakan teknik-teknik yang jauh lebih rumit daripada teknik sederhana yang saya paparkan di atas. Namun setidaknya kita mencoba untuk memproteksi hasil karya kita dari pengcopyan ilegal. Semoga tulisan saya ini bermanfaat buat rekan2 programmer semua. Viva Programmer Indonesia!!!
[ add comment ] | permalink |
( 0 / 0 )*** WARNING ***
Tulisan ini digunakan untuk tujuan pendidikan, jika anda sudah mengetahui bagaimana menginjeksi registry dari VB, mohon jangan dimanfaatkan untuk menginjeksi registry dengan tujuan lainnya, sebagaimana yang program virus biasa lakukan.
Jika anda tidak pernah belajar atau tahu tentang registry sebelumnya, mohon jangan mencoba trik berikut, karena saya tidak bertanggung jawab atas kesalahan pengetikan/pengcopyan yang anda lakukan ataupun apa yang terjadi pada komputer anda.
*** WARNING ***
Setelah kita belajar bagaimana proteksi program dengan memanfaatkan file yang kita sembunyikan di folder tertentu, sekarang kita akan mencoba belajar proteksi program dengan registry.
Mungkin sudah banyak yang tahu untuk dapat melakukan operasi registry, kita perlu memanggil function API terlebih dahulu.
Masukkan deklarasi function API berikut ke dalam module program anda.
' Reg Key ROOT Types...
Public Const ERROR_SUCCESS = 0
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_USERS = &H80000003
' Reg Key Security Options...
Public Const KEY_ALL_ACCESS = &HF003F
Public Const KEY_CREATE_LINK = &H20
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_EXECUTE = &H20019
Public Const KEY_NOTIFY = &H10
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_READ = &H20019
Public Const KEY_SET_VALUE = &H2
Public Const KEY_WRITE = &H20006
Public Const READ_CONTROL = &H20000
Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_DWORD = 4
Public Const REG_EXPAND_SZ = 2
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_NONE = 0
Public Const REG_RESOURCE_LIST = 8
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const KeyName = "SOFTWARE\Semau Gue"
Public Const SubKeyName = "Kunci"
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Public Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hkey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As String, ByVal cbData As Long) As Long
Setelah deklarasi fungsi-fungsi API di module sudah kita masukkan, kita tinggal mengetikkan sebuah procedure untuk pengecekan, apakah benar ada key yang dimaksud. Untuk key yang anda simpan di dalam registry komputer client anda nantinya, boleh berupa apa saja. Berikut ini adalah procedurenya
Private Sub Registry_Check()
Dim rc As Long
Dim hkey As Long
Dim KeyValType As Long
Dim KeyVal As String
Dim KeyValSize As Long
' Open Registry...
rc = RegOpenKeyEx(HKEY_CURRENT_USER, KeyName, 0, KEY_ALL_ACCESS, hkey)
If (rc <> ERROR_SUCCESS) Then
rc = RegCloseKey(hkey)
MsgBox "Maaf Program Anda belum diregistrasi" & vbCrLf & vbCrLf & "Untuk registrasi program, anda dapat menghubungi:" & vbCrLf & vbCrLf & "Candra Wahyu Kurniawan ph. 081330995038", vbCritical, PesanMessageBox
End
Else
KeyVal = String$(1024, 0)
KeyValSize = 1024
' Retrieve Registry Key Value...
rc = RegQueryValueEx(hkey, SubKeyName, 0, KeyValType, KeyVal, KeyValSize)
If (rc <> ERROR_SUCCESS) Then
rc = RegCloseKey(hkey)
MsgBox "Maaf Program Anda belum diregistrasi" & vbCrLf & vbCrLf & "Untuk registrasi program, anda dapat menghubungi:" & vbCrLf & vbCrLf & "Candra Wahyu Kurniawan ph. 081330995038", vbCritical, PesanMessageBox
End
Else
t = KeyVal
End If
End If
End Sub
Dalam contoh diatas, saya menggunakan key yang bernama Kunci, yang saya simpan di registry HKEY_CURRENT_USER\SOFTWARE. Sekali lagi penyimpanan key ini boleh terserah diletakkan di directory registry yang mana saja. Lalu apa yang terjadi apabila program menemukan key tersebut? Tentunya kita bisa memanfaatkan untuk pengecekan periode atau umur program dengan menyimpan data tanggal expired di key tersebut, lalu kita tinggal bandingkan dengan tanggal sistem seperti biasa.
Dengan memanfaatkan registry sebagai alternatif untuk proteksi pengcopyan program, program anda akan menjadi lebih sulit dicopy, sehingga hubungan anda dengan client akan tetap terpelihara dengan baik.
[ add comment ] | permalink |
( 0 / 0 )
Calendar
