TUGAS TGL 20 JAN 2012CLIENT-SERVER

Dim i As Byte

Private Sub CmdProses_Click(Index As Integer)

    Select Case Index

    Case 0

        PanggilDataPegawai

    Case 1

        End

    End Select

End Sub

Private Sub Form_load()

User.Text = ""

Password.Text = ""

Password.PasswordChar = "*"

i = 1

End Sub

Sub PanggilDataPegawai()

If User.Text = "HARIYADI" And Password.Text = "vb" Then

    MsgBox "Selamat Menggunakan..." & vbCrLf & _

    "Data Pegawai" & vbCrLf & _

    " " & vbCrLf & _

    "(C)opy Right by HARIYADI", vbInformation + vbOKOnly, "Password"

Unload Me

DataPegawai.Show

Else

If i > 2 Then

MsgBox "Maaf..!" & vbCrLf & _

    "Anda tidak berhak menggnakan program ini !", vbInformation + vbOKOnly, "Password"

    End

Else

    MsgBox "Maaf..!" & vbCrLf & _

        "Password Anda Salah", vbInformation + vbOKOnly, "Password"

    End If

User.Text = ""

Password.Text = ""

User.SetFocus

i = i + 1

End If

End Sub

Private Sub Password_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

    If TextPassword.Text = "" Then Exit Sub

    CmdProses(0).SetFocus

End If

End Sub

Private Sub User_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

    If TextUser.Text = "" Then Exit Sub

    Password.SetFocus

End If

End Sub

Private Sub MnF1_Click()

Password.Show

End Sub

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=D:\Tugas tgl 20\Test.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, L4 As Boolean)

    f.CmdProses(0).Enabled = L0

    f.CmdProses(1).Enabled = L1

    f.CmdProses(2).Enabled = L2

    f.CmdProses(3).Enabled = L3

    f.CmdProses(4).Enabled = L4

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 Command1_Click()

    Adodc1.Refresh

End Sub

Sub MulaiServer()

    WS.LocalPort = 1000

    WS.Listen

End Sub

Private Sub Form_load()

Pendidikan.AddItem "S1"

Pendidikan.AddItem "S2"

Pendidikan.AddItem "D3"

    Call OPENDB

    Call Hapus

    MulaiServer

End Sub

Sub Hapus()

    Nip.Enabled = True

    ClearFORM Me

    Call RubahCMD(Me, True, False, 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, Alamat, Jabatan, Gol, Pendidikan, Telp)" & _

                "values('" & Nip.Text & _

                "','" & Nama.Text & _

                "','" & Alamat.Text & _

                "','" & Jabatan.Text & _

                "','" & Gol.Text & _

                "','" & Pendidikan.Text & _

                "','" & Telp.Text & "')"

        Case 1

            SQL = "Update Pegawai set Nama='" & Nama.Text & "'," & _

                "Alamat='" & Alamat.Text & "'" & _

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

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

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

                "Telp='" & Telp.Text & "'" & _

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

        Case 2

            SQL = "Delete from Pegawai where Nip='" & Nip.Text & "'"

    End Select

    MsgBox "Pemrosesan Record Database telah berhasil.", vbInformation, "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

    Alamat.Text = RS!Alamat

    Jabatan.Text = RS!Jabatan

    Gol.Text = RS!Gol

    Pendidikan.Text = RS!Pendidikan

    Telp.Text = RS!Telp

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, True)

            CmdProses(1).Caption = "&Edit"

            Nip.Enabled = False

        Else

            X = Nip.Text

            Call Hapus

            Nip.Text = X

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

            CmdProses(1).Caption = "&Simpan"

        End If

        Nama.SetFocus

    End If

End Sub

Private Sub Text2_Change()

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!Alamat & "/" & RS!Jabatan & "/" & RS!Gol & "/" & RS!Pendidikan & "/" & RS!Telp

            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

        WS.SendData "edit-sukses"

        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-sukses"

  

    End Select

   

End Sub

