FORM BUKU/SERVER

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 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 If

End Sub

TAMPILAN MENU

 

Private Sub mnkeluar_Click()

Unload Me

End Sub

Private Sub mnsiswa_Click()

buku.Show

End Sub

TAMPILAN FORM BUKU

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 "Pemorosesan record Database telah Berhasil...!", 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