Minggu, 29 Januari 2012 0 komentar


LISTING PROGRAM SERVER

Dim ClientIndex As Byte
Dim cRequest As Integer
Dim cData As String
Dim i As Integer
Dim iGD As Integer
Sub MulaiServer()
WS(0).LocalPort = 3000
WS(0).Listen
cRequest = 1
ClientIndex = 1
End Sub
Private Sub Form_Load()
MulaiServer
GD.Rows = 41
For i = 1 To 40
GD.Col = 0
GD.Row = i
GD.Text = i
Next i
iGD = 1
End Sub
Private Sub Timer1_Timer()
For i = 1 To GD.Rows - 1
GD.Row = i
GD.Col = 4
If GD.Text = "START" Then
GD.Col = 3
GD.Text = Time
End If
Next i
End Sub

Private Sub Timer2_Timer()
WS.SendData "PAKAI-" & Pakai.Value & "/" & 3000
End Sub
Private Sub WS_ConnectionRequest(index As Integer, ByVal requestID As Long)
Load WS(cRequest)
WS(cRequest).Close
WS(cRequest).Accept requestID
cRequest = cRequest + 1 '
Timer1.Enabled = True
Timer2.Enabled = True
End Sub
Private Sub WS_DataArrival(index As Integer, ByVal bytesTotal As Long)
WS(index).GetData cData, vbString, bytesTotal
Call CekData(index)
End Sub
Sub CekData(index)
Dim kata() As String
kata = Split(cData, "-")
Select Case kata(0)
Case "START"
GD.Row = iGD
GD.Col = 1
GD.Text = kata(1) 'WS(index).RemoteHostIP
GD.Col = 2
GD.Text = Time
GD.Col = 4
GD.Text = "START"
GD.Col = 5
GD.Text = kata(2)
iGD = iGD
Case "STOP"
For i = 1 To GD.Rows - 1
GD.Row = i
GD.Col = 1
If GD.Text = kata(1) Then
GD.Col = 4
GD.Text = "STOP"
End If
Next i
End Select
End Sub

