Form login:
Private Sub Form_Load()
Call hapus
End Sub
Sub hapus()
user.Text = ""
pass.Text = ""
End Sub
Private Sub keluar_Click()
Unload Me
End Sub
Private Sub masuk_Click()
If user.Text = "wulan" And pass.Text = "wulan" Then
Menu.Show
ElseIf user.Text = "wewen" And pass.Text = "wewen" Then
Menu.Show
ElseIf user.Text = "desi" And pass.Text = "desi" Then
Menu.Show
ElseIf user.Text = "leni" And pass.Text = "leni" Then
Menu.Show
ElseIf user.Text = "rahma" And pass.Text = "rahma" Then
Menu.Show
ElseIf user.Text = "ayu" And pass.Text = "ayu" Then
Menu.Show
ElseIf user.Text = "siti" And pass.Text = "siti" Then
Menu.Show
Unload Me
Else
MsgBox "Password Anda Salah!!!", vbInformation, "info"
Call hapus
user.SetFocus
End If
End Sub
Private Sub pass_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If user.Text = "wulan" And pass.Text = "wulan" Then
Menu.Show
Unload Me
Else
MsgBox "Password Anda Salah!!!"
Call hapus
user.SetFocus
End If
End If
End Sub
Private Sub user_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If user.Text = "" Then
MsgBox "Username belum diisi!!!"
Else
pass.SetFocus
End If
End If
End Sub
Menu utama:
Private Sub f1_click()
Form_mahasiswa.Show
End Sub
Private Sub f2_click()
Form_login.Show
End Sub
Private Sub f3_click()
End
End Sub
Form Mahasiswa:
Sub hapus()
NPM.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(npm,nama,jenjang,jurusan)" & _
"values('" & NPM.Text & _
"','" & NAMA.Text & _
"','" & JENJANG.Text & _
"','" & JURUSAN.Text & "')"
Case 1
SQL = "UPDATE siswa set nama='" & NAMA.Text & "'," & _
"jenjang='" & JENJANG.Text & "' " & _
"jurusan='" & JURUSAN.Text & "' " & _
"where npm='" & NPM.Text & "'"
Case 2
SQL = "DELETE FROM siswa WHERE npm='" & NPM.Text & "' "
End Select
MsgBox "Pemrosesan RECORD Database telah berhasil...!!!", vbInformation, "Data Siswa"
Db.BeginTrans
Db.Execute SQL, adCmdTable
Db.CommitTrans
Call hapus
Adodc1.Refresh
NPM.SetFocus
End Sub
Sub tampilsiswa()
On Error Resume Next
NPM.Text = RS!NPM
NAMA.Text = RS!NAMA
JENJANG.Text = RS!JENJANG
JURUSAN.Text = RS!JURUSAN
End Sub
Private Sub cmdproses_click(index As Integer)
Select Case index
Case 0
Call hapus
kode.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
kode.SetFocus
Case 3
Call hapus
kode.SetFocus
Case 4
Unload Me
End Select
End Sub
Private Sub Form_Load()
Call hapus
JURUSAN.AddItem "MANAJEMEN"
JURUSAN.AddItem "TEKNIK"
JURUSAN.AddItem "INFORMASI"
JENJANG.AddItem "S1"
JENJANG.AddItem "D3"
JENJANG.AddItem "D1"
Call openDB
mulaiserver
End Sub
Private Sub npm_keypress(KeyAscii As Integer)
If KeyAscii = 13 Then
If NPM.Text = "" Then
MsgBox "Masukkan siswa!", vbInformation, "siswa"
NPM.SetFocus
Exit Sub
End If
SQL = "SELECT*FROM siswa WHERE npm='" & NPM.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"
NPM.Enabled = False
Else
x = NPM.Text
Call hapus
NPM.Text = x
Call rubahCMD(Me, False, True, False, True)
cmdproses(1).Caption = " & simpan"
End If
NAMA.SetFocus
End If
End Sub
Sub mulaiserver()
WS.LocalPort = 1500
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 npm='" & xData1(1) & "'"
If RS.State = adStateOpen Then RS.Close
RS.Open SQL, Db, adOpenDynamic, adLockOptimistic
If RS.RecordCount <> 0 Then
WS.SendData "RECORD-" & RS!NAMA & "/" & RS!JENJANG & RS!JURUSAN
Else
WS.SendData "NOTHING-DATA"
End If
Case "DELETE"
SQL = "Delete * from siswa" & _
"where npm='" & xData1(1) & "'"
Db.BeginTrans
Db.CommitTrans
Adodc1.Refresh
WS.SendData "DEL-XXX"
Case "UPDATE"
Db.BeginTrans
Db.Execute xData1(1), adCmdTable
Db.CommitTrans
WS.SendData "EDIT-XXX"
Adodc1.Refresh
Case "INSERT"
Db.BeginTrans
Db.Execute xData1(1), adCmdTable
Db.CommitTrans
WS.SendData "INSERT-XXX"
Adodc1.Refresh
End Select
End Sub
Module:
Public Db As New ADODB.Connection
Public RS As New ADODB.Recordset
Public RS2 As New 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:\apache\mysql\data\DbSiswa\siswa.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
