program aplikasi ujian online vb 6

Aplikasi Ujian ONLINE VB 6.0

5.6  Membuat Aplikasi Dengan Database MySql

 

Pada bab ini akan dibahas tentang sebuah aplikasi sederhana tentang PSB (Penerimaan Siswa Baru). Fokus pembahasan adalah pada soal ujian bagi para calon siswa dimana ujian saringan dilakukan dengan menjawab soal-soal dalam bentuk aplikasi (Ujian digital). Untuk memulainya ikutilah langkah-langkah di bawah ini.

5.6.1   Membuat Database Dan Tabel

1.              Aktifkan wamp server

2.              Aktifkan phpmyadmin

3.              Buatlah database dengan nama DBPSB (Ciptakan)

4.              Buatlah beberapa tabel dengan struktur sebagai berikut

 

Koding :

Dim Dijawab, status As String

Private Sub Form_Activate()

Call KoneksI

ADO.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\DBUjian.mdb"

ADO.RecordSource = "tEMPORER"

ADO.Refresh

Set DG.DataSource = ADO

DG.Refresh

End Sub

Private Sub Form_Load()

Call KoneksI

Dim RSCari As New ADODB.Recordset

RSCari.Open "select distinct soal.idkuliah from soal,mata_kuliah where soal.idkuliah=mata_kuliah.idkuliah", Conn

If Not RSCari.EOF Then

    Combo5.Clear

    Do While Not RSCari.EOF

        Combo5.AddItem RSCari!idkuliah

        RSCari.MoveNext

    Loop

End If

Call Blank

Text1 = ""

LblTanggal = Date

Timer3.Enabled = False

AwalOpsi

End Sub

Sub Blank()

Call KoneksI

Dim hapustemporer As String

hapustemporer = "delete * from temporer"

Conn.Execute hapustemporer

Form_Activate

ADO.Refresh

DG.Refresh

End Sub

Private Sub Combo1_Click()

Call AwalOpsi

Text1 = ""

Call KoneksI

RSHasil.Open "select * from hasilujian where nim='" & Menu.STBar.Panels(1) & "' and idkuliah='" & Combo1 & "'", Conn

If Not RSHasil.EOF Then

    MsgBox "anda pernah mengikui ujian mata kuliah ini, pilih mata kuliah lain"

    Combo5.SetFocus

    Exit Sub

End If

RSSoal.Open "select nomor,matakuliah from soal,mata_kuliah where soal.idkuliah=mata_kuliah.idkuliah and soal.idkuliah='" & Combo1 & "'", Conn

If Not RSSoal.EOF Then

    LblMataKuliah = RSSoal!Matakuliah

    List5.Clear

    Do While Not RSSoal.EOF

        List5.AddItem RSSoal!nomor

        RSSoal.MoveNext

    Loop

Else

    List5.Clear

    MsgBox "Soal belum dientri atau tidak terdaftar"

    Combo5.SetFocus

End If

End Sub

Private Sub Command1_Click()

On Error Resume Next

If Combo1 = "" Then

    MsgBox "Anda belum memilih mata kuliah"

    Combo5.SetFocus

    Exit Sub

ElseIf List1 = "" Then

    MsgBox "anda belum memilih nomor soal"

    List5.SetFocus

    Exit Sub

ElseIf Text1 = "" Then

    MsgBox "anda belum memilih nomor soal"

    List5.SetFocus

    Exit Sub

ElseIf Option5.Value = False And Option2.Value = False And Option3.Value = False And Option4.Value = False Then

    MsgBox "anda belum melilih jawaban"

    Exit Sub

End If

Call KoneksI

RSTemporer.Open "select * from temporer where nomor='" & List1 & "'", Conn

If Not RSTemporer.EOF Then

    MsgBox "nomor ini sudah dijawab"

    List5.SetFocus

    Exit Sub

End If

Dim simpan As String

simpan = "insert into temporer(nomor,dijawab,jawaban,keterangan) values " & _

