Program Mahasiswa Client & Server

Berikut tampilan-tampilan form nya....

Di bawah listing programnya :

LISTING PROGRAM CLIENT

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,TGL_LAHIR,ALAMAT,PROG_STUDI,JENJANG_STUDI)" & _

        "values('" & NPM.Text & _

        "','" & nama.Text & _

        "','" & TGL_LAHIR.Text & _

        "','" & ALAMAT.Text & _

        "','" & PROG_STUDI.Text & _

        "','" & JENJANG_STUDI.Text & "')"

    Case 1

        SQL = "UPDATE MAHASISWA set nama='" & nama.Text & "'," & _

        "TGL_LAHIR='" & TGL_LAHIR.Text & "', " & _

        "ALAMAT='" & PROG_STUDI.Text & "', " & _

        "PROG_STUDI='" & JENJANG_STUDI.Text & "', " & _

        "JENJANG_STUDI='" & PROG_STUDI.Text & "' " & _

        "where NPM='" & NPM.Text & "'"

    Case 2

        SQL = "DELETE From MAHASISWA where NPM='" & NPM.Text & "'"

    End Select

 MsgBox "Pemrosesan Record Database telah berhasil...!", vbInformation, "Data MAHASISWA"

 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

    SQL = "INSERT INTO MAHASISWA(NPM,nama,TGL_LAHIR,ALAMAT,PROG_STUDI,JENJANG_STUDI)" & _

        "values('" & NPM.Text & _

        "','" & nama.Text & _

        "','" & TGL_LAHIR.Text & _

        "','" & ALAMAT.Text & _

        "','" & PROG_STUDI.Text & _

        "','" & JENJANG_STUDI.Text & "')"

            

        WS.SendData "INSERT-" & SQL

    Else

        SQL = "UPDATE MAHASISWA set nama='" & nama.Text & "'," & _

        "TGL_LAHIR='" & TGL_LAHIR.Text & "', " & _

        "ALAMAT='" & PROG_STUDI.Text & "', " & _

        "PROG_STUDI='" & JENJANG_STUDI.Text & "', " & _

        "JENJANG_STUDI='" & PROG_STUDI.Text & "' " & _

        "where NPM='" & NPM.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-" & NPM.Text

End If

Call Hapus

NPM.SetFocus

    Case 3

    Call Hapus

NPM.SetFocus

    Case 4

    Unload Me

End Select

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

Sub mulaikoneksi()

ipserver = "192.168.10.1"

ipclient = WS.LocalIP

WS.Connect ipserver, 1000

End Sub

Private Sub Form_Load()

Call Hapus

mulaikoneksi

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 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), "/")

nama.Text = xdata2(0)

TGL_LAHIR.Text = xdata2(1)

ALAMAT.Text = xdata2(2)

PROG_STUDI = xdata2(3)

JENJANG_STUDI = xdata2(4)

Call RubahCMD(Me, False, True, True, True)

cmdProses(1).Caption = "&Edit"

NPM.Enabled = False

nama.SetFocus

            

Case "DEL"

MsgBox "Penhapusan Data Berhasil.....!!!"

Call Hapus

Case "EDIT"

MsgBox "Pengeditan Record Berhasil.....!!!"

Call Hapus

Case "INSERT"

MsgBox "Penyimpanan Record Berhasil.....!!!"

Call Hapus

End Select

End Sub

MODUL CLIENT

Public Db As New ADODB.Connection

Public RS As New ADODB.Recordset

Public RS2 As New ADODB.Recordset

Public TCari As 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\UserXP\Desktop\Kode Barang Martin\Server\Database\Mahasiswa.mdb;Persist Security Info=False"

    End Sub

Sub clearform(f As Form)

Dim clt As Control

For Each clt In f

    If TypeOf clt Is TextBox Then clt.Text = ""

    If TypeOf clt Is ComboBox Then clt.Text = ""

    If TypeOf ctl Is MaskEdBox Then ctl.Mask = "##/##/####"

Next

End Sub

Sub center(f As Form)

f.Move (Screen.Width - f.Width) / 2, (Screen.Height - f.Height) / 4

End Sub

Public Sub Ketengah(ByVal Frm As Form)

    Frm.Left = (Menu.Width - Frm.Width) / 2

    Frm.Top = (Menu.Height - Frm.Height) / 2 - 500

    

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

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"

End Select

End Sub

MENU UTAMA CLIENT

Private Sub Mahasiswa_Click()

frmmahasiswa.Show

End Sub

