KARTIKA SITUMORANG

 LINK KE QUIS PAK MESRAN

 I1. FORM SERVER

LISTING PROGRAM SERVER 

Dim xKirim As String

Dim xData1() As String

Dim xData2() As String

Dim xPesan As String

Private Sub form_load()

IPServer = WS.LocalIP

Me.Caption = "Server IP:" & IPServer

Kirim = ""

Pesan = ""

Timer1.Enabled = False

Timer2.Enabled = False

MulaiServer

End Sub

Sub MulaiServer()

WS.LocalPort = 1000

WS.Listen

End Sub

Private Sub Timer1_Timer()

selesai.Value = Format(Now, "HH:mm:ss")

pakai.Value = selesai.Value - mulai.Value

End Sub

Private Sub Timer2_Timer()

WS.SendData "PAKAI-" & pakai.Value & "/" & 3000

End Sub

Private Sub WS_ConnectionRequest(ByVal requestID As Long)

WS.Close

WS.Accept requestID

Me.Caption = "Server-Client" & WS.RemoteHostIP & "Connect"

mulai.Value = Format(Now, "HH:mm:ss")

Timer1.Enabled = True

Timer2.Enabled = True

End Sub

Sub CheckData()

xData1 = Split(xKirim, "-")

xData2 = Split(xData1(1), "/")

Select Case xData1(0)

    Case "STOP"

Timer1.Enabled = False

Timer2.Enabled = False

End Select

End Sub

Private Sub WS_DataArrival(ByVal bytesTotal As Long)

WS.GetData xKirim, vbString, bytesTotal

Call CheckData

End Sub

LISTING PROGRAM CLIENT

LISTING PROGRAM CLIENT

Dim xdata1() As String

Dim xdata2() As String

Dim xkirim As String

Dim IPServer As String

Private Sub cmdConnect_click()

IPServer = "192.168.10.1"

IPClient = ws.LocalIP

ws.Connect IPServer, 1000

End Sub

Private Sub cmddisconnect_Click()

ws.SendData "STOP-XXX"

End Sub

Private Sub form_load()

Me.Caption = "CLIENT IP " & ws.LocalIP

waktu = ""

biaya = ""

End Sub

Sub CheckData()

    xdata1() = Split(xkirim, "-")

    xdata2() = Split(xdata1(1), "/")

    Select Case xdata1(0)

    Case "PAKAI":

        pakai.Value = xdata2(0)

        biaya.Text = xdata2(1)

        pemakaian.Text = Val(Hour(pakai.Value)) + Val(Minute(pakai.Value)) * (xdata2(1) / 60)

    End Select

End Sub

    

Private Sub ws_DataArrival(ByVal bytesTotal As Long)

ws.GetData xkirim, vbString, bytesTotal

Call CheckData

End Sub

II.   SOAL MODUL HALAMAN  9



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:\DENNI\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

KARTIKA SITUMORANG

LINK KARTIKA KESOAL QUIS 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:\DENNI\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

TUGAS SERVER CLIENT

INPUT SERVER