"('" & List1 & "','" & LblDijawab & "','" & LblJawaban & "','" & LblKet & "')"

Conn.Execute simpan

Form_Activate

List5.ListIndex = List5.ListIndex + 1

End Sub

Private Sub Command2_Click()

Timer2.Enabled = False

LblTotalSoal = List5.ListCount

Call TTLSoalDijawab

Call TTLbenar

Call TTLSALAH

LblDurasi = Format(CDate(LblSelesai.Caption) - CDate(LblMulai.Caption), "hh:mm:ss")

If LblBenar > LblSalah Then

    LblKeterangan = "LULUS"

Else

    LblKeterangan = "GAGAL"

End If

Timer3.Enabled = True

If Menu.STBar.Panels(3) = "ADMINISTRATOR" Then

MsgBox "Data ujian admin tidak perlu disimpan" & Chr(13) & _

        "Cukup untuk percobaan saja"

    Exit Sub

End If

Call KoneksI

Dim simpan1 As String

simpan1 = "insert into hasilujian(Nim,IDKULIAH,tanggal,mulai,selesai,durasi,jmlsoal,dijawab,benar,salah,keterangan) values " & _

"('" & Menu.STBar.Panels(1) & "','" & Combo1 & "','" & LblTanggal & "','" & LblMulai & "','" & LblSelesai & "','" & LblDurasi & "','" & LblTotalSoal & "','" & LblSoalDijawab & "','" & LblBenar & "','" & LblSalah & "','" & LblKeterangan & "')"

Conn.Execute simpan1

ADO.Recordset.MoveFirst

Do While Not ADO.Recordset.EOF

    Dim simpan2 As String

    simpan2 = "insert into detail(Nim,IDKULIAH,NOMOR,DIJAWAB,JAWABAN,KETERANGAN) values " & _

    "('" & Menu.STBar.Panels(1) & "','" & Combo1 & "','" & ADO.Recordset!nomor & "','" & ADO.Recordset!Dijawab & "','" & ADO.Recordset!jawaban & "','" & ADO.Recordset!keterangan & "')"

    Conn.Execute simpan2

    ADO.Recordset.MoveNext

Loop

End Sub

Private Sub Command3_Click()

Unload Me

End Sub

Private Sub Command4_Click()

MsgBox "5. Pilih Materi di combo paling atas" & Chr(13) & _

        "2. Pilih Nomor Soal dalam list di kiri" & Chr(13) & _

        "3. Pilih Jawaban pada option button" & vbCrLf & _

        "4. Klik Jawab" & vbCrLf & _

        "5. Lanjutkan ke Nomor Berikutnya"

End Sub

Private Sub List1_Click()

Call AwalOpsi

Call KoneksI

RSTemporer.Open "SELECT * FROM TEMPORER WHERE Nomor='" & List1 & "'", Conn

If Not RSTemporer.EOF Then

    MsgBox "Soal ini sudah dijawab"

    List5.SetFocus

Else

    RSSoal.Open "SELECT pertanyaan,a,b,c,d,jawaban FROM SOAL WHERE nomor='" & List1 & "' and idkuliah='" & Combo1 & "'", Conn

    If Not RSSoal.EOF Then

        Text1 = RSSoal!pertanyaan

        Option5.Caption = RSSoal!A

        Option2.Caption = RSSoal!B

        Option3.Caption = RSSoal!c

        Option4.Caption = RSSoal!d

        Label19 = RSSoal!jawaban

    End If

End If

End Sub

Private Sub Option1_Click()

Call KoneksI

RSSoal.Open "SELECT jawaban FROM SOAL WHERE nomor='" & List1 & "' and idkuliah='" & Combo1 & "'", Conn

If Not RSSoal.EOF Then

    LblDijawab = "A"

    LblJawaban = RSSoal!jawaban

    If LblDijawab = LblJawaban Then LblKet = "BENAR" Else LblKet = "SALAH"

End If

End Sub

Private Sub Option2_Click()

Call KoneksI

