c. setelah itu muncul dialog berikut
Checklist share this folder and allow network hal ini bertujuan untuk memberikan hak accsess kepada komputer client untuk bisa merubah data yang berada pada komputer server. Kemudian klik ok dan akan muncul gambar tangan pada folder yanf sudah di sharingkan.
Kemudian buat database dengan menggunakan Microsoft Accsess dengan field
NO | Field | Type |
1. | Npm | Text |
2. | Nama | Text |
3. | Alamat | Text |
4. | Jurusan | Text |
NO | Npm | Nama | Alamat | Jurusan |
1. | 0023 | Elsa fitri | Katamso | MI |
2 | 00056 | Irlen naibaho | Helvet | MI |
3. | 0089 | Fera yunita | Asrama Haji | MI |
Langkah membuat database Microsoft Office Accsess
Plih blank database dan ketikkan nama database data_buku, cari lokasi untuk penyimpanannya.misalnya di Drive D:
Kemudian klik create
Pilih Design view
Label : ketikkan di caption pada jendela windowpropety disebelah kanan user dan
Password.
Textbox : ketikkan di name pada jendela windowproperty
text 1: user
text2: password
Commanbutton: ketikkan di name dan caption
Name:cmdlogin caption:Login
Name:cmdexit caption:exit
Listing Program:
Private Sub cmdkeluar_Click()
Unload Me
End Sub
Private Sub cmdmasuk_Click()
If user.Text = "fera_yunita" And password.Text = "fera" Then
menu.Show
ElseIf user.Text = "" & password.Text = "" Then
MsgBox "Silahkan Anda Masukkan password untuk Login", vbCritical, "info"
user.SetFocus
Else
MsgBox "Password yang anda inputkan salah", vbCritical, "info"
user.Text = ""
password.Text = ""
End If
End Sub
Private Sub Form_Load()
user.Text = ""
password.Text = ""
password.PasswordChar = "*"
End Sub
Private Sub password_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdmasuk_Click
End If
End Sub
Private Sub user_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If user.Text = "" Then
user.SetFocus
Exit Sub
End If
password.SetFocus
End If
End Sub
2. Tampilan Menu Utama
Untuk membuat menu utama :
1.klik kanan project, add, form, dan enter
2.klik kanan form, menu editor, isikan caption dan file
Caption: File
File :f
Kemudian pilih insert dan tanda panah, isikan kembali
Caption: Pendaftaran Mahasiswa Baru
File :ldb
Kemudian next, begitu seterusnya kemudian klik ok.jadilah menu utama sesuai yang dibutuhkan.
Listing Program menu Utama
Private Sub k_Click()
Unload Me
End Sub
Private Sub ldb_Click()
Pendaftaran.Show
End Sub
3. Tampilan Pendaftaran Mahasiswa Baru
Pendaftaran Mahasiswa Baru terdiri dari Beberapa Field
Tabel Pendaftaran
Nama Database : Pendaftaran
NO | Field | Type |
1. | Npm | Text |
2. | Nama | Text |
3. | Alamat | Text |
4. | Jurusan | Text |
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 data akan dihapus...!", vbQuestion + vbYesNo, "test")
If X = vbYes Then prosesDB 2
Call hapus
npm.SetFocus
Case 3
Call hapus
npm.SetFocus
Case 4
Unload Me
End Select
End Sub
Sub hapus()
npm.Enabled = True
clearform Me
Call rubahcmd(Me, True, False, False, False)
cmdproses(1).Caption = " &Simpan"
End Sub
Private Sub Form_Load()
Call opendb
Call hapus
mulaiserver
End Sub
Sub prosesDB(log As Byte)
Select Case log
Case 0
SQL = "INSERT INTO data(npm,nama,alamat,jurusan)" & _
"values('" & npm.Text & _
"','" & nama.Text & _
"','" & alamat.Text & _
"','" & jurusan.Text & "')"
Case 1
SQL = "UPDATE data SET nama='" & nama.Text & "'," & _
"alamat='" & alamat.Text & "' " & _
"jurusan='" & jurusan.Text & "' " & _
"WHERE npm='" & npm.Text & "'"
Case 2
SQL = "DELETE FROM data WHERE npm='" & npm.Text & "'"
End Select
MsgBox "Pemrosesan record Database telah berhasil....!!", vbInformation, "test"
db.BeginTrans
db.Execute SQL, adCmdTable
db.CommitTrans
Call hapus
Adodc1.Refresh
npm.SetFocus
End Sub
Private Sub npm_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If npm.Text = "" Then
MsgBox "Masukkan npm!", vbInformation, "test"
npm.SetFocus
Exit Sub
End If
SQL = " SELECT * FROM data WHERE npm='" & npm.Text & "'"
If rs.State = adStateOpen Then rs.Close
rs.Open SQL, db, adOpenDynamic, adLockOptimistic
If rs.RecordCount <> 0 Then
tampildata
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
npm.SetFocus
End If
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 = " delete * FROM data " & _
" where npm= '" & xData1(1) & "'"
SQL = "SELECT * FROM data 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!alamat & "/" & rs!jurusan
Else
ws.SendData "NOTHING-DATA"
End If
Case "INSERT"
db.BeginTrans
db.Execute xData1(1), adCmdTable
db.CommitTrans
Adodc1.Refresh
ws.SendData "INSERT-XXX"
Case "UPDATE"
db.BeginTrans
db.Execute xData1(1), adCmdTable
db.CommitTrans
Adodc1.Refresh
ws.SendData "UPDATE-XXX"
Case "DELETE"
SQL = " delete * FROM data " & _
" where npm= '" & xData1(1) & "'"
db.BeginTrans
db.Execute SQL, adCmdTable
db.CommitTrans
Adodc1.Refresh
ws.SendData "DEL-xxx"
End Select
End Sub
4.Tampilan Login
Listing Program FrmLogin
Private Sub Command1_Click()
If user.Text = "ferayunita" And password.Text = "0902123" Then
MDIForm1.Show
ElseIf user.Text = "" & password.Text = "" Then
MsgBox "Silahkan masukkan password login", vbCritical, "info"
user.SetFocus
Else
MsgBox "Password yang anda inputkan salah", vbCritical, "info"
user.Text = ""
password.Text = ""
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
user.Text = ""
password.Text = ""
password.PasswordChar = "*"
End Sub
5.Tampilan MDIform
Listing Program FrmMDI
Private Sub e_Click()
Unload Me
End Sub
Private Sub ldm_Click()
formbarang.Show
End SubCLIENT
Client adalah komputer-komputer yang menerima atau menggunakan fasilitas yang disediakan oleh server.
Sebelum masuk ke form Client, kita harus Login terlebih dahulu.
Inputkan user dan password, kemudian klik masuk.
Berikut ini adalah form Login.
Tampilan listing program login:
Private Sub cmdkeluar_Click()
Unload Me
End Sub
Private Sub cmdmasuk_Click()
If user.Text = "elsa_fitri" And password.Text = "elsa" Then
MDIForm1.Show
ElseIf user.Text = "" & password.Text = "" Then
MsgBox "silahkan masukkan password login", vbCritical, "info"
user.SetFocus
Else
MsgBox "password yang anda inputkan salah", vbCritical, "info"
user.Text = ""
password.Text = ""
End If
End Sub
Private Sub Form_Load()
user.Text = ""
password.Text = ""
password.PasswordChar = "*"
End Sub
Private Sub user_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
password.SetFocus
End If
End Sub
Dan berikut ini adalah tampilan listing program menu utama:
Private Sub e_Click()
Unload Me
End Sub
Private Sub ldb_Click()
client.Show
End Sub
Setelah dipilih Pendaftaran maka akan tampil form client.
Listing Program Form Client
Dim IpServer As String
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 data(npm,nama,alamat,jurusan)" & _
"values('" & npm.Text & _
"','" & nama.Text & _
"','" & alamat.Text & _
"','" & jurusan.Text & "')"
Case 1
SQL = "UPDATE data SET nama='" & nama.Text & "'," & _
"alamat='" & alamat.Text & "' " & _
"jurusan='" & jurusan.Text & "' " & _
"where npm='" & npm.Text & "'"
Case 2
SQL = "DELETE FROM data WHERE npm='" & npm.Text & "'"
End Select
MsgBox "pemrosesan RECORD database telah berhasil...!", vbInformation, "test"
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
Else
SQL = "UPDATE data Set " & _
"nama = '" & nama.Text & _
"alamat = '" & alamat.Text & _
"' , jurusan= '" & jurusan.Text & _
"' where npm= '" & npm.Text & "'"
ws.SendData "UPDATE-" & SQL
End If
Case 2
X = MsgBox("yakin RECORD data akan dihapus...!", vbQuestion + vbYesNo, "test")
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 Form_Load()
Call hapus
mulaikoneksi
End Sub
Sub mulaikoneksi()
IpServer = "192.168.10.1"
IPClient = ws.LocalIP
ws.Connect IpServer, 1000
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents
End
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
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), "/")
npm.Text = xdata2(0)
alamat.Text = xdata2(1)
jurusan.Text = xdata2(2)
Call rubahCMD(Me, False, True, True, True)
cmdproses(1).Caption = "&Edit"
npm.Enabled = False
nama.SetFocus
Case "DEL"
MsgBox "penghapusan data berhasil!"
Call hapus
Case "EDIT"
MsgBox "Pengeditan Record berhasil!"
Call hapus
End Select
End Sub
Listing Program Modul
Public SQL As String
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