Showing posts with label Database. Show all posts
Showing posts with label Database. Show all posts

Monday, July 29, 2013

VB6 Database: Listview Code Generator Source Code

Tools VB6 Add-Ins yang satu ini digunakan untuk mengenerate source code listview untuk berinteraksi dengan database. Cara menggunakan:

  • Registrasikan terlebih dahulu komponen VB6 Listview Generator.dll yang terdapat dalam folder bin.
  • Buka project VB6
  • Klik menu Add-Ins >> VB6 Listview Generator, maka akan muncul form seperti di bawah ini:

VB6 Listview Generator
Gambar - VB6 Listview Generator

  • Pilih database apa saja (terserah), seperti gambar di bawah ini :

VB6 Listview Generator - Memilih database
Gambar: VB6 Listview Generator - Memilih database

  • Pilih tabel apa saja (terserah), seperti gambar di bawah ini:

VB6 Listview Generator - Memilih Tabel
VB6 Listview Generator - Memilih Tabel

Pilih ID (sebaiknya AUTO INCREMENT), seperti gambar di bawah ini:

VB6 Listview Generator - Memilih ID
VB6 Listview Generator - Memilih ID

  • Klik tombol Generate Code.
  • Ulangi seluruh langkah di atas sejumlah form listview yang Anda butuhkan.
  • Terakhir, edit manual jika ada kode yang kurang sesuai.
  • Selesai.

Download: VB6 Listview Generator Source Code. 

READ MORE - VB6 Database: Listview Code Generator Source Code

Monday, July 15, 2013

VB6 DataGrid: Multiple Delete (Del Key)

Option Explicit 

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

'-------------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-------------------------------------------------------------------------------

Dim DontResponseErrorTemporary As Boolean

Private Sub DeleteRows(dtGrid As DataGrid)
Dim varBmk As Variant
For Each varBmk In dtGrid.SelBookmarks
Adodc1.Recordset.Bookmark = varBmk
Adodc1.Recordset.Delete
Sleep 5 'miliseconds (as delay multiple delete animations)
dtGrid.Refresh
Next
End Sub

Private Sub DataGrid1_Error(ByVal DataError As Integer, Response As Integer)
If DontResponseErrorTemporary Then
Response = 0
DontResponseErrorTemporary = False
End If
End Sub

Private Sub DataGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDelete Then
If Not DeleteConfirm Then
KeyCode = 0
Exit Sub
End If
DontResponseErrorTemporary = True
Call DeleteRows(DataGrid1)
KeyCode = 0
End If
End Sub

Private Function DeleteConfirm() As Boolean
If MsgBox("Are you sure want to delete this record?", vbQuestion + vbYesNo + vbDefaultButton2, "Delete Confirm") = vbYes Then
DeleteConfirm = True
End If
End Function
READ MORE - VB6 DataGrid: Multiple Delete (Del Key)

VB6 DataGrid: Multiple Selection (Left Mouse Down + SHIFT)

Option Explicit 

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const
VK_SHIFT = &H10
Private LastRow As Long
Private
SelectionCount As Long

'-------------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-------------------------------------------------------------------------------

Private Sub Form_Load()
'load database
With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb;Persist Security Info=False"
.RecordSource = "Select * from [titles]"
.Refresh
.Recordset.MoveFirst
End With
Set DataGrid1.DataSource = Adodc1
End Sub

Private Sub DataGrid1_SelChange(Cancel As Integer)
Call SetSelectionPlusShiftKey(DataGrid1)
End Sub

Private Sub SetSelectionPlusShiftKey(dtGrid As DataGrid)
Dim i As Integer
Dim Direction As Integer
If GetKeyState(VK_SHIFT) < 0 Then
SelectionCount = LastRow - dtGrid.Row
If SelectionCount < 0 Then
Direction = 1
Else
Direction = -1
End If
For i = 0 To SelectionCount Step -Direction
DataGrid1.SelBookmarks.Add (dtGrid.GetBookmark(i))
Next i
Else
LastRow = dtGrid.Row
End If
End Sub

Private Sub Form_Resize()
On Error Resume Next
DataGrid1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub
READ MORE - VB6 DataGrid: Multiple Selection (Left Mouse Down + SHIFT)

