Minggu, 29 Januari 2012

Postingan jawaban no 3 (Siti Waliam Mursida)

Untuk kasus lihat disini kasus

Listing program

Dim IPServer As String
Dim xKirim As String
Dim xData1() As String
Dim xData2() As String


Private Sub cmdconnect_click()
    IPServer = "192.168.10.1"
    IPClient = WS.LocalIP
    WS.Connect IPServer, 1000
End Sub

Private Sub cmddisconnet_Click()
    WS.SendData "STOP-xxx"
   
   
End Sub

Private Sub Form_Load()
    Me.Caption = "CLIENT IP :" & WS.LocalIP
    biaya = ""
    Pemakaian = ""
   
End Sub

Private Sub WS_DataArrival(ByVal bytesTotal As Long)
    WS.GetData xKirim, vbString, bytesTotal
    Call CheckData
End Sub
Sub CheckData()
    xData1 = Split(xKirim, "-")
    xData2 = Split(xData1(1), "/")
   
    Select Case xData1(0)
        Case "PAKAI"
            pakai.Value = xData2(0)
            biaya.Text = xData2(1)
            Pemakaian.Text = xData2(1) / 60
           
        End Select
End Sub


Hasil program

Postingan jawaban no 2 (Siti Walian Mursida)

Untuk kasus lihat disini kasus

Listing Program

Module :

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:\belajarserver\test.mdb;persist security info=false"
   
End Sub

Sub clearform(f As From)
    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, lo 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

Form Barang :

Private Sub Command1_Click()
    Adodc1.Refresh
End Sub

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 "Pemrosesan 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
            callprosesdb (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 Form_Load()
    Call opendb
    Call hapus
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, adLockOptimistic
        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

Hasil Program

Kamis, 19 Januari 2012

Data Mahasiswa Berbasis Client-Server

Form login:

Private Sub Form_Load()
    Call hapus
   
End Sub
Sub hapus()
    user.Text = ""
    pass.Text = ""
   
End Sub

Private Sub keluar_Click()
    Unload Me
   
End Sub

Private Sub masuk_Click()
    If user.Text = "wulan" And pass.Text = "wulan" Then
        Menu.Show
        ElseIf user.Text = "wewen" And pass.Text = "wewen" Then
            Menu.Show
        ElseIf user.Text = "desi" And pass.Text = "desi" Then
            Menu.Show
        ElseIf user.Text = "leni" And pass.Text = "leni" Then
            Menu.Show
        ElseIf user.Text = "rahma" And pass.Text = "rahma" Then
            Menu.Show
        ElseIf user.Text = "ayu" And pass.Text = "ayu" Then
            Menu.Show
        ElseIf user.Text = "siti" And pass.Text = "siti" Then
            Menu.Show
        Unload Me
    Else
        MsgBox "Password Anda Salah!!!", vbInformation, "info"
        Call hapus
        user.SetFocus
    End If

End Sub

Private Sub pass_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If user.Text = "wulan" And pass.Text = "wulan" Then
            Menu.Show
            Unload Me
        Else
            MsgBox "Password Anda Salah!!!"
            Call hapus
            user.SetFocus
        End If
    End If
           
End Sub

Private Sub user_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If user.Text = "" Then
            MsgBox "Username belum diisi!!!"
        Else
            pass.SetFocus
        End If
    End If
   
End Sub

Menu utama:

Private Sub f1_click()
  Form_mahasiswa.Show
End Sub

Private Sub f2_click()
    Form_login.Show
End Sub

Private Sub f3_click()
   End
End Sub

Form Mahasiswa:

Sub hapus()
    NPM.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 siswa(npm,nama,jenjang,jurusan)" & _
            "values('" & NPM.Text & _
            "','" & NAMA.Text & _
            "','" & JENJANG.Text & _
            "','" & JURUSAN.Text & "')"
        Case 1
            SQL = "UPDATE siswa set nama='" & NAMA.Text & "'," & _
            "jenjang='" & JENJANG.Text & "' " & _
            "jurusan='" & JURUSAN.Text & "' " & _
            "where npm='" & NPM.Text & "'"
        Case 2
            SQL = "DELETE FROM siswa WHERE npm='" & NPM.Text & "' "
    End Select
    MsgBox "Pemrosesan RECORD Database telah berhasil...!!!", vbInformation, "Data Siswa"
    Db.BeginTrans
    Db.Execute SQL, adCmdTable
    Db.CommitTrans
    Call hapus
    Adodc1.Refresh
    NPM.SetFocus
End Sub
Sub tampilsiswa()
    On Error Resume Next
    NPM.Text = RS!NPM
    NAMA.Text = RS!NAMA
    JENJANG.Text = RS!JENJANG
    JURUSAN.Text = RS!JURUSAN
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 siswa akan dihapus...???", vbQuestion + vbYesNo, "siswa")
            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 Form_Load()
    Call hapus
    JURUSAN.AddItem "MANAJEMEN"
    JURUSAN.AddItem "TEKNIK"
    JURUSAN.AddItem "INFORMASI"
   
    JENJANG.AddItem "S1"
    JENJANG.AddItem "D3"
    JENJANG.AddItem "D1"
   
    Call openDB
    mulaiserver
End Sub
Private Sub npm_keypress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If NPM.Text = "" Then
            MsgBox "Masukkan siswa!", vbInformation, "siswa"
            NPM.SetFocus
            Exit Sub
        End If
        SQL = "SELECT*FROM siswa WHERE npm='" & NPM.Text & "'"
        If RS.State = adStateOpen Then RS.Close
        RS.Open SQL, Db, adOpenDynamic, adLockOptimistic
        If RS.RecordCount <> 0 Then
            tampilsiswa
            Call rubahCMD(Me, False, True, True, True)
            cmdproses(1).Caption = " & edit"
            NPM.Enabled = False
        Else
            x = NPM.Text
            Call hapus
            NPM.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 = 1500
    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 siswa WHERE npm='" & 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!JENJANG & RS!JURUSAN
            Else
                WS.SendData "NOTHING-DATA"
            End If
        Case "DELETE"
            SQL = "Delete * from siswa" & _
                "where npm='" & xData1(1) & "'"
                Db.BeginTrans
                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
           
        Case "INSERT"
            Db.BeginTrans
            Db.Execute xData1(1), adCmdTable
            Db.CommitTrans
            WS.SendData "INSERT-XXX"
            Adodc1.Refresh
    End Select
End Sub

Module:

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:\apache\mysql\data\DbSiswa\siswa.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