RSSoal.Open "SELECT jawaban FROM SOAL WHERE nomor='" & List1 & "' and idkuliah='" & Combo1 & "'", Conn

If Not RSSoal.EOF Then

    LblDijawab = "B"

    LblJawaban = RSSoal!jawaban

    If LblDijawab = LblJawaban Then LblKet = "BENAR" Else LblKet = "SALAH"

End If

End Sub

Private Sub Option3_Click()

Call KoneksI

RSSoal.Open "SELECT jawaban FROM SOAL WHERE nomor='" & List1 & "' and idkuliah='" & Combo1 & "'", Conn

If Not RSSoal.EOF Then

    LblDijawab = "C"

    LblJawaban = RSSoal!jawaban

    If LblDijawab = LblJawaban Then LblKet = "BENAR" Else LblKet = "SALAH"

End If

End Sub

Private Sub Option4_Click()

Call KoneksI

RSSoal.Open "SELECT jawaban FROM SOAL WHERE nomor='" & List1 & "' and idkuliah='" & Combo1 & "'", Conn

If Not RSSoal.EOF Then

    LblDijawab = "D"

    LblJawaban = RSSoal!jawaban

    If LblDijawab = LblJawaban Then LblKet = "BENAR" Else LblKet = "SALAH"

End If

End Sub

Private Sub Timer1_Timer()

LblMulai = Time$

Timer5.Enabled = False

End Sub

Private Sub Timer2_Timer()

LblSelesai = Time$

End Sub

Sub TTLSoalDijawab()

Call KoneksI

RSTemporer.Open "select count(*) as TOTALSOAL from temporer", Conn

LblSoalDijawab = RSTemporer!TOTALSOAL

End Sub

Sub TTLSoal()

Call KoneksI

RSTemporer.Open "select count(*) as aaa from temporer", Conn

LblTotalSoal = RSTemporer!aaa

'LblSoalDijawab = List5.ListCount

End Sub

Sub TTLbenar()

Call KoneksI

RSTemporer.Open "select count(keterangan) as aaa from temporer where keterangan='BENAR'", Conn

LblBenar = RSTemporer!aaa

End Sub

Sub TTLSALAH()

Call KoneksI

RSTemporer.Open "select count(keterangan) as aaa from temporer where keterangan='SALAH'", Conn

LblSalah = RSTemporer!aaa

End Sub

Private Sub Timer3_Timer()

If LblKeterangan.Visible = True Then

    LblKeterangan.Visible = False

ElseIf LblKeterangan.Visible = False Then

    LblKeterangan.Visible = True

End If

End Sub

Sub AwalOpsi()

Option5.Value = False

Option2.Value = False

Option3.Value = False

Option4.Value = False

Option5.Caption = "Jawaban A"

Option2.Caption = "Jawaban B"

Option3.Caption = "Jawaban C"

Option4.Caption = "Jawaban D"

End Sub

5.6.7   Membuat Form Laporan

Koding :

Private Sub Form_Load()

Call KoneksI

RSHasil.Open "select distinct nim,idkuliah from hasilujian", Conn

Combo5.Clear

Do While Not RSHasil.EOF

    Combo5.AddItem RSHasil!nim

    RSHasil.MoveNext

Loop

Conn.Close

Call KoneksI

RSHasil.Open "select distinct idkuliah from hasilujian", Conn

Combo2.Clear

Combo4.Clear

Combo6.Clear

Do While Not RSHasil.EOF

    Combo2.AddItem RSHasil!idkuliah

    Combo4.AddItem RSHasil!idkuliah

    Combo6.AddItem RSHasil!idkuliah

    RSHasil.MoveNext

Loop

Conn.Close

Call KoneksI

RSHasil.Open "select distinct kelas from mata_kuliah,siswa,hasilujian where hasilujian.nim=siswa.nim and mata_kuliah.idkuliah=hasilujian.idkuliah", Conn

Combo3.Clear

Combo5.Clear

