Membuat Program Penerimaan Siswa Baru Menggunakan Database Mic. Access

Berikut merupakan salah satu contoh Program Pendaftaran Siswa Baru sederhana yang merupakan hasil karya saya :

1. FORM LOGIN

 

 

 

 

 

 

 

Listing Program :

Public conn As New ADODB.Connection
Public RS As New ADODB.Recordset

Private Sub commandok_Click()
If conn.State = 1 Then conn.Close
conn.Open “provider=microsoft.jet.oledb.4.0;data source=” & App.Path & “\login.mdb”

If RS.State = 1 Then RS.Close
RS.Open “select * from login where user= ‘” & UserName.Text & “‘ And pass = ‘” & Password.Text & “‘”, conn, 3, 3

If Not RS.EOF Then
MsgBox “SELAMAT DATANG…!!!”, vbInformation + vbOKOnly, “Login Success”
Unload Me
frmMenu.Show
Else
MsgBox “Data Usernama atau Password Anda Salah”, vbCritical, “Login Failed”
UserName.Text = “”
Password.Text = “”
UserName.SetFocus
End If
End Sub

Private Sub Form_Load()
UserName.Text = “”
Password.Text = “”
End Sub

Private Sub password_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Password.Text = “” Then Exit Sub
CommandOK.SetFocus
End If
End Sub

Private Sub username_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If UserName.Text = “” Then Exit Sub
Password.SetFocus
End If
End Sub

2. FORM MENU

 

 

 

 

 

 

List Program :

Private Sub mnAbout_Click()
frmAbout.Show
End Sub

Private Sub mnDaftar_Click()
frmPendaftaran.Show
End Sub

Private Sub mnKeluar_Click()
If MsgBox(“Yakin mau keluar?”, vbQuestion + vbYesNo, “Konfirmasi”) = vbYes Then End
End Sub

 

3. FORM DAFTAR

 

 

 

 

 

 

Listing Program :

Sub Hapus()
No_Pendaftaran.Enabled = True
ClearFORM Me
Call RubahCmd(Me, True, False, False, False)
cmdProses(1).Caption = “Simpan”
End Sub

