Jumat, 20 Januari 2012

SERVER

1.Login

Listing
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

Private Sub Form_Load()
OPENDB
batal
isi

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


2.Tampilan

Listing
Private Sub F2_Click()
End
End Sub

Private Sub Fn1_Click()
Frmahasiswa.Show
End Sub

Private Sub Fn2_Click()
End
End Sub

3.Mahasiswa

Setelahtampilketikkanlah
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 Mahasiswa(NPM, Nama, Jenjang, Jurusan, Alamat)" & _
"values('" &NPM.Text& _
"','" &Nama.Text& _
"','" &Jenjang.Text& _
"','" &Jurusan.Text& _
"','" &Alamat.Text& "')"
Case 1
SQL = "UPDATE Mahasiswa SET Nama='" &Nama.Text& "'," & _
" Jenjang = '" &Jenjang.Text& "'," & _
" Jurusan = '" &Jurusan.Text& "'," & _
" Alamat = '" &Alamat.Text& "' " & _
"where NPM ='" &NPM.Text& "'"
Case 2
SQL = "DELETE FROM Mahasiswa WHERE NPM='" &NPM.Text& "'"
End Select
MsgBox "Pemorosesan record Database telah Berhasil...!",vbInformation, "Data Mahasiswa"
Db.BeginTrans
Db.Execute SQL, adCmdTable
Db.CommitTrans
Call hapus
Adodc1.Refresh
NPM.SetFocus
End Sub
Sub tampilMahasiswa()
On Error Resume Next
NPM.Text = Rs!NPM
Nama.Text = Rs!Nama
Jenjang.Text = Rs!Jenjang
Jurusan.Text = Rs!Jurusan
Alamat.Text = Rs!Alamat
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
Call ProsesDB(0)
Else
Call ProsesDB(1)
End If
Case 2
x = MsgBox("Yakin RECORD NPM Anda Maksud Akan Dihapus...!", vbQuestion + vbYesNo, "Mahasiswa")
If x = vbYes Then ProsesDB 2
Call hapus
NPM.SetFocus
Case 3
Call hapus
NPM.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 NPM_keyPress(keyAscii As Integer)
If keyAscii = 13 Then
If NPM.Text = "" Then
MsgBox "Masukkan NPM!",vbInformation, "Mahasiswa"
NPM.SetFocus
Exit Sub
End If
SQL = "SELECT * FROM Mahasiswa WHERE NPM='" &NPM.Text& "'"
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockBatchOptimistic
If Rs.RecordCount<> 0 Then
tampilMahasiswa
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
Nama.SetFocus
End If
End Sub


Sub MulaiServer()
WS.LocalPort = 1000
WS.Listen
End Sub

Private Sub WS_ConnectionRequest(ByValrequestID As Long)
WS.Close
WS.AcceptrequestID
Me.Caption = "Server-Client" &WS.RemoteHostIP& "Connect"

End Sub

Private Sub WS_DataArrival(ByValbytesTotal As Long)
Dim xKirim As String
Dim xData1() As String
Dim xData2() As String

WS.GetDataxKirim, vdString, bytesTotal
xData1 = Split(xKirim, "-")

Select Case xData1(0)
Case "SEARCH"

SQL = "SELECT*FROM Mahasiswa WHERE NPM='" &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!Nama& "/" &Rs!Jenjangstudi& "/" &Rs!Jurusan& "/" &Rs!Alamat
Else
WS.SendData "NOTHING-xxx"
End If
Case "INSERT"
Db.BeginTrans
Db.ExecutexData1(1), adCmdTable
Db.CommitTrans
WS.SendData "INSERT-xxx"
Adodc1.Refresh
Case "UPDATE"
Db.BeginTrans
Db.ExecutexData1(1), adCmdTable
Db.CommitTrans
WS.SendData "EDIT-xxx"
Adodc1.Refresh
Case "DELETE"
SQL = "Delete * from Mahasiswa " & _
"where NPM='" &xData1(1) & "'"
Db.BeginTrans
Db.Execute SQL, adCmdTable
Db.CommitTrans
Adodc1.Refresh
WS.SendData "DEL-xxx"
End Select
End Sub

Ketikkanlah:
Private Sub F2_Click()
End
End Sub

Private Sub Fn1_Click()
Frmahasiswa.Show
End Sub

Private Sub Fn2_Click()
End
End Sub

Private Sub Label1_Click()

End Sub

Tidak ada komentar:

Posting Komentar