Private Sub WS_Error(index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
WS(index).Close
End Sub


BERIKUT ADALAH HASIL PROGRAM SERVER


LISTING PROGRAM CLIENT
Dim IPS As String
Dim user As String
Dim xpakai As String
Dim xkirim As String
Dim xData1() As String
Dim xData2() As String
Private Sub Form_Load()
IPS = "127.0.0.1"
user = ws.LocalIP
ws.Connect IPS, 3000
End Sub
Private Sub start_Click()
ws.SendData "START-" & user & "-FERA UINITA"
End Sub
Private Sub stop_Click()
ws.SendData "STOP-" & user
End Sub
Private Sub Timer1_Timer()
mulai.Value = Format(Now, "HH:MM:SS")
Timer1.Enabled = True
End Sub
Private Sub Timer2_Timer()
pakai.Value = Format(Now, "HH:MM:SS")
Timer2.Enabled = True
Private Sub WS_DataArrival(ByVal bytesTotal As Long)
ws.GetData xkirim, vbString, bytesTotal
Call CheckData
End Sub
Sub CheckData()
xData1 = Split(xkirim, "-")
xData2 = Split(xData1(1), "/")
Select Case xData1(0)
Case "PAKAI"
mulai.Value = xData2(0)
selesai.Value = xData2(1)
pakai.Value = xData2(2)
biaya.Text = (Val(Hour(pakai.Value) * 60) + Val(Minute(pakai.Value) * 50))
End Select
End Sub

HASIL PROGRAM CLIENT:



Sabtu, 28 Januari 2012 0 komentar
JAWABAN NO 2 (FERA YUNITA)

SERVER



MOULE

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:\Documents and Settings\Administrator\My Documents\belajar server\test2.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

BERIKUT INI ADALAH FORM SERVER




LISTING PROGRAM SERVER

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 4
    Unload Me
End Select
End Sub

Sub hapus()
kode.Enabled = True
clearform Me
Call rubahcmd(Me, True, False, False, False)
cmdproses(1).Caption = " &Simpan"
End Sub

Private Sub Form_Load()
Call opendb
Call hapus
mulaiserver
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



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, adLockOptimistic
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, vbString, bytesTotal

xData1 = Split(xkirim, "-")
Select Case xData1(0)
    Case "SEARCH"
    SQL = " delete * FROM barang " & _
    " where kode= '" & xData1(1) & "'"
    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"
   
    Case "EDIT"
   
    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
   End Select
End Sub


BERIKUT INI ADALAH HASIL TAMPILAN SERVER


CLIENT


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=C:\Documents and Settings\Administrator\My Documents\belajar server\test2.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

BERIKUT INI ADALAH FORM CLIENT

LISTING PROGRAM CLIENT

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 4
    Unload Me
End Select
       
End Sub

Sub hapus()
kode.Enabled = True
clearform Me
Call rubahcmd(Me, True, False, False, False)
cmdproses(1).Caption = " &Simpan"
End Sub


Private Sub Form_Load()
Call opendb
Call hapus
mulaiserver
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


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, adLockOptimistic
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, vbString, bytesTotal

xData1 = Split(xkirim, "-")
Select Case xData1(0)
    Case "SEARCH"
    SQL = " delete * FROM barang " & _
    " where kode= '" & xData1(1) & "'"
    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"
   
    Case "EDIT"
   
    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
   End Select
End Sub

BERIKUT INI ADALAH FORM CLIENT
JAWABAN NO 2 (FERA YUNITA)

 
Kamis, 19 Januari 2012 0 komentar

PENDAFTARAN MAHASISWA BARU

 
c. setelah itu muncul dialog berikut
 

Checklist share this folder and allow network hal ini bertujuan untuk memberikan hak accsess kepada komputer client untuk bisa merubah data yang berada pada komputer server. Kemudian klik ok dan akan muncul gambar tangan pada folder yanf sudah di sharingkan.
Kemudian buat database dengan menggunakan Microsoft Accsess dengan field 

NO
Field
Type
1.
Npm
Text
2.
Nama
Text
3.
Alamat
Text
4.
Jurusan
Text
  Isikan data:

NO
Npm
Nama
Alamat
Jurusan
1.
0023
Elsa fitri
Katamso
MI
2
00056
Irlen naibaho
Helvet
MI
3.
0089
Fera yunita
Asrama Haji
MI
 
Langkah membuat database Microsoft Office Accsess

1.buka Microsoft Office Accsess
 Plih blank database dan ketikkan nama database data_buku, cari lokasi untuk penyimpanannya.misalnya di Drive D:

Kemudian klik create




































Pilih Design view 
Berikut adalah tampilan form Login server beserta Listing Program :


Label : ketikkan di caption pada jendela windowpropety disebelah kanan user dan
Password.
Textbox : ketikkan di name pada jendela windowproperty
text 1: user
text2: password
Commanbutton: ketikkan di name dan caption
Name:cmdlogin caption:Login
Name:cmdexit caption:exit

Listing Program:
Private Sub cmdkeluar_Click()
Unload Me
End Sub

Private Sub cmdmasuk_Click()
If user.Text = "fera_yunita" And password.Text = "fera" Then
menu.Show
ElseIf user.Text = "" & password.Text = "" Then
MsgBox "Silahkan Anda Masukkan password untuk Login", vbCritical, "info"
user.SetFocus
Else
MsgBox "Password yang anda inputkan salah", vbCritical, "info"
user.Text = ""
password.Text = ""
End If
End Sub

Private Sub Form_Load()
user.Text = ""
password.Text = ""
password.PasswordChar = "*"
End Sub

Private Sub password_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdmasuk_Click
End If
End Sub

Private Sub user_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If user.Text = "" Then
user.SetFocus
Exit Sub
End If
password.SetFocus
End If
End Sub

2. Tampilan Menu Utama


Untuk membuat menu utama :

1.klik kanan project, add, form, dan enter

2.klik kanan form, menu editor, isikan caption dan file
Caption: File
File :f
Kemudian pilih insert dan tanda panah, isikan kembali
Caption: Pendaftaran Mahasiswa Baru
File :ldb
Kemudian next, begitu seterusnya kemudian klik ok.jadilah menu utama sesuai yang dibutuhkan.
Listing Program menu Utama
Private Sub k_Click()
Unload Me
End Sub
Private Sub ldb_Click()
Pendaftaran.Show
End Sub

3. Tampilan Pendaftaran Mahasiswa Baru




Pendaftaran Mahasiswa Baru  terdiri dari Beberapa Field
Tabel Pendaftaran
Nama Database : Pendaftaran
NO
Field
Type
1.
Npm
Text
2.
Nama
Text
3.
Alamat
Text
4.
Jurusan
Text
Private Sub cmdproses_Click(Index As Integer)
Select Case Index

    Case 0
        Call hapus
        npm.SetFocus
    Case 1
        If cmdproses(1).Caption = "&Simpan" Then
            Call prosesDB(0)
        Else
            Call prosesDB(1)
        End If
    Case 2
        X = MsgBox("yakin RECORD data akan dihapus...!", vbQuestion + vbYesNo, "test")
        If X = vbYes Then prosesDB 2
        Call hapus
        npm.SetFocus
    Case 3
        Call hapus
        npm.SetFocus
    Case 4
    Unload Me
End Select
End Sub

Sub hapus()
npm.Enabled = True
clearform Me
Call rubahcmd(Me, True, False, False, False)
cmdproses(1).Caption = " &Simpan"
End Sub

Private Sub Form_Load()
Call opendb
Call hapus
mulaiserver
End Sub


Sub prosesDB(log As Byte)
Select Case log
    Case 0
        SQL = "INSERT INTO data(npm,nama,alamat,jurusan)" & _
        "values('" & npm.Text & _
        "','" & nama.Text & _
        "','" & alamat.Text & _
        "','" & jurusan.Text & "')"
    Case 1
        SQL = "UPDATE data SET nama='" & nama.Text & "'," & _
            "alamat='" & alamat.Text & "' " & _
            "jurusan='" & jurusan.Text & "' " & _
            "WHERE npm='" & npm.Text & "'"
    Case 2
        SQL = "DELETE  FROM data WHERE npm='" & npm.Text & "'"
    End Select
MsgBox "Pemrosesan  record Database telah berhasil....!!", vbInformation, "test"
    db.BeginTrans
    db.Execute SQL, adCmdTable
    db.CommitTrans
    Call hapus
    Adodc1.Refresh
    npm.SetFocus
End Sub
Private Sub npm_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    If npm.Text = "" Then
        MsgBox "Masukkan npm!", vbInformation, "test"
        npm.SetFocus
        Exit Sub
End If
SQL = " SELECT * FROM data WHERE npm='" & npm.Text & "'"
If rs.State = adStateOpen Then rs.Close
rs.Open SQL, db, adOpenDynamic, adLockOptimistic
If rs.RecordCount <> 0 Then
    tampildata
    Call rubahcmd(Me, False, True, True, True)
    cmdproses(1).Caption = "&Edit"
    npm.Enabled = False
    Else
        X = npm.Text
        Call hapus
        npm.Text = X
        Call rubahcmd(Me, False, True, False, True)
          cmdproses(1).Caption = "&Simpan"
End If
npm.SetFocus
End If
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, vbString, bytesTotal
xData1 = Split(xkirim, "-")
Select Case xData1(0)

    Case "SEARCH"
    SQL = " delete * FROM data " & _
    " where npm= '" & xData1(1) & "'"
    SQL = "SELECT * FROM data WHERE npm='" & 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!alamat & "/" & rs!jurusan
    Else
        ws.SendData "NOTHING-DATA"
    End If

    Case "INSERT"
        db.BeginTrans
        db.Execute xData1(1), adCmdTable
        db.CommitTrans
        Adodc1.Refresh
        ws.SendData "INSERT-XXX"
    Case "UPDATE"
        db.BeginTrans
        db.Execute xData1(1), adCmdTable
        db.CommitTrans
        Adodc1.Refresh
        ws.SendData "UPDATE-XXX"
    Case "DELETE"
    SQL = " delete * FROM data " & _
    " where npm= '" & xData1(1) & "'"
    db.BeginTrans
    db.Execute SQL, adCmdTable
    db.CommitTrans
    Adodc1.Refresh
    ws.SendData "DEL-xxx"
   End Select
End Sub

4.Tampilan Login

 
Listing Program FrmLogin
Private Sub Command1_Click()
If user.Text = "ferayunita" And password.Text = "0902123" Then
MDIForm1.Show
ElseIf user.Text = "" & password.Text = "" Then
MsgBox "Silahkan masukkan password login", vbCritical, "info"
user.SetFocus
Else
MsgBox "Password yang anda inputkan salah", vbCritical, "info"
user.Text = ""
password.Text = ""
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
            Private Sub Form_Load()
user.Text = ""
password.Text = ""
password.PasswordChar = "*"
End Sub

5.Tampilan MDIform
 
Listing Program FrmMDI
Private Sub e_Click()
Unload Me
End Sub
            Private Sub ldm_Click()
formbarang.Show
End Sub
CLIENT



Client adalah komputer-komputer yang menerima atau menggunakan fasilitas yang disediakan oleh server.

Sebelum masuk ke form Client, kita harus Login terlebih dahulu.
Inputkan user dan password, kemudian klik masuk.
Berikut ini adalah form Login.
Tampilan listing program login:

Private Sub cmdkeluar_Click()
Unload Me
End Sub

Private Sub cmdmasuk_Click()
If user.Text = "elsa_fitri" And password.Text = "elsa" Then
MDIForm1.Show
ElseIf user.Text = "" & password.Text = "" Then
MsgBox "silahkan masukkan password login", vbCritical, "info"
user.SetFocus
Else
MsgBox "password yang anda inputkan salah", vbCritical, "info"
user.Text = ""
password.Text = ""
End If

End Sub

Private Sub Form_Load()
user.Text = ""
password.Text = ""
password.PasswordChar = "*"
End Sub

Private Sub user_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
password.SetFocus
End If
End Sub


Dan berikut ini adalah tampilan listing program menu utama:

Private Sub e_Click()
Unload Me
End Sub

Private Sub ldb_Click()
client.Show
End Sub
Setelah dipilih Pendaftaran maka akan tampil form client. 
Listing Program Form Client

Dim IpServer As String

Sub hapus()
npm.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 data(npm,nama,alamat,jurusan)" & _
"values('" & npm.Text & _
"','" & nama.Text & _
"','" & alamat.Text & _
"','" & jurusan.Text & "')"
Case 1
SQL = "UPDATE data SET nama='" & nama.Text & "'," & _
"alamat='" & alamat.Text & "' " & _
"jurusan='" & jurusan.Text & "' " & _
"where npm='" & npm.Text & "'"
Case 2
SQL = "DELETE FROM data WHERE npm='" & npm.Text & "'"
End Select
MsgBox "pemrosesan RECORD database telah berhasil...!", vbInformation, "test"
Call hapus
npm.SetFocus
End Sub
Private Sub cmdproses_Click(Index As Integer)
Select Case Index
Case 0
Call hapus
npm.SetFocus
Case 1
If cmdproses(1).Caption = " &Simpan" Then
Else
SQL = "UPDATE data Set " & _
"nama = '" & nama.Text & _
"alamat = '" & alamat.Text & _
"' , jurusan= '" & jurusan.Text & _
"' where npm= '" & npm.Text & "'"
ws.SendData "UPDATE-" & SQL
End If
Case 2
X = MsgBox("yakin RECORD data akan dihapus...!", vbQuestion + vbYesNo, "test")
If X = vbYes Then
ws.SendData "DELETE-" & npm.Text
End If
Call hapus
npm.SetFocus
Case 3
Call hapus
npm.SetFocus
Case 4
Unload Me
End Select
End Sub
Private Sub Form_Load()
Call hapus
mulaikoneksi

End Sub
Sub mulaikoneksi()
IpServer = "192.168.10.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 npm_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If npm.Text = "" Then Exit Sub
ws.SendData "SEARCH-" & npm.Text
End If
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, "-")
 Select Case xdata1(0)
 Case "NOTHING"
 X = npm.Text
 Call hapus
 npm.Text = X
 Call rubahCMD(Me, False, True, False, True)
 cmdproses(1).Caption = "&Simpan"
 nama.SetFocus
 Case "RECORD"
 xdata2 = Split(xdata1(1), "/")
 npm.Text = xdata2(0)
 alamat.Text = xdata2(1)
 jurusan.Text = xdata2(2)
 Call rubahCMD(Me, False, True, True, True)
 cmdproses(1).Caption = "&Edit"
 npm.Enabled = False
 nama.SetFocus
 Case "DEL"
 MsgBox "penghapusan data berhasil!"
 Call hapus
 Case "EDIT"
 MsgBox "Pengeditan Record berhasil!"
 Call hapus
 End Select
End Sub
 
Listing Program Modul
  
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
 

 
;