JAWABAN QUIS NO 2

LINK SONYA AGUSTINA KE TUGAS PAK MESRAN

Module server
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:\SONYA\db1.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

Listing program server
Sub hapus()
Kode.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 Barang(Kode, Nama, Harga)" & _
"values('" & Kode.Text & _
"','" & Nama.Text & _
"','" & Harga.Text & "')"
Case 1
SQL = "UPDATE Barang SET Nama='" & Nama.Text & "'," & _
" Harga = '" & Harga.Text & "' " & _
"where Kode ='" & Kode.Text & "'"
Case 2
SQL = "DELETE FROM Barang WHERE Kode='" & Kode.Text & "'"
End Select
MsgBox "Pemorosesan record Database telah Berhasil...!", vbInformation, "Data Barang"
Db.BeginTrans
Db.Execute SQL, adCmdTable
Db.CommitTrans
Call hapus
Adodc1.Refresh
Kode.SetFocus
End Sub
Sub tampilBarang()
On Error Resume Next
Kode.Text = Rs!Kode
Nama.Text = Rs!Nama
Harga.Text = Rs!Harga
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 Barang Akan Dihapus...!", vbQuestion + vbYesNo, "Barang")
If x = vbYes Then ProsesDB 2
Call hapus
Kode.SetFocus
Case 3
Call hapus
Kode.SetFocus
Case 5
Adodc1.Refresh
Case 4
Unload Me
End Select
End Sub

Private Sub Command1_Click()
Adodc1.Refresh
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 Kode.Text = "" Then
MsgBox "Masukkan Kode Barang!", vbInformation, "Barang"
Kode.SetFocus
Exit Sub
End If
SQL = "SELECT * FROM Barang WHERE Kode='" & Kode.Text & "'"
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockBatchOptimistic
If Rs.RecordCount <> 0 Then
tampilBarang
Call RubahCMD(Me, False, True, True, True)
CmdProses(1).Caption = "&Edit"
Kode.Enabled = False
Else
x = Kode.Text
Call hapus
Kode.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 = 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, vdString, bytesTotal
xData1 = Split(xKirim, "-")

Select Case xData1(0)
Case "SEARCH"
SQL = "SELECT*FROM Barang WHERE Kode='" & 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!Harga
Else
WS.SendData "NOTHING-DATA"
End If
Case "INSERT"
SQL = "INSERT*from barang" & _
Db.BeginTrans
Db.Execute xData1(1), adCmdTable
Db.CommitTrans
WS.SendData "SIMPAN - xxx"
Adodc1.Refresh
Case "DELETE"
SQL = "Delete*from barang" & _
" where kode='" & xData1(1) & "'"
Db.BeginTrans
Db.Execute SQL, adCmdTable
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

End Select
End Sub

Module client
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
LISTING PROGRAM CLIENT

Dim IPServer As String

Sub Hapus()
Kode.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 Barang(Kode,Nama,Harga)" & _
"values('" & Kode.Text & _
"','" & Nama.Text & _
"','" & Harga.Text & "')"
Case 1
SQL = "UPDATE Barang SET Nama='" & Nama.Text & "'," & _
"Harga='" & Harga.Text & "'," & _
"where Kode='" & Kode.Text & "'"
Case 2
SQL = "DELETE FROM Barang WHERE Kode='" & Kode.Text & "'"
End Select
MsgBox "Pemprosesan RECORD Database telah berhasil...!", vbInformation, "Barang"
Call Hapus
Kode.SetFocus
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
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 Barang Akan Dihapus...!", vbQuestion + vbYesNo, "Barang")
If x = vbYes Then
WS.SendData "DELETE-" & Kode.Text

End If
Call Hapus
Kode.SetFocus
Case 3
Call Hapus
Kode.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 = "l27.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 WS_Dataarrival(ByVal bytesTotal As Long)
Dim xkrim 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 = Kode.Text
Call Hapus
Kode.Text = x
Call RubahCMD(Me, False, True, False, True)
CmdProses(1).Caption = "&Simpan"
Nama.SetFocus
Case "RECORD"
xData2 = Split(xData1(1), "/")
Nama.Text = xData2(0)
Harga.Text = xData2(1)
Call RubahCMD(Me, False, True, True, True)
CmdProses(1).Caption = "&Edit"
Kode.Enabled = False
Nama.SetFocus
Case "DEL"
MsgBox "penghapusan data berhasil !"
Call Hapus
Case "EDIT"
MsgBox "pengeditan record berhasil !"
Call Hapus
End Select
End Sub

CLIENT

1. From Login
Langkah awal untuk server buat form mahasiswa adalah design form mahasiswa yang sama seperti gambar berikut

