Belajar Pemograman Yuuk (VB 6.0, SQL Server, PostgreSQL, PHP)

Source Code For Maintenance User

Dim Cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset

Private Sub Check1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
SendKeys vbTab
End If

End Sub

Private Sub Check2_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
SendKeys vbTab
End If

End Sub

Private Sub Check3_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
SendKeys vbTab
End If

End Sub

Private Sub CmdBatal_Click()

Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True

Check1.Enabled = True
Check2.Enabled = True
Check3.Enabled = True

Call Kosong

CmdHapus.Enabled = False
CmdBatal.Enabled = False
CmdSimpan.Enabled = False

End Sub

Private Sub CmdFind_Click()
Dim SintakSQL As String

If Combo1.Text = "All Record" Then
Cnn.BeginTrans

SintakSQL = "Select * From members "
Set rs = Cnn.Execute(SintakSQL)

i = 1
'tidak diperkenankan ada kosong

Do While Not rs.EOF
'Field Kosong Diabaikan dengan menggunakan perintah
'On error resume next
On Error Resume Next
Set Item = ListView1.ListItems.Add(i, , rs!member)
ListView1.ListItems(Rec + 1).Bold = True
ListView1.ListItems(Rec + 1).ForeColor = vbRed
Item.SubItems(1) = rs!sandi
Item.SubItems(2) = rs!m1
Item.SubItems(3) = rs!m2
Item.SubItems(4) = rs!m3
rs.MoveNext
Loop
Cnn.CommitTrans
Set rs = Nothing
Else
If Text4.Text <> "" Then
Cnn.BeginTrans

SintakSQL = "Select * from members Where ID Like'" & Text4.Text & "'"
Set rs = Cnn.Execute(SintakSQL)

i = 1
'tidak diperkenankan ada kosong

Do While Not rs.EOF
'Field Kosong Diabaikan dengan menggunakan perintah
'On error resume next
On Error Resume Next
Set Item = ListView1.ListItems.Add(i, , rs!member)
ListView1.ListItems(Rec + 1).Bold = True
ListView1.ListItems(Rec + 1).ForeColor = vbRed
Item.SubItems(1) = rs!sandi
Item.SubItems(2) = rs!m1
Item.SubItems(3) = rs!m2
Item.SubItems(4) = rs!m3
rs.MoveNext
Loop

If rs.EOF Then
MsgBox "User tidak ditemukan !!!", vbInformation + vbOKOnly, "Perhatian"
CmdFindAnother_Click
End If
Cnn.CommitTrans
End If
End If
End Sub

Private Sub CmdFindAnother_Click()

ListView1.ListItems.Clear
Combo1.Text = ""
Text4.Text = ""
Combo1.SetFocus

End Sub

Private Sub CmdHapus_Click()
Dim SintakSQL As String
Dim Konfirmasi As String

If Text1.Text <> "" And Text1.Enabled = False Then

Cnn.BeginTrans

Konfirmasi = MsgBox("Apakah Anda yakin akan menghapus Record ini ???", vbYesNo + vbCritical, "Konfirmasi")
If Konfirmasi = vbYes Then

'Menghapus record pada tabel user
SintakSQL = " Delete from members " & _
" where member='" & Text1.Text & "'"

'Mengeksekusi perintah SQL
Cnn.Execute (SintakSQL)

Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True

Check1.Enabled = True
Check2.Enabled = True
Check3.Enabled = True

Call Kosong

CmdHapus.Enabled = False
CmdBatal.Enabled = False
CmdSimpan.Enabled = False
CmdTambah.Enabled = False

Cnn.CommitTrans
actifitas = Replace(SintakSQL, "'", "`", 1, -1)
SintakSQL = " insert into Activity (sandi, activity) values ('" & namauser & "','" & actifitas & "')"
Cnn.Execute (SintakSQL)
End If
End If

End Sub

Private Sub CmdRubah_Click()
'Buka TextBox
Text2.Enabled = True
Text3.Enabled = True

Check1.Enabled = True
Check2.Enabled = True
Check3.Enabled = True

CmdSimpan.Enabled = True
CmdSimpan.Caption = "Update"
CmdBatal.Enabled = True
CmdHapus.Enabled = False
CmdTambah.Enabled = False

End Sub

Private Sub CmdSelesai_Click()
Cnn.Close
Set Cnn = Nothing
Unload Me
End Sub

Private Sub CmdSimpan_Click()
Dim SintakSQL As String
If CmdSimpan.Caption = "Simpan" Then

If Text1.Text <> "" And Text1.Enabled = True Then
'Menambah Record pada tabel user
SintakSQL = " Insert into members (member, sandi, m1, m2, m3) " & _
" Values('" & Text1.Text & "','" & Text2.Text & "', " & _
" " & Check1.Value & "," & Check2.Value & "," & _
" " & Check3.Value & ")"

'Mengeksekusi perintah SQL
Cnn.Execute (SintakSQL)
CmdSimpan.Enabled = False
CmdRubah.Enabled = True

actifitas = Replace(SintakSQL, "'", "`", 1, -1)
SintakSQL = " insert into Activity (sandi, activity) values ('" & namauser & "','" & actifitas & "')"
Cnn.Execute (SintakSQL)
End If
Else

