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
