Contoh Client & Server

Tampilan login

 

Listing Program

Private Sub Cmdok_Click()

    If Txtuser.Text = "ridho" And Txtpas.Text = "azhar" Then

 FrmPegawai.Show

 FrmLogin.Hide

 Else

 FrmLogin.Show

 FrmPegawai.Hide

 MsgBox "maaf User dan Password Salah Bosss"

 bersih

 Txtuser.SetFocus

 End If

End Sub

Private Sub Form_Load()

    bersih

End Sub

Sub bersih()

Txtuser.Text = ""

Txtpas.Text = ""

End Sub

Private Sub CmdKeluar_Click()

End

End Sub

Tampilan Data Pegawai

 

 

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, TempatLhr, TanggalLhr, Pendidikan, Bagian, Status)" & _

                " values('" & NIP.Text & _

                "','" & NAMA.Text & _

                "','" & TEMPAT.Text & _

                "','" & TANGGAL.Text & _

                "','" & PENDIDIKAN.Text & _

                "','" & BAGIAN.Text & _

                "','" & STATUS.Text & "')"

        Case 1

            ctgl = Mid(TANGGAL.Text, 7, 4) & "-" & Mid(TANGGAL.Text, 4, 2) & "-" & Mid(TANGGAL.Text, 1, 2)

           

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

                  " TempatLhr = '" & TEMPAT.Text & "'," & _

                  " TanggalLhr = '" & ctgl & "'," & _

                  " Pendidikan = '" & PENDIDIKAN.Text & "'," & _

                  " Bagian = '" & BAGIAN.Text & "'," & _

                  " Status = '" & STATUS.Text & "' " & _

                  " where NIP ='" & NIP.Text & "'"

        Case 2

            SQL = "DELETE FROM Pegawai WHERE NIP='" & NIP.Text & "'"

    End Select

    MsgBox "Pemorosesan RECORD Database telah berhasil...!", vbInformation, "Data Pegawai"

    Db.Execute SQL, adCmdTable

    Call Hapus

    Adodc1.Refresh

    NIP.SetFocus

End Sub

Sub Tampilpegawai()

    On Error Resume Next

    NIP.Text = RS!NIP

    NAMA.Text = RS!NAMA

    TEMPAT.Text = RS!TempatLhr

    TANGGAL.Text = RS!TanggalLhr

    PENDIDIKAN.Text = RS!PENDIDIKAN

    BAGIAN.Text = RS!BAGIAN

    STATUS.Text = RS!STATUS

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

   

    BAGIAN.AddItem "HRD"

    BAGIAN.AddItem "HUMAS"

    BAGIAN.AddItem "KEUANGAN"

   

    PENDIDIKAN.AddItem "DIPLOMA III"

    PENDIDIKAN.AddItem "STRATA I"

    PENDIDIKAN.AddItem "STRATA II"

   

    STATUS.AddItem "MENIKAH"

    STATUS.AddItem "TIDAK MENIKAH"

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

Private Sub WS_CconnectionRequest(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 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!TempatLhr & "/" & RS!TanggalLhr & "/" & RS!PENDIDIKAN & "/" & RS!STATUS

            Else

                WS.SendData "NOTHING-xxx"

            End If

    Case "INSERT"

            Db.BeginTrans

            Db.Execute xData1(1), adCmdTable

            Db.CommitTrans

            WS.SendData "INSERT-xxx"

            Adodc1.Refresh

    Case "UPDATE"

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

    Db.Execute SQL, adCmdTable

    Db.CommitTrans

    Adodc1.Refresh

    WS.SendData "DEL-xxx"

        End Select

End Sub

Module1

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=MSDASQL.1;Persist Security Info=False;Data Source=Pegawai"

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