Listing Program Server Dosen

Sub hapus()
NIDN.Enabled = True
clearFORM Me
Call RubahCMD(Me, True, False, False, False)
CmdProses(1).Caption = "&Simpan"
End Sub
Sub ProsesDB(Log As Byte)

al,Pendidikan,Bagian,Status)" & _
"values('" & NIDN.Text & _
"','" & NAMA.Text & _
"','" & TEMPAT.Text & _
"','" & TANGGAL.Text & _
"','" & PENDIDIKAN.Text & _
"','" & BAGIAN.Text & _
"','" & STATUS.Text & "')"
Case 1
SQL = "UPDATE Dosen SET Nama='" & NAMA.Text & "'," & _
" Tempat = '" & TEMPAT.Text & "' " & _
" Tanggal = '" & TANGGAL.Text & "' " & _
" Pendidikan = '" & PENDIDIKAN.Text & "' " & _
" Bagian = '" & BAGIAN.Text & "' " & _
" Status = '" & STATUS.Text & "' " & _
"where NIDN ='" & NIDN.Text & "'"
Case 2
SQL = "DELETE FROM Dosen WHERE NIDN='" & NIDN.Text & "'"
End Select
MsgBox "Pemorosesan record Database telah Berhasil...!", vbInformation, "Data Dosen"
Db.BeginTrans
Db.Execute SQL, adCmdTable
Db.CommitTrans
Call hapus
Adodc1.Refresh
NIDN.SetFocus
End Sub
Sub tampilDosen()
On Error Resume Next
NIDN.Text = Rs!NIDN
NAMA.Text = Rs!NAMA
TEMPAT.Text = Rs!TEMPAT
TANGGAL.Text = Rs!TANGGAL
PENDIDIKAN.Text = Rs!PENDIDIKAN
BAGIAN.Text = Rs!BAGIAN
STATUS.Text = Rs!STATUS
End Sub

Private Sub CMDproses_click(index As Integer)
Select Case index
Case 0
Call hapus
NIDN.SetFocus
Case 1
If CmdProses(1).Caption = "&Simpan" Then
Call ProsesDB(0)
Else
Call ProsesDB(1)
End If
Case 2
x = MsgBox("Yakin RECORD Dosen Akan Dihapus...!", vbQuestion + vbYesNo, "Dosen")
If x = vbYes Then ProsesDB 2
Call hapus
NIDN.SetFocus
Case 3
Call hapus
NIDN.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
BAGIAN.AddItem "HRD"
BAGIAN.AddItem "Humas"
BAGIAN.AddItem "Keuangan"

PENDIDIKAN.AddItem "Diploma III"
PENDIDIKAN.AddItem "Strata I"
PENDIDIKAN.AddItem "Strata II"

STATUS.AddItem "Menikah"
STATUS.AddItem "Belum MENIKAH"
End Sub
Private Sub NIDN_keyPress(keyAscii As Integer)
If keyAscii = 13 Then
If NIDN.Text = "" Then
MsgBox "Masukkan NIDN Dosen!", vbInformation, "Dosen"
NIDN.SetFocus
If NIDN.Text = "" Then
MsgBox "NIDN Harus 6 Digit!", vbInformation, "Dosen"
NIDN.SetFocus
End If

Exit Sub
End If
SQL = "SELECT * FROM Dosen WHERE NIDN='" & NIDN.Text & "'"
If Rs.State = adStateOpen Then Rs.Close
Rs.Open SQL, Db, adOpenDynamic, adLockBatchOptimistic
If Rs.RecordCount <> 0 Then
tampilDosen
Call RubahCMD(Me, False, True, True, True)
CmdProses(1).Caption = "&Edit"
NIDN.Enabled = False
Else
x = NIDN.Text
Call hapus
NIDN.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
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 Dosen WHERE NIDN='" & 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!TEMPAT & "/" & Rs!TANGGAL
Else
WS.SendData "NOTHING-xxx"
End If
Case "INSERT"
Db.BeginTrans
Db.Execute xData1(1), adCmdTable
Db.CommitTrans
WS.SendData "INSERT-xxx"
Adodc1.Refresh
Case "UPDATE"
Db.BeginTrans
Db.Execute xData1(1), adCmdTable
Db.CommitTrans
WS.SendData "EDIT-xxx"
Adodc1.Refresh
Case "DELETE"
SQL = "Delete * from DOSEN " & _
"where NIDN='" & xData1(1) & "'"
Db.BeginTrans
Db.Execute SQL, adCmdTable
Db.CommitTrans
Adodc1.Refresh
WS.SendData "DEL-xxx"
End Select
End Sub