HIDUP PENUH PERJUANGAN

Minggu, 29 Januari 2012

QUIZ 3

link tugas ke pak mesran

LISTING CLIENT

Dim IPS As String

Dim User As String

Private Sub Command1_Click()

WS.SendData "START-" & User & "-denni"

End Sub

Private Sub Command2_Click()

WS.SendData "STOP-" & User

End Sub

Private Sub Form_Load()

IPS = "127.0.0.1"

User = WS.LocalIP

WS.Connect IPS, 3000

End Sub

Private Sub WS_DataArrival(index As Integer, ByVal bytesTotal As Long)

WS(index).GetData cData, vbString, bytesTotal

Call CekData(index)

End Sub

Private Sub WS_ConnectionRequest(index As Integer, ByVal requestID As Long)

Load WS(cRequest)

WS(cRequest).Close

WS(cRequest).Accept requestID

cRequest = cRequest + 1 '

End Sub

QUIZ 2

LINK DARSUARI KE TUGAS QUIZ PAK MESRAN

Module server

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:\DARSUARI\db1.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

Listing program server

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 "Pemorosesan 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
        Call ProsesDB(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 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 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, adLockBatchOptimistic
    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

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 Barang 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!Nama & "/" & Rs!Harga
            Else
                WS.SendData "NOTHING-DATA"
            End If
        Case "INSERT"
            SQL = "INSERT*from barang" & _
                Db.BeginTrans
                Db.Execute xData1(1), adCmdTable
                Db.CommitTrans
                WS.SendData "SIMPAN - xxx"
                Adodc1.Refresh
        Case "DELETE"
            SQL = "Delete*from barang" & _
                " 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

Module client
Public SQL As String

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

LISTING PROGRAM CLIENT

Dim IPServer As String

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 "Pemprosesan RECORD Database telah berhasil...!", vbInformation, "Barang"
        Call Hapus
        Kode.SetFocus
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
        SQL = "INSERT INTO Barang(Kode,Nama,Harga)" & _
        "values('" & Kode.Text & _
        "','" & Nama.Text & _
        "','" & Harga.Text & "')"
        WS.SendData "INSERT-" & SQL

    Else
        SQL = "UPDATE barang set " & _
            "nama= '" & Nama.Text & _
            "',harga='" & Harga.Text & _
            "' where kode='" & Kode.Text & "'"
        WS.SendData "UPDATE-" & SQL

    End If
    Case 2
        x = MsgBox("Yakin RECORD Barang Akan Dihapus...!", vbQuestion + vbYesNo, "Barang")
        If x = vbYes Then
        WS.SendData "DELETE-" & Kode.Text

        End If
        Call Hapus
        Kode.SetFocus
    Case 3
        Call Hapus
        Kode.SetFocus
    Case 4
        Unload Me
    End Select
End Sub

Private Sub Form_Load()
    Call Hapus
    MulaiKoneksi
End Sub
Private Sub Kode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Kode.Text = "" Then Exit Sub
WS.SendData "SEARCH-" & Kode.Text
End If
End Sub
Sub MulaiKoneksi()
    IPServer = "l27.0.0.1"
    IPClient = WS.LocalIP
    WS.Connect IPServer, 1000
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    DoEvents
End
End Sub
Private Sub WS_Dataarrival(ByVal bytesTotal As Long)
Dim xkrim 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 = Kode.Text
Call Hapus
    Kode.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)
    Harga.Text = xData2(1)
Call RubahCMD(Me, False, True, True, True)
    CmdProses(1).Caption = "&Edit"
    Kode.Enabled = False
    Nama.SetFocus
Case "DEL"
    MsgBox "penghapusan data berhasil !"
Call Hapus
Case "EDIT"
    MsgBox "pengeditan record berhasil !"
Call Hapus
End Select
End Sub

Jumat, 20 Januari 2012

FORM BUKU/CLIENT

TAMPILAN LOGIN

Dim A As Byte

Dim B As Byte

Private Sub Command1_Click()

End

End Sub

Private Sub Form_Load()

Text1.MaxLength = 30

Text2.MaxLength = 10

Text2.PasswordChar = "x"

Text2.Enabled = False

End Sub

