Rabu, 18 Januari 2012

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)
    Select Case Log
    Case 0
        SQL = "INSERT INTO Dosen(NIDN, Nama, Tempat,Tanggal,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


Tidak ada komentar:

Posting Komentar