Sunday, July 14, 2013

VB6 DataGrid: Multiple Selection (Mouse Down + Mouse Move)

Option Explicit 

Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare Function
SetCapture Lib "user32.dll" (ByVal hwnd As Long) As Long

'-------------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-------------------------------------------------------------------------------

Dim BeginSelect As Boolean
Dim
CurrentRowY As Long

Private Sub DataGrid1_Click()
BeginSelect = False
ReleaseCapture
End Sub

Private Sub Form_Load()
'load database
With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb;Persist Security Info=False"
.RecordSource = "Select * from [titles]"
.Refresh
.Recordset.MoveFirst
End With
Set DataGrid1.DataSource = Adodc1
End Sub

Private Sub RemoveAllSelected()
Dim h As Integer
Dim i As Integer
h = DataGrid1.SelBookmarks.Count
If h = 0 Then Exit Sub
For i = h - 1 To 0 Step -1
DataGrid1.SelBookmarks.Remove i
Next i
End Sub

Private Sub DataGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static t As Integer
Dim Direction As Integer
Dim i As Integer
If BeginSelect Then
SetCapture DataGrid1.hwnd
If CurrentRowY > DataGrid1.RowContaining(Y) Then
Direction = 1
Else
Direction = -1
End If
RemoveAllSelected
For i = CurrentRowY To DataGrid1.RowContaining(Y) Step -Direction
If i = -1 Then
Exit For
End If
DataGrid1.SelBookmarks.Add DataGrid1.RowBookmark(i)
Next
End If
End Sub

Private Sub DataGrid1_SelChange(Cancel As Integer)
If BeginSelect = False Then
Debug.Print DataGrid1.Col
CurrentRowY = DataGrid1.Row
End If
BeginSelect = True
End Sub

Private Sub Form_Resize()
On Error Resume Next
DataGrid1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub

Private Sub ReleaseSelect()
BeginSelect = False
ReleaseCapture
End Sub
READ MORE - VB6 DataGrid: Multiple Selection (Mouse Down + Mouse Move)

Wednesday, December 19, 2012

Membuat Auto Backup Untuk MySQL Menggunakan VB6

Menjelaskan mengenai cara membuat MySQL autobackup dengan menggunakan Visual Basic 6.0 - Hal yang paling ditakuti pada saat bekerjaa dengan database adalah terjadinya kerusakan database, terutama jika aplikasinya merupakan aplikasi yang sensitif (baca: banyak berhubungan dengan uang) sebut saja salah satu diantaranya adalah server pulsa. Kerusakan database bisa disebabkan oleh banyak hal.

Di bawah ini merupakan kode VB6 untuk melakukan autobackup database MySQL:

Option Explicit

Private Sub Form_Load()
tmrIntervalBackup.Interval = 1000 '1 detik
End Sub

Private Sub tmrIntervalBackup_Timer()
Dim intInterval As Integer
intInterval = 10 'menit
If IsTimeNow(dtTimeFirstLoad, intInterval) Then
'Command di bawah ini disesuaikan dengan database Anda!
Shell "cmd /c c:\xampp\mysql\bin\mysqldump.exe -uroot -hlocalhost serverpulsa> " & Chr(34) & App.Path & "\Backup.sql", vbHide
End If
End Sub

Public Function IsTimeNow(FirstLoad As Date, Number As Integer, Optional Interval As String = "n") As Boolean
Dim Different As Integer
Different = DateDiff(Interval, FirstLoad, Now)
If Different > 0 Then
IsTimeNow = ((DateDiff("s", FirstLoad, Now) Mod (Number * 60)) = 0)
End If
End Function
Sedangkan di bawah ini merupakan alternatif lain untuk mengantisifasi kerusakan database dan kerusakan hardisk, dengan cara memisahkan aplikasi utama dan aplikasi pembackup database, disini aplikasi utama hanya bertindak sebagai launcher/trigger untuk menjalankan aplikasi yang diberi nama AutoBackup.EXE, adapun tujuan utamanya agar tidak mengganggu kinerja aplikasi utama terutama jika file MySQL yang dibackup ukurannya cukup/sangat besar. 
Option Explicit

Private Sub Form_Load()
tmrIntervalBackup.Interval = 1000
End Sub

Private Sub tmrIntervalBackup_Timer()
Dim intInterval As Integer
intInterval = 10
If IsTimeNow(dtTimeFirstLoad, intInterval) Then
Shell App.Path & "\AutoBackup.exe"
End If
End Sub

Public Function IsTimeNow(FirstLoad As Date, Number As Integer, Optional Interval As String = "n") As Boolean
Dim Different As Integer
Different = DateDiff(Interval, FirstLoad, Now)
If Different > 0 Then
IsTimeNow = ((DateDiff("s", FirstLoad, Now) Mod (Number * 60)) = 0)
End If
End Function
Aplikasi di bawah ini dipisahkan dengan aplikasi utama, buat project baru, compile dan berinama AutoBackup.EXE
Option Explicit

Private Sub Form_Load()
Me.Visible = False
Dim strBackUpPath As String
strBackUpPath = App.Path & "\Backup"
If Len(Dir(strBackUpPath, vbDirectory)) = 0 Then
MkDir strBackUpPath
End If
'Membutuhkan fungsi Shell And Wait
'Shell "cmd /c c:\xampp\mysql\bin\mysqldump.exe -uroot -hlocalhost serverpulsa> " & Chr(34) & strBackUpPath & "\Backup.sql", vbHide
'Tunggu hingga selesai melakukan backup (Fungsi Shell And Wait)
'Setelah selesai Copy file ke flashdisk, etc menggunakan method FileCopy

'Brah... tiba-tiba harddisknya rusak,
'oh tenang masih ada filenya dan tersimpan baik di flashdik/ekternal hardisk/
'drive d:/drive e:/ drive f:/ ah.. pokoknya dimana saja yang menurut Anda Aman.
Unload Me
End Sub
Demikianlah dua kode untuk melakukan autobackup MySQL yang bisa Anda kembangkan lebih lanjut. Semoga bermanfaat.
READ MORE - Membuat Auto Backup Untuk MySQL Menggunakan VB6

Friday, November 30, 2012

VB6 Database: Koneksi Access 2007 ke VB6

Koneksi VB6 dengan Access 2007: di bawah ini merupakan contoh kode sederhana untuk mengkoneksiakan Access 2007 dengan VB6, Adapun contoh kode untuk mengkoneksikan VB6 dengan Access 2007 adalah sebagai berikut:

Option Explicit

'-----------------------------------------------------------------------------------
' http://khoiriyyah.blogspot.com
'-----------------------------------------------------------------------------------

Dim conn As New ADODB.Connection

Private Sub Command1_Click()
Static i As Integer
i = i + 1
conn.Execute "INSERT INTO tbTest (fdTest)VALUES('Record ke-" & i & "')"
End Sub

Private Sub Form_Load()
If Not OpenAccess2007 Then
MsgBox Err.Description
End If
End Sub

Private Function OpenAccess2007() As Boolean
On Error GoTo ErrHandler
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & App.Path & "\test.accdb;Persist Security Info=False;"
OpenAccess2007 = True
Exit Function
ErrHandler:
End Function

Download: Source Code VB6 - Koneksi Access 2007 ke VB6.

Demikian contoh kode sederhana untuk mengkoneksikan Access 2007 dengan VB6.

Tags: koneksi vb6 dengan access 2007, koneksi access 2007 ke vb6, koneksi vb6 ke access 2007.

READ MORE - VB6 Database: Koneksi Access 2007 ke VB6

Monday, June 25, 2012

Software - Simple SQL Query Tester 2.0 Open Source

Ini merupakan software sederhana untuk menguji connection string beberapa database serta menguji sql query meliputi INSERT, UPDATE, SELECT, DELETE selanjutnya melalui software ini, Anda dapat merubahnya menjadi Visual Basic String dan mengcopy paste pada project yang sedang Anda buat.Selain yang telah dijelaskan, Anda pun dapat mempelajari pembuatan script installer untuk pembuatan file setup, dan beberapa code VB6 yang kebanyakan telah dituliskan pada postingan secara terpisah.

Catatan:

  1. Compile terlebih dahulu menjadi file .exe, karena ada sedikit perbedaan antara design time dan runtime.
  2. Apabila Anda berkeinginan membuat file setup, download terlebih dahulu innosetup installer kemudian klik kanan pada file Application.iss >> compile. maka pada folder output Anda akan mendapati file Query Tester.EXE yang merupakan file setup.
Download: Query Tester (Source Code)
Download: Query Tester (Setup)
READ MORE - Software - Simple SQL Query Tester 2.0 Open Source

Update: My Source Online 2.0 - Online MySQL Database

Rupanya pada versi yang sebelumnya terjadi beberapa kegagalan, diantaranya:
  1. Gagal dalam mengecek koneksi internet, modul yang digunakan adalah -[memeriksa keberadaan koneksi internet]- sehingga selalu terkadang menampilkan pesan error "Mohon maaf, tidak ada koneksi internet".
  2. Gagal dalam meregistrasikan COMDLG32.OCX (CommonDialog ActiveX), kemungkinan masalah versi.
Kedua masalah tersebut telah saya perbaiki, pertama dengan mengganti modul check koneksi internet masalah kedua diatasi dengan cara mengganti COMDLG32.OCX dengan class yang diembed langsung pada aplikasi.

Catatan: karena aplikasi ini tidak dilengkapi dengan file-file runtime (hanya dua ActiveX yang disertakan vbSendMail dan CMAX20.OCX [Syntax Hightlighter]), maka sebaiknya Anda lengkapi dulu runtimenya dan beberapa file untuk mengakses database MySQL, atau Anda rujuk pada link di bawah ini:
  1. Aplikasi Minimarket (menggunakan database MySQL, lengkap beserta file-file runtime yang dibutuhkan)
  2. MySQL ODBC 3.51 Driver
Nah, setelah menjalankan dua file di atas, seharusnya Anda sudah dapat mengakses database MySQL secara online menggunakan VB6.
READ MORE - Update: My Source Online 2.0 - Online MySQL Database

Sunday, June 17, 2012

Custom File Untuk Keperluan Import Database

''Gunakan editor terbaik dari Microsoft yakni Notepad
''Tulis seperti di bawah ini
'1, Description 1 ,1,100.00,3/1/1998
'2, Description 2 ,2,200.00,3/2/1998
'Simpan dengan nama c:\test.txt.

Private Sub Command1_Click()
Dim F As Long, sLine As String, A(0 To 4) As String
Dim db As Database, rs As Recordset
F = FreeFile
Open "c:\test.txt" For Input As F
Set db = CurrentDb
Set db = DBEngine(0).OpenDatabase("biblio.mdb")
On Error Resume Next
db.Execute "DROP TABLE TestImport"
On Error GoTo 0
db.Execute "CREATE TABLE TestImport (ID LONG, [Desc] TEXT (50), " & "Qty LONG, Cost CURRENCY, OrdDate DATETIME)"
Set rs = db.OpenRecordset("TestImport", dbOpenTable)
Do While Not EOF(F)
Line Input #F, sLine
ParseToArray sLine, A()
rs.AddNew
rs(0) = Val(A(0))
rs(1) = A(1)
rs(2) = Val(A(2))
rs(3) = Val(A(3))
rs(4) = CDate(A(4))
rs.Update
Loop
rs.Close
db.Close
Close #F
End Sub

Sub ParseToArray(sLine As String, A() As String)
Dim P As Long, LastPos As Long, I As Long
P = InStr(sLine, ",")
Do While P
A(I) = Mid$(sLine, LastPos + 1, P - LastPos - 1)
LastPos = P
I = I + 1
P = InStr(LastPos + 1, sLine, ",", vbBinaryCompare)
Loop
A(I) = Mid$(sLine, LastPos + 1)
End Sub
READ MORE - Custom File Untuk Keperluan Import Database

Membuat Random Auto Number - DAO

Public Sub CreateRandomAutonumber()
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim f As DAO.field

Set db = CurrentDb
Set td = db.CreateTableDef("Table1")
Set f = td.CreateField("MyAutoNumber")

f.Type = dbLong
f.Attributes = dbAutoIncrField
td.Fields.Append f

Set f = td.CreateField("MyTextField")
f.Type = dbText
td.Fields.Append f
db.TableDefs.Append td
td.Fields("MyAutoNumber").DefaultValue = "GenUniqueID()"
Application.RefreshDatabaseWindow
End Sub
READ MORE - Membuat Random Auto Number - DAO

Contoh CommonDialog - Print Dengan Range Tertentu

Option Explicit

Private Sub Command1_Click()
Dim myDatabase As Database
Dim rsMyTable As Recordset
Dim i As Integer
Dim j As Integer
Dim startpage As Integer

CommonDialog1.Max = 3
CommonDialog1.FromPage = 1
CommonDialog1.ToPage = 3
CommonDialog1.flags = 0
CommonDialog1.ShowPrinter
startpage = CommonDialog1.FromPage

Printer.FontSize = 18

Set myDatabase = OpenDatabase("nwind.mdb")
Set rsMyTable = myDatabase.OpenRecordset("Customers")

rsMyTable.MoveFirst

If (CommonDialog1.flags And cdlPDPageNums) <> 0 Then
MsgBox " Printing pages " & CommonDialog1.FromPage & " to " & CommonDialog1.ToPage
Select Case startpage
Case 1

Case 2
For i = 1 To 42
rsMyTable.MoveNext
Next

Case 3
For i = 1 To 84
rsMyTable.MoveNext
Next
End Select

If startpage <> 0 Then
For j = startpage To CommonDialog1.ToPage
For i = 1 To 42
If rsMyTable.EOF Then Exit For
Text1.Text = Text1.Text & rsMyTable!CompanyName & vbCrLf
Printer.Print rsMyTable!CompanyName
rsMyTable.MoveNext
Next
Printer.NewPage
Next
Printer.EndDoc
End If

ElseIf (CommonDialog1.flags And cdlPDSelection) <> 0 Then

rsMyTable.MoveLast
rsMyTable.MoveFirst
For i = 1 To rsMyTable.RecordCount
Text1.Text = Text1.Text & rsMyTable!CompanyName & vbCrLf
rsMyTable.MoveNext
Next
MsgBox "Select text to be printed"
Else
For i = 1 To rsMyTable.RecordCount
Text1.Text = Text1.Text & rsMyTable!CompanyName & vbCrLf
rsMyTable.MoveNext
Next
Printer.Print Text1.Text
Printer.EndDoc
MsgBox "Printing all pages"
End If
End Sub

Private Sub Command2_Click()
Printer.Print Text1.SelText
Printer.EndDoc
End Sub

Private Sub Form_Load()
Command1.Caption = "Select Printing Option"
Command2.Caption = "Print selected text"
End Sub
READ MORE - Contoh CommonDialog - Print Dengan Range Tertentu

Contoh Mengisi ListView Secara Recursive

Function FirstFileMatch()

Dim strFileName As String
On Error Resume Next

strFileName = Dir(InputBox("Enter a valid path and file name."))
If strFileName = "" Then
FirstFileMatch = FirstFileMatch()
Else
FirstFileMatch = strFileName
End If

End Function

Private Sub Form_Load()
Const strTableQueryName = "Employees"
Dim db As DAO.Database, rst As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset(strTableQueryName, dbOpenDynaset, dbReadOnly)
AddBranch rst:=rst, strPointerField:="ReportsTo", strIDField:="EmployeeID", strTextField:="LastName"
End Sub

Sub AddBranch(rst As Recordset, strPointerField As String, strIDField As String, strTextField As String, Optional varReportToID As Variant)
On Error GoTo errAddBranch
Dim nodCurrent As node, objTree As TreeView
Dim strCriteria As String, strText As String, strKey As String
Dim nodParent As node, bk As String
Set objTree = Me!xTree.object
If IsMissing(varReportToID) Then
strCriteria = strPointerField & " Is Null"
Else
strCriteria = BuildCriteria(strPointerField, rst.Fields(strPointerField).Type, "=" & varReportToID)
Set nodParent = objTree.Nodes("a" & varReportToID)
End If

rst.FindFirst strCriteria
Do Until rst.NoMatch
strText = rst(strTextField)
strKey = "a" & rst(strIDField)
If Not IsMissing(varReportToID) Then
Set nodCurrent = objTree.Nodes.Add(nodParent, tvwChild, strKey, strText)
Else
Set nodCurrent = objTree.Nodes.Add(, , strKey, strText)
End If
bk = rst.Bookmark
AddBranch rst, strPointerField, strIDField, strTextField, rst(strIDField)
rst.Bookmark = bk
rst.FindNext strCriteria
Loop