Sub ProsesDB(log As Byte)
Select Case log
Case 0
SQL = “INSERT INTO siswa(NoPend,TglDaf,JenDaf,Nm_Cs,Jenkel,TmpLhr,TglLhr,Agama,AlmtCs,TelpCs)” & _
“values(‘” & No_Pendaftaran.Text & _
“‘,'” & tgldaf.Text & _
“‘,'” & Jenis.Text & _
“‘,'” & txtNmCS.Text & _
“‘,'” & JK.Text & _
“‘,'” & txtTempL.Text & _
“‘,'” & TglLhr.Text & _
“‘,'” & Agama.Text & _
“‘,'” & txtAlmtCS.Text & _
“‘,'” & txtTelpCS.Text & “‘)”
Case 1
SQL = “UPDATE siswa SET TglDaf='” & tgldaf.Text & “‘,” & _
“JenDaf='” & Jenis.Text & “‘,” & _
“Nm_Cs='” & txtNmCS.Text & “‘,” & _
“Jenkel='” & JK.Text & “‘,” & _
“TmpLhr='” & txtTempL.Text & “‘,” & _
“TglLhr='” & TglLhr.Text & “‘,” & _
“Agama='” & Agama.Text & “‘,” & _
“AlmtCs='” & txtAlmtCS.Text & “‘ ” & _
“TelpCs='” & txtTelpCS.Text & “‘ ” & _
“where NoPend='” & No_Pendaftaran.Text & “‘”
Case 2
SQL = “DELETE FROM siswa WHERE NoPend='” & No_Pendaftaran.Text & “‘”
End Select
MsgBox “Pemprosesan RECORD Database telah berhasil…!”, vbInformation, “siswa”
DB.BeginTrans
DB.Execute SQL, adCmdTable
DB.CommitTrans
Call Hapus
Adodc1.Refresh
No_Pendaftaran.SetFocus
End Sub

Sub Tampilsiswa()
On Error Resume Next
No_Pendaftaran.Text = RS!NoPend
tgldaf.Text = RS!tgldaf
Jenis.Text = RS!JenDaf
txtNmCS.Text = RS!Nm_Cs
JK.Text = RS!Jenkel
txtTempL.Text = RS!TmpLhr
TglLhr.Text = RS!TglLhr
Agama.Text = RS!Agama
txtAlmtCS.Text = RS!AlmtCs
txtTelpCS.Text = RS!TelpCs
End Sub

Private Sub cmdBatal_Click()

End Sub

Private Sub cboJK_Change()

End Sub

Private Sub CmdProses_Click(Index As Integer)
Select Case Index
Case 0
Call Hapus
No_Pendaftaran.SetFocus
Case 1
If cmdProses(1).Caption = “&Simpan” Then
Call ProsesDB(0)
Else
Call ProsesDB(1)
End If
Case 2
X = MsgBox(“Yakin RECORD siswa Akan Dihapus…!”, vbQuestion + vbYesNo, “siswa”)
If X = vbYes Then ProsesDB 2
Call Hapus
No_Pendaftaran.SetFocus
Case 3
Call Hapus
No_Pendaftaran.SetFocus
Case 4
Unload Me
End Select
End Sub

Private Sub cmdKeluar_Click()

End Sub

Private Sub Form_Load()
Call OPENDB
Call Hapus
MulaiServer
End Sub

Private Sub Kode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If No_Pendaftaran.Text = “” Then
MsgBox “Masukkan No. Pendaftaran…!”, vbInformation, “siswa”
No_Pendaftaran.SetFocus
Exit Sub
End If
SQL = “SELECT * FROM siswa WHERE NoPend='” & No_Pendaftaran.Text & “‘”
If RS.State = adStateOpen Then RS.Close
RS.Open SQL, DB, adOpenDynamic, adLockOptimistic
If RS.RecordCount <> 0 Then
Tampilsiswa
Call RubahCmd(Me, False, True, True, True)
cmdProses(1).Caption = “&Edit”
No_Pendaftaran.Enabled = False
Else
X = No_Pendaftaran.Text
Call Hapus
No_Pendaftaran.Text = X
Call RubahCmd(Me, False, True, False, True)
cmdProses(1).Caption = “&Simpan”
End If
tgldaf.SetFocus
End If
End Sub

Sub MulaiServer()
WS.LocalPort = 1000
WS.Listen
End Sub

Private Sub WS_ConnectionRequest(ByVal requestID As Long)
WS.Close
WS.Accept requestID
Me.Caption = “Server – Client” & WS.RemoteHostIP & “Connect”
End Sub

Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim xKirim As String
Dim xData1() As String
Dim xData2() As String

WS.GetData xKirim, vbString, bytesTotal

xData1 = Split(xKirim, “-“)

Select Case xData1(0)
Case “SEARCH”
SQL = “SELECT * FROM siswa WHERE No_Pendaftaran='” & xData1(1) & “‘”
If RS.State = adStateOpen Then RS.Close
RS.Open SQL, DB, adOpenDynamic, adLockOptimistic
If RS.RecordCount <> 0 Then
WS.SendData “RECORD-” & RS!tgldaf & “/” & RS!JenDaf & “/” & RS!Nm_Cs & “/” & RS!Jenkel & “/” & RS!TmpLhr & “/” & RS!TglLhr & “/” & RS!Agama & “/” & RS!AlmtCs & “/” & RS!TelpCs
Else
WS.SendData “NOTHING-DATA”
End If
Case “INSERT”
DB.BeginTrans
DB.Execute xData1(1), adCmdTable
DB.CommitTrans
WS.SendData “INSERT-xxx”
Adodc1.Refresh
Case “EDIT”
DB.BeginTrans
DB.Execute xData1(1), adCmdTable
DB.CommitTrans
WS.SendData “EDIT-xxx”
Adodc1.Refresh
Case “DELETE”
SQL = “DELETE FROM siswa” & -“where No_Pendaftaran='” & xData1(1) & “‘”
DB.Execute SQL, adCmdTable
WS.SendData “DEL-SUKSES”
End Select
End Sub

Listing Module :

Public DB As New ADODB.Connection
Public RS As New ADODB.Recordset
Public RS2 As New ADODB.Recordset
Public RSLogin As ADODB.Recordset
Public SQL As String

Sub OPENDB()
If DB.State = adStateOpen Then DB.Close
DB.CursorLocation = adUseClient
DB.Open “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\dbpendaftaran2.mdb;Persist Security Info=False”
End Sub

Sub ClearFORM(f As Form)
Dim ctl As Control
For Each ctl In f
If TypeOf ctl Is TextBox Then ctl.Text = “”
If TypeOf ctl Is ComboBox Then ctl.Text = “”
Next
End Sub

Sub Center(f As Form)
f.Move (Screen.Width – f.Width) / 2, (Screen.Height – f.Height) / 4
End Sub

Sub RubahCmd(f As Form, L0 As Boolean, L1 As Boolean, L2 As Boolean, L3 As Boolean)
f.cmdProses(0).Enabled = L0
f.cmdProses(1).Enabled = L1
f.cmdProses(2).Enabled = L2
f.cmdProses(3).Enabled = L3
End Sub

CLIENT

 

1. FORM LOGIN

 

 

 

 

 

 

Listing Program :
Public conn As New ADODB.Connection
Public RS As New ADODB.Recordset

Private Sub commandok_Click()
If conn.State = 1 Then conn.Close
conn.Open “provider=microsoft.jet.oledb.4.0;data source=” & App.Path & “\login.mdb”

If RS.State = 1 Then RS.Close
RS.Open “select * from login where user= ‘” & Username.Text & “‘ And pass = ‘” & Password.Text & “‘”, conn, 3, 3

If Not RS.EOF Then
MsgBox “SELAMAT DATANG…!!!”, vbInformation + vbOKOnly, “Login Success”
Unload Me
FrmClient.Show
Else
MsgBox “Data Usernama atau Password Anda Salah”, vbCritical, “Login Failed”
Username.Text = “”
Password.Text = “”
Username.SetFocus
End If
End Sub

Private Sub Form_Load()
Username.Text = “”
Password.Text = “”
End Sub

Private Sub password_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Password.Text = “” Then Exit Sub
CommandOK.SetFocus
End If
End Sub

Private Sub username_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Username.Text = “” Then Exit Sub
Password.SetFocus
End If
End Sub

2. FORM CLIENT

 

 

 

 

 

 

 

Listing Program :

Dim IPServer As String

Sub Hapus()
No_Pendaftaran.Enabled = True
ClearFORM Me
Call RubahCMD(Me, True, False, False, False)
CmdProses(1).Caption = “Simpan”
End Sub

Sub ProsesDB(Log As Byte)
Select Case Log
Case 0
SQL = “INSERT INTO siswa(NoPend,TglDaf,JenDaf,Nm_Cs,Jenkel,TmpLhr,TglLhr,Agama,AlmtCs,TelpCs,AslSek,NmAy,NmIb,PekAy,PekIb,AlmOrt)” & _
“values(‘” & No_Pendaftaran.Text & _
“‘,'” & tgldaf.Value & _
“‘,'” & Jenis.Text & _
“‘,'” & txtNmCS.Text & _
“‘,'” & JK.Text & _
“‘,'” & txtTempL.Text & _
“‘,'” & tglL.Value & _
“‘,'” & Agama.Text & _
“‘,'” & txtAlmtCS.Text & _
“‘,'” & txtTelpCS.Text & _
“‘,'” & txtAsal.Text & _
“‘,'” & txtNmAyah.Text & _
“‘,'” & txtNmIbu.Text & _
“‘,'” & Pekerjaan_Ayah.Text & _
“‘,'” & Pekerjaan_Ibu.Text & _
“‘,'” & txtAlmtOrtu.Text & “‘)”
Case 1
SQL = “UPDATE siswa SET TglDaf='” & tgldaf.Value & “‘,” & _
“JenDaf='” & Jenis.Text & “‘,” & _
“Nm_Cs='” & txtNmCS.Text & “‘,” & _
“Jenkel='” & JK.Text & “‘,” & _
“TmpLhr='” & txtTempL.Text & “‘,” & _
“TglLhr='” & tglL.Value & “‘,” & _
“Agama='” & Agama.Text & “‘,” & _
“AlmtCs='” & txtAlmtCS.Text & “‘ ” & _
“TelpCs='” & txtTelpCS.Text & “‘ ” & _
“AslSek='” & txtAsal.Text & “‘ ” & _
“NmAy='” & txtNmAyah.Text & “‘ ” & _
“NmIb='” & txtNmIbu.Text & “‘ ” & _
“PekAy='” & Pekerjaan_Ayah.Text & “‘ ” & _
“PekIb='” & Pekerjaan_Ibu.Text & “‘ ” & _
“AlmOrt='” & txtAlmtOrtu.Text & “‘ ” & _
“where NoPend='” & No_Pendaftaran.Text & “‘”
Case 2
SQL = “DELETE FROM siswa WHERE NoPend='” & No_Pendaftaran.Text & “‘”
End Select
MsgBox “Pemprosesan RECORD Database telah berhasil…!”, vbInformation, “Data Siswa”
Call Hapus
No_Pendaftaran.SetFocus
End Sub

Private Sub CmdProses_Click(Index As Integer)
Select Case Index
Case 0
Call Hapus
No_Pendaftaran.SetFocus
Case 1
If CmdProses(1).Caption = “&Simpan” Then
SQL = “INSERT INTO Barang(Kode,Nama,Harga)” & _
“values(‘” & Kode.Text & _
“‘,'” & Nama.Text & _
“‘,'” & Harga.Text & “‘)”
WS.SendData “INSERT-” & SQL
Else
SQL = “UPDATE barang set ” & _
“nama= ‘” & Nama.Text & _
“‘,harga='” & Harga.Text & _
“‘ where kode='” & Kode.Text & “‘”
WS.SendData “UPDATE-” & SQL
End If
Case 2
X = MsgBox(“Yakin RECORD siswa Akan Dihapus…!”, vbQuestion + vbYesNo, “siswa”)
If X = vbYes Then
WS.SendData “DELETE-” & No_Pendaftaran.Text

End If
Call Hapus
No_Pendaftaran.SetFocus
Case 3
Call Hapus
No_Pendaftaran.SetFocus
Case 4
Unload Me
End Select
End Sub

Private Sub Form_Load()
Call Hapus
MulaiKoneksi
End Sub

Private Sub Kode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Kode.Text = “” Then Exit Sub
WS.SendData “SEARCH-” & Kode.Text
End If
End Sub

Sub MulaiKoneksi()
IPServer = “127.0.0.1”
IPClient = WS.LocalIP
WS.Connect IPServer, 1000
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents
End
End Sub

Private Sub Label14_Click()

End Sub

Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim xKirim As String
Dim xData1() As String
Dim xData2() As String

WS.GetData xKirim, vbString, bytesTotal

xData1 = Split(xKirim, “-“)

Select Case xData1(0)
Case “NOTHING”
X = No_Pendaftaran.Text
Call Hapus
No_Pendaftaran.Text = X
Call RubahCMD(Me, False, True, False, True)
CmdProses(1).Caption = “&Simpan”
tgldaf.SetFocus
Case “RECORD”
xData2 = Split(xData1(1), “/”)
tgldaf.Value = xData2(0)
Jenis.Text = xData2(1)
txtNmCS.Text = xData2(2)
JK.Text = xData2(3)
txtTempL.Text = xData2(4)
tglL.Value = xData2(5)
Agama.Text = xData2(6)
txtAlmtCS.Text = xData2(7)
txtTelpCS.Text = xData2(8)
txtAsal.Text = xData2(9)
txtNmAyah.Text = xData2(10)
txtNmIbu.Text = xData2(11)
Pekerjaan_Ayah.Text = xData2(12)
Pekerjaan_Ibu.Text = xData2(13)
txtAlmtOrtu.Text = xData2(14)

Call RubahCMD(Me, False, True, True, True)
CmdProses(1).Caption = “&Edit”
No_Pendaftaran.Enabled = False
tgldaf.SetFocus

Case “DEL”
MsgBox “Penghapusan Data Berhasil !”
Call Hapus
Case “EDIT”
MsgBox “Pengeditan Record Berhasil !”
Call Hapus
End Select
End Sub

3. FORM MODULE

Public SQL As String

Sub ClearFORM(f As Form)
Dim ctl As Control
For Each ctl In f
If TypeOf ctl Is TextBox Then ctl.Text = “”
If TypeOf ctl Is ComboBox Then ctl.Text = “”
Next
End Sub

Sub center(f As Form)
f.Move (Screen.Width – f.Width) / 2, (Screen.Height – f.Height) / 4
End Sub

Sub RubahCMD(f As Form, L0 As Boolean, L1 As Boolean, L2 As Boolean, L3 As Boolean)
f.CmdProses(0).Enabled = L0
f.CmdProses(1).Enabled = L1
f.CmdProses(2).Enabled = L2
f.CmdProses(3).Enabled = L3
End Sub

 

Berikut Database nya :

1. Database Siswa

 

 

 

 

 

 

2. Database Login

3 Comments

Gan, bisa bantu link downloadnya.

iya gan… bantu link program nya dong…

aduhh sory gan.
itu dulu tugas kuliah ku waktu tahun 2012.
Ini program udah terhapus dari laptop ku.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: