Free Source Code

Manipulasi Database II

Source code berikut saya dapat di internet dan sangat membantu dalam pengolaan database. dan contoh ini saya sudah praktekkan dalam pembuatan program aplikasi dan sangat membatu sekali.

Di dalam contoh tersebut sudah meliputi:

1. Compac Database

2. Navigasi Control Ado

3. Backup dan Restore Database

4. Password Database

5. Laporan Database dengan DataReport

6. Menampilkan Data di GridView

Bagi anda yang pingin belajar pengelolaan database silakan download di bawah ini :

Download Source Code

Dengan adanya properties Control VALUE, akan memudahkan didalam melakukan operasi matematika sehingga tidak lagi sibuk membuang karakter koma (,) cukup menggunakan properties VALUE saja. Di dalam contoh program ini disertai 2 contoh yaitu :
1. menggunakan: myText.Text
2. menggunakan: myText.Value
Bagi anda yang pingin mencoba Membuat Text Box Khusus Angka silakan klik link download di bawah ini. Terima Kasih.
Download Code Selengkapnya.

Manipulasi Database

Contoh source code untuk menangani database, lengkap dengan fungsi/prosedur menambah, menyimpan, mengedit, menghapus, navigasi, mencari pertama, mencari berikutnya, memfilter, dan menyortir data. Sangat cocok untuk digunakan sebagai template untuk menangani pemrograman database menggunakan coding yang memerlukan validasi data dan penanganan khusus lainnya.
Menggunakan reference "Microsoft ActiveX Data Objects 2.0 Library" dan control "DataGrid".

Download Code Selengkapnya.

Membuat Program Screen Saver

Screen secara harafiah berarti layar. Screen sering digunakan untuk layar monitor pada komputer, layar tempat penayangan film di bioskop, dsb. Screen Saver berarti animasi yang ditampilkan apabila tidak ada respon input ke komputer dari user dalam jangka waktu tertentu (Windows). Di dalam visual basic kita bisa membuat program screen saver. seperti contoh code yang bisa didownload dibawah ini untuk dikembangkan.

Download

Print Preview File TXT

Contoh program menampilkan hasil laporan txt atau Print Preview File Txt dengan menggunakan ActiveX Control. Seperti tampilan dibawah ini:

Contoh Penggunaannya :

Option Explicit
Dim db As DAO.Database, DbMaster As DAO.Database, DbTmp As DAO.Database
Dim Rs As DAO.Recordset, RsSandi As DAO.Recordset, RsTmp As DAO.Recordset
Dim jJum1 As Currency, jJum2 As Currency, jJum3 As Currency, jJum4 As Currency, jJum5 As Currency, jJum6 As Currency, jJum7 As Currency
Dim mintFileNo As Integer
Dim mstrfilename As String
Dim mintpageno As Integer
Dim mintlineno As Integer
Dim CariR As String * 9
Private Sub CmdKeluar_Click()
  boolDirty = False
  Call RekamKegiatan(" Keluar dari menu : " & HrfJalan)
  HrfJalan = "Aplikasi System Akuntansi"
  Unload Me
End Sub
Private Sub CmdLayar_Click()
  ReportViewer1.ShowPrintPreview
End Sub
Private Sub CmdPrinter_Click()
  'Load Form36
  Form36.Show
End Sub
Private Sub CmdProses_Click()
  If Option1.Value = False And Option2.Value = False And Option3.Value = False And Option4.Value = False And Option5.Value = False Then
   CInteraction.ShowMsgBox "Informasi", "Anda tidak memilih pilihan yang akan dicetak", , , , , imgExclamationEx, 1
   Exit Sub
  End If
  Set db = OpenDatabase(App.Path & "\DATA\AKUN" & BDatabase & ".MDB", False, False, dbLangGeneral & ";pwd=newpassword")
  Set Rs = db.OpenRecordset(Filedata & "B", dbOpenTable)
  Rs.Index = "TANGGAL"
  Set DbMaster = OpenDatabase(App.Path & "\DATA\AKUNTANSI.MDB", False, False, dbLangGeneral & ";pwd=newpassword")
  Set RsSandi = DbMaster.OpenRecordset("AKNSANDI", dbOpenTable)
  RsSandi.Index = "REKSANDI"
  Call TabelSaldo
  Set DbTmp = OpenDatabase(App.Path & "\DATA\TMPMDB.MDB", False, False, dbLangGeneral & ";pwd=newpassword")
  Set RsTmp = DbTmp.OpenRecordset(Operator, dbOpenTable)
  RsTmp.Index = "REBUKU"

  jJum1 = 0: jJum2 = 0: jJum3 = 0: jJum4 = 0: jJum5 = 0: jJum6 = 0
  '-----------------------
  'sub-sub buku besar
  '-----------------------
  If Option3.Value = True Then
   With RsTmp
   If .RecordCount > 0 Then
   .MoveFirst
   Do While Not .EOF
   .Delete
   .MoveNext
   Loop
   End If
   End With
   With Rs
   If .RecordCount < 1 Then
   CInteraction.ShowMsgBox "Informasi", "Data masih kosong", , , , , 0, 1
   Tutup
   Exit Sub
   End If
   .MoveFirst
   Do While Not .EOF
   If Right(!rebuku, 2) <> "00" Then
   With RsTmp
   .AddNew
   !rebuku = Rs!rebuku
   .Update
   End With
   End If
   .MoveNext
   Loop
   End With
   With RsTmp
   If .RecordCount < 1 Then
   CInteraction.ShowMsgBox "Informasi", "Data masih kosong", , , , , 0, 1
   Tutup
   Exit Sub
   End If
   mstrfilename = App.Path & "\" & Operator & ".txt"
   mintFileNo = 1
   mintpageno = 1
   Open mstrfilename For Output As #mintFileNo ' Open file for output.
   .MoveFirst
   If .RecordCount > 100 Then
   PBar.Max = .RecordCount + 1
   End If
   putar = 0
   Do While Not .EOF
   CariR = !rebuku
   Call ReportHeader
   jJum1 = 0: jJum2 = 0: jJum3 = 0: jJum4 = 0: jJum5 = 0: jJum6 = 0
   With Rs
   .MoveFirst
   Do While Not .EOF
   If !rebuku = CariR Then
   Print #mintFileNo, AlignValue(!tanggal, "L", 12);
   Print #mintFileNo, AlignValue(" ", "L", 30);
   Print #mintFileNo, AlignValue(Format(!saldoa, "#,##0.#0"), "R", 21);
   Print #mintFileNo, AlignValue(Format(!dbkas, "#,##0.#0"), "R", 21);
   Print #mintFileNo, AlignValue(Format(!kdkas, "#,##0.#0"), "R", 21);
   Print #mintFileNo, AlignValue(Format(!dbmem, "#,##0.#0"), "R", 21);
   Print #mintFileNo, AlignValue(Format(!kdmem, "#,##0.#0"), "R", 21);
   Print #mintFileNo, AlignValue(Format(!Saldok, "#,##0.#0"), "R", 21)
   jJum1 = jJum1 + !dbkas: jJum2 = jJum2 + !kdkas: jJum3 = jJum3 + !dbmem: jJum4 = jJum4 + !kdmem
   mintlineno = mintlineno + 1
   If mintlineno > 35 Then
   Call ReportFother
   Print #mintFileNo, Chr(12)
   mintlineno = 0
   mintpageno = mintpageno + 1
   Call ReportHeader
   End If
   End If
   Rs.MoveNext
   Loop
   Call ReportFother
   End With
   putar = putar + 1
   PBar.Value = putar
   .MoveNext
   Loop
   End With
   Close #mintFileNo
   ReportViewer1.ReportTitle = "Rekening Koran Buku Besar" ' Optional
   ReportViewer1.FileName = mstrfilename 'Must Fields
   'ReportViewer1.ShowPrintPreview ' To Show the Report
   'Showing about form Optional
   'ReportViewer1.ShowAboutDlg
   Tutup
   'CInteraction.ShowMsgBox "Informasi", "Proses selesai", , , , , 0, 1
   CmdLayar.Enabled = True
   CmdPrinter.Enabled = True
   CmdProses.Enabled = False
   Call RekamKegiatan(" Melihat : " & Option3.Caption)
  End If
Private Sub ReportHeader()
  Print #mintFileNo, Chr(27) + Chr(69);
  Print #mintFileNo, AlignValue("REKENING KORAN", "C", 120)
  Print #mintFileNo,
  Print #mintFileNo, AlignValue("Rekening : " & CariR, "L", 30) & Space(2)
  RsSandi.Seek "=", CariR
  If Not RsSandi.NoMatch Then
   Print #mintFileNo, AlignValue("Nama : " & RsSandi!nama, "L", 30) & Space(2)
  Else
   Print #mintFileNo, AlignValue("Nama : ", "L", 30) & Space(2)
  End If
  Print #mintFileNo, String(168, "=")
  Print #mintFileNo, AlignValue(" ", "L", 63); AlignValue("MUTASI KAS", "C", 42); AlignValue("MUTASI MEMORIAL", "C", 42)
  Print #mintFileNo, AlignValue("Tanggal", "C", 12); AlignValue("Keterangan", "C", 30); AlignValue("Saldo Awal", "C", 21);
  Print #mintFileNo, String(84, "-"); AlignValue("Saldo Akhir", "C", 21)
  Print #mintFileNo, AlignValue(" ", "L", 63); AlignValue("Debet", "C", 21); AlignValue("Kredit", "C", 21); AlignValue("Debet", "C", 21); AlignValue("Kredit", "C", 21)
  Print #mintFileNo, String(168, "-");
  Print #mintFileNo, Chr(27) + Chr(70)
  mintlineno = mintlineno + 8
End Sub
Private Sub ReportFother()
  Print #mintFileNo, String(168, "-")
  Print #mintFileNo, AlignValue(" Jumlah ", "C", 63); AlignValue(Format(jJum1, "#,##0.#0"), "R", 21); AlignValue(Format(jJum2, "#,##0.#0"), "R", 21); AlignValue(Format(jJum3, "#,##0.#0"), "R", 21); AlignValue(Format(jJum4, "#,##0.#0"), "R", 21)
  Print #mintFileNo, String(168, "-")
End Sub
Private Function RndNum(n As Integer) As Integer
  Randomize n + Timer
  RndNum = Int(Rnd * n)
End Function
Private Sub Form_Activate()
  boolDirty = True
End Sub
Private Sub Form_Load()
  Dim inghwnd As String
  inghwnd = Me.hWnd
  Call DisableClose(inghwnd)
  Call RekamKegiatan(" Menjalankan menu : " & HrfJalan)
  CmdLayar.Enabled = False
  CmdPrinter.Enabled = False
  CmdProses.Enabled = False
  Form19.Left = Lebar / 2 - (Me.Width / 2)
  Form19.Top = ((Tinggi / 2) - (Me.Height / 2))
  Call DisableClose(inghwnd)
End Sub
Private Sub Option3_Click()
  CmdLayar.Enabled = False
  CmdPrinter.Enabled = False
  CmdProses.Enabled = True
End Sub
Private Sub Option4_Click()
  CmdLayar.Enabled = False
  CmdPrinter.Enabled = False
  CmdProses.Enabled = True
End Sub
Sub Tutup()
  Rs.Close
  Set Rs = Nothing
  RsSandi.Close
  Set RsSandi = Nothing
  RsTmp.Close
  Set RsTmp = Nothing
  db.Close
  Set db = Nothing
  DbMaster.Close
  Set DbMaster = Nothing
  DbTmp.Close
  Set DbTmp = Nothing