LISTING PROGRAM SERVER

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,TGL_LAHIR,ALAMAT,PROG_STUDI,JENJANG_STUDI)" & _

        "values('" & NPM.Text & _

        "','" & nama.Text & _

        "','" & TGL_LAHIR.Text & _

        "','" & ALAMAT.Text & _

        "','" & PROG_STUDI.Text & _

        "','" & JENJANG_STUDI.Text & "')"

    Case 1

        SQL = "UPDATE MAHASISWA set nama='" & nama.Text & "'," & _

        "TGL_LAHIR='" & TGL_LAHIR.Text & "', " & _

        "ALAMAT='" & PROG_STUDI.Text & "', " & _

        "PROG_STUDI='" & JENJANG_STUDI.Text & "', " & _

        "JENJANG_STUDI='" & PROG_STUDI.Text & "' " & _

        "where NPM='" & NPM.Text & "'"

    Case 2

        SQL = "DELETE From MAHASISWA where NPM='" & NPM.Text & "'"

    End Select

MsgBox "pemrosesan record database telah berhasil....!!", vbInformation, "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

    TGL_LAHIR.Text = RS!TGL_LAHIR

    ALAMAT.Text = RS!ALAMAT

    PROG_STUDI.Text = RS!PROG_STUDI

    JENJANG_STUDI.Text = RS!JENJANG_STUDI

End Sub

Private Sub cmdCari_Click()

Dim cari

ulang:

cari = InputBox("Masukkan Kode Mahasiswa yang akan di cari...", "Cari Kode Mahasiswa")

If cari = "" Then Exit Sub

    Me.MousePointer = 11

    Set TCari = New ADODB.Recordset

        Kata = "Select * from Mahasiswa where [NPM]='" & cari & "'"

        TCari.Open Kata, Db, adOpenDynamic, adLockPessimistic

        If TCari.EOF Then

            TCari.Close

            Set TCari = Nothing

            Me.MousePointer = 1

            MsgBox "Kode Mahasiswa = " & cari & " tidak ditemukan..", vbInformation, ""

            Exit Sub

        End If

            DaftarCari

            TCari.Close

            Set TCari = Nothing

            Me.MousePointer = 1

            cmdproses(1).Enabled = True

            cmdproses(2).Enabled = True

        Me.MousePointer = 1

            

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 MAHASISWA akan di hapus...!", vbQuestion + vbYesNo, "MAHASISWA")

            If X = vbYes Then prosesdb (2)

            Call hapus

            NPM.SetFocus

        Case 3

            Call hapus

            NPM.SetFocus

        Case 4

            Unload Me

        End Select

End Sub

Private Sub Form_Load()

    Ketengah Me

    Call OPENDB

    Call hapus

    mulaiserver

End Sub

Private Sub NPM_KeyPress(KeyAscii As Integer)

    If KeyAscii = 13 Then

        If NPM.Text = "" Then

            MsgBox "masukan NPM MAHASISWA..!", 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, adLockOptimistic

        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(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 = "select*from MAHASISWA 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!TGL_LAHIR & "/" & RS!ALAMAT & "/" & RS!PROG_STUDI & "/" & RS!JENJANG_STUDI

        Else

        WS.SendData "NOTHING-DATA"

        End If

        

        Case "DELETE"

            SQL = "DELETE * From MAHASISWA " & _

            "where NPM='" & 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

            WS.SendData "Edit-xxx"

            Adodc1.Refresh

        Case "INSERT"

            Db.BeginTrans

            Db.Execute xData1(1), adCmdTable

            Db.CommitTrans

            WS.SendData "INSERT-xxx"

            Adodc1.Refresh

        End Select

End Sub

Sub DaftarCari()

    With TCari

        NPM = ![NPM]

        nama = ![nama]

        TGL_LAHIR = ![TGL_LAHIR]

        ALAMAT = ![ALAMAT]

        PROG_STUDI = ![PROG_STUDI]

        JENJANG_STUDI = ![JENJANG_STUDI]

    End With

End Sub

MODUL SERVER

Public Db As New ADODB.Connection

Public RS As New ADODB.Recordset

Public RS2 As New ADODB.Recordset

Public TCari As 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=" & App.Path & _

    "\Database\Mahasiswa.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 = ""

    If TypeOf ctl Is MaskEdBox Then ctl.Mask = "##/##/####"

Next

End Sub

Sub center(f As Form)

    f.Move (Screen.Width - f.Width) / 2, (Screen.Height - f.Height) / 4

End Sub

Public Sub Ketengah(ByVal Frm As Form)

    Frm.Left = (menu.Width - Frm.Width) / 2

    Frm.Top = (menu.Height - Frm.Height) / 2 - 500

    

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

MENU UTAMA SERVER

Private Sub mnuMahasiswa_Click()

frmmahasiswa.Show

End Sub