Jumat, 20 Januari 2012

Program VB Mahasiswa Client & Server

1. From Login
Langkah awal untuk server buat form mahasiswa adalah design form mahasiswa yang sama seperti gambar berikut ;

Setelah Tampil Ketikkanlah
Private Sub cmd_Click(Index As Integer)
Select Case Index
Case 0
If username = "" Then
MsgBox "Silahkan isi password"
batal
username.SetFocus
Else
If password.Text = password.Text Then
Tampilan1.Show
Else
MsgBox "password anda salah"
batal
password.SetFocus
End If
End If
Case 1
batal
End Select
End Sub

Sub batal()
username.Text = ""
password.Text = ""
End Sub

Sub isi()
SQL = "select*from login"
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockOptimistic
If Rs.RecordCount <> 0 Then
Rs.MoveFirst
Do While Not Rs.EOF
Rs.MoveNext
Loop
End If
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub username_Click()
SQL = " select*from login " & _
"where username='" & username.Text & "'"
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockOptimistic
If Rs.RecordCount <> o Then
password.Text = Rs!password
End If
End Sub

Private Sub Form_Load()

End Sub

2. From Mahasiswa

Setelah tampil ketikkanlah
Sub Hapus()
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 Mahasiswa(npm,nama,jenjang,jurusan,alamat)" & _
"values('" & Npm.Text & _
"','" & Nama.Text & _
"','" & Jenjang.Text & _
"','" & jurusan.Text & _
"','" & Alamat.Text & "')"
Case 1
SQL = "UPDATE mahasiswa SET npm='" & Npm.Text & "'," & _
"nama='" & Nama.Text & "'," & _
"jenjang='" & Jenjang.Text & "'," & _
"jurusan='" & jurusan.Text & "'," & _
"where alamat='" & Alamat.Text & "'"
Case 2
SQL = "DELETE FROM mahasiswa WHERE npm='" & Npm.Text & "'"
End Select
MsgBox "Pemprosesan RECORD Database telah berhasil...!", vbInformation, "mahasiswa"
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 mahasiswa(npm, nama, jurusan, jenjang, alamat)" & _
"values('" & Npm.Text & _
"','" & Nama.Text & _
"','" & Jenjang.Text & _
"','" & jurusan.Text & _
"','" & Alamat.Text & "')"
WS.SendData "INSERT-" & SQL

Else
SQL = "UPDATE mahasiswa set " & _
"alamat= '" & Alamat.Text & _
"',npm='" & Npm.Text & _
"',jurusan='" & jurusan.Text & _
"',jenjang='" & Jenjang.Text & _
"' where nama='" & Nama.Text & "'"
WS.SendData "UPDATE-" & SQL

End If
Case 2
X = MsgBox("Yakin RECORD mahasiswa Akan Dihapus...!", vbQuestion + vbYesNo, "mahasiswa")
If X = vbYes Then
WS.SendData "DELETE-" & Nama.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 Nama.Text = "" Then Exit Sub
WS.SendData "SEARCH-" & Nama.Text
End If
End Sub
Sub MulaiKoneksi()
IPServer = "192.168.10.1"
IPClient = "192.168.10.2"
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 = Npm.Text
Call Hapus
Npm.Text = X
Call RubahCMD(Me, False, True, False, True)
CmdProses(1).Caption = "&Simpan"
kode.Enabled = Me
Case "RECORD"
xData2 = Split(xData1(1), "/")
Nama.Text = xData2(0)
Jenjang.Text = xData2(1)
jurusan.Text = xData2(2)
Alamat.Text = xData2(3)
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

3. Menu Atau From Tampil

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

Tidak ada komentar:

Posting Komentar