exitAddBranch:
Exit Sub

errAddBranch:
MsgBox "Can"
Resume exitAddBranch
End Sub
READ MORE - Contoh Mengisi ListView Secara Recursive

Friday, June 8, 2012

VB6 Code - Compact And Repair Database MS Access

Di bawah ini merupakan fungsi untuk mengcompact dan merepair database Microsoft Access. Kegunaan Compact And Repair database untuk menghilangkan secara permanen data-data yang terhapus. Bagaimana Fungsi mengenai Compact And Repair Database MS Access.
Option Explicit 

Private Function
CompactDB(Filename As String) As Boolean
On Error GoTo
ErrHandler

Dim
DC As New DBEngine

Screen.MousePointer = vbHourglass
DC.CompactDatabase Filename, App.Path & "\~database.tmp"
Kill Filename
Name App.Path & "\~database.tmp" As Filename
Screen.MousePointer = vbDefault
CompactDB = True
Exit Function

ErrHandler:

CompactDB = False

End Function
Contoh penggunaan Compact and Repair Database:
Private Sub Command1_Click() 
MsgBox CompactDB(App.Path & "\database.mdb") 'true jika database sukses di compact dan repair
End Sub
READ MORE - VB6 Code - Compact And Repair Database MS Access

Tuesday, May 29, 2012

Fungsi Terbilang Bagaimanakah Membuatnya - Database VB6

Posting yang menjelaskan tentang cara membuat fungsi terbilang - Fungsi terbilang adalah sebuah fungsi yang dapat mengkonversi angka ke dalam kalimat. Sebuah fungsi yang cukup penting, terutama pada saat kita bekerja dengan database. Bagaimanakah cara membuat fungsi terbilang ini:
Option Explicit 

Public Function
Terbilang(x As Double, Optional w = "terlalu besar") As String

Dim t As Double, s As String, b As String, i As Integer, d As Boolean,
letak()
letak = Array("", "ribu ", "juta ", "milyar ", "trilyun ")

If
(x = 0) Then
Terbilang = "nol"
Exit Function
End If

If
(x < 2000) Then d = True

If
(x >= 1E+15) Then
Terbilang = w
Exit Function
End If

For i =
4 To 1 Step -1
t = Int(x / (10 ^ (3 * i)))
If (t > 0) Then
b =
ratusan(t, d)
s = s & b & letak(i)
End If
x = x - t *
(10 ^ (3 * i))
Next

s = s
& ratusan(x, False)
Terbilang = s

End Function

Private Function
ratusan(ByVal y As Double, ByVal f As Boolean) As String
Dim t As Double, b As String, g As String, j As Integer,
a(), p()
a = Array("", "se", "dua ", "tiga ", "empat ", "lima ", "enam ", "tujuh ", "delapan ", "sembilan ")
p = Array("", "puluh ", "ratus ")

For j =
2 To 1 Step -1
t = Int(y / (10 ^ j))
If (t > 0) Then
g =
a(t)
If (j = 1 And t = 1) Then
y = y - t *
10 ^ j
If
(y >= 1) Then
p(j) = "belas "
Else
a(y) = "se"
End If
b = b
& a(y) & p(j)
ratusan = b
Exit Function
Else
b = b
& g & p(j)
End If
End If
y = y - t *
10 ^ j
Next

If
(f = False) Then a(1) = "satu "

b = b
& a(y)
ratusan = b

End Function

Contoh penggunaan fungsi di atas:
Option Explicit 

Private Sub
cmdTerbilang_Click()
txtTerbilang.Text = UCase(Terbilang(Val(txtAngka.Text)))
End Sub

READ MORE - Fungsi Terbilang Bagaimanakah Membuatnya - Database VB6

Kode Ini Efektif Untuk Validasi Empty Text - Database VB6

Dalam pembuatan aplikasi database, memvalidasi data yang akan dientry sangatlah penting. Apakah tujuan utama dari validasi entry tersebut? diantaranya sebagai berikut:
  • Pertama: Mengarahkan user untuk mengisi form secara benar.
  • Kedua: Meminimalisir error yang terjadi
  • Ketiga dan seterusnya : Silakan Anda tambahkan.