Setelah Tampil Ketikkanlah
Private Sub cmd_Click(Index As Integer)
Select Case Index
Case 0
If username = "" Then
MsgBox "Silahkan isi password"
batal
username.SetFocus
Else
If password.Text = password.Text Then
Tampilan1.Show
Else
MsgBox "password anda salah"
batal
password.SetFocus
End If
End If
Case 1
batal
End Select
End Sub

Sub batal()
username.Text = ""
password.Text = ""
End Sub

Sub isi()
SQL = "select*from login"
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockOptimistic
If Rs.RecordCount <> 0 Then
Rs.MoveFirst
Do While Not Rs.EOF
Rs.MoveNext
Loop
End If
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub username_Click()
SQL = " select*from login " & _
"where username='" & username.Text & "'"
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockOptimistic
If Rs.RecordCount <> o Then
password.Text = Rs!password
End If
End Sub

Private Sub Form_Load()

End Sub

2. From Mahasiswa

Setelah tampil ketikkanlah
Sub Hapus()
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 Mahasiswa(npm,nama,jenjang,jurusan,alamat)" & _
"values('" & Npm.Text & _
"','" & Nama.Text & _
"','" & Jenjang.Text & _
"','" & jurusan.Text & _
"','" & Alamat.Text & "')"
Case 1
SQL = "UPDATE mahasiswa SET npm='" & Npm.Text & "'," & _
"nama='" & Nama.Text & "'," & _
"jenjang='" & Jenjang.Text & "'," & _
"jurusan='" & jurusan.Text & "'," & _
"where alamat='" & Alamat.Text & "'"
Case 2
SQL = "DELETE FROM mahasiswa WHERE npm='" & Npm.Text & "'"
End Select
MsgBox "Pemprosesan RECORD Database telah berhasil...!", vbInformation, "mahasiswa"
Call Hapus
kode.SetFocus
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
SQL = "INSERT INTO mahasiswa(npm, nama, jurusan, jenjang, alamat)" & _
"values('" & Npm.Text & _
"','" & Nama.Text & _
"','" & Jenjang.Text & _
"','" & jurusan.Text & _
"','" & Alamat.Text & "')"
WS.SendData "INSERT-" & SQL

Else
SQL = "UPDATE mahasiswa set " & _
"alamat= '" & Alamat.Text & _
"',npm='" & Npm.Text & _
"',jurusan='" & jurusan.Text & _
"',jenjang='" & Jenjang.Text & _
"' where nama='" & Nama.Text & "'"
WS.SendData "UPDATE-" & SQL

End If
Case 2
X = MsgBox("Yakin RECORD mahasiswa Akan Dihapus...!", vbQuestion + vbYesNo, "mahasiswa")
If X = vbYes Then
WS.SendData "DELETE-" & Nama.Text

End If
Call Hapus
kode.SetFocus
Case 3
Call Hapus
kode.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 Nama.Text = "" Then Exit Sub
WS.SendData "SEARCH-" & Nama.Text
End If
End Sub
Sub MulaiKoneksi()
IPServer = "192.168.10.1"
IPClient = "192.168.10.2"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents
End
End Sub
Private Sub WS_Dataarrival(ByVal bytesTotal As Long)
Dim xkrim 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 = Npm.Text
Call Hapus
Npm.Text = X
Call RubahCMD(Me, False, True, False, True)
CmdProses(1).Caption = "&Simpan"
kode.Enabled = Me
Case "RECORD"
xData2 = Split(xData1(1), "/")
Nama.Text = xData2(0)
Jenjang.Text = xData2(1)
jurusan.Text = xData2(2)
Alamat.Text = xData2(3)
Call RubahCMD(Me, False, True, True, True)
CmdProses(1).Caption = "&Edit"
kode.Enabled = False
Nama.SetFocus
Case "DEL"
MsgBox "penghapusan data berhasil !"
Call Hapus
Case "EDIT"
MsgBox "pengeditan record berhasil !"
Call Hapus
End Select
End Sub

3. Menu Atau From Tampil

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

Form Mahasiswa

FORM MAHASISWA

SERVER

1.Login

Listing
Private Sub cmd_Click(Index As Integer)
Select Case Index
Case 0
If Username = "" Then
MsgBox "Silahkan isi password"
batal
Username.SetFocus
Else
If Password.Text = Password.Text Then
Tampilan1.Show
Else
MsgBox "password anda salah"
batal
Password.SetFocus
End If
End If
Case 1
batal
End Select
End Sub

Sub batal()
Username.Text = ""
Password.Text = ""
End Sub

Private Sub Form_Load()
OPENDB
batal
isi

End Sub

Sub isi()
SQL = "select*from login"
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockOptimistic
If Rs.RecordCount <> 0 Then
Rs.MoveFirst
Do While Not Rs.EOF
Rs.MoveNext
Loop
End If
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)
End Sub

Private Sub username_Click()
SQL = " select*from login " & _
"where username='" & Username.Text & "'"
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockOptimistic
If Rs.RecordCount <> o Then
Password.Text = Rs!Password
End If

