Langkah Awal untuk buat data pencarian data buku adalah dengan membuat database pada Microsoft access seperti yang terlihat pada gambar dibawah, cara membuat database login,
Langkah ke 2 yaitu buat database form bukunya seperti gambar dibawah ini
Langkah selanjutnya designlah form buku di VB 06 sama seperti dibawah ini untuk Server
Dengan listing code seperti dibawah ini : 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
Langkah selanjutnya desiglah form tampilan menu sama seperti gambar dibawah ini:
Klik kanan pada form menu dan klik menu Editor:
Maka akan tampil gambar seperti dibawah ini ;
Pada Caption Ketik File, dan Name nya ketik FN, lalu pilih tombol next yg tertera pada gambar untuk melanjutkan. Setelah itu akan tampil sama seperti gamabr dibawah ini :
pada form menu ketik listing code sama seperti dibawah ini :
Private Sub mnkeluar_Click() Unload Me End Sub
Private Sub mnsiswa_Click() buku.Show End Sub
Lalu designlah form loginnya sama seperti ganbar dibawah ini;
Dengan ketik listing code dibawah ini pada form 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
Dan jangan lupa buat pada listing code pada module; Public ConN As New ADODB.Connection Public RSSiswa As New ADODB.Recordset Public RSOperator As New ADODB.Recordset Public RSDetail As New ADODB.Recordset Public Rs As New ADODB.Recordset Public Rs2 As New ADODB.Recordset Public SQL As String Public Db As New ADODB.Connection
Sub KOneksI() Set ConN = New ADODB.Connection Set RSSiswa = New ADODB.Recordset
Set RSOperator = New ADODB.Recordset Set RSDetail = New ADODB.Recordset 'ConN.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=DBSPP" ConN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=F:\Baru Pakmes\data\DBSPP.mdb;Persist Security Info=False" End Sub
Sub OPENDB() If Db.State = adStateOpen Then Db.Close Db.CursorLocation = adUseClient Db.CursorLocation = adUseClient Db.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=F:\Baru Pakmes\data\DBSPP.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
Inilah untuk form server.
