tugas buku///server afri

Listing program

Private Sub cmd_Click(Index As Integer)
Select Case Index
Case 0
If username = "" Then
MsgBox "Silahkan isi password"
batal
username.SetFocus
Else
If password.Text = password.Text Then
Tampilan1.Show
Else
MsgBox "password anda salah"
batal
password.SetFocus
End If
End If
Case 1
batal
Unload Me
End Select
End Sub

Sub batal()
username.Text = ""
password.Text = ""
End Sub

Private Sub Form_Load()
OPENDB
batal
isi
End Sub
Sub isi()
SQL = "select*from login"
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockOptimistic
If Rs.RecordCount <> 0 Then
Rs.MoveFirst
Do While Not Rs.EOF
Rs.MoveNext
Loop
End If



End Sub



Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub username_Click()
SQL = " select*from login " & _
"where username='" & username.Text & "'"
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockOptimistic
If Rs.RecordCount <> o Then
password.Text = Rs!password
End If

End Sub
Tampilan form buku

Form proses

Tampilan menu utama

Llisting program 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 "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



Listing modulnya
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=C:\Buku\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

Listing menu utama
Private Sub Fn1_Click()
Frmbuku.Show
End Sub

Private Sub Fn2_Click()
End
End Sub