End Sub


2.Tampilan

Listing
Private Sub F2_Click()
End
End Sub

Private Sub Fn1_Click()
Frmahasiswa.Show
End Sub

Private Sub Fn2_Click()
End
End Sub


3.Mahasiswa
Langkah awal untuk server buat form mahasiswa adalah design form mahasiswa yang sama seperti gambar berikut ;

Setelahtampilketikkanlah
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 Mahasiswa(NPM, Nama, Jenjang, Jurusan, Alamat)" & _
"values('" &NPM.Text& _
"','" &Nama.Text& _
"','" &Jenjang.Text& _
"','" &Jurusan.Text& _
"','" &Alamat.Text& "')"
Case 1
SQL = "UPDATE Mahasiswa SET Nama='" &Nama.Text& "'," & _
" Jenjang = '" &Jenjang.Text& "'," & _
" Jurusan = '" &Jurusan.Text& "'," & _
" Alamat = '" &Alamat.Text& "' " & _
"where NPM ='" &NPM.Text& "'"
Case 2
SQL = "DELETE FROM Mahasiswa WHERE NPM='" &NPM.Text& "'"
End Select
MsgBox "Pemorosesan record Database telah Berhasil...!",vbInformation, "Data Mahasiswa"
Db.BeginTrans
Db.Execute SQL, adCmdTable
Db.CommitTrans
Call hapus
Adodc1.Refresh
NPM.SetFocus
End Sub
Sub tampilMahasiswa()
On Error Resume Next
NPM.Text = Rs!NPM
Nama.Text = Rs!Nama
Jenjang.Text = Rs!Jenjang
Jurusan.Text = Rs!Jurusan
Alamat.Text = Rs!Alamat
End Sub

Private Sub CMDproses_click(index As Integer)
Select Case index
Case 0
Call hapus
NPM.SetFocus
Case 1
If CmdProses(1).Caption = "&Simpan" Then
Call ProsesDB(0)
Else
Call ProsesDB(1)
End If
Case 2
x = MsgBox("Yakin RECORD NPM Anda Maksud Akan Dihapus...!", vbQuestion + vbYesNo, "Mahasiswa")
If x = vbYes Then ProsesDB 2
Call hapus
NPM.SetFocus
Case 3
Call hapus
NPM.SetFocus
Case 5
Adodc1.Refresh
Case 4
Unload Me
End Select
End Sub


Private Sub Command1_Click()
Adodc1.Refresh
End Sub

Private Sub form_load()
Call OPENDB
Call hapus
MulaiServer
End Sub
Private Sub NPM_keyPress(keyAscii As Integer)
If keyAscii = 13 Then
If NPM.Text = "" Then
MsgBox "Masukkan NPM!",vbInformation, "Mahasiswa"
NPM.SetFocus
Exit Sub
End If
SQL = "SELECT * FROM Mahasiswa WHERE NPM='" &NPM.Text& "'"
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockBatchOptimistic
If Rs.RecordCount<> 0 Then
tampilMahasiswa
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 = 1000
WS.Listen
End Sub

Private Sub WS_ConnectionRequest(ByValrequestID As Long)
WS.Close
WS.AcceptrequestID
Me.Caption = "Server-Client" &WS.RemoteHostIP& "Connect"

End Sub

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

WS.GetDataxKirim, vdString, bytesTotal
xData1 = Split(xKirim, "-")

Select Case xData1(0)
Case "SEARCH"

SQL = "SELECT*FROM Mahasiswa WHERE NPM='" &xData1(1) & "'"
MsgBox SQL
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockOptimistic
If Rs.RecordCount<> 0 Then
WS.SendData "RECORD-" &Rs!Nama& "/" &Rs!Jenjangstudi& "/" &Rs!Jurusan& "/" &Rs!Alamat
Else
WS.SendData "NOTHING-xxx"
End If
Case "INSERT"
Db.BeginTrans
Db.ExecutexData1(1), adCmdTable
Db.CommitTrans
WS.SendData "INSERT-xxx"
Adodc1.Refresh
Case "UPDATE"
Db.BeginTrans
Db.ExecutexData1(1), adCmdTable
Db.CommitTrans
WS.SendData "EDIT-xxx"
Adodc1.Refresh
Case "DELETE"
SQL = "Delete * from Mahasiswa " & _
"where NPM='" &xData1(1) & "'"
Db.BeginTrans
Db.Execute SQL, adCmdTable
Db.CommitTrans
Adodc1.Refresh
WS.SendData "DEL-xxx"
End Select
End Sub

Ketikkanlah:
Private Sub F2_Click()
End
End Sub

Private Sub Fn1_Click()
Frmahasiswa.Show
End Sub

Private Sub Fn2_Click()
End
End Sub

Private Sub Label1_Click()

End Sub