Dari sekian banyak validasi entry yang umum digunakan, diantaranya adalah validasi empty text, yang digunakan untuk memeriksa apakah text telah terisi atau belum.

Di bawah merupakan kode yang efektif untuk tujuan di atas (kode ini dilengkapi dengan pesan yang spesifik yang diambil dari caption label):
'Fungsi untuk memvalidasi empty text secara massal disertai dengan 
'warning message yang spesifik, simpan kode ini dalam modul
Public Function IsFilledAll(l As Variant, t As Variant) As Boolean
Dim o As Object
For Each o In t
If
Trim(o.Text) = "" Then
MsgBox "Maaf, informasi " & Replace(l(o.Index).Caption, "&", "") & " tidak boleh dikosongkan", vbInformation + vbOKOnly, "Perhatian"
o.SetFocus
Exit For
Else
IsFilledAll = True
End If
Next
End Function
Contoh penggunaan fungsi di atas:
Option Explicit 
'Simpan kode ini pada form untuk mengecek empty text
Private Sub cmdCheck_click()
If Not IsFilledAll(Label1, Text1) Then Exit Sub 'Check apakah terdapat textbox kosong
'Jika textbox telah diisi maka lanjutkan pada kode berikutnya
MsgBox "Seluruh data telah terisi!", vbInformation, "Terima Kasih"
End Sub
READ MORE - Kode Ini Efektif Untuk Validasi Empty Text - Database VB6

Menampilkan Informasi User Yang Sedang Login

Dalam pembuatan aplikasi database, sangatlah penting untuk mengetahui informasi user yang sedang atau telah login, baik mengenai ID, UserName, tanggal login dan lain sebagainya. Bagaimana implementasinya dalam kode?

Di bawah ini merupakan contoh sederhana dalam mengimplementasikan informasi user yang sedang login.

[Download Project Menampilkan Informasi User Yang Sedang Login]
READ MORE - Menampilkan Informasi User Yang Sedang Login

Wednesday, November 23, 2011

Memahami Bookmark Pada Microsoft ADO

Masing-masing record akan memiliki bookmark. Bookmark itu sifatnya unik (berbeda satu sama lainnya). Bookmark tidak dapat dilihat. Bookmark hanya bisa ditampung dalam datatype variant. Bookmark itu ... dan lain sebagainya.

Di bawah ini merupakan contoh sederhana penggunaan bookmark pada Microsoft ADO:
Download: Contoh Penggunaan Bookmark
READ MORE - Memahami Bookmark Pada Microsoft ADO

ADO Database dan Progress Bar - VB6 Source Code

Umumnya pada saat kita me-load database, seluruh form akan menjadi freeze (beku). Hal ini disebabkan kompiler hanya melakukan satu eksekusi kode dalam satu waktu. Hal ini tentu saja mempengaruhi terhadap splash form (form loading) yang dilengkapi unlimited progress bar. Pada dasarnya progress bar tersebut tidak akan pernah ditampilkan dengan baik. Nah, agar kompiler dapat mengeksekusi 2 kode dalam waktu bersamaan (load database/recordset dan tampilan progress bar) maka load-lah database tersebut menggunakan mode Asyncron. Nah, Asyncron itu adalah kata kuncinya.
READ MORE - ADO Database dan Progress Bar - VB6 Source Code

Sunday, October 23, 2011

Connection String Untuk Mengakses MySQL Online

Sebelum mencoba kode di bawah, Anda harus mendaftar terlebih dahulu pada hosting yang membuka port defaulnya 3306 untuk diakses secara publik. Mengenai hal ini Anda bisa mencoba mendaftar pada link di samping http://www.freemysql.net/. Setelah mendaftar sekarang Anda memiliki UserName dan Password yang digunakan untuk mengakses MySQL online. Selanjutnya cobalah untuk membuat database sederhana dengan satu table, dan satu field (kelak Anda dapat membuat database, dan memperbanyak table dengan cara mengeksekusi syntax-syntax SQL).

Option Explicit 

Dim
conn As New ADODB.Connection

