Nama : Munawir Napitupulu
npm : 0902424
MI S0911 A siang
dari kasus
FORM SERVER
Sebelum di comfile atau di f5
setelah di comfile atau di f5
Listing program Module
Public Db As New ADODB.Connection
Public rs As New ADODB.Recordset
Public rs2 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=D:\BelajarServer\Test.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 progam Server
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 Barang(kode,nama,harga)" & _
"values('" & kode.Text & _
"','" & nama.Text & _
"','" & harga.Text & "')"
Case 1
sql = "update Barang set nama='" & nama.Text & "'," & _
"harga= '" & harga.Text & "'" & _
"where kode='" & kode.Text & "'"
Case 2
sql = "delete from Barang where kode='" & kode.Text & "'"
End Select
MsgBox "Pemrosesan record database telah berhasil...!", vbInformation, "data Barang"
Db.BeginTrans
Db.Execute sql, adCmdTable
Db.CommitTrans
Call hapus
Adodc1.Refresh
kode.SetFocus
End Sub
Sub TampilBarang()
On Error Resume Next
kode.Text = rs!kode
nama.Text = rs!nama
harga.Text = rs!harga
End Sub
FORM CLIENT
sebelum di comfile atau di f5
setelah di comfile atau di f5
Listing Module
Public SQL As String
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 Program Client
Dim IPServer As String
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 Barang(Kode,Nama,Harga)" & _
"values('" & Kode.Text & _
"','" & Nama.Text & _
"','" & Harga.Text & "')"
Case 1
SQL = "UPDATE Barang Set Nama='" & Nama.Text & "'," & _
"Harga='" & Harga.Text & "'," & _
"where Kode='" & Kode.Text & "'"
Case 2
SQL = " DELETE FROM Barang WHERE Kode='" & Kode.Text & "'"
End Select
MsgBox "Pemrosesan RECORD Database telah berhasil....!", vbInformation, "Data Barang"
Call Hapus
Kode.SetFocus
End Sub
Sub MulaiKoneksi()
IPServer = "127.0.0.1"
IPClient = WS.LocalIP
WS.Connect IPServer, 1000
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents
End
End Sub
Private Sub Kode_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Kode.Text = "" Then Exit Sub
WS.SendData "SEARCH-" & Kode.Text
End If
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
SQL = "INSERT INTO Barang(Kode,Nama,Harga) " & _
"values('" & Kode.Text & _
"','" & Nama.Text & _
"','" & Harga.Text & "')"
WS.SendData "INSERT-" & SQL
Else
SQL = "UPDATE Barang Set " & _
"nama='" & Nama.Text & _
"',harga='" & Harga.Text & _
"' where kode = '" & Kode.Text & "'"
WS.SendData "UPDATE-" & SQL
End If
Call Hapus
Kode.SetFocus
Case 2
X = MsgBox("Yakin RECORD Barang Akan Dihapus.....!", vbQuestion + vbYesNo, "Barang")
If X = vbYes Then
WS.SendData "DELETE-" & Kode.Text
End If
Call Hapus
Kode.SetFocus
Case 3
Call Hapus
Kode.SetFocus
Case 4
Unload Me
End Select
End Sub
Private Sub Form_Load()
Call Hapus
MulaiKoneksi
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, vbString, bytesTotal
xData1 = Split(xKirim, "-")
xData2 = Split(xData1(1), "/")
Select Case xData1(0)
Case "NOTHING"
X = Kode.Text
Call Hapus
Kode.Text = X
Call RubahCMD(Me, False, True, False, True)
CmdProses(1).Caption = "&Simpan"
Nama.SetFocus
Case "RECORD"
xData2 = Split(xData1(1), "/")
Nama.Text = xData2(0)
Harga.Text = xData2(1)
Call RubahCMD(Me, False, True, True, True)
CmdProses(1).Caption = "&Edit"
Kode.Enabled = False
Nama.SetFocus
Case "INSERT"
MsgBox "Penyimpanan Berhasil!"
Call Hapus
Case "DEL"
MsgBox "Penghapusan Data Berhasil!"
Call Hapus
Case "EDIT"
MsgBox "Pengeditan Record Berhasil!"
Call Hapus
End Select
End Sub
Slots by Pragmatic Play - AprCasino
ReplyDeletePragmatic Play. Pragmatic Play. Pragmatic 출장샵 Play. Slot Machine. https://septcasino.com/review/merit-casino/ The Dog House. kadangpintar Slots. Wild West dental implants Gold. Pragmatic Play. Jackpot Party. apr casino