Tugas Pemograman Jaringan

Persiapan :

Data Base dibuat dari Accsess
Nama Data Base: TestPR.mdb
 

1. Tabel : TblMataKuliah

 

2. Tabel : TblPassword

Mendesain Project Server

Desain Form Login :
 

Source Code Login Server

Private Sub cmdcancel_Click()
 End
End Sub
Private Sub cmdLogin_Click()
 On Error Resume NextStatic i As IntegerIf txtUser.Text = "" Then
 GoSub noacc
 MsgBox "Ekawata: " & vbCrLf & " Anda belum memasukkan Nama", vbInformation + vbOKOnly, ":: Informasi ::"
 txtUser.SetFocus
ElseIf txtPass.Text = "" Then
 GoSub noacc
 MsgBox "Ekawata: " & vbCrLf & " Anda belum memasukkan Kata Sandi", vbInformation + vbOKOnly, ":: Informasi ::"
 txtPass.SetFocus
Else
 SQL = "SELECT * FROM TblPassword WHERE Username='" & txtUser.Text & "'"
 Set RS = Db.Execute(SQL)
 If RS.EOF Then
 GoSub noacc
 MsgBox "Ekawata: " & vbCrLf & " Nama atau Kata sandi yang anda masukkan salah", vbInformation + vbOKOnly, ":: Informasi ::"
 txtUser.SetFocus
ElseIf txtPass.Text <> RS("Pass") Then
 GoSub noacc
 MsgBox "Ekawata: " & vbCrLf & " Nama atau Kata sandi yang anda masukkan salah", vbInformation + vbOKOnly, ":: Informasi ::"
 txtUser.SetFocus
Else
MsgBox "Ekawata: " & vbCrLf & " Selamat anda berhasil login " & vbCrLf & " Untuk Masuk Aplikasi Klik OK", vbInformation + vbOKOnly, "Informasi"
 Unload Me
 'Menampilkan Menu Utama'
 Menu.Show
 End If
 End If
 Exit Sub
noacc:
 i = i + 1
 If i = 3 Then
 MsgBox "Ekawata: " & vbCrLf & " Maaf anda tidak berhak mengakses aplikasi ini !", vbCritical, ":: Gagal ::"
 End
 Else
 Return
 End If
End Sub
Private Sub Form_Load()
 OPENDB
 txtUser.Text = ""
 txtPass.Text = Empty
End Sub

Desain Form Mata Kuliah (Untuk Server)

 

Source Code Form Mata Kuliah (Untuk Server)

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 Matakuliah Akan Dihapus.", vbQuestion + vbYesNo, "Barang")
 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 Command1_Click()
 Adodc1.Refresh
 End Sub
Sub MulaiServer()
 WS.LocalPort = 1000
 WS.Listen
 End Sub
Private Sub Form_Load()
 Call OPENDB
 Call Hapus
 MulaiServer
 End Sub
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 TblMatakuliah " & _
 "values('" & kode.Text & "','" & matkul.Text & "','" & sem.Text & "'," & sks.Text & ")"
Case 1
 SQL = "Update TblMatakuliah set Matakuliah='" & matkul.Text & "'," & _
 "Semester='" & sem.Text & "'," & _
 "SKS=" & sks.Text & _
 " where Kode ='" & kode.Text & "'"
 Case 2
 SQL = "Delete from TblMataKuliah where Kode='" & kode.Text & "'"
 End Select
 MsgBox "Pemrosesan Record Database telah berhasil.", vbInformation, "Data Input Mata Kuliah"
 'MsgBox SQL
 Db.BeginTrans
 Db.Execute SQL, adCmdTable
 Db.CommitTrans
 Call Hapus
 Adodc1.Refresh
 kode.SetFocus
 End Sub