End Sub

Download File OCX

Membuat Preview Laporan

Membuat laporan dari suatu aplikasi yang kita buat, tentunya kita menginginkan tampilan laporan yang menarik. VB telah menyediakan bentuk laporan seperti :
1. Laporan dengan bantuan crystal report
2. Laporan yang hasil di preview di form
3. Laporan yang langsung di cetak ke printer
dan masih banyak lagi trik-trik laporan, tergantung kebutuhan kita. Berikut ini saya akan mencontohkan laporan membuat print Preview versi saya seperti gambar berikut :

Bentuk laporan seperti ini saya modifikasi dari Code Visual Basic yang saya dapat dari internet (Sumbernya sudah lupa alamatnya). Tapi bagi anda yang ingin silakan download codenya untuk dikembangkan.

Download

MultiCoulum ComboBox

Menampilkan data drop down telah disediakan oleh visual basic yaitu ComboBox. Combo Box hanya menampilkan satu coloum. Bagaimanakah kita menampilkan combobox dengan beberapa coloum (Multi Coloum ComboBox)? Seperti contoh code berikut ini.

Download

Membuat Setup Aplikasi

Program ini adalah contoh sederhana bagaimana membuat file setup aplikasi sendiri untuk menginstall/mengcopy file-file aplikasi yang anda buat ke dalam suatu folder/lokasi tertentu. seting setup disimpan ke dalam registry.

Code Form

Private Sub Command1_Click()
'Tampilkan form ini
Show
DoEvents
pbProgress.Value = 0
DoEvents
'Deklarasi variabel
Dim Run As String
'Ambil dari Registry settings
Run = GetSetting(ThisApp, ThisKey, "Run", "")
DoEvents
'Periksa apakah sebelumnya sudah pernah disetup
If Run = "True" Then 'Jika ya...
'Bebaskan form dari memori
Unload Form1
MsgBox "Setup ini sudah pernah dijalankan sebelumnya!", vbCritical, "Gagal"
Exit Sub 'Langsung keluar dari aplikasi
'Jika muncul pesan sudah pernah dijalankan,
'silahkan Anda hapus setting di registry dengan
'menjalankan regedit. Lokasi setting ada di:
'HKEY_CURRENT_USER\Software\VB And VBA Program Settings\VBS\Setup Master\
'Hapus (delete) String Value "Run" jika Anda ingin
'menjalankan setup ini lagi.
End If
'Jika belum, simpan nilai Run di registry dengan True
SaveSetting ThisApp, ThisKey, "Run", "True"
DoEvents
'Pembuatan direktori
Const ATTR_DIRECTORY = 16
If Dir$(DestPath, ATTR_DIRECTORY) <> "" Then
'Jika direktori sudah ada, tidak usah dibuat lagi
Else
'Jika direktori belum ada, buat!
MkDir DestPath
DoEvents
End If
pbProgress.Value = 33
DoEvents
'Copy file yang Anda inginkan
'dalam contoh ini misalkan saja file index.html
HTMLFiles
FileCopy App.Path & "\index.html", DestPath & "index.html"
DoEvents
pbProgress.Value = 66
DoEvents
pbProgress.Value = 100
DoEvents
'Jika sudah selesai, tampilkan pesan, lalu keluar/selesai!
MsgBox "Setup telah berhasil dengan sukses!", vbInformation, "Sukses"
pbProgress.Value = 0
Unload Me
End
End Sub
Private Sub Command2_Click()
End
End Sub

Module

Option Explicit
'Set Constanta sebagai Public agar dikenali di seluruh
'project
Public Const INVALID_HANDLE_VALUE = -1
Public Const MAX_PATH = 260
Public Const ThisApp = "VBS"
Public Const ThisKey = "Setup Master"
Public Const DestPath = "c:\vbsquare\"
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" _
(ByVal lpPathName As String, _
lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
'API Calls for Registry
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByVal lpType As Long, ByVal lpData As Any, lpcbData As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
'Fungsi API Call untuk memeriksa registrasi
Declare Function RegComCtl32 Lib "c:\windows\system\ComCtl32.dll" Alias "DllRegisterServer" () As Long
'Set konstanta lainnya untuk Registry
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_CURRENT_USER = &H80000001
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const SYNCHRONIZE = &H100000
Const ERROR_SUCCESS = 0&
Const ERROR_MORE_DATA = 234
Const REG_SZ = 1
Const KEY_READ = ((READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Public Function CopyFiles(sSourcePath As String, sDestination As String, sFiles As String) As Long
'Deklarasi variabel
Dim WFD As WIN32_FIND_DATA
Dim SA As SECURITY_ATTRIBUTES
Dim r As Long
Dim hFile As Long
Dim bNext As Long
Dim copied As Long
Dim currFile As String
'Membuat direktori
r = CreateDirectory(sDestination, SA)
hFile = FindFirstFile(sSourcePath & sFiles, WFD)
'Penanganan jika terjadi error
If (hFile = INVALID_HANDLE_VALUE) Then
MsgBox "No " & sFiles & " files found."
Exit Function
End If
'Copy file-file yang diperlukan
If hFile Then
Do
currFile = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)))
r = CopyFile(sSourcePath & currFile, sDestination & currFile, False)
copied = copied + 1
bNext = FindNextFile(hFile, WFD)
Loop Until bNext = 0
End If
'Selesai proses peng-copy-an
r = FindClose(hFile)
CopyFiles = copied
End Function
Public Function HTMLFiles()
'Deklarasi variabel
Dim sSourcePath As String
Dim sDestination As String
Dim sFiles As String
Dim numCopied As Long
'Set nilai variabel
sSourcePath = App.Path + "\"
sDestination = DestPath
sFiles = "*.htm"
'Copy file-file yang diperlukan
numCopied = CopyFiles(sSourcePath, sDestination, sFiles)
End Function

