JAWABAN SOAL NO. 3

KLIK DISINI LINK KE KASUS WINSOCK PAK MESRAN


LISTING PROGRAM SERVER

Dim ClientIndex As Byte
Dim cRequest As Integer
Dim cData As String
Dim i As Integer
Dim iGD As Integer

Sub MulaiServer()
        WS(0).LocalPort = 3000
        WS(0).Listen
        cRequest = 1
        ClientIndex = 1
End Sub

Private Sub Form_Load()
        MulaiServer
        GD.Rows = 41
        For i = 1 To 40
            GD.Col = 0
            GD.Row = i
            GD.Text = i
        Next i
        iGD = 1
End Sub

Private Sub Timer1_Timer()
    For i = 1 To GD.Rows - 1
        GD.Row = i
        GD.Col = 4
        If GD.Text = "START" Then
            GD.Col = 3
            GD.Text = Time
        End If
    Next i
End Sub

Private Sub WS_ConnectionRequest(index As Integer, ByVal requestID As Long)
        Load WS(cRequest)
        WS(cRequest).Close
        WS(cRequest).Accept requestID
        cRequest = cRequest + 1 '
End Sub

Private Sub WS_DataArrival(index As Integer, ByVal bytesTotal As Long)
        WS(index).GetData cData, vbString, bytesTotal
        Call CekData(index)
       
End Sub

Sub CekData(index)
    On Error Resume Next
        Dim kata() As String
        kata = Split(cData, "-")
        Select Case kata(0)
        Case "START"
                        GD.Row = iGD
                        GD.Col = 1
                        GD.Text = kata(1) 'WS(index).RemoteHostIP
                        GD.Col = 2
                        GD.Text = Time
                        GD.Col = 4
                        GD.Text = "START"
                        GD.Col = 5
                        GD.Text = kata(2)
                        iGD = iGD + 1
        Case "STOP"
            For i = 1 To GD.Rows - 1
                GD.Row = i
                GD.Col = 1
                If GD.Text = kata(1) Then
                    GD.Col = 4
                    GD.Text = "STOP"
                End If
            Next i
        End Select
End Sub
       