Private Sub
Form_Load()
If ConnectToServer Then
Debug.Print "Sukses terkoneksi dengan server"
Else
Unload Me
End If
End Sub

Private Function
ConnectToServer() As Boolean

On Error GoTo
ErrHandler

Dim
server As String, port As String, database As String
Dim
username As String, password As String

'-----------------------------------------------------------------
'Sesuaikan!
server = <your server> 'nama server
port = "3306" 'default port
Database = <your database> 'database yang telah Anda buat
username = <your username> 'username pada saat Anda mendaftar
password = <your password> 'password pada saat Anda mendaftar
'-----------------------------------------------------------------

Set
conn = New ADODB.Connection
conn.CursorLocation = adUseClient
conn.Mode = adModeReadWrite

conn.ConnectionString = "Driver={MySQL ODBC 3.51 Driver};Server=" & server _
& ";Port=" & port & ";Database=" & database & ";User=" & username & ";Password=" _
& password & ";Option=3;default command timeout =20;writetimeout=300"

conn.Open

ConnectToServer = True
Exit Function

ErrHandler:

MsgBox Err.Description, vbCritical, "Error"

End Function

Private Sub
Form_Unload(Cancel As Integer)
If conn.State <> adStateClosed Then
conn.Close
End If
Set
conn = Nothing
End Sub
READ MORE - Connection String Untuk Mengakses MySQL Online

Contoh Kode Untuk Login dan Menambah User - MySQL Online

Sebenarnya tidak ada yang istimewa mengenai hal ini. Setelah kita berhasil melakukan koneksi terhadap database yang tersimpan di server, tentu saja sekarang kita dapat melakukan manipulasi database seperti yang biasa kita lakukan di localhost. Berikut merupakan contoh sederhananya:

Login:

Private Sub cmdLogin_Click() 

On Error GoTo
ErrHandler

Dim
strSQL As String
Dim
rsLogin As New ADODB.Recordset
Dim strUserName As String

If
txtUserName.Text = "" Then
MsgBox "Please fill User ID", vbInformation, "Information"
txtUserName.SetFocus
Exit Sub
End If

If
txtPassword.Text = "" Then
MsgBox "Please fill the password", vbInformation, "Information"
txtPassword.SetFocus
Exit Sub
End If

strSQL = "SELECT username FROM tbl_player_game WHERE username='" & rep(txtUserName.Text) & "'"
rsLogin.Open strSQL, conn

If
rsLogin.RecordCount <= 0 Then
txtUserName.SetFocus
MsgBox "User belum tidak/belum terdaftar", vbInformation
Exit Sub
Else
strUserName = rsLogin!username
End If

rsLogin.Close

strSQL = "SELECT password,username FROM tbl_player_game WHERE password='" & rep(txtPassword.Text) & "' AND username='" & strUserName & "'"
rsLogin.Open strSQL, conn

If
rsLogin.RecordCount <= 0 Then
txtPassword.SetFocus
MsgBox "Password salah", vbInformation
Exit Sub
End If

frmMain.Show 'show the Second form if login success!

Unload Me

Exit Sub

ErrHandler:

MsgBox Err.Description

End Sub

Private Function
rep(ByVal kata As String) As String
rep = Trim$(Replace(kata, "'", "''"))
End Function


Menambah user:

Private Sub cmdAddOnlinePlayer_Click() 

On Error GoTo
ErrHandler

Dim
strSQL As String
Dim
rsLogin As New ADODB.Recordset
Dim strUserName As String

If
txtUserName.Text = "" Then
MsgBox "Please fill User ID", vbInformation, "Information"
txtUserName.SetFocus
Exit Sub
End If

If
txtPassword.Text = "" Then
MsgBox "Please fill the password", vbInformation, "Information"
txtPassword.SetFocus
Exit Sub
End If

conn.Execute "INSERT INTO tbl_player_game(username, password)VALUES('" & rep(txtUserName.Text) & "', '" & rep(txtPassword.Text) & "')"

Exit Sub

MsgBox Err.Description, vbInformation, "Fail add player/username"

End Sub


Catatan: Database, table, field-nya harap diperhatikan dan disesuaikan.
READ MORE - Contoh Kode Untuk Login dan Menambah User - MySQL Online