'Mengupdate Record pada tabel user
'Mengubah record pada tabel

SintakSQL = " Update members Set " & _
" Password='" & Text2.Text & "'," & _
" m1=" & Check1.Value & "," & _
" m2=" & Check2.Value & "," & _
" m3=" & Check3.Value & "" & _
" Where ID='" & Text1.Text & "'"
'Mengeksekusi perintah SQL
Cnn.Execute (SintakSQL)
CmdSimpan.Enabled = False
CmdRubah.Enabled = True
CmdSimpan.Caption = "Simpan"

actifitas = Replace(SintakSQL, "'", "`", 1, -1)
SintakSQL = " insert into Activity (sandi, activity) values ('" & namauser & "','" & actifitas & "')"
Cnn.Execute (SintakSQL)
End If

Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False

Check1.Enabled = False
Check2.Enabled = False
Check3.Enabled = False

CmdBatal.Enabled = False
CmdTambah.Enabled = True
CmdHapus.Enabled = True

End Sub

Private Sub CmdTambah_Click()

Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True

Check1.Enabled = True
Check2.Enabled = True
Check3.Enabled = True

Call Kosong

CmdHapus.Enabled = False
CmdBatal.Enabled = False
CmdSimpan.Enabled = False
CmdTambah.Enabled = False
Text1.SetFocus

End Sub

Private Sub Form_Load()
'Membuat Sebuah Koneksi
Set Cnn = New ADODB.Connection

With Cnn
.ConnectionString = "provider=SQLOLEDB;" & _
"Data Source=10.11.12.56,1433/Kenari;initial Catalog=Pulsa;" & _
"Trusted Connection=yes; User ID=pulsa; Password=Pulsa123"
.Open
End With

Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open "members", Cnn

AturListView "User ID", 25, "Password", 25, _
"m1", 10, "m2", 10, "m3", 10

CmdSimpan.Enabled = False
CmdHapus.Enabled = False
CmdBatal.Enabled = False
CmdRubah.Enabled = False

Me.Top = (Main.ScaleHeight - Me.ScaleHeight) / 2
Me.Left = (Main.ScaleWidth - Me.ScaleWidth) / 2

Combo1.AddItem "All Record"
Combo1.AddItem "User ID"

End Sub

Private Sub ListView1_Click()
Dim SintakSQL As String
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.Open "members", Cnn

SintakSQL = "select member from members where member='" & ListView1.SelectedItem & "'"

Set rs = Cnn.Execute(SintakSQL)

SSTab1.Tab = 0
Text5.Text = ListView1.SelectedItem.Index
On Error Resume Next
Text1.Enabled = False
Text1.Text = rs!member
Text2.Text = ListView1.SelectedItem.ListSubItems.Item(1)
Check1.Value = ListView1.SelectedItem.ListSubItems.Item(2)
Check2.Value = ListView1.SelectedItem.ListSubItems.Item(3)
Check3.Value = ListView1.SelectedItem.ListSubItems.Item(4)

CmdSimpan.Enabled = False
CmdRubah.Enabled = True
CmdBatal.Enabled = True
CmdTambah.Enabled = False
CmdHapus.Enabled = True

End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
If SSTab1.Caption = "List User" Then
AturListView "User ID", 20, "Password", 20, _
"Master", 10, "Pengaturan", 20, "Bantuan", 20

End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
SendKeys vbTab
End If

End Sub

Private Sub Text1_LostFocus()
Dim SintakSQL As String

If Text1.Text <> "" Then

Cnn.BeginTrans

'Mencari record ID pada tabel user
SintakSQL = " Select * From members " & _
" Where member='" & Text1.Text & "'"

Set rs = Cnn.Execute(SintakSQL)

'Jika ID Sudah Ada
If Not rs.EOF Then
MsgBox "User ID sudah Ada !", vbOKOnly + vbInformation, "Duplikasi ID"

Text2.Text = rs!sandi
Check1.Value = rs!m1
Check2.Value = rs!m2
Check3.Value = rs!m3

Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False

Check1.Enabled = False
Check2.Enabled = False
Check3.Enabled = False
CmdTambah.Enabled = True
CmdHapus.Enabled = True
CmdRubah.Enabled = True
Else

CmdSimpan.Enabled = True
CmdBatal.Enabled = True

End If

rs.Close

Cnn.CommitTrans

End If

End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
SendKeys vbTab
End If

End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
SendKeys vbTab
End If

End Sub

Private Sub Text3_LostFocus()

'Mengecek password sama dengan konfirmasi
If Text2.Text <> "" Then
If Text2.Text <> Text3.Text Then
MsgBox "Password tidak sama", vbOKOnly + vbCritical, "Salah Password"
End If
End If

End Sub

Sub Kosong()

Text1.Text = ""
Text2.Text = ""
Text3.Text = ""

Check1.Value = 0
Check2.Value = 0
Check3.Value = 0

End Sub

Public Sub AturListView(ParamArray lstView())
Dim i, Lebar

ListView1.View = lvwReport
Lebar = ListView1.Width - 80
With ListView1.ColumnHeaders
.Clear
For i = 0 To UBound(lstView) - 1 Step 2
.Add , , lstView(i), (lstView(i + 1) _
* Lebar) / 100
Next i
End With
Exit Sub
End Sub