Private Sub WS_Error(index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
        WS(index).Close
End Sub


listing program client

Dim IPS As String
Dim User As String

Private Sub Command1_Click()
ws.SendData “START-” & User & “-MASDAULI”
End Sub

Private Sub Command2_Click()
ws.SendData “STOP-” & User
End Sub

Private Sub Form_Load()
IPS = “127.0.0.1″
User = ws.LocalIP
ws.Connect IPS, 3000
masuk.Text = “”
keluar = “”
biaya.Text = “”
bayar.Text = “”
End Sub
Sub CheckData()
Dim kata() As String
kata = Split(cData, “-”)
Select Case kata(0)
Case “PAKAI”:
pakai.Value = xdata2(0)
biaya.Text = xdata2(1)
bayar.Text = Val(Hour(pakai.Value)) + Val(Minute(pakai.Value)) * (xkata(1) / 60)
End Select
End Sub
Private Sub ws_DataArrival(ByVal bytesTotal As Long)
ws.GetData xkirim, vbString, bytesTotal
Call CheckData
End Sub


HASIL PROGRAM

JAWABAN SOAL NO 2

 KLIK LINK MASDA ke Quiz BaPakE 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:\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

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

DATA PEGAWAI SERVER - CLIENT DENGAN PROGRAM VB

1. INPUT SERVER

1. DATABASE  M.ACCESS

       Sebelum kita merancang program DataPegawai terlebih dahulu buat dulu databasenya dari M.access seperti dibawah ini :

 2. INPUT  SERVER DATA PEGAWAI

      

    Setelah databasenya selesai, rancang Form vb seperti diabawah ini.

 

Listing program server

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

DATABASES  LOGIN

     Setelah programnnya selesai, buatlah form login nya, namun sebelum itu buatlah terlebih dahulu databases nya dengan M.ACCESS  SEPERTI DIBAWAH :

3. FORM LOGIN

Setelah database dibuat, rancang form login nya seperti ini :

LISTING PROGRAM LOGIN

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 = "MASDAULI" And PasswordUser.Text = "DAMANIK" 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

4. FORM MENU SERVER

kemudian setelah itu buat form menu

LISTING PROGRAM MENU

Private Sub F1_Click()

FormPegawai.Show

End Sub

Private Sub mnc_Click()

End

End Sub

MODULE DATA PEGAWAI

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

2.INPUT CLIENT

1. FORM PEGAWAI

Project Form Pegawai

Dim IPServer As String

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,Jeniskelamin,Jabatan)" & _

                "values('" & Nip.Text & _

                "','" & Nama.Text & _

                "','" & Gol.Text & _

                "','" & Jeniskelamin.Text & _

                "','" & Jabatan.Text & "')"

        Case 1

            SQL = "UPDATE Pegawai SET Nama='" & Nama.Text & "'," & _

                "Gol= '" & Gol.Text & "'," & _

                "Jeniskelamin= '" & Jeniskelamin.Text & "'," & _

                "Jabatan= '" & Jabatan.Text & "'," & _

                "where Nip='" & Nip.Text & "'"

        Case 2

            SQL = "DELETE FROM Pewagai WHERE Nip='" & Nip.Text & "'"

        End Select

        MsgBox "Pemprosesan RECORD Database telah berhasil...!", vbInformation, "Pegawai"

        Call Hapus

        Nip.SetFocus

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

        SQL = "INSERT INTO Pegawai(Nip,Nama,Gol,Jeniskelamin,Jabatan)" & _

        "values('" & Nip.Text & _

        "','" & Nama.Text & _

        "','" & Gol.Text & _

        "','" & Jeniskelamin.Text & _

        "','" & Jabatan.Text & "')"

        WS.SendData "INSERT-" & SQL

        

    Else

        SQL = "UPDATE pegawai set " & _

            "nama= '" & Nama.Text & _

            "',jabatan='" & Jabatan.Text & _

            "' where Nip='" & Nip.Text & "'"

        WS.SendData "UPDATE-" & SQL

       

    End If

    Case 2

        x = MsgBox("Yakin RECORD Pegawai Akan Dihapus...!", vbQuestion + vbYesNo, "Pegawai")

        If x = vbYes Then

        WS.SendData "DELETE-" & Nip.Text

       

        End If

        Call Hapus

        Nip.SetFocus

    Case 3

        Call Hapus

        Nip.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 Nip.Text = "" Then Exit Sub

WS.SendData "SEARCH-" & Nip.Text

End If

End Sub

Sub MulaiKoneksi()

IPServer = "192.168.10.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 = Nip.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)

    Gol.Text = xData2(1)

    Jeniskelamin.Text = xData2(2)

    Jabatan.Text = xData2(3)

   

Call RubahCMD(Me, False, True, True, True)

CmdProses(1).Caption = "&Edit"

Nip.Enabled = False

Nama.SetFocus

Case "DEL"

MsgBox "penghapusan data berhasil !"

Call Hapus

Case "EDIT"

MsgBox "pengeditan record berhasil !"

Call Hapus

End Select

End Sub

2.FORM MENU

Project Form Menu Utama

Private Sub F1_Click()

Form1.Show

End Sub

Private Sub C_Click()

End

End Sub

Private Sub Form_Activate()

Text1 = Time

Text2 = Date

End Sub

3. 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

OUTPUT

  Setelah di  f5 maka program akan jalan, kemudian isikan username and password yg sudah anda buat sebelumnya.
jika password yang anda masukkan salah maka akan muncul " perintah password anda salah", dan sebaliknya jika benar akan tampil seperti dibawah ini.

lalu klik OK

 

     maka akan tampil menu seperti ini

 

 klik data pegawai maka akan muncul tampilan seperti ini, kemudian isikan NIP yg anda inginkan untuk memastikan apakah fungsi Command nya dah jalan, lalu enter, jika berhasil maka akan muncul tampilan "Pemrosesan record Database telah berhasil".
lalu klik OK.

 

maka akan muncul Seperti tampilan berikut setelah ok 

 SAMPAI DISINILAH YANG KAMI COBA

CLIENT-SERVER
SEMOGA BERMANFAAT BAGI YANG MEMBACA
TRIMAKASIH.