LISTING PROGRAM Sub Hapus() Nip.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 Pegawai(Nip,Nama,Gol,jeniskel,jabatan)" & _ "values('" & Nip.Text & _ "','" & Nama.Text & _ "','" & Gol.Text & _ "','" & JenisKel.Text & _ "','" & Jabatan.Text & "')" Case 1 SQL = "UPDATE Pegawai SET Nama='" & Nama.Text & "'," & _ "Gol='" & Gol.Text & "'," & _ "Jeniskel='" & JenisKel.Text & "'," & _ "Jabatan='" & Jabatan.Text & "' " & _ "where Nip='" & Nip.Text & "'" Case 2 SQL = "DELETE FROM Pegawai WHERE Nip='" & Nip.Text & "'" End Select MsgBox "Pemprosesan RECORD Database telah berhasil...!", vbInformation, "Data Pegawai" DB.BeginTrans DB.Execute SQL, adCmdTable DB.CommitTrans Call Hapus Adodc1.Refresh Nip.SetFocus End Sub Sub TampilPegawai() On Error Resume Next Nip.Text = RS!Nip Nama.Text = RS!Nama Gol.Text = RS!Gol JenisKel.Text = RS!JenisKel Jabatan.Text = RS!Jabatan End Sub Private Sub CmdProses_Click(Index As Integer) Select Case Index Case 0 Call Hapus Nip.SetFocus Case 1 If CmdProses(1).Caption = "&Simpan" Then Call ProsesDB(0) Else Call ProsesDB(1) End If Case 2 x = MsgBox("Yakin RECORD Pegawai Akan Dihapus...!", vbQuestion + vbYesNo, "Pegawai") If x = vbYes Then ProsesDB 2 Call Hapus Nip.SetFocus Case 3 Call Hapus Nip.SetFocus Case 4 Unload Me End Select End Sub Private Sub Form_Load() Call OPENDB Call Hapus MulaiServer End Sub Private Sub Nip_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If Nip.Text = "" Then MsgBox "Masukkan Nip Pegawai...!", vbInformation, "Pegawai" Nip.SetFocus Exit Sub End If SQL = "SELECT * FROM Pegawai WHERE Nip='" & Nip.Text & "'" If RS.State = adStateOpen Then RS.Close RS.Open SQL, DB, adOpenDynamic, adLockOptimistic If RS.RecordCount <> 0 Then TampilPegawai Call RubahCmd(Me, False, True, True, True) CmdProses(1).Caption = "&Edit" Nip.Enabled = False Else x = Nip.Text Call Hapus Nip.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, vbString, bytesTotal xData1 = Split(xKirim, "-") Select Case xData1(0) Case "SEARCH" SQL = "SELECT * FROM Pegawai WHERE Nip='" & 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!Gol & "/" & RS!JnsKelamin & "/" & RS!Jabatan 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 Pegawai" & -"where Nip='" & xData1(1) & "'" DB.Execute SQL, adCmdTable ws.SendData "DEL-SUKSES" End Select End Sub FORM LOGIN

LISTING PROGRAM Dim i As Byte Private Sub CommandOK_Click() Select Case Index Case 0 PanggilMENU Case 1 End End Select End Sub Private Sub Form_Load() NamaUser.Text = "" PasswordUser.Text = "" i = 1 End Sub Sub PanggilMENU() If NamaUser.Text = "IKA" And PasswordUser.Text = "KARTIKA" Then MsgBox "Semoga sukses..." & vbCrLf & _ "DATA PEGAWAI MAS_TI" & vbCrLf & _ "" & vbCrLf & _ "PEGAWAI YANG MASIH AKTIP", vbInformation + vbOKOnly, "Passsword" Unload Me Form_menu.Show Else If i > 2 Then MsgBox "Maaf...!" & vbCrLf & _ "Anda tidak berhak menggunakan program ini !", vbInformation + vbOKOnly, "Password" End Else MsgBox "Maaf...!" & vbCrLf & _ "Password anda SALAH", vbInformation + vbOKOnly, "Password" End If NamaUser.Text = "" PasswordUser.Text = "" NamaUser.SetFocus i = i + 1 End If End Sub Private Sub NamaUser_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If NamaUser.Text = "" Then Exit Sub PasswordUser.SetFocus End If End Sub Private Sub PasswordUser_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If PasswordUser.Text = "" Then Exit Sub CommandOK.SetFocus End If End Sub FROM MENU SERVER

LISTING PROGRAM Private Sub F1_Click() FormPegawai.Show End Sub Private Sub mnc_Click() End End Sub 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:\MASDA\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 DATABASE PROGRAM DATA PEGAWAI

GAMBAR HASIL FROM TAMPILA MENU

GAMBAR HASIL FORM PEGAWAI

GAMBAR FORM PEGAWAI

PROJECT 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