SERVER

Form login

Form menu

 

Form proses

Listing program

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 buku(Kode, Judul, Penerbit, Karangan, Tahun)" & _

                    "values('" & Kode.Text & _

                    "','" & Judul.Text & _

                    "','" & Penerbit.Text & _

                    "','" & Karangan.Text & _

                    "','" & Tahun.Text & "')"

    Case 1

    SQL = "UPDATE buku SET Judul='" & Judul.Text & "'," & _

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

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

        " Tahun = '" & Tahun.Text & "' " & _

         "where Kode ='" & Kode.Text & "'"

    Case 2

    SQL = "DELETE FROM buku WHERE Kode='" & Kode.Text & "'"

End Select

MsgBox "Data Telah Diubah Sesuai Keinginan Anda...!", vbInformation, "Data buku"

Db.BeginTrans

Db.Execute SQL, adCmdTable

Db.CommitTrans

Call hapus

Adodc1.Refresh

Kode.SetFocus

End Sub

Sub tampilbuku()

On Error Resume Next

Kode.Text = Rs!Kode

Judul.Text = Rs!Judul

Penerbit.Text = Rs!Penerbit

Karangan.Text = Rs!Karangan

Tahun.Text = Rs!Tahun

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 Tampilan buku Akan Dihapus...!", vbQuestion + vbYesNo, "buku")

    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 Buku!", vbInformation, "buku"

        Kode.SetFocus

        Exit Sub

    End If

    SQL = "SELECT * FROM buku WHERE Kode='" & Kode.Text & "'"

    If Rs.State = adStateOpen Then Rs.Close

    Rs.Open SQL, Db, adOpenDynamic, adLockBatchOptimistic

    If Rs.RecordCount <> 0 Then

        tampilbuku

        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

    Judul.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 buku WHERE Kode='" & xData1(1) & "'"

        MsgBox SQL

            If Rs.State = adStateOpen Then Rs.Close

            Rs.Open SQL, Db, adOpenDynamic, adLockOptimistic

            If Rs.RecordCount <> 0 Then

                WS.SendData "RECORD-" & Rs!Judul & "/" & Rs!Penerbit & "/" & Rs!Karangan & "/" & Rs!Tahun

            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 buku " & _

    "where Kode='" & xData1(1) & "'"

    Db.BeginTrans

    Db.Execute SQL, adCmdTable

    Db.CommitTrans

    Adodc1.Refresh

    WS.SendData "DEL-xxx"

        End Select

End Sub

Modul

Public Db As New ADODB.Connection

Public Rs As New ADODB.Recordset

Public Rs2 As New ADODB.Recordset

Public Rslogin 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=f:\Buku1\db2.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