Sub TampilMatkul()
 On Error Resume Next
 kode.Text = RS!kode
 matkul.Text = RS!Matakuliah
 sem.Text = RS!Semester
 sks.Text = RS!sks
 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 TblMataKuliah where Kode='" & kode.Text & "'"
 If RS.State = adStateOpen Then RS.Close
 RS.Open SQL, Db, adOpenDynamic, adLockOptimistic
 If RS.RecordCount <> 0 Then
 TampilMatkul
 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
 matkul.SetFocus
 End If
 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 TblMataKuliah 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!Matakuliah & "/" & RS!Semester & "/" & RS!sks
 Else
 WS.SendData "NOTHING-DATA"
 End If
 Case "INSERT"
 Db.BeginTrans
 Db.Execute xData1(1), adCmdTable
 Db.CommitTrans
 Adodc1.Refresh
 WS.SendData "INSERT-XXX"
 Case "UPDATE"
 Db.BeginTrans
 Db.Execute xData1(1), adCmdTable
 Db.CommitTrans
 Adodc1.Refresh
 WS.SendData "UPDATE-XXX"
 Case "DELETE"
 SQL = "Delete From TblMataKuliah " & _
 " where Kode = '" & xData1(1) & "'"
 Db.BeginTrans
 Db.Execute SQL, adCmdTable
 Db.CommitTrans
 WS.SendData "DELETE - SUKSES"
 Adodc1.Refresh
End Select
 End Sub

Desain Form Menu Utama Server

 

Source Code Form Menu Utama Server

Private Sub mnT1_Click()
 Form1.Show
 End Sub

Selanjutnya Tambahkan Module (Untuk Server)
Source Code

Public Db As New ADODB.Connection
 Public RS 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=" & App.Path & "\TestPR.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

 

Mendesain Project Client

Desain Form Login Client

"Tampilan Form Login Client sama dengan tampilan form Login server"

Source code Form Login Client

Private Sub cmdcancel_Click()
 Unload Me
End Sub
Private Sub cmdLogin_Click()
 On Error Resume Next
 Static i As Integer
 If txtUser.Text = "" Then
 GoSub noacc
 MsgBox "Eva: " & vbCrLf & " Anda belum memasukkan Nama", vbInformation + vbOKOnly, ":: Informasi ::"
 txtUser.SetFocus
ElseIf txtPass.Text = "" Then
 GoSub noacc
 MsgBox "Eva: " & vbCrLf & " Anda belum memasukkan Kata Sandi", vbInformation + vbOKOnly, ":: Informasi ::"
 txtPass.SetFocus
 Else
 SQL = "SELECT * FROM login WHERE Username='" & txtUser.Text & "'"
Set RS = Db.Execute(SQL)
 If RS.EOF Then
 GoSub noacc
 MsgBox "Eva: " & vbCrLf & " Nama atau Kata sandi yang anda masukkan salah", vbInformation + vbOKOnly, ":: Informasi ::"
 txtUser.SetFocus
ElseIf txtPass.Text <> RS("Pass") Then
 GoSub noacc
 MsgBox "Eva: " & vbCrLf & " Nama atau Kata sandi yang anda masukkan salah", vbInformation + vbOKOnly, ":: Informasi ::"
 txtUser.SetFocus
Else
 MsgBox "Eva: " & vbCrLf & " Selamat anda berhasil login " & vbCrLf & " Untuk Masuk Aplikasi Klik OK", vbInformation + vbOKOnly, "Informasi"
 Unload Me
 '''Menampilkan Menu Utama'''
 MenuUtama.Show
 End If
 End If
 Exit Sub
noacc:
 i = i + 1
 If i = 3 Then
 MsgBox "Eva: " & vbCrLf & " Maaf anda tidak berhak mengakses aplikasi ini !", vbCritical, ":: Gagal ::"
 End
 Else
 Return
 End If
 End Sub

Private Sub Form_Load()
 OPENDB
 txtUser.Text = ""
 txtPass.Text = Empty
 End Sub

