Server (Mobil)

Listing program Login

Private Sub keluar_Click()

Unload Me

End Sub

Private Sub login_Click()

If username.Text = "iben" And pass.Text = "555" Then

Me.Hide

Menu.Show

Else

MsgBox "maaf username and pasword yg anda masukan tidak sesuai", vbInformation, "pemakai"

End If

End Sub

Listing program form mobil

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 cars(kode,namamobil,jenismobil,seri,harga)" & _

"values('" & kode.Text & _

"','" & namamobil.Text & _

"','" & jenismobil.Text & _

"','" & seri.Text & _

"','" & harga.Text & "')"

Case 1

sql = "update cars set namamobil='" & namamobil.Text & "'," & _

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

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

"harga= '" & harga.Text & "'" & _

"where kode='" & kode.Text & "'"

Case 2

sql = "delete from cars where kode='" & kode.Text & "'"

End Select

 MsgBox "Pemrosesan record database telah berhasil...!", vbInformation, "data cars"

 Db.BeginTrans

 Db.Execute sql, adCmdTable

 Db.CommitTrans

 Call hapus

 Adodc1.Refresh

 kode.SetFocus

End Sub

Sub Tampilnamamobil()

On Error Resume Next

kode.Text = rs!kode

namamobil.Text = rs!namamobil

jenismobil.Text = rs!jenismobil

seri.Text = rs!seri

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 namamobil akan dihapus...!", vbQuestion + vbYesNo, "cars")

    If X = vbYes Then ProsesDB 2

    Call hapus

    kode.SetFocus

Case 3

    Call hapus

    kode.SetFocus

Case 4

    Unload Me

    End Select

   

End Sub

Private Sub DataGrid1_Click()

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 mobil! ", vbInformation, "cars"

        kode.SetFocus

        Exit Sub

    End If

    sql = "SELECT * FROM cars WHERE kode='" & kode.Text & "' "

    If rs.State = adStateOpen Then rs.Close

    rs.Open sql, Db, adOpenDynamic, adLockOptimistic

    If rs.RecordCount <> 0 Then

        Tampilnamamobil

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

        cmdproses(1).Caption = "&Edit"

       

        kode.Enabled = True

    Else

        X = kode.Text

        Call hapus

        kode.Text = X

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

            cmdproses(1).Caption = "&Simpan"

    End If

    namamobil.SetFocus

End If

End Sub

Sub MulaiServer()

ws.LocalPort = 1000

ws.Listen

End Sub

Private Sub namamobil_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 cars 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!namamobil & "/" & rs!jenismobil & "/" & rs!seri & "/" & rs!harga

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

            sql = " Delete * from cars " & _

                " 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

Listing menu utama

Private Sub mnuexit_Click()

Unload Me

End Sub

Private Sub PembelianMobil_Click()

frmmobil.Show

End Sub