FORM CLIENT

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,Alamat,Jabatan,Gol,Pendidikan,Telpon)" & _

                "values('" & Nip.Text & _

                "','" & Nama.Text & _

                "','" & Alamat.Text & _

                "','" & Jabatan.Text & _

                "','" & Gol.Text & _

                "','" & Pendidikan.Text & _

                "','" & Telpon.Text & "')"

        Case 1

            SQL = "Update Pegawai set Nama='" & Nama.Text & "'," & _

                "Alamat='" & Alamat.Text & "'" & _

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

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

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

                "Telpon='" & Telpon.Text & "'" & _

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

        Case 2

            SQL = "Delete from Pegawai where Nip='" & Nip.Text & "'"

    End Select

    MsgBox "Pemrosesan Record Database telah berhasil...!", vbInformation, "Pegawai"

    Db.BeginTrans

    Db.Execute SQL, adCmdTable

    Db.CommitTrans

    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,Alamat,Jabatan,Gol,Pendidikan,Telpon)" & _

            "values ('" & Nip.Text & _

            "','" & Nama.Text & _

            "','" & Alamat.Text & _

            "','" & Jabatan.Text & _

            "','" & Gol.Text & _

            "','" & Pendidikan.Text & _

            "','" & Telpon.Text & "')"

            WS.SendData "INSERT-" & SQL

        Else

            SQL = "update Pegawai set nama='" & Nama.Text & _

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

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

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

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

            "', Telpon='" & Telpon.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

Sub MulaiKoneksi()

    IPServer = "192.168.10.1"

    IPClient = WS.LocalIP

    WS.Connect IPServer, 1000

End Sub

Private Sub Form_load()

Pendidikan.AddItem "S1"

Pendidikan.AddItem "S2"

Pendidikan.AddItem "D3"

    Call Hapus

    MulaiKoneksi

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    DoEvents

    End

End Sub

Private Sub Nip_Keypress(KeyAscii As Integer)

    If KeyAscii = 13 Then

        If Nip.Text = "" Then Exit Sub

       

        WS.SendData "SEARCH-" & Nip.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 = Nip.Text

            Call Hapus

            Nip.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)

            Alamat.Text = xData2(1)

            Jabatan.Text = xData2(2)

            Gol.Text = xData2(3)

            Pendidikan.Text = xData2(4)

            Telpon.Text = xData2(5)

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

            CmdProses(1).Caption = "&Edit"

            Nip.Enabled = False

            Nama.SetFocus

        Case "INSERT"

            Call Hapus

        Case "UPDATE"

            Call Hapus

        Case "DEL"

            MsgBox "Hapus Berhasil"

            WS.SendData "INSERT" & Nip.Text & "/" & _

            Nama.Text & "/" & Alamat.Text & "/" & Jabatan.Text & "/" & Gol.Text & "/" & Pendidikan.Text & "/" & Telpon.Text

            Call Hapus

        End Select

End Sub

 

Private Sub MnF1_Click()

Password.Show

End Sub

Dim i As Byte

Private Sub CmdProses_Click(Index As Integer)

    Select Case Index

    Case 0

        PanggilDataPegawai

    Case 1

        End

    End Select

End Sub

Private Sub Form_load()

User.Text = ""

Password.Text = ""

Password.PasswordChar = "*"

i = 1

End Sub

Sub PanggilDataPegawai()

If User.Text = "FITKA DETRI" And Password.Text = "COBA" Then

    MsgBox "Selamat Menggunakan..." & vbCrLf & _

    "Data Pegawai" & vbCrLf & _

    " " & vbCrLf & _

    "copy Right by FITKA DETRI", vbInformation + vbOKOnly, "Password"

Unload Me

Pegawai.Show

Else

If i > 2 Then

MsgBox "Maaf..!" & vbCrLf & _

    "Anda tidak berhak menggnakan program ini !", vbInformation + vbOKOnly, "Password"

    End

Else

    MsgBox "Maaf..!" & vbCrLf & _

        "Password Anda Salah", vbInformation + vbOKOnly, "Password"

    End If

User.Text = ""

Password.Text = ""

User.SetFocus

i = i + 1

End If

End Sub

Private Sub Password_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

    If TextPassword.Text = "" Then Exit Sub

    CmdProses(0).SetFocus

End If

End Sub

Private Sub User_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

    If TextUser.Text = "" Then Exit Sub

    Password.SetFocus

End If

End Sub