KARTIKA SITUMORANG

LINK KARTIKA KESOAL QUIS PAK MESRAN

Module server 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=C:\DENNI\db1.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 program 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 "Pemorosesan 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 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 Barang Akan Dihapus...!", vbQuestion + vbYesNo, "Barang") 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 Barang!", vbInformation, "Barang" Kode.SetFocus Exit Sub End If SQL = "SELECT * FROM Barang WHERE Kode='" & Kode.Text & "'" If Rs.State = adStateOpen Then Rs.Close Rs.Open SQL, Db, adOpenDynamic, adLockBatchOptimistic If Rs.RecordCount <> 0 Then tampilBarang 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 Nama.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 Barang WHERE Kode='" & xData1(1) & "'" If Rs.State = adStateOpen Then Rs.Close Rs.Open SQL, Db, adOpenDynamic, adLockOptimistic If Rs.RecordCount <> 0 Then WS.SendData "RECORD-" & Rs!Nama & "/" & Rs!Harga Else WS.SendData "NOTHING-DATA" End If Case "INSERT" SQL = "INSERT*from barang" & _ Db.BeginTrans Db.Execute xData1(1), adCmdTable Db.CommitTrans WS.SendData "SIMPAN - xxx" Adodc1.Refresh Case "DELETE" SQL = "Delete*from barang" & _ " where kode='" & xData1(1) & "'" Db.BeginTrans Db.Execute SQL, adCmdTable Db.CommitTrans Adodc1.Refresh WS.SendData "DEL-xxx" Case "UPDATE" Db.BeginTrans Db.Execute xData1(1), adCmdTable Db.CommitTrans WS.SendData "EDIT - XXX" Adodc1.Refresh End Select End Sub Module client 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 "Pemprosesan RECORD Database telah berhasil...!", vbInformation, "Barang" Call Hapus Kode.SetFocus 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 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 Kode_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If Kode.Text = "" Then Exit Sub WS.SendData "SEARCH-" & Kode.Text End If End Sub Sub MulaiKoneksi() IPServer = "l27.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 WS_Dataarrival(ByVal bytesTotal As Long) Dim xkrim As String Dim xData1() As String Dim xData2() As String WS.GetData xkirim, vbString, bytesTotal xData1 = Split(xkirim, "-") 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 "DEL" MsgBox "penghapusan data berhasil !" Call Hapus Case "EDIT" MsgBox "pengeditan record berhasil !" Call Hapus End Select End Sub