Do While Not RSHasil.EOF

    Combo3.AddItem RSHasil!kelas

    Combo5.AddItem RSHasil!kelas

    RSHasil.MoveNext

Loop

Conn.Close

Call KoneksI

RSHasil.Open "select distinct keterangan from hasilujian", Conn

Combo7.Clear

Do While Not RSHasil.EOF

    Combo7.AddItem RSHasil!keterangan

    RSHasil.MoveNext

Loop

Conn.Close

End Sub

Private Sub Combo1_Click()

Call KoneksI

RSSiswa.Open "select * from siswa where nim='" & Combo1 & "'", Conn

If Not RSSiswa.EOF Then

    LblNamamhs = RSSiswa!nama

Else

    MsgBox "nim tidak terfdaftar"

    Combo5.SetFocus

End If

End Sub

Private Sub Combo2_Click()

Call KoneksI

RSKuliah.Open "select * from mata_kuliah where idkuliah='" & Combo2 & "'", Conn

If Not RSKuliah.EOF Then

    Lblmatakuliah = RSKuliah!Matakuliah

Else

    MsgBox "id mata kuliah tidak terfdaftar"

    Combo2.SetFocus

End If

End Sub

Private Sub Combo3_Click()

Call KoneksI

RSSiswa.Open "select * from siswa where kelas='" & Combo3 & "'", Conn

If Not RSSiswa.EOF Then

    LblJurusan = RSSiswa!jurusan

Else

    MsgBox "kelas tidak terfdaftar"

    Combo3.SetFocus

End If

End Sub

Private Sub Combo4_Click()

Call KoneksI

RSKuliah.Open "select * from mata_kuliah where idkuliah='" & Combo4 & "'", Conn

If Not RSKuliah.EOF Then

    Lblkuliah1 = RSKuliah!Matakuliah

Else

    MsgBox "id mata kuliah tidak terfdaftar"

    Combo2.SetFocus

End If

End Sub

Private Sub Combo5_Click()

Call KoneksI

RSSiswa.Open "select * from siswa where kelas='" & Combo5 & "'", Conn

If Not RSSiswa.EOF Then

    Lbljurusan1 = RSSiswa!jurusan

Else

    MsgBox "kelas tidak terfdaftar"

    Combo5.SetFocus

End If

End Sub

Private Sub Combo6_Click()

Call KoneksI

RSKuliah.Open "select * from mata_kuliah where idkuliah='" & Combo6 & "'", Conn

If Not RSKuliah.EOF Then

    Lblkuliah2 = RSKuliah!Matakuliah

Else

    MsgBox "id mata kuliah tidak terfdaftar"

    Combo6.SetFocus

End If

End Sub

Private Sub Command1_Click()

If Combo1 = "" Or Combo2 = "" Then

    MsgBox "Data tidak lengkap"

    Exit Sub

End If

CR.SelectionFormula = "({siswa.nim})='" & Combo1 & "' and ({mata_kuliah.idkuliah})='" & Combo2 & "'"

CR.ReportFileName = App.Path & "\lap ujian5.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

CR.Reset

End Sub

Private Sub Command2_Click()

If Combo3 = "" Or Combo4 = "" Then

    MsgBox "Data tidak lengkap"

    Exit Sub

End If

CR.SelectionFormula = "({siswa.kelas})='" & Combo3 & "' and ({mata_kuliah.idkuliah})='" & Combo4 & "'"

CR.ReportFileName = App.Path & "\lap per kelas.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

CR.Reset

End Sub

Private Sub Command3_Click()

If Combo5 = "" Or Combo6 = "" Or Combo7 = "" Then

    MsgBox "Data tidak lengkap"

    Exit Sub

End If

CR.SelectionFormula = "({siswa.kelas})='" & Combo5 & "' and ({mata_kuliah.idkuliah})='" & Combo6 & "' and ({hasilujian.keterangan})='" & Combo7 & "'"

CR.ReportFileName = App.Path & "\lap per kelas.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

CR.Reset

End Sub