Private Sub Text1_Keypress(KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

If KeyAscii = 27 Then End

If KeyAscii = 13 Then

Call KOneksI

RSOperator.Open "Select NamaOpr from Operator where NamaOpr ='" & Text1 & "'", ConN

If RSOperator.EOF Then

A = A + 1

If 1 - A = 0 Then

MsgBox "Kesempatan ke " & A & " Salah" & Chr(13) & _

"Nama '" & Text1 & "' tidak dikenal"

Text1 = "Lotar"

Text1.SetFocus

ElseIf 2 - A = 0 Then

MsgBox "Kesempatan ke " & A & " Salah" & Chr(13) & _

"Nama '" & Text1 & "' tidak dikenal"

Text1 = ""

Text1.SetFocus

ElseIf 3 - A = 0 Then

MsgBox "Kesempatan ke " & A & " Salah" & Chr(13) & _

"Nama '" & Text1 & "' tidak dikenal" & Chr(13) & _

"Kesempatan habis, Ulangi dari awal"

Unload Me

End If

Else

Text1.Enabled = False

Text2.Enabled = True

Text2.SetFocus

End If

End Sub

Private Sub Text2_Keypress(KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

If KeyAscii = 27 Then End

Dim KodeOperator As String

Dim NamaOperator As String

If KeyAscii = 13 Then

Call KOneksI

RSOperator.Open "Select * from Operator where NamaOpr ='" & Text1 & "' and passwordOpr='" & Text2 & "'", ConN

If RSOperator.EOF Then

B = B + 1

If 1 - B = 0 Then

MsgBox "Kesempatan ke " & B & " Salah"

Text2 = ""

Text2.SetFocus

ElseIf 2 - B = 0 Then

MsgBox "Kesempatan ke " & B & " Salah"

Text2 = ""

Text2.SetFocus

ElseIf 3 - B = 0 Then

MsgBox "Kesempatan ke " & B & " Salah"

Unload Me

End If

Else

Me.Visible = False

Menu.Show

Menu.STBar.Panels(1).Text = Login.Text1

Menu.STBar.Panels(2).Text = RSOperator!STATUSOPR

Menu.STBar.Panels(3).Text = RSOperator!KODEOPR

Menu.STBar.Panels(3).Visible = False

End If

End Sub

TAMPILAN MENU

Private Sub Fn1_Click()

FrmClient.Show

End Sub

Private Sub mnkeluar_Click()

Unload Me

End Sub

TAMPILAN FORM BUKU

Dim IPServer As String

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 Barang 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 "Pemprosesan RECORD Database telah berhasil...!", vbInformation, "buku"

Call Hapus

Kode.SetFocus

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

SQL = "INSERT INTO buku(Kode, Judul, Penerbit, Karangan, Tahun)" & _

"values('" & Kode.Text & _

"','" & Judul.Text & _

"','" & Penerbit.Text & _

"','" & Karangan.Text & _

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

WS.SendData "INSERT-" & SQL

Else

SQL = "UPDATE buku set " & _

"Judul= '" & Judul.Text & _

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

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

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

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

WS.SendData "UPDATE-" & SQL

End If

Case 2

x = MsgBox("Yakin RECORD Buku Akan Dihapus...!", vbQuestion + vbYesNo, "buku")

If x = vbYes Then

WS.SendData "DELETE-" & Kode.Text

End If

Call Hapus

Kode.SetFocus

Case 3

Call Hapus

Kode.SetFocus

Case 4

Unload Me

End Select

End Sub

Private Sub Form_Load()

Call Hapus

MulaiKoneksi

End Sub

Private Sub Kode_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

If Kode.Text = "" Then Exit Sub

WS.SendData "SEARCH-" & Kode.Text

End If

End Sub

Sub MulaiKoneksi()

IPServer = "192.168.10.1"

IPClient = WS.LocalIP

WS.Connect IPServer, 1000

End Sub

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

DoEvents

End

End Sub

Private Sub WS_Dataarrival(ByVal bytesTotal As Long)

Dim xkrim 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 = Kode.Text

Call Hapus

Kode.Text = x

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

CmdProses(1).Caption = "&Simpan"

Judul.SetFocus

Case "RECORD"

xData2 = Split(xData1(1), "/")

Judul.Text = xData2(0)

Penerbit.Text = xData2(1)

Karangan.Text = xData2(2)

Tahun.Text = xData2(3)

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

CmdProses(1).Caption = "&Edit"

Kode.Enabled = False

Judul.SetFocus

Case "DEL"

MsgBox "penghapusan data berhasil !"

Call Hapus

Case "EDIT"

MsgBox "pengeditan record berhasil !"

Call Hapus

End Select

End Sub