Desain Form Mata Kuliah (untuk client)

Source Code Form Mata Kuliah (untuk client)

Dim IPServer As String
 Private Sub Timer1_Timer()
 'Teks Berjalan'
 jalan.Caption = Right$(jalan.Caption, Len(jalan.Caption) - 1) + Left$(jalan.Caption, 1)
 'Tanggal dan Jam'
 jam = Format(Now, "hh:mm:ss")
 tgl = Format(Now, "dddd,dd-mm-yyyy")
End Sub
Sub Hapus()
 Kode.Enabled = True
 ClearFORM Me
 Call RubahCMD(Me, True, False, False, False)
 End Sub
Sub ProsesDB(Log As Byte)
 Select Case Log
 Case 0
 SQL = "Insert into TblMataKuliah(Kode,MataKuliah,Semester,SKS)" & _
 "values('" & Kode.Text & _
 "','" & MataKuliah.Text & _
 "','" & Semester.Text & _
 "','" & sks.Text & "')"
 Case 1
 SQL = "Update TblMataKuliah set MataKuliah='" & MataKuliah.Text & "'," & _
 "Semester='" & Semester.Text & "'" & _
 "SKS=" & sks.Text & _
 "where Kode ='" & Kode.Text & "'"
 Case 2
 SQL = "Delete from TblMataKuliah where Kode='" & Kode.Text & "'"
 End Select
MsgBox "Pemrosesan Record Database telah berhasil.", vbInformation, "Table Mata Kuliah"
 Db.BeginTrans
 Db.Execute SQL, adCmdTable
 Db.CommitTrans
 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 TblMataKuliah(Kode,MataKuliah,Semester,SKS)" & _
 "values('" & Kode.Text & _
 "','" & MataKuliah.Text & _
 "','" & Semester.Text & _
 "','" & sks.Text & "')"
 WS.SendData "UPDATE-" & SQL
 Else
 SQL = "UPDATE TblMataKuliah set MataKuliah='" & MataKuliah.Text & _
 "', Semester='" & Semester.Text & _
 "', SKS='" & sks.Text & _
 "' where kode='" & Kode.Text & "'"
 WS.SendData "UPDATE-" & SQL
End If
 Case 2
 X = MsgBox("Yakin Record TblMataKuliah Akan Dihapus.", vbQuestion + vbYesNo, "Mata Kuliah")
 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
Sub MulaiKoneksi()
 IPServer = "192.168.10.01"
 IPClient = WS.LocalIP
 WS.Connect IPServer, 1000
 End Sub
Private Sub Form_Load()
 Call Hapus
 MulaiKoneksi
 End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
 DoEvents
 End
 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
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 = Kode.Text
 Call Hapus
 Kode.Text = X
 Call RubahCMD(Me, False, True, False, True)
 CmdProses(1).Caption = "&Simpan"
 MataKuliah.SetFocus
 Case "RECORD"
 xData2 = Split(xData1(1), "/")
 MataKuliah.Text = xData2(0)
 Semester.Text = xData2(1)
 sks.Text = xData2(2)
 Call RubahCMD(Me, False, True, True, True)
 CmdProses(1).Caption = "&Edit"
 Kode.Enabled = False
 MataKuliah.SetFocus
Case "INSERT"
 Call Hapus
Case "UPDATE"
 Call Hapus
Case "DEL"
 MsgBox "Hapus Berhasil"
 WS.SendData "INSERT" & Kode.Text & "/" & _
 MataKuliah.Text & "/" & Semester.Text & "/" & sks.Text
 Call Hapus
 End Select
 End Sub

Desain Form Menu Utama Client "Sama denga Form Utama Server"
Source Code Form Menu Utama Client

Private Sub mnT1_Click()
Form2.Show
End Sub

Tampilan Form saat dijalankan

1. Form Mata Kuliah (Server)

 

2. Form Mata Kuliah (Client)