SISTEM M PAKAR DIAGNOS SIS DAN PE ENANGAN NAN PENY YAKIT PA ADA TAN NAMAN PA ADI MENG GGUNAKA AN METOD DE DECISI SION TREE E
SKRIP PSI
Diajjukan dan Disusun D Seb bagi Salah Satu S Syarat Untuk Memperoleh Gelar Sarjaana Jenjang Strata Satu (S1) Pada Proogram Studii Teknik Infformatika Fakultas F Tekknik Universitaas Muhamm madiyah Ponnorogo
SUG GENG PRE EHANTO 095305 580
PROG GRAM ST TUDI TEKN NIK INFOR RMATIKA A FA AKULTAS TEKNIK T UNIVE ERSITAS MUHAMM M MADIYAH PONOROG P GO (2013 3)
MOTTO DAN PERSEMBAHAN
Motto : Agar dapat membahagiakan seseorang, isilah tangannya dengan kerja, hatinya dengan kasih sayang, pikirannya dengan tujuan, ingatannya dengan ilmu yang bermanfaat, masa depannya dengan harapan, dan perutnya dengan makanan.(Federick E. Crane)
Persembahaan :
Skripsi ini kupersembahkan untuk kedua orang tua saya, kakak-kakak dan keluarga besar, serta teman-teman yang membantu memberikan masukan demi kesempurnaan Skripsi ini.
ABSTRAK
Secara umum, sistem pakar (expert system) adalah sistem yang berusaha mengadopsi
pengetahuan
manusia
ke
komputer
agar
komputer
dapat
menyelesaikan masalah seperti yang biasa dilakukan oleh para ahli. Pengambilan keputusan pada sistem pakar dapat menggunakan metode pohon keputusan (decision tree). Metode decision tree cocok untuk diagnosa awal pada penyakit dengan pelacakan dari gejala-gejala yang diderita. Sistem pakar ini dapat diterapkan untuk membantu petani menyelesaikan permasalahan yang dihadapi akibat dari penyakit yang menjakit tanaman padinya. Karena dengan sistem pakar dapat mengidentifikasi penyakit tanaman padi dari gejala-gejala yang ada serta memberikan solusi berdasarkan jenis penyakit layaknya seorang pakar. Sistem pakar dengan metode decision tree ini diterapkan menggunakan bahasa pemrograman Visual Basic 6.0 dan Database Management System (DBMS) menggunakan MySQL. Kata kunci : Sistem Pakar, Decision Tree, Padi, Visual Basic 6.0, MySQL
KATA PENGANTAR
Puji syukur kami panjatkan kehadirat Allah SWT atas limpahan rahmat dan hidayahNya, sehingga penulis dapat menyelesaikan skripsi ini dengan judul “SISTEM PAKAR DIAGNOSIS DAN PENANGANAN PENYAKIT PADA TANAMAN PADI MENGGUNAKAN METODE DECISION TREE”. Penulisan skripsi ini adalah sebagai persyaratan yang wajib sebagai memenuhi salah satu syarat guna menyelesaikan program Strata Satu (S1) Jurusan Teknik Informatika di Universitas Muhammadiyah Ponorogo. Dalam menyelesaikan skripsi ini, penulis telah banyak mendapatkan bantuan dari berbagai pihak. Oleh karena itu, dalam kesempatan ini penulis mengucapkan terima kasih kepada yang terhormat pihak-pihak sebagai berikut : 1. Drs. H. Sulton, M.Si Selaku Rektor Universitas Muhammadiyah Ponorogo. 2. Ir. Aliyadi, MM Selaku Dekan Fakultas Teknik Universitas Muhammadiyah Ponorogo. 3. Andy Trianto Pujorahardjo, ST selaku Kepala Jurusan Teknik Informatika Universitas Muhammadiyah Ponorogo. 4. Fauzan Masykur, ST, M.Kom selaku Dosen Pembimbing I yang telah banyak membantu penyusunan skripsi ini. 5. Adi Fajaryanto C, S.Kom selaku Dosen Pembimbing II yang telah banyak membantu penyusunan skripsi ini. 6. Bapak dan Ibu dosen yang telah memberikan bekal ilmu selama penulis kuliah di Universitas Muhammadiyah Ponorogo.
7. Teman-teman Fakultas Teknik jurusan Teknik Informatika yang banyak membantu dan memberikan motivasi pada penulis dalam menyelesaikan penulisan skripsi ini.
Penulis menyadari bahwa dalam penulisan skripsi ini masih jauh dari kesempurnaan oleh karena itu kritik dan saran yang membangun akan kami terima untuk kesempurnaan dimasa datang. Harapan kami semoga penulisan skripsi ini dapat bermanfaat bagi penyusun khususnya dan para pembaca pada umumnya.
Ponorogo, …………………… Penulis
Sugeng Prehanto
DAFTAR ISI
HALAMAN JUDUL .....................................................................................
i
HALAMAN PENGESAHAN .......................................................................
ii
HALAMAN BERITA ACARA UJIAN SKRIPSI ......................................
iii
HALAMAN BERITA ACARA BIMBINGAN SKRIPSI ..........................
iv
MOTTO DAN PERSEMBAHAN ................................................................
vi
ABSTRAK ...................................................................................................... vii KATA PENGANTAR .................................................................................... viii DAFTAR ISI ..................................................................................................
x
DAFTAR TABEL ......................................................................................... xiii DAFTAR GAMBAR ..................................................................................... xiv DAFTAR LAMPIRAN ................................................................................. xvii BAB I PENDAHULUAN ..............................................................................
1
A. Latar Belakang .......................................................................................
1
B. Rumusan Masalah ..................................................................................
3
C. Batasan Masalah ....................................................................................
3
D. Tujuan Penelitian ...................................................................................
4
E. Manfaat Penelitian .................................................................................
4
F. Metode Penelitian ..................................................................................
4
G. Sistematika Penulisan Skripsi ................................................................
6
BAB II TINJAUAN PUSTAKA ...................................................................
8
A. Tanaman Padi ........................................................................................
8
1. Ciri-ciri Umum Tanaman Padi ........................................................
8
2. Penyakit tanaman padi .....................................................................
9
B. Sistem Pakar .......................................................................................... 25 1. Definisi Sistem Pakar ...................................................................... 25 2. Struktur Sistem Pakar ...................................................................... 26 3. Basis Pengetahuan (Knowledge based) ........................................... 28 C. Metode Pohon Keputusan (Decision Tree) ........................................... 29 D. Data Flow Diagram (DFD) ................................................................... 31 E. Entity Relationship Diagram (ERD) ...................................................... 33 F. Diagram Alur (Flowchart) ..................................................................... 37 G. MySQL .................................................................................................. 39 H. Microsoft Visual Basic 6.0 .................................................................... 42 BAB III METODE PENELITIAN ATAU PERANCANGAN .................. 43 A. Metode Penelitian .................................................................................. 43 B. Perancangan Basis Pengetahuan (Knowledge Base) ............................. 45 1. Perancangan tabel pengetahuan ....................................................... 45 2. Perancangan tabel keputusan diagnosa penyakit tanaman padi ....... 47 3. Pembentukan aturan (rule) .............................................................. 50 4. Motor inferensi (inference engine) .................................................. 51 C. Perancangan Sistem .............................................................................. 53 1. IDFD (Data Flow Diagram) ............................................................ 53 2. Flowchart .......................................................................................... 55 D. Perancangan Basis Data (Database) ...................................................... 56 1. Entity Relationship Diagram (ERD) ................................................ 56 2. Perancangan tabel database ............................................................. 56
E. Perancangan Antarmuka Pemakai (User Interface) .............................. 59 BAB IV ANALISA DATA DAN PEMBAHASAN ..................................... 62 A. Analisa Data ........................................................................................ 62 B. Pembahasan ......................................................................................... 66 1. Form Login ................................................................................... 66 2. Form Menu Utama ....................................................................... 66 3. Form Tentang Program ................................................................ 68 4. Form Tentang Pembuat ................................................................ 69 5.
Form Administrator Baru ............................................................ 69
6. Form Ganti Password .................................................................. 70 7. Form Hapus Administrator .......................................................... 70 8. Form Pengguna Baru ................................................................... 71 9. Form Ganti Password .................................................................. 71 10. Form Hapus Penguna ................................................................... 72 11. Form Input Penyakit .................................................................... 72 12. Form Input Gejala ........................................................................ 73 13. Form Basis Pengetahuan Data Rule ............................................. 73 14. Form Diagnosis ............................................................................ 74 15. Form Data Hasil Diagnosis ......................................................... 75 16. Laporan ........................................................................................ 76 BAB V PENUTUP ......................................................................................... 77 A. Kesimpulan ......................................................................................... 77 B. Saran .................................................................................................... 77 DAFTAR PUSTAKA .................................................................................... 78 LAMPIRAN
DAFTAR TABEL
Tabel 2.1 Simbol flowchart ...........................................................................
37
Tabel 3.1 Daftar jenis penyakit .....................................................................
45
Tabel 3.2 Daftar gejala .................................................................................
46
Tabel 3.3 Daftar keputusan penyakit ............................................................
48
Tabel 3.4 Aturan (rule) .................................................................................
50
Tabel 3.5 Tabel gejala ...................................................................................
57
Tabel 3.6 Tabel penyakit ...............................................................................
57
Tabel 3.7 Tabel pertanyaan ...........................................................................
57
Tabel 3.8 Tabel administrator .......................................................................
58
Tabel 3.9 Tabel user ......................................................................................
58
Tabel 3.10 Tabel temp ...................................................................................
58
Tabel 3.11 Tabel diagnosis ...........................................................................
58
DAFTAR GAMBAR
Gambar 2.1 Hawar Daun Bakteri ....................................................................
9
Gambar 2.2 Bakteri Daun Bergaris .................................................................. 11 Gambar 2.3 Blas .............................................................................................. 12 Gambar 2.4 Hawar Pelepah ............................................................................. 14 Gambar 2.5 Busuk Batang .............................................................................. 15 Gambar 2.6 Busuk Pelepah ............................................................................. 17 Gambar 2.7 Bercak Daun Coklat .................................................................... 18 Gambar 2.8 Bercak Cercospora ...................................................................... 19 Gambar 2.9 Hawar Daun Jingga ..................................................................... 20 Gambar 2.10 Tungro ....................................................................................... 21 Gambar 2.11 Kerdil Rumput ........................................................................... 23 Gambar 2.12 Kerdil Hampa ............................................................................ 24 Gambar 2.13 Struktur sistem pakar ................................................................. 26 Gambar 2.14 Pohon Keputusan (Decision Tree) ........................................... 30 Gambar 2.15 Proses ....................................................................................... 31 Gambar 2.16 Aliran ........................................................................................ 32 Gambar 2.17 Simpan data .............................................................................. 32
Gambar 2.18 Kesatuan luar ............................................................................ 32 Gambar 2.19 Kardinalitas relasi ...................................................................... 33 Gambar 2.20 Diagram E-R untuk relasi satu-ke-satu ..................................... 34 Gambar 2.21 Diagram E-R untuk relasi satu-ke-banyak ................................ 35 Gambar 2.22 Diagram E-R untuk relasi banyak-ke-banyak ........................... 36 Gambar 3.1 Blok diagram penelitian .............................................................. 43 Gambar 3.2 Decision tree diagnosis penyakit pada tanaman padi .................. 52 Gambar 3.3 Data Flow Diagram level 0 ........................................................ 54 Gambar 3.4 DFD level 1 proses administrator input data dan proses pengguna konsultasi ....................................................................................... 54 Gambar 3.5 Flowchart login ........................................................................... 55 Gambar 3.6 Flowchart diagnosis .................................................................... 55 Gambar 3.7 Entity Relationship Diagram ....................................................... 56 Gambar 3.8 Form Login .................................................................................. 59 Gambar 3.9 Form utama administrator .......................................................... 59 Gambar 3.10 Form utama pengguna ............................................................... 60 Gambar 3.11 Form diagnosis .......................................................................... 61 Gambar 4.1 Tampilan form login .................................................................... 66 Gambar 4.2 Tampilan form menu utama administrator ................................. 67 Gambar 4.3 Tampilan form menu utama pengguna / user .............................. 68 Gambar 4.4 Tampilan form tentang program .................................................. 68 Gambar 4.5 Tampilan form tentang program ................................................. 69 Gambar 4.6 Tampilan form administrator baru .............................................. 69
Gambar 4.7 Tampilan form ganti password .................................................... 70 Gambar 4.8 Tampilan form hapus administrator ............................................ 70 Gambar 4.9 Tampilan form pengguna baru .................................................... 71 Gambar 4.10 Tampilan form ganti password .................................................. 71 Gambar 4.11 Tampilan form hapus pengguna ................................................ 72 Gambar 4.12 Tampilan form input panyakit ................................................... 72 Gambar 4.13 Tampilan form input gejala ....................................................... 73 Gambar 4.14 Tampilan form input dara rule / pertanyaan .............................. 73 Gambar 4.15 Tampilan form diagnosis ........................................................... 74 Gambar 4.16 Tampilan form pencarian data hasil diagnosis .......................... 75 Gambar 4.17 Tampilan laporan hasil diagnosis .............................................. 76
DAFTAR LAMPIRAN
Listing Program Form Login .......................................................................... 79 Listing Program Form Menu Utama ............................................................... 83 Listing Program Form Diagnosis .................................................................... 85 Listing Program Form Hasil Diagnosis ........................................................... 87 Listing Program Form Pencarian Data Hasil Diagnosis ................................. 87 Listing Program Form Basis Pengetahuan Data Rule ..................................... 87 Listing Program Form Input Gejala ................................................................ 88 Listing Program Form Input Penyakit ............................................................. 97 Listing Program Form Daftar Administartor Baru .......................................... 102 Listing Program Form Ganti Password Administrator ................................... 103 Listing Program Form Hapus Administartor .................................................. 105 Listing Program Form Pengguna Baru ........................................................... 107 Listing Program Form Ganti Password Pengguna .......................................... 108 Listing Program Form Hapus Pengguna ......................................................... 110
DAFTAR PUSTAKA
Fathansyah. (1999). Basis Data. Bandung: Informatika. http://id.wikipedia.org/wiki/Padi; diakses tanggal 19 Januari 2013. http://sulsel.litbang.deptan.go.id/; diakses tanggal 19 Januari 2013. Kusumadewi, S. (2003). Artificial Intelligenci (Teknik dan Aplikasinya). Yogyakarta: Graha Ilmu. Soleh, R. T. (2007). Aplikasi Penjualan Menggunakan VB 6.0 dan Navicat MySQL. Jakarta: PT Elex Media Komputindo. Subari, & Yuswanto. (2008). Panduan Lengkap Pemrograman Visual Basic 6.0. Jakarta: Cerdas Pustaka Publisher. Sutabri, T. (2004). Pemrograman Terstruktur. Yogyakarta: Andi.
LAMPIRAN
Listing Program Form Login Private Sub cboLevel_Click() If cboLevel.Text = "Pengguna" Then Frame2.Visible = True Frame3.Visible = False txtlogin.Enabled = True txtpass.Enabled = True txtlogin.BackColor = &HFFFFFF txtpass.BackColor = &HFFFFFF txtlogin.Text = "" txtpass.Text = "" txtlogin.SetFocus ElseIf cboLevel.Text = "Administrator" Then Frame2.Visible = False Frame3.Visible = True txtLogin1.Enabled = True txtPass1.Enabled = True txtLogin1.BackColor = &HFFFFFF txtPass1.BackColor = &HFFFFFF txtLogin1.Text = "" txtPass1.Text = "" txtLogin1.SetFocus End If End Sub Private Sub daftarr_Click() frmUserBaru.Show vbModal End Sub Private Sub Form_Load() cboLevel.AddItem "Pengguna" cboLevel.AddItem "Administrator" Frame2.Visible = False Frame3.Visible = False End Sub Private Sub keluar_Click() End End Sub Private Sub keluar1_Click() End
End Sub Private Sub masuk_Click() On Error GoTo login_err If txtlogin.Text = "" Then MsgBox "Masukkan User ID !", vbCritical txtlogin.SetFocus Exit Sub End If If Not validity(txtlogin, "User ID") Then txtlogin.SetFocus Exit Sub End If If txtpass.Text = "" Then MsgBox "Masukkan Password !", vbCritical txtpass.SetFocus Exit Sub End If If Not validity(txtpass, "Password") Then txtpass.SetFocus Exit Sub End If konek_db Dim sql As String Set adoRS = New ADODB.Recordset sql = "select * from tbluser where user_id = '" & txtlogin.Text & "' and pass = '" & Crypt(txtpass.Text) & "'" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic If (adoRS.EOF) Then MsgBox "User ID dan Password salah! ", vbCritical, "Peringatan" txtlogin.Text = "" txtpass.Text = "" txtlogin.SetFocus Call closeconn Exit Sub End If Call closeconn userid = txtlogin.Text
Unload Me
frmUtama.mnuInput.Visible = False frmUtama.mnuBasis.Visible = False frmUtama.admin.Visible = False frmUtama.StatusBar1.Panels(1) = userid frmUtama.StatusBar1.Panels(2) = "Pengguna" frmUtama.Show frmHasilDiagnosis.Label6 = userid
Unload Me Exit Sub
login_err: MsgBox Err.Description End Sub Private Sub mnuBaru_Click() frmUserBaru.Show vbModal End Sub Private Sub mnuGanti_Click() frmGantiPass.Show vbModal End Sub Private Sub mnuHapus_Click() frmHapusUser.Show vbModal End Sub Private Sub masuk1_Click() On Error GoTo login_err If txtLogin1.Text = "" Then MsgBox "Masukkan User ID !", vbCritical txtLogin1.SetFocus Exit Sub End If If Not validity(txtlogin, "User ID") Then txtLogin1.SetFocus Exit Sub End If If txtPass1.Text = "" Then
MsgBox "Masukkan Password !", vbCritical txtPass1.SetFocus Exit Sub End If If Not validity(txtpass, "Password") Then txtPass1.SetFocus Exit Sub End If konek_db Dim sql As String Set adoRS = New ADODB.Recordset sql = "select * from admin where user_id = '" & txtLogin1.Text & "' and pass = '" & Crypt(txtPass1.Text) & "'" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic If (adoRS.EOF) Then MsgBox "User ID dan Password salah! ", vbCritical, "Peringatan" txtLogin1.Text = "" txtPass1.Text = "" txtLogin1.SetFocus Call closeconn Exit Sub End If Call closeconn userid = txtLogin1.Text Unload Me
frmUtama.mnuInput.Visible = True frmUtama.mnuBasis.Visible = True frmUtama.admin.Visible = True frmUtama.StatusBar1.Panels(1) = userid frmUtama.StatusBar1.Panels(2) = "Administrator" frmUtama.Show frmHasilDiagnosis.Label6 = userid Unload Me Exit Sub
login_err: MsgBox Err.Description
End Sub Private Sub txtLogin_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtpass.SetFocus txtPass1.SetFocus End If End Sub Private Sub txtPass_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then masuk_Click masuk1_Click End If End Sub
Listing Program Form Menu Utama Private Sub cmdDiagnosis_Click() frmDiagnosis.Show vbModal End Sub Private Sub adminbaru_Click() FrmPenggunaBaru.Show vbModal End Sub Private Sub Form_Activate() Call Form_Load End Sub Private Sub Form_Load() konek_db End Sub Private Sub Form_Unload(Cancel As Integer) diskonek_db Unload Me End End Sub Private Sub gantipass_Click() FrmPasAdmin.Show vbModal End Sub Private Sub gantipasswordd_Click()
frmGantiPass.Show vbModal End Sub Private Sub hapusadmin_Click() FrmHapusAdmin.Show vbModal End Sub Private Sub hapuspengguna_Click() frmHapusUser.Show vbModal End Sub Private Sub mnDiagnosiskeluhan_Click() frmDiagnosis.Show vbModal End Sub Private Sub mnEdit_Click() frmBasisPertanyaan.Show vbModal End Sub Private Sub mnKeluar_Click() Dim pesan pesan = MsgBox("Anda yakin mau keluar dari program ?", vbQuestion + vbYesNo + vbDefaultButton2, "Konfirmasi") If pesan = vbYes Then Unload Me End If End Sub
Private Sub mnPembuat_Click() frmPembuat.Show vbModal End Sub Private Sub mnProgram_Click() frmProgram.Show vbModal End Sub Private Sub mnuGejala_Click() frmGejala.Show vbModal End Sub Private Sub mnuPenyakit_Click() frmPenyakit.Show vbModal End Sub Private Sub pencarian_Click() FrmPencarian.Show End Sub
Private Sub penggunabaru_Click() frmUserBaru.Show vbModal End Sub
Listing Program Form Diagnosis
Private Sub cmdSelesai_Click() Unload Me End Sub Private Sub cmdYa_Click() On Error Resume Next rsTemp.AddNew rsTemp!ID_temp = rspertanyaan!kode_pertanyaan rsTemp!fakta = rspertanyaan!nama_gejala rsTemp.Update jwb = rspertanyaan!Ya If Left(jwb, 1) = "T" Then rspertanyaan.MoveFirst rspertanyaan.Find " kode_pertanyaan= '" & jwb & "' " Label1.Caption = "Apakah " + rspertanyaan!nama_gejala + " ? " Else rsPenyakit.MoveFirst rsPenyakit.Find " kode_penyakit= '" & jwb & "' " rsTemp.MoveFirst While Not rsTemp.EOF frmHasilDiagnosis.Label1.Text = frmHasilDiagnosis.Label1.Text + "- " + _ rsTemp!fakta + vbCrLf rsTemp.MoveNext Wend frmHasilDiagnosis.Label1.Text = frmHasilDiagnosis.Label1.Text + vbCrLf + vbCrLf + _ "Kemungkinan padi anda terkena : " + vbCrLf + "- " + rsPenyakit!nama_penyakit frmHasilDiagnosis.Label1.Text = frmHasilDiagnosis.Label1.Text + vbCrLf + vbCrLf + _ "Solusi Penanganan : " + vbCrLf + "- " + rsPenyakit!solusi
Unload Me frmHasilDiagnosis.Show vbModal frmHasilDiagnosis.Label6 = frmUtama.StatusBar1.Panels(1) End If End Sub Private Sub cmdTIDAK_Click() On Error Resume Next jwb = rspertanyaan!Tidak jawab = rsPenyakit!solusi If Left(jwb, 1) = "T" Then rspertanyaan.MoveFirst rspertanyaan.Find " kode_pertanyaan= '" & jwb & "' " Label1.Caption = "Apakah " + rspertanyaan!nama_gejala + " ? " Else rsPenyakit.Find " kode_penyakit= '" & jwb & "' " frmHasilDiagnosis.Label1.Text = rsPenyakit!nama_penyakit rsPenyakit.Find " solusi= '" & jawab & "' " frmHasilDiagnosis.Label1.Text = rsPenyakit!solusi Unload Me frmHasilDiagnosis.Show vbModal frmHasilDiagnosis.Label6 = frmUtama.StatusBar1.Panels(1) End If End Sub Private Sub Form_Activate() Call Form_Load End Sub Private Sub Form_Load() On Error Resume Next With rsTemp .Requery While Not .EOF .Delete .MoveNext Wend
End With With rspertanyaan .MoveFirst Label1.Caption = "Apakah " + rspertanyaan!nama_gejala + " ? " End With End Sub Private Sub Form_Unload(Cancel As Integer) Call cmdSelesai_Click End Sub
Listing Program Form Hasil Diagnosis Private Sub cmdCetak_Click() Set laporan.DataSource = rsTemp laporan.Sections("SECTION2").Controls("label1").Caption = Label1 laporan.Show vbModal End Sub Private Sub cmdSelesai_Click() Unload Me End Sub Private Sub cmdSimpan_Click() Conn.Execute "INSERT INTO diagnosis VALUES ('" & Label6.Caption & "','" & Label5.Caption & "','" & Label4.Caption & "','" & Label1.Text & "')" MsgBox "Data telah tersimpan!" End Sub
Private Sub Form_Activate() Label4 = Format(Now, "hh:mm:ss") Label5 = Format(Now, "dddd, dd / mm / yyyy") End Sub Listing Program Form Pencarian Data Hasil Diagnosis Private Sub CMDKELUAR_Click() Unload Me End Sub
Private Sub Form_Load() Adodc1.Visible = False End Sub Private Sub Text1_Change() Adodc1.RecordSource = "Select * from diagnosis where user like '%" & Text1 & "%'" Adodc1.Refresh End Sub
Listing Program Form Basis Pengetahuan Data Rule Public baru As Boolean Dim rsRusak As New ADODB.Recordset Dim rsnamaGejala As New ADODB.Recordset Dim rsTampilPenyakit As New ADODB.Recordset Private Sub cboCari_Click() txtCari.Text = "" txtCari.SetFocus End Sub Private Sub cbGejala_Click() On Error GoTo rusakErr Set rsnamaGejala = New ADODB.Recordset rsnamaGejala.Open "select * from gejala where nama_gejala='" & cbGejala.Text & "'", Conn txtGejala.Text = rsnamaGejala!kode_gejala Exit Sub rusakErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub
Private Sub cmdBatal_Click() KunciTeks True tombolAwal True Adodc1.Recordset.Cancel KosongkanForm End Sub Private Sub cmdHapus_Click() On Error GoTo hapusErr
Dim pil pil = MsgBox("Apakah anda yakin data ini akan dihapus ?", vbQuestion + vbYesNo + vbDefaultButton2, "Konfirmasi") If pil = vbYes Then Adodc1.Recordset.Delete Adodc1.Recordset.MoveLast MsgBox "Data Berhasil Dihapus !", vbInformation, "Informasi" End If Exit Sub hapusErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub CMDKELUAR_Click() Me.Hide End Sub Private Sub cmdSimpan_Click() On Error GoTo simpanErr If txtIDPertanyaan.Text = Empty Or _ cboKeluhan.Text = "" Or _ cbGejala.Text = Empty Or _ cboYA.Text = Empty Or _ cboTIDAK.Text = Empty Then MsgBox "Informasi belum lengkap ! Lengkapi terlebih dahulu !", vbExclamation, "Peringatan" txtIDPertanyaan.SetFocus Else Dim rsCek As ADODB.Recordset Set rsCek = New ADODB.Recordset rsCek.Open "select * from pertanyaan where kode_pertanyaan='" & txtIDPertanyaan.Text & "'", Conn If Not rsCek.EOF And baru Then MsgBox "Aturan dengan kode " & txtIDPertanyaan.Text & " sudah ada, silahkan ganti dengan kode yang lain !", vbExclamation, "Peringatan" txtIDPertanyaan.SetFocus: SendKeys "{HOME}+{END}" Else With Adodc1.Recordset If baru Then .AddNew !kode_pertanyaan = txtIDPertanyaan.Text !kode_gejala = txtGejala.Text !nama_gejala = cbGejala.Text
!Ya = cboYA.Text !Tidak = cboTIDAK.Text !kode_penyakit = txtIDKeluhan.Text .Update MsgBox "Data berhasil disimpan !", vbInformation, "Informasi" KunciTeks True tombolAwal True KosongkanForm End With End If End If Exit Sub simpanErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub cmdTambah_Click() baru = True KunciTeks False tombolAwal False txtIDPertanyaan.SetFocus End Sub Sub tombolAwal(kunci As Boolean) cmdTambah.Enabled = kunci cmdSimpan.Enabled = Not kunci cmdBatal.Enabled = Not kunci cmdUbah.Enabled = kunci cmdHapus.Enabled = kunci CMDKELUAR.Enabled = kunci End Sub Private Sub cmdUbah_Click() On Error GoTo ubahErr KunciTeks False With Adodc1.Recordset If baru Then .AddNew !kode_pertanyaan = txtIDPertanyaan.Text !kode_gejala = txtGejala.Text !nama_gejala = cbGejala.Text !Ya = cboYA.Text !Tidak = cboTIDAK.Text
!kode_penyakit = txtIDKeluhan.Text .Update MsgBox "Data berhasil diubah !", vbInformation, "Informasi" KosongkanForm End With txtIDPertanyaan.SetFocus baru = False Exit Sub
ubahErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub Form_Activate() Dim i As Integer For i = 0 To 6 Next i cboKeluhan.Clear If rsPenyakit.EOF Then MsgBox "Data keluhan masih kosong" Exit Sub End If rsPenyakit.MoveFirst While Not rsPenyakit.EOF cboKeluhan.AddItem rsPenyakit!nama_penyakit rsPenyakit.MoveNext Wend cbGejala.Clear If rsGejala.EOF Then MsgBox "Data gejala masih kosong" Exit Sub End If rsGejala.MoveFirst While Not rsGejala.EOF cbGejala.AddItem rsGejala!nama_gejala rsGejala.MoveNext
Wend If Not rspertanyaan.EOF Then cboYA.Clear cboTIDAK.Clear With rspertanyaan If .EOF Then MsgBox "Data pertanyaan masih kosong...!" cmdTambah.SetFocus Exit Sub .MoveFirst End If While Not .EOF cboYA.AddItem !kode_pertanyaan cboTIDAK.AddItem !kode_pertanyaan .MoveNext Wend End With End If End Sub Private Sub Form_Load() KunciTeks True tombolAwal True Adodc1.ConnectionString = Conn.ConnectionString Adodc1.RecordSource = "select * from pertanyaan" Adodc1.Refresh Set gridPertanyaan.DataSource = Adodc1 gridPertanyaan.Columns(0).Width = 600 gridPertanyaan.Columns(1).Width = 800 gridPertanyaan.Columns(2).Width = 5000 gridPertanyaan.Columns(3).Width = 800 gridPertanyaan.Columns(4).Width = 800 gridPertanyaan.Columns(5).Width = 900 End Sub Sub KosongkanForm() txtIDPertanyaan.Text = Empty txtIDKeluhan.Text = Empty cboKeluhan.Text = Empty
cbGejala.Text = Empty cboYA.Text = Empty cboTIDAK.Text = Empty End Sub Sub KunciTeks(kunci As Boolean) cboYA.Locked = kunci cboTIDAK.Locked = kunci End Sub Private Sub cbokeluhan_Click() On Error GoTo rusakErr Set rsRusak = New ADODB.Recordset rsRusak.Open "select * from penyakit where nama_penyakit='" & cboKeluhan.Text & "'", Conn txtIDKeluhan.Text = rsRusak!kode_penyakit Exit Sub rusakErr: MsgBox "Terdapat kesalahan ! " & Err.Description, vbCritical, "Peringatan" End Sub Private Sub gridpertanyaan_DblClick() On Error GoTo ErrPilih KunciTeks False TmpKode = gridPertanyaan.Columns(0).Text txtIDPertanyaan.Text = gridPertanyaan.Columns(0).Text txtGejala.Text = gridPertanyaan.Columns(1).Text cbGejala.Text = gridPertanyaan.Columns(2).Text cboYA.Text = gridPertanyaan.Columns(3).Text cboTIDAK.Text = gridPertanyaan.Columns(4).Text txtIDKeluhan.Text = gridPertanyaan.Columns(5).Text Set rsTampilPenyakit = New ADODB.Recordset rsTampilPenyakit.Open "select * from penyakit where kode_penyakit='" & txtIDKeluhan.Text & "'", Conn cboKeluhan.Text = rsTampilPenyakit!nama_penyakit Exit Sub Exit Sub ErrPilih: TmpKode = "" End Sub
Listing Program Form Input Gejala Dim TmpKode As String Dim WithEvents rsRefresh As Recordset Dim WithEvents rsJenis As Recordset Dim WithEvents rsType As Recordset Dim WithEvents rsnamaGejala As Recordset Private Sub cmdHapus_Click() On Error GoTo ErrHapus If Txt_Kode.Text = "" Or _ Txt_Nama.Text = "" Then MsgBox ("Data belum ada..."), vbInformation + vbQuestion Txt_Kode.SetFocus Else If MsgBox("Apakah anda yakin akan Menghapus gejala " + Txt_Nama, _ vbQuestion + vbYesNo, "Information") _ <> vbYes Then Txt_Kode.SetFocus Exit Sub Else ' Menghapus data pada Database Satuan Conn.Execute "DELETE FROM gejala WHERE kode_gejala='" & Txt_Kode.Text & "'"
MsgBox "gejala Sudah Dihapus", vbInformation, "Information" cmdReset_Click Txt_Kode.SetFocus End If End If SubRefresh Exit Sub ErrHapus: MsgBox "Data ini tidak dapat dihapus, karena sedang dalam Proses", vbCritical SubRefresh End Sub Private Sub CMDREFRESH_Click() SubRefresh End Sub Private Sub cmdReset_Click() Txt_Kode.Text = "" Txt_Nama.Text = ""
Txt_Kode.SetFocus End Sub Sub NonAktif() cmdSimpan.Enabled = False CmdREFRESH.Enabled = False cmdUbah.Enabled = True cmdHapus.Enabled = True End Sub Sub Aktif() cmdSimpan.Enabled = True CmdREFRESH.Enabled = True cmdUbah.Enabled = False cmdHapus.Enabled = False End Sub Private Sub cmdSimpan_Click() If Txt_Kode.Text = "" Then MsgBox "Kode harus diisi", vbCritical Txt_Kode.SetFocus Exit Sub End If On Error GoTo ErrMasuk Conn.Execute "INSERT INTO gejala VALUES ('" & Txt_Kode.Text & "','" & Txt_Nama.Text & "')" MsgBox "Data telah tersimpan!" cmdReset_Click SubRefresh Exit Sub ErrMasuk: MsgBox "Proses penyimpanan data Error", vbCritical SubRefresh End Sub Sub SubRefresh() Adodc1.ConnectionString = Conn.ConnectionString Adodc1.RecordSource = "SELECT * FROM gejala ORDER BY kode_gejala " Adodc1.Refresh Set GRID.DataSource = Adodc1
GRID.Columns(0).Caption = "Kode gejala" GRID.Columns(1).Caption = "Nama gejala" GRID.Columns(0).Width = 1800 GRID.Columns(1).Width = 3000 End Sub Private Sub cmdTutup_Click() Me.Hide End Sub Private Sub DataGrid1_Click() NonAktif End Sub Private Sub cmdUbah_Click() If Txt_Kode.Text = "" Then MsgBox "Kode harus diisi", vbCritical Txt_Kode.SetFocus Exit Sub End If On Error GoTo ErrUbah Conn.Execute "UPDATE gejala SET kode_gejala = '" & Txt_Kode.Text & "',nama_gejala = '" & Txt_Nama.Text & "' WHERE kode_gejala = '" & Txt_Kode.Text & "'" MsgBox "Data telah diubah!" cmdReset_Click SubRefresh Exit Sub ErrUbah: MsgBox "Update Error", vbCritical SubRefresh End Sub Sub center(Frm As Form) Frm.Top = 300 Frm.Left = (Screen.Width - Frm.Width) / 2 Frm.Height = 8000 Frm.Width = 9000 End Sub Private Sub Form_Load() Lbl_Tgl = Format(Now, "dd/MM/yyyy") konek_db center Me
SubRefresh End Sub Private Sub GRID_DblClick() On Error GoTo ErrPilih TmpKode = GRID.Columns(0).Text Txt_Kode.Text = GRID.Columns(0).Text Txt_Nama.Text = GRID.Columns(1).Text Exit Sub ErrPilih: TmpKode = "" cmdReset_Click End Sub Private Sub Txt_Kode_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Set rsnamaGejala = New ADODB.Recordset rsnamaGejala.Open "select nama_gejala from gejala where kode_gejala='" & Txt_Kode.Text & "'", Conn With rsnamaGejala If .EOF Then MsgBox "Kode baru dan Nama gejala belum ada ", vbInformation Txt_Nama.SetFocus Exit Sub .MoveFirst End If While Not .EOF Txt_Nama.Text = .Fields(0) .MoveNext Wend End With End If End Sub
Listing Program Form Input Penyakit Dim TmpKode As String Dim WithEvents rsRefresh As Recordset Dim WithEvents rsJenis As Recordset
Dim WithEvents rsType As Recordset Dim WithEvents rsnamaPenyakit As Recordset Private Sub cmdHapus_Click() On Error GoTo ErrHapus If Txt_Kode.Text = "" Or _ Txt_Nama.Text = "" Then MsgBox ("Data belum ada..."), vbInformation + vbQuestion Txt_Kode.SetFocus Else If MsgBox("Apakah anda yakin akan Menghapus penyakit " + Txt_Nama, _ vbQuestion + vbYesNo, "Information") _ <> vbYes Then Txt_Kode.SetFocus Exit Sub Else Conn.Execute "DELETE FROM penyakit WHERE kode_penyakit='" & Txt_Kode.Text & "'"
MsgBox "penyakit Sudah Dihapus", vbInformation, "Information" cmdReset_Click Txt_Kode.SetFocus End If End If SubRefresh Exit Sub ErrHapus: MsgBox "Data ini tidak dapat dihapus, karena sedang dalam Proses", vbCritical SubRefresh End Sub Private Sub CMDREFRESH_Click() SubRefresh End Sub Private Sub cmdReset_Click() Txt_Kode.Text = "" Txt_Nama.Text = "" Txt_Solusi.Text = "" Txt_Kode.SetFocus End Sub Sub NonAktif() cmdSimpan.Enabled = False
CmdREFRESH.Enabled = False cmdUbah.Enabled = True cmdHapus.Enabled = True End Sub Sub Aktif() cmdSimpan.Enabled = True CmdREFRESH.Enabled = True cmdUbah.Enabled = False cmdHapus.Enabled = False End Sub Private Sub cmdSimpan_Click() If Txt_Kode.Text = "" Then MsgBox "Kode harus diisi", vbCritical Txt_Kode.SetFocus Exit Sub End If On Error GoTo ErrMasuk Conn.Execute "INSERT INTO penyakit VALUES ('" & Txt_Kode.Text & "','" & Txt_Nama.Text & "','" & Txt_Solusi.Text & "')" MsgBox "Data telah tersimpan!" cmdReset_Click SubRefresh Exit Sub ErrMasuk: MsgBox "Proses penyimpanan data Error", vbCritical SubRefresh End Sub Sub SubRefresh() Adodc1.ConnectionString = Conn.ConnectionString Adodc1.RecordSource = "SELECT * FROM penyakit ORDER BY kode_penyakit " Adodc1.Refresh Set GRID.DataSource = Adodc1 GRID.Columns(0).Caption = "Kode penyakit" GRID.Columns(1).Caption = "Nama penyakit" GRID.Columns(2).Caption = "Solusi" GRID.Columns(0).Width = 1000
GRID.Columns(1).Width = 2000 GRID.Columns(2).Width = 5000 End Sub Private Sub cmdTutup_Click() Me.Hide End Sub Private Sub DataGrid1_Click() NonAktif End Sub Private Sub cmdUbah_Click() If Txt_Kode.Text = "" Then MsgBox "Kode harus diisi", vbCritical Txt_Kode.SetFocus Exit Sub End If On Error GoTo ErrUbah Conn.Execute "UPDATE penyakit SET kode_penyakit = '" & Txt_Kode.Text & "',nama_penyakit = '" & Txt_Nama.Text & "',solusi = '" & Txt_Solusi.Text & "' WHERE kode_penyakit = '" & Txt_Kode.Text & "'" MsgBox "Data telah diubah!" cmdReset_Click SubRefresh Exit Sub ErrUbah: MsgBox "Update Error", vbCritical SubRefresh End Sub Sub center(Frm As Form) Frm.Top = 300 Frm.Left = (Screen.Width - Frm.Width) / 2 Frm.Height = 9000 Frm.Width = 9000 End Sub Private Sub Form_Load() Lbl_Tgl = Format(Now, "dd/MM/yyyy") konek_db center Me SubRefresh
End Sub Private Sub GRID_DblClick() On Error GoTo ErrPilih TmpKode = GRID.Columns(0).Text Txt_Kode.Text = GRID.Columns(0).Text Txt_Nama.Text = GRID.Columns(1).Text Txt_Solusi.Text = GRID.Columns(2).Text ' NonAktif Exit Sub ErrPilih: TmpKode = "" cmdReset_Click End Sub Private Sub Txt_Kode_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Set rsnamaPenyakit = New ADODB.Recordset rsnamaPenyakit.Open "select nama_penyakit,solusi from penyakit where kode_penyakit='" & Txt_Kode.Text & "'", Conn With rsnamaPenyakit If .EOF Then MsgBox "Kode baru dan Nama penyakit belum ada ", vbInformation Txt_Nama.SetFocus Exit Sub .MoveFirst End If While Not .EOF Txt_Nama.Text = .Fields(0) Txt_Solusi.Text = .Fields(1) .MoveNext Wend End With End If End Sub
Listing Program Form Daftar Administartor Baru Private Sub cmdlogin_Click() If txtlogin.Text = "" Then MsgBox "Masukkan User ID !", vbCritical txtlogin.SetFocus Exit Sub End If If Not validity(txtlogin, "User ID") Then txtlogin.SetFocus Exit Sub End If If txtpass.Text = "" Then MsgBox "Masukkan Password !", vbCritical txtpass.SetFocus Exit Sub End If If Not validity(txtpass, "Password") Then txtpass.SetFocus Exit Sub End If If txtpass2.Text = "" Then MsgBox "Ulangi Memasukkan Password !", vbCritical txtpass2.SetFocus Exit Sub End If If Not validity(txtpass2, "Konfirmasi Password") Then txtpass2.SetFocus Exit Sub End If If txtpass.Text <> txtpass2.Text Then MsgBox "Password dan ulangi password tidak sesuai !", vbCritical txtpass.Text = "" txtpass2.Text = "" txtpass.SetFocus Exit Sub End If konek_db sql = "select * from admin " adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic
If (adoRS.EOF) Then MsgBox "Data tidak boleh kosong! ", vbCritical Call closeconn Exit Sub End If Call closeconn sql = "select * from admin where user_id = '" & txtlogin.Text & "'" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic If Not (adoRS.EOF) Then MsgBox "User ID sudah ada! Masukkan user ID yang lain!", vbCritical, "Peringatan" txtlogin.Text = "" txtlogin.SetFocus Call closeconn Exit Sub End If Call closeconn sql = "insert into admin values('" & txtlogin.Text & "','" & Crypt(txtpass.Text) & "')" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic Call closeconn MsgBox "Admin Baru Berhasil Disimpan!", vbInformation, "Informasi" Unload Me End Sub Private Sub Command1_Click() Unload Me End Sub
Listing Program Form Ganti Password Administrator Private Sub cmdlogin_Click() If txtlogin.Text = "" Then MsgBox "Masukkan User ID !", vbCritical, "Peringatan" txtlogin.SetFocus Exit Sub End If
If Not validity(txtlogin, "User ID") Then txtlogin.SetFocus Exit Sub End If If txtpass.Text = "" Then MsgBox "Masukkan Password Administrator yang sekarang !", vbCritical, "Peringatan" txtpass.SetFocus Exit Sub End If If Not validity(txtpass, "Password Administrator sekarang") Then txtpass.SetFocus Exit Sub End If If txtpass2.Text = "" Then MsgBox "Masukkan password yang baru !", vbCritical, "Peringatan" txtpass2.SetFocus Exit Sub End If If Not validity(txtpass2, "Password Baru") Then txtpass2.SetFocus Exit Sub End If
If txtpass3.Text = "" Then MsgBox "Ulangi password baru !", vbCritical, "Peringatan" txtpass3.SetFocus Exit Sub End If If Not validity(txtpass3, "Konfirmasi Password") Then txtpass3.SetFocus Exit Sub End If If txtpass2.Text <> txtpass3.Text Then MsgBox "Password dan Ulangi Password tidak sesuai !", vbCritical, "Peringatan" txtpass2.Text = "" txtpass3.Text = "" txtpass2.SetFocus
Exit Sub End If
konek_db sql = "select * from admin where user_id = '" & txtlogin.Text & "' and pass = '" & Crypt(txtpass.Text) & "'" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic If (adoRS.EOF) Then MsgBox "Password yang lama salah! ", vbCritical txtpass.Text = "" txtpass.SetFocus Call closeconn Exit Sub End If Call closeconn sql = "update admin set pass = '" & Crypt(txtpass2.Text) & "' where user_id = '" & txtlogin.Text & "'" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic Call closeconn MsgBox "Password berhasil diubah!", vbInformation, "Informasi" Unload Me End Sub Private Sub Command1_Click() Unload Me End Sub
Listing Program Form Hapus Administartor Private Sub cmdlogin_Click() If txtlogin.Text = "" Then MsgBox "Masukkan User ID !", vbCritical txtlogin.SetFocus Exit Sub End If If Not validity(txtlogin, "User ID") Then
txtlogin.SetFocus Exit Sub End If
If txtadmin.Text = "" Then MsgBox "Masukkan Password !", vbCritical txtadmin.SetFocus Exit Sub End If If Not validity(txtadmin, "Administrator") Then txtadmin.SetFocus Exit Sub End If konek_db sql = "select * from admin where user_id = '" & txtlogin.Text & "'" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic If (adoRS.EOF) Then MsgBox "User ID (" & txtlogin.Text & ") tidak terdaftar! Masukkan User ID yang benar!", vbCritical, "Peringatan" txtlogin.Text = "" txtlogin.SetFocus Call closeconn Exit Sub End If Call closeconn sql = "delete from admin where user_id = '" & txtlogin.Text & "'" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic Call closeconn MsgBox "Admin berhasiil dihapus!", vbInformation, "Informasi" Unload Me End Sub Private Sub Command1_Click() Unload Me End Sub
Listing Program Form Pengguna Baru Private Sub cmdlogin_Click() If txtlogin.Text = "" Then MsgBox "Masukkan User ID !", vbCritical txtlogin.SetFocus Exit Sub End If If Not validity(txtlogin, "User ID") Then txtlogin.SetFocus Exit Sub End If If txtpass.Text = "" Then MsgBox "Masukkan Password !", vbCritical txtpass.SetFocus Exit Sub End If If Not validity(txtpass, "Password") Then txtpass.SetFocus Exit Sub End If If txtpass2.Text = "" Then MsgBox "Ulangi Memasukkan Password !", vbCritical txtpass2.SetFocus Exit Sub End If If Not validity(txtpass2, "Konfirmasi Password") Then txtpass2.SetFocus Exit Sub End If If txtpass.Text <> txtpass2.Text Then MsgBox "Password dan ulangi password tidak sesuai !", vbCritical txtpass.Text = "" txtpass2.Text = "" txtpass.SetFocus Exit Sub End If konek_db sql = "select * from tbluser " adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic
If (adoRS.EOF) Then MsgBox "Data tidak boleh kosong! ", vbCritical Call closeconn Exit Sub End If Call closeconn sql = "select * from tbluser where user_id = '" & txtlogin.Text & "'" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic If Not (adoRS.EOF) Then MsgBox "User ID sudah ada! Masukkan user ID yang lain!", vbCritical, "Peringatan" txtlogin.Text = "" txtlogin.SetFocus Call closeconn Exit Sub End If Call closeconn sql = "insert into tbluser values('" & txtlogin.Text & "','" & Crypt(txtpass.Text) & "')" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic Call closeconn MsgBox "Pengguna Baru Berhasil Disimpan!", vbInformation, "Informasi" Unload Me End Sub Private Sub Command1_Click() Unload Me End Sub
Listing Program Form Ganti Password Pengguna Private Sub cmdlogin_Click() If txtlogin.Text = "" Then MsgBox "Masukkan User ID !", vbCritical, "Peringatan" txtlogin.SetFocus Exit Sub End If
If Not validity(txtlogin, "User ID") Then txtlogin.SetFocus Exit Sub End If If txtpass.Text = "" Then MsgBox "Masukkan Password Pengguna yang sekarang !", vbCritical, "Peringatan" txtpass.SetFocus Exit Sub End If If Not validity(txtpass, "Password Pengguna sekarang") Then txtpass.SetFocus Exit Sub End If If txtpass2.Text = "" Then MsgBox "Masukkan password yang baru !", vbCritical, "Peringatan" txtpass2.SetFocus Exit Sub End If If Not validity(txtpass2, "Password Baru") Then txtpass2.SetFocus Exit Sub End If
If txtpass3.Text = "" Then MsgBox "Ulangi password baru !", vbCritical, "Peringatan" txtpass3.SetFocus Exit Sub End If If Not validity(txtpass3, "Konfirmasi Password") Then txtpass3.SetFocus Exit Sub End If If txtpass2.Text <> txtpass3.Text Then MsgBox "Password dan Ulangi Password tidak sesuai !", vbCritical, "Peringatan" txtpass2.Text = "" txtpass3.Text = "" txtpass2.SetFocus
Exit Sub End If
konek_db sql = "select * from tbluser where user_id = '" & txtlogin.Text & "' and pass = '" & Crypt(txtpass.Text) & "'" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic If (adoRS.EOF) Then MsgBox "Password yang lama salah! ", vbCritical txtpass.Text = "" txtpass.SetFocus Call closeconn Exit Sub End If Call closeconn sql = "update tbluser set pass = '" & Crypt(txtpass2.Text) & "' where user_id = '" & txtlogin.Text & "'" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic Call closeconn MsgBox "Password berhasil diubah!", vbInformation, "Informasi" Unload Me End Sub Private Sub Command1_Click() Unload Me End Sub
Listing Program Form Hapus Pengguna
Private Sub cmdlogin_Click() If txtlogin.Text = "" Then MsgBox "Masukkan User ID !", vbCritical txtlogin.SetFocus Exit Sub End If
If Not validity(txtlogin, "User ID") Then txtlogin.SetFocus Exit Sub End If
If txtadmin.Text = "" Then MsgBox "Masukkan Password !", vbCritical txtadmin.SetFocus Exit Sub End If If Not validity(txtadmin, "Administrator") Then txtadmin.SetFocus Exit Sub End If konek_db sql = "select * from tbluser where user_id = '" & txtlogin.Text & "'" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic If (adoRS.EOF) Then MsgBox "User ID (" & txtlogin.Text & ") tidak terdaftar! Masukkan User ID yang benar!", vbCritical, "Peringatan" txtlogin.Text = "" txtlogin.SetFocus Call closeconn Exit Sub End If Call closeconn sql = "delete from tbluser where user_id = '" & txtlogin.Text & "'" adoRS.Open sql, Conn, adOpenDynamic, adLockOptimistic Call closeconn MsgBox "Pengguna berhasiil dihapus!", vbInformation, "Informasi" Unload Me End Sub Private Sub Command1_Click() Unload Me End Sub
