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