Menghitung Biaya Dengan Timer

Berikut saya share contoh program untuk menghitung biaya berdasarkan perubahan durasi waktu 30 detik. Dan sangat cocok dikembangkan di dalam pembuatan aplikasi warnet.

Dim Awal, Akhir, Lama As Single
Dim dtkAwal, dtkAkhir As Single
Private Sub Command1_Click()
   If Command1.Caption = "Start" Then
   Text4.Text = 0
   dtkAwal = Time
   Awal = Now
   Text1.Text = Format(Awal, "hh:mm:ss")
   Command1.Caption = "Stop"
   ElseIf Command1.Caption = "Stop" Then
   Timer1.Enabled = False
   Akhir = Now
   Lama = Akhir - Awal
   Text3.Text = Format(Lama, "hh:mm:ss")
   Command1.Caption = "Selesai"
   ElseIf Command1.Caption = "Selesai" Then
   End
  End If
End Sub
Private Sub Timer1_Timer()
If Command1.Caption = "Stop" Then
   dtkAkhir = Time 'dtkAkhir adalah waktu terkini
   If Second(dtkAkhir - dtkAwal) = 30 Then
   dtkAwal = dtkAkhir 'Assignment dtkAkhir ke dtkAwal
   Text4.Text = Format(Text4.Text + 1100, "#,#") 'Update biaya
   End If
   Text2.Text = Format(Now, "hh:mm:ss")
   Text3.Text = Format(Now - Awal, "hh:mm:ss")
End If
End Sub

Banwidth Monitor

Banwidth Monitor yaitu untuk mengontrol transfer dan receive data Seperti contoh dibawah ini :

Download

Dial Connection

Dial Connection bisa dibuat dengan menggunakan code VB selain yang telah disedikan oleh Windows XP.

Download

Menampilkan Icon Network (Winsock)

Di dalam suatu program network tentu kita perlu mengetahui apakah computer kita sudah terkoneksi dengan komputer lain?. Berikut ini contoh program menampilkan icon koneksi dengan komponen winsock.

Option Explicit
Private Sub Form_Load()
   If OnTheNet Then
   lblConnectInfo.Caption = "Connected"
   Else
   lblConnectInfo.Caption = "Not connected"
   End If
End Sub
Private Function OnTheNet() As Boolean
   Winsock1.Close
   Winsock1.Bind
   If Winsock1.LocalIP = "" Then
   OnTheNet = False
   Else
   OnTheNet = True
   End If
End Function

Membuat Map Network Drive

Membuat Map Network Drive tidak hanya di tool Windows Tetapi bisa juga kita membuatnya dengan Source Kode VB. Seperti gambar berikut ini :

Contoh Source Code Membuat Map Network Drive

Option ExplicitPrivate Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" (ByVal lpszNetPath As String, ByVal lpszPassword As String, ByVal lpszLocalName As String) As Long
Private Sub cmdMapDrive_Click()Dim drive_letter As StringDim share_name As StringDim password As String lblResult.Caption = "Working..." Screen.MousePointer = vbHourglass DoEvents drive_letter = txtDriveLetter.Text If InStr(drive_letter, ":") = 0 _ Then drive_letter = drive_letter & ":" share_name = txtShareName.Text password = txtPassword.Text If WNetAddConnection(share_name, password, _ drive_letter) > 0 _ Then lblResult.Caption = "Error mapping drive" Else lblResult.Caption = "Drive mapped" End If Screen.MousePointer = vbDefaultEnd Sub

Demikian dan saya ucapkan terima kasih.

Program Trial

Di dunia maya banyak sekali program-program yang dijual dengan memiliki masa waktu tertentu (Trial). Bagaimanakah kita membuat program seperti tersebut diatas?. Berikut ini saya berikan contoh Program Trial dalam code visual basic. Contoh code ini saya dapat dari internet (sumbernya sudah lupa) berhubung suudah lama. jika anda berminat silakan download programnya.

Download

Membuat Password

Membuat program aplikasi yang aman, tentunya kita membutuhkan password. disaat mengimput password di text tentunya kita tidak inginkan orang lain melihat password yang kita masukan. berikut ini saya uraikan bagaimana memasukan password dengan menampilkan tanda bintang (*).

Di dalam code dibawah ini di suatu form kita siapkan komponen dibawah ini:

Component Timer 2 Buah di form
Component Label2 untuk menampilkan timer
Component TextBox1
Component Command

Code Form1

Option Explicit
Dim ter As Booleana
Private Sub Command1_Click()
ter = False
DisableCtrlAltDelete (False)
Unload Form1
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Timer1.Enabled = False
Timer2.Enabled = True
Text1.Enabled = True
End If
End Sub
Private Sub Form_Load()
DisableCtrlAltDelete (True)
ter = True
End Sub
Private Sub Form_LostFocus()
Form1.SetFocus
End Sub
Private Sub Form_Unload(Cancel As Integer)
If ter = True Then
Cancel = 5
Else
End If
End Sub
Private Sub Timer1_Timer()
Form1.SetFocus
Label2.Caption = 5
End Sub
Private Sub Timer2_Timer()
Label2.Caption = Val(Label2.Caption) - 1 & " Waktu untuk memasukan password."
Text1.SetFocus
If Text1.Text = "mouse" Then
ter = False
Timer2.Enabled = False
Timer1.Enabled = False
Label2.Caption = "5"
MsgBox "Password diterima, prgram bisa ditutup sekarang."
Text1.Enabled = False
Command1.Enabled = True
End If
If Val(Label2.Caption) = 0 Then
Timer1.Enabled = True
Timer2.Enabled = False
Text1.Text = ""
Text1.Enabled = False
Command1.Enabled = False
End If
End Sub

Code Module

'Used for DisableCtrlAltDelete
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
'Used for ExitWindows
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
'Used for AlwaysOnTop
Const FLAGS = 3
Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Public SetTop As Boolean
Private Declare Function SetWindowPos Lib "user32" (ByVal h%, ByVal hb%, ByVal X%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal f%) As Integer
Sub ExitWindows(ExitMode As String)
Select Case ExitMode
Case Is = "shutdown"
ter = ExitWindowsEx(EWX_SHUTDOWN, 0)
Case Is = "reboot"
ter = ExitWindowsEx(EWX_REBOOT Or EXW_FORCE, 0)
Case Else
MsgBox ("Error in ExitWindows call")
End Select
End Sub
Sub AlwaysOnTop(FormName As Form, bOnTop As Boolean)
'Set form selalu di atas
Dim Success As Integer
If bOnTop = False Then
Success% = SetWindowPos(FormName.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
Else
Success% = SetWindowPos(FormName.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
End If
End Sub
Sub Center(FormName As Form)
'Center Forms...
Move (Screen.Width - FormName.Width) \ 2, (Screen.Height - FormName.Height) \ 2
End Sub
Sub DisableCtrlAltDelete(bDisabled As Boolean)
Dim X As Long
X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub
Sub OpenApp(File As String)
X = Shell(File)
End Sub

Membuat Menu TabStrip

Membuat Menu TabStrip seperti contoh kode program dibawah ini :

Option Explicit
Private SelectedTab As Integer
Private Sub Form_Load()
Dim i As Integer
   For i = 1 To ChoiceFrame.UBound
   ChoiceFrame(i).Move _
   ChoiceFrame(0).Left, _
   ChoiceFrame(0).Top, _
   ChoiceFrame(0).Width, _
   ChoiceFrame(0).Height
   ChoiceFrame(i).Visible = False
   Next i
    SelectedTab = 1
   TabStrip1.SelectedItem = TabStrip1.Tabs(SelectedTab)
   ChoiceFrame(SelectedTab - 1).Visible = True
End Sub
Private Sub TabStrip1_Click()
   ChoiceFrame(SelectedTab - 1).Visible = False
   SelectedTab = TabStrip1.SelectedItem.Index
   ChoiceFrame(SelectedTab - 1).Visible = True
End Sub

Memanipulasi Text Menggunakan Timer

Berikut sample Memanipulasi Text Menggunakan Timer atau membuat tulisan berjalan dengan visual basic.

Dim awal As Date
Dim Gerak As Boolean
Dim Aksi As Boolean,Angka As Integer
Private Sub MDIForm_Load()
HrfJalan = "Huruf Jalan"
StatusBar1.Panels(4).Text = Time
Timer2.Enabled = True
iJam = Format(StatusBar1.Panels(4).Text,"hh:mm:ss")
ShowWinnerMessage
Gerak = False
Aksi = False
Timer3.Interval = 500
Timer3.Enabled = True
awal = Time
End Sub

Private Sub ShowWinnerMessage()
    LblJalan.Visible = True
    Timer1.Enabled = True
    Timer4.Enabled = True
End Sub
--------------------------------------------------
Menampilkan huruf berjalan dari kiri ke kanan
-------------------------------------------------
Private Sub Timer1_Timer()
LblJalan = HrfJalan
LblJalan.Left = LblJalan.Left + 2
'Jika huruf jalan lebih besar dari scala picture 2 maka labejln.left akan meset ke 0
If LblJalan.Left > Picture2.ScaleWidth Then LblJalan.Left = 0
End Sub
-------------------------------------------------
Menampilkan jam dengan detik berjalan di status bar panel 4
-------------------------------------------------
Private Sub Timer2_Timer()
With StatusBar1
     .Panels(4).Text = Time
End With
End Sub
------------------------------------------------
Penhitung waktu, Jika dalam program tidak
terjadi aksi apapun maka program otomatis
akan keluar dengan waktu interval tertentu
-----------------------------------------------
Private Sub Timer3_Timer()
Dim durasi As Date
Aksi = False
'Periksa...
If Aksi = False Then
     Gerak = False
     Timer3.Enabled = True
Else 'Jika ada perubahan di Mouse_Move
     Gerak = True
     Timer3.Enabled = False
End If
'Text1.Text = awal
'Text2.Text = Time
'Jika tidak ada pergerakan, aktifkan perhitungan durasi
If Gerak = False Then
    durasi = Time - awal
    'Dalam contoh ini, jika 5 detik aplikasi tidak
    'mengalami kegiatan, maka langsung keluar...
    If Format(durasi, "hh:mm:ss") = "00:01:05" Then
       'Sebelum keluar, bebaskan semua variabel di form ini
       FormSplash.Show
       Set fMainForm = Nothing
       Unload Me
    End If
End If
End Sub
--------------------------------------------------------------
Menampilkan text berjalan pada status bar panel 1
--------------------------------------------------------------
Private Sub Timer4_Timer()
Dim Tulis As String
Dim pnlX1 As Panel
Set pnlX1 = StatusBar1.Panels(1)
      Tulis = "User : " + Operator
      Angka = Angka + 1
      pnlX1.Text = TulisJalan(Angka, Tulis, 100)
End Sub
----------------------------------------------------
Fungsi penghitung kalimat untuk teks berjalan dari kanan
---------------------------------------------------
Function TulisJalan(ByRef Hitung As Integer, kalimat As String, panjang As Integer)
    If Hitung = Len(kalimat) + panjang Then
        Hitung = 0
    ElseIf Hitung > Len(kalimat) Then
        TulisJalan = kalimat & Space(Hitung - Len(kalimat))
    Else
        TulisJalan = Mid(kalimat, 1, Hitung)
    End If
End Function

Mengimport Database Ke Dalam SQL Server 7.0

Jika Anda pernah menggunakan Access sebelumnya dan ingin berpindah ke SQL Server, Anda mungkin juga perlu mengubah beberapa database Anda.

Untuk mengimpor database ke dalam SQL Server, gunakanlah Data Transformation Services (DTS). DTS adalah sebuah komponen dari SQL Server yang digunakan untuk mengimpor data dari database dan file teks yang berbeda, juga untuk mengekspor data ke dalam database lain. Untuk mengimpor database BIBLIO.MDB dari Access, ikutilah langkah langkah berikut:

Untuk menjalankan DTS Import Wizard, terlebih dahulu jalankan program Enterprise Manager, explorelah tanda + sampai terlihat folder Database, lalu klik kanan pada folder Database à All Tasks à Import Data, yang ditunjukkan pada gambar dibawah ini.

Setelah klik Import Data, akan muncul gambar berikut, dan klik Next.

Pada layar DTS Import Wizard, tentukan sumber data (database BIBLIO Access). Pda kotak Source, pilihlah Microsoft Access, dan pada kotak File Name, ketikanlah path ke file BIBLIO.MDB, atau klik tombol di sebelah kanan File Name lalu carilah file database tersebut dengan kotak dialog File Open. Klik Next.

Pada layar Chose a Destination, pilihlah databse yang akan menerima data tersebut. Tujuan ini haruslah berupa Microsoft OLE DB Provider for SQL Server. Tentukanlah nama dari server network Anda atau (local), jika Anda menjalankan SQL Server pada komputer yang sama, serta jenis autentikasinya.

Pada kotak Database, pilihlah <new> untuk membuat database baru yang akan menerima database Biblio. Segera setelah Anda memilih entri <new> pada daftar Database, kotak dialog Create Database akan muncul (lihat gambar dibawah ini). Kotak dialog yang sama akan muncul apabila Anda membuat database SQL Server yang baru.

Pada kotak Create Database, tentukanlah nama database yang baru dan ukuran awalnya. Delapan megabyte adalah lebih dari cukup untuk database Biblio, dan ukuran file log sebesar 2 Mb juga cukup memadai. Klik OK, dan SQL Server akan membuat database baru lalu kembali ke layar Choose a Destination. Klik Next untuk melanjutkan.

Pada layar Specify Table Copy or Query (lihat Gambar berikut), tentukanlah apakah Anda ingin meng-copy tabel-tabel database Access ke dalam database baru, atau memilih baris-baris tertentu dari tabel dengan satu atau lebih query. Anda ingin meng-copy semua baris pada tabel Biblio ke dalam database baru, jadi pilihlah pilihan yang pertama dan klik Next.

Pada layar Select Source Tables (lihat Gambar dibawah), tentukanlah tabel-tabel mana yang akan ditransfer. Setiap kali Anda memilih sebuah tabel dengan meng-klik di depan namanya, nama tabel yang serupa akan ditambahkan ke dalam kolom Destination Table. Pilihlah semua tabel sumber pada kolom pertama. Anda juga bisa mengubah nama dari tabel tujuan, tetapi untuk saat ini Anda tidak perlu mengubah nama-nama dari database Biblio.

Tombol-tombol pada kolom Transform pada gambar diatas, mengizinkan Anda menentukan transformasi pada data saat diimport ke dalam SQL Server. Klik tombol pada kolom yang ingin Anda ubah, dan Anda akan diminta menentukan transformasinya (biasanya hanya berupa perubahan tipe data). Jendela Column Mappings and Transformations mengandung dua buah tab. Tab Column Mappings menampilkan definisi atau bahkan membuang kolom tertentu. Jika Anda ingin membuang sebuah kolom, klik nama tabel pada kolom Destination dan pilih <ignore>.

Pada tab Tansformation (lihat gambar dibawah) Anda bisa menentukan apakah kolom-kolom sumber akan di-copy secara langsung atau ditransformasi saat mereka di-copy ke kolom tujuan. Jika Anda memilih pilihan yang kedua, kotak teks pada jendela akan diaktifkan. Di sini Anda bisa mengetikkan skrip untuk mengubah data saat ditransfer. Skrip ini adalah program pendek yang ditulis dalam VBScript yang memanipulasi field-field sumber dan field-field tujuan.

Klik OK untuk kembali ke Column Mappings and Transformation Wizard. Anda tidak perlu melakukan transformasi pada saat ini, jadi biarkan Wizard yang mennerjemahkan definisi tabel dan mentransfer semua baris untuk Anda.
Klik OK untuk kembali ke DTS Wizard dan klik Next untuk menentukan kapan impor data akan dilaksanakan. Pilihlah Run Immediately untuk mengimpor database saat ini juga.

Pilihan Save DTS Package jika Anda ingin mengimpor data yang sama di lain waktu dan SQL Server akan membuat sebuah skrip secara automatis agar Anda tidak perlu melalui layar-layar Import Wizard kembali. Jika Anda memilih untuk menyimpan paket DTS, Anda akan diminta memasukkan nama untuk paket tersebut.

Klik Next sekali lagi untuk melihat layar terakhir. Pastikan tujuan Anda untuk mengimpor database, lalu klik Finish. SQL Server akan mulai mentransfer database secara asinkron, dan akan menampilkan kemajuan operasi pada layar Data Transferring.

Setelah Anda klik Finish gambar berikut akan tampil yang menunjukkan bahwa proses transformasi database sedang berlangsung.

Gambar dibawah ini menginformasikan bahwa proses transfer 4 table dari Microsoft Access ke Microsoft SQL Server telah berhasil.

Jika terdapat error selama proses transfer, proses mengimpor tabel-tabel yang berhubungan akan dibatalkan. Wizard akan memberi tahu Anda berapa banyak baris yang telah ditransfer dengan sukses, dan Anda bisa membuka tabel aslinya untuk mengetahui baris apa saja yang tidak ditransfer.

Import Data Excel Menggunakan DAO dan ADO

Contoh program ini mendemonstrasikan bagaimana cara untuk import data excel dengan menggunakan DAO atau ADO ke FlexGrid.

Component :

Microsoft ActiveX Data Objects 2.6 Library
Microsoft DAO 3.6 Object Library

Reference:

Microsoft FlexGrid Control 6

Download Code

Option Explicit
Dim db As DAO.Database
Dim rsDAO As DAO.Recordset
Dim Conn As ADODB.Connection
Dim rsADO As ADODB.Recordset
Dim strDBField() As String ' Array untuk nama nama field Database.

Private Sub AccessDataWithDAO()

Set db = OpenDatabase(App.Path & "\test.xls", False, True, "Excel 8.0;")
DoEvents
Set rsDAO = db.OpenRecordset("SELECT * FROM [Sheet1$C6:D10]")
rsDAO.MoveFirst
Screen.MousePointer = vbHourglass
ReDim strDBField(1)
strDBField(0) = "Nama"
strDBField(1) = "Kota Lahir"
FillDataToGridControl
Screen.MousePointer = vbDefault
End Sub

Private Sub AccessDataWithADO()
Dim strConn As String
' Open koneksi ADO ke file Excel
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\test.xls;" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

Set Conn = New ADODB.Connection
Set rsADO = New ADODB.Recordset

Conn.ConnectionString = strConn
Conn.Open

' Pada file excel, definisikan nama ListURL dalam Sheet2
rsADO.Open "SELECT * FROM ListURL", Conn, adOpenDynamic, adLockOptimistic

If rsADO.RecordCount > 0 Then rsADO.MoveFirst
Screen.MousePointer = vbHourglass
ReDim strDBField(1)
strDBField(0) = "URL"
strDBField(1) = "Language"
FillDataToGridControl
Screen.MousePointer = vbDefault
End Sub
Private Sub opAksesData_Click(Index As Integer)
Set Conn = Nothing
Set rsADO = Nothing
Set db = Nothing
Set rsDAO = Nothing
Select Case Index
Case 0: AccessDataWithDAO
Case 1: AccessDataWithADO
Case Else
End Select
End Sub

Private Sub HeadingFlexGrid(oMSFlexGrid, nCol, cTextHeading, nColWidth)
With oMSFlexGrid
.TextMatrix(0, nCol) = cTextHeading
.ColWidth(nCol) = nColWidth
.Row = 0
.Col = nCol
.CellFontBold = True
.CellAlignment = flexAlignCenterCenter
End With
End Sub

Private Sub FillDataToGridControl()
Dim rownum As Integer
Dim icount As Integer
Dim rs As Object

' Set recordset sesuai Option
If opAksesData(0) Then
Set rs = rsDAO
Else
Set rs = rsADO
End If

' Bersihkan data pada Grid dan setting row
MSFlexGrid1.Rows = 2
MSFlexGrid1.Clear

' Buat jumlah kolom sesuai dengan jumlah field(s)
If Not (MSFlexGrid1.Cols = UBound(strDBField, 1) + 1) Then
MSFlexGrid1.Cols = UBound(strDBField, 1) + 2
End If

' Setting grid header dan column.
Call HeadingFlexGrid(MSFlexGrid1, 0, "", 225)
Call HeadingFlexGrid(MSFlexGrid1, 1, strDBField(0), 3000)
Call HeadingFlexGrid(MSFlexGrid1, 2, strDBField(1), 2200)

' Isi grid dengan data dari cell file Excel.
rs.MoveFirst
Do Until rs.EOF
rownum = rownum + 1
MSFlexGrid1.AddItem ""
For icount = 0 To UBound(strDBField, 1)
MSFlexGrid1.TextMatrix(rownum, icount + 1) = _
rs.Fields(strDBField(icount))
Next
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Sub

DataGrid Dengan ListBox

Contoh program ini mendemonstrasikan bagaimana cara untuk merefresh suatu DataGrid berdasarkan kriteria atau data yg terdaftar pada object ListBox. Selain itu contoh program ini bisa juga digunakan sebagai latihan bagaimana memilih data pada List yg satu ke List yg lain.

Component : 1. Microsoft ADO Data Control 6.0 (SP4) (OLEDB)
2. Microsoft DataGrid Control 6.0 (OLEDB)
Reference: 1. Microsoft ActiveX Data Objects 2.6 Library

Download Code

Option Explicit
Dim Conn As ADODB.Connection
Dim rs As ADODB.Recordset

Private Sub cmdRefresh_Click()
Dim i As Integer
Dim strSQL As String

Set rs = Nothing
Set Conn = Nothing

If List2.ListCount >= 1 Then
strSQL = "SELECT * FROM Table1 WHERE "
For i = 1 To List2.ListCount
strSQL = strSQL & "Kode = '" & List2.List(i - 1) & "' OR "
Next
If Right(strSQL, 3) = "OR " Then
strSQL = Left(strSQL, Len(strSQL) - 3)
End If
Else
strSQL = "SELECT * FROM Table1"
End If
RefreshGrid (strSQL)
End Sub

Private Sub cmdSelect_Click(Index As Integer)
Dim i As Integer
Select Case Index
Case 0:
For i = 0 To List1.ListCount - 1
List1.ListIndex = 0
List2.AddItem List1.Text
List1.RemoveItem (0)
Next
Case 1:
If List1.ListIndex >= 0 Then
List2.AddItem List1.Text
List1.RemoveItem (List1.ListIndex)
Else
MsgBox "Select Kode Mahasiswa..."
End If
Case 2:
If List2.ListIndex >= 0 Then
List1.AddItem List2.Text
List2.RemoveItem (List2.ListIndex)
Else
MsgBox "Select Kode Mahasiswa..."
End If
Case 3:
For i = 0 To List2.ListCount - 1
List2.ListIndex = 0
List1.AddItem List2.Text
List2.RemoveItem (0)
Next
End Select
End Sub

Private Sub CommandButton1_Click()
End
End Sub

Private Sub Form_Load()
RefreshGrid ("SELECT * FROM Table1")
rs.MoveFirst
While Not rs.EOF
List1.AddItem rs.Fields(0)
rs.MoveNext
Wend
End Sub

Private Sub List1_DblClick()
cmdSelect_Click (1)
End Sub

Private Sub List1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cmdSelect_Click (1)
End If
End Sub

Private Sub List2_DblClick()
cmdSelect_Click (2)
End Sub

Private Sub RefreshGrid(strSQL As String)
Dim strConn As String

Set Conn = New ADODB.Connection
Set rs = New ADODB.Recordset

strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db5.mdb;"
Conn.CursorLocation = adUseClient
Conn.ConnectionString = strConn
Conn.Open
rs.Open strSQL, _
Conn, adOpenKeyset, adLockOptimistic
Set Adodc1.Recordset = rs
End Sub

Private Sub List2_KeyPress(KeyAscii As Integer)
cmdSelect_Click (2)
End Sub

Membuat Database Dengan Ado

Selain merancang sebuah database beserta tabelnya dengan menggunakan tool acces bisa juga kita Membuat Database Dengan Ado dengan menggunakan code program.

Private Sub cmdCreate_Click()
Dim lCatalog As New ADOX.Catalog
Dim lTable As New ADOX.Table
Dim lIndex As New ADOX.Index

lCatalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\DATABASE.MDB"

lTable.Name = "Content"
Set lTable.ParentCatalog = lCatalog
lTable.Columns.Append "ContentID", adInteger
lTable.Columns("ContentID").Properties("AutoIncrement") = True
lTable.Columns.Append "UserID", adInteger
lTable.Columns.Append "RegionID", adInteger
lTable.Columns.Append "ContentTypeID", adInteger
lTable.Columns.Append "CatID", adInteger
lTable.Columns.Append "Title", adVarWChar, 100
lTable.Columns.Append "Author", adVarWChar, 50
lTable.Columns.Append "FileName", adVarWChar, 50
lTable.Columns("FileName").Properties("Jet OLEDB:Allow Zero Length") = True
lTable.Columns.Append "RelatedURL", adVarWChar, 70
lTable.Columns.Append "DownloadURL", adVarWChar, 70
lTable.Columns.Append "DateAdded", adDate
lTable.Columns.Append "ShortDesc", adLongVarWChar
lTable.Columns.Append "LongDesc", adLongVarWChar
lTable.Columns.Append "Display", adSingle
lTable.Columns.Append "Email", adVarWChar, 70
lTable.Columns.Append "Expire", adDate
lTable.Columns.Append "Priority", adInteger
lTable.Columns.Append "Impressions", adInteger
lTable.Columns.Append "ClickThrus", adInteger
lTable.Columns.Append "Downloads", adInteger
lTable.Columns.Append "AvgRating", adInteger
lTable.Columns.Append "Ratings", adInteger
lTable.Columns.Append "Feature", adSingle

lIndex.Name = "P_Key"
lIndex.Columns.Append "ContentID"

'Tambahkan index ke table
lTable.Indexes.Append lIndex

'Simpan table dan strukturnya ke database
lCatalog.Tables.Append lTable

Set lCatalog = Nothing

MsgBox "Database dan table telah sukses di buat."
End Sub

Code Visual Basic diatas adalah untuk membuat database dan table di dalam database. Jika terjadi erro atau runtime error : User-defined type not defined. Maka anda harus mengaktifkan dengan cara :

Dari menu pilih Project
Referensi
Setelah muncul Daftar referensi, cari Microsoft ADO Ext. 2.5 for DDL and Security
Setelah ketemu dan dicentang disebelah kiri tekan Ok untuk Selesai.

Demikian semoga bisa membantu.

ComboBox Di Dalam DBGrid

Berikut saya berikan contoh Source Code ComboBox Di Dalam DBGrid

Private Sub Combo1_GotFocus()
Const CB_SHOWDROPDOWN = H14F
Dim Tmp
Tmp = SendMessage(Combo1.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0)
End Sub
Private Sub Combo1_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
DBGrid1.Text = Combo1.Text
DBGrid1.SetFocus
End If
End Sub
Private Sub Combo1_LostFocus()
Combo1.Visible = False
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub DBGrid1_ButtonClick(ByVal ColIndex As Integer)
Combo1.Top = DBGrid1.Top + DBGrid1.RowTop(DBGrid1.Row)
Combo1.Visible = True
Combo1.SetFocus
If Not (DBGrid1.Text = "") Then
Combo1.Text = DBGrid1.Text
End If
End Sub
Private Sub Form_Load()
Data1.DatabaseName = App.Path & "\Data1.mdb"
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Demikian Code Visual Basic menempatkan ComboBox di dalam DBGrid semoga bermanfaat.Program lengkapnya bisa di download di sini.

Free Source Code

Total Pageviews

Manipulasi Database II

Membuat Text Box Khusus Angka

Manipulasi Database

Membuat Program Screen Saver

Print Preview File TXT

Membuat Preview Laporan

MultiCoulum ComboBox

Membuat Setup Aplikasi

Menghitung Biaya Dengan Timer

Banwidth Monitor

Dial Connection

Menampilkan Icon Network (Winsock)

Membuat Map Network Drive

Program Trial

Membuat Password

Membuat Menu TabStrip

Memanipulasi Text Menggunakan Timer

Mengimport Database Ke Dalam SQL Server 7.0

Import Data Excel Menggunakan DAO dan ADO

DataGrid Dengan ListBox

Membuat Database Dengan Ado

ComboBox Di Dalam DBGrid

Translate

Link

Archieve Blog

Popular post

Label

About Me

Followers

Subscribe To

Total Pageviews

Translate

Link

Archieve Blog

Popular post

Label

About Me

Followers