Langkah
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
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
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
Tidak ada komentar:
Posting Komentar