June 19, 2018
Hot Topics:

The Function Bank

  • November 19, 2002
  • By Dax Pandhi
  • Send Email »
  • More Articles »

We all know that you'll go around customizing these forms and adding more of them here and there.

But if you're going to get serious about customizing your setup, you'll need more functionality. And that means more coding, more work, and more bloomin' hassle... well no more!

Here, is a commented code dump of the best and most popular functions you're likely to need in your setup program... put together specially by yours truly.

Just add the following code to a new module in your setup project:

Public Function SetCurrentDirectory& Lib "kernel32" Alias _"SetCurrentDirectoryA" (ByVal lpPathName As String)Public Declare Function ShellExecute& _       Lib "shell32.dll" Alias _"ShellExecuteA" (ByVal hwnd As Long, _                 ByVal lpOperation As String, _                 ByVal lpFile As String, _                 ByVal lpParameters As String, _                 ByVal lpDirectory As String, _                 ByVal nShowCmd As Long)Public Const SW_NORMAL = 1Public Declare Function RegCreateKeyEx& _       Lib "advapi32.dll" Alias _      "RegCreateKeyExA" (ByVal hKey As Long, _       ByVal lpSubKey As String, _       ByVal Reserved As Long, _       ByVal lpClass As String, _       ByVal dwOptions As Long, _       ByVal samDesired As Long, _             lpSecurityAttributes As Any, _             phkResult As Long, _             lpdwDisposition As Long)Public Declare Function RegSetValueEx& _       Lib "advapi32.dll" Alias "RegSetValueExA" _      (ByVal hKey As Long, ByVal lpValueName As String, _       ByVal Reserved As Long, _       ByVal dwType As Long, lpData As Any, _       ByVal cbData As Long)Public Declare Function RegCloseKey& _       Lib "advapi32.dll" _      (ByVal hKey As Long)Public Const HKEY_CURRENT_USER = &H80000001Public Const HKEY_LOCAL_MACHINE = &H80000002Public Const REG_OPTION_NON_VOLATILE = 0Public Const SYNCHRONIZE = &H100000Public Const STANDARD_RIGHTS_ALL = &H1F0000Public Const KEY_QUERY_VALUE = &H1Public Const KEY_SET_VALUE = &H2Public Const KEY_CREATE_SUB_KEY = &H4Public Const KEY_ENUMERATE_SUB_KEYS = &H8Public Const KEY_NOTIFY = &H10Public Const KEY_CREATE_LINK = &H20Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or _KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or _KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) _And (Not SYNCHRONIZE))Public Const ERROR_SUCCESS = 0&Public Const REG_SZ = 1Public Declare Function ExitWindowsEx& Lib "user32" _(ByVal uFlags As Long, ByVal dwReserved As Long)Public Declare Sub GlobalMemoryStatus Lib "kernel32" _(lpBuffer As MEMORYSTATUS)Public Type MEMORYSTATUS        DwLength As Long        DwMemoryLoad As Long        DwTotalPhys As Long        DwAvailPhys As Long        DwTotalPageFile As Long        DwAvailPageFile As Long        dwTotalVirtual As Long        dwAvailVirtual As LongEnd TypePublic UsedPhysicalMemory As LongPublic TotalPhysicalMemory As LongPublic AvailablePhysicalMemory As LongPublic TotalPageFile As LongPublic AvailablePageFile As LongPublic TotalVirtualMemory As LongPublic AvailableVirtualMemory As LongPublic Const EWX_LOGOFF = 0Public Const EWX_SHUTDOWN = 1Public Const EWX_REBOOT = 2Public Const EWX_FORCE = 4Public Declare Function FindWindow& Lib "user32" Alias _"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String)Public Declare Function SendMessage& Lib "user32" Alias _"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal _wParam As Long, lParam As Any)Public Const WM_CLOSE = &H10Public Declare Function OpenProcess& Lib "kernel32" _(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _ByVal dwProcessId As Long)Public Declare Function GetExitCodeProcess& Lib "kernel32" _(ByVal hProcess As Long, lpExitCode As Long)Public Declare Function CloseHandle& Lib "kernel32" _(ByVal hObject As Long)Public Const STILL_ACTIVE = &H103Public Const PROCESS_QUERY_INFORMATION = &H400Public Declare Function SetWindowPos& Lib "user32" (ByVal _hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, _ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, _ByVal wFlags As Long)Const HWND_TOPMOST = -1Const SWP_NOSIZE = &H1Const SWP_NOMOVE = &H2' Set frm to the Form you want to put on top.Public Sub StayOnTop(frm As Form)  SetWindowPos frm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZEEnd Sub' Set strPath to the path of the appPublic Sub ShellWaitUntilClosed(strPath As String)Dim lngPID As LongDim lngHP As LongDim lngExitCode As LonglngPID = Shell(strPath, vbNormalFocus)lngHP = OpenProcess(PROCESS_QUERY_INFORMATION, False, lngPID)DoGetExitCodeProcess lngHP, lngExitCodeDoEventsLoop While (lngExitCode = STILL_ACTIVE)CloseHandle lngHPEnd Sub' Closes app by title. Set strTitle to the title of the app.Public Sub CloseAppByTitle(strTitle As String)Dim lngHwnd As LonglngHwnd = FindWindow(vbNullString, strTitle)SendMessage lngHwnd, WM_CLOSE, 0, 0End Sub' Exit windows use either, EWX_LOGOFF, EWX_SHUTDOWN, ' EWX_REBOOT or EWX_FORCE in bytCloseType.Public Sub ExitWindows(bytCloseType As Byte)  If ExitWindowsEx(bytCloseType, 0) = 0 Then  Else    End  End IfEnd Sub' Opens WebsitesPublic Sub OpenWebsite(strWebsite As String)  If ShellExecute(&O0, "Open", strWebsite, vbNullString, vbNullString, _  SW_NORMAL) < 33 Then  End IfEnd Sub' Sets current directoryPublic Sub SetCurrentDir(strDirectory As String)  SetCurrentDir = SetCurrentDirectory(strDirectory)  If SetCurrentDir = 0 Then  End IfEnd Sub'Sets a key in the registry to have your app run the next ' time Windows is rebooted, or everytime Windows is rebooted.' Set AppName to the name of your application' Set CmdLine to the path of you application with any other arguments following' Set ThisUserOnly to true if the application should only be run ' when the current user reboots' Set RunEveryBoot to true if the application should run every ' reboot, instead of just the next timePublic Function RunNextBoot(ByVal AppName As String, ByVal _CmdLine As String, Optional ThisUserOnly As Boolean = False, _Optional RunEveryBoot As Boolean = False)  Dim TopKey As Long  Dim SubKey As String  Dim nRet As Long  Dim hKey As Long  Dim nResult As Long        If RunEveryBoot Then    SubKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"  Else    SubKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce"  End If    If ThisUserOnly Then    TopKey = HKEY_CURRENT_USER  Else    TopKey = HKEY_LOCAL_MACHINE  End If    nRet = RegCreateKeyEx(TopKey, SubKey, 0&, vbNullString, _  REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, hKey, nResult)    If nRet = ERROR_SUCCESS Then    nRet = RegSetValueEx(hKey, AppName, 0&, REG_SZ, _ByVal CmdLine, Len(CmdLine))    Call RegCloseKey(hKey)  End If    RunNextBoot = (nRet = ERROR_SUCCESS)End Function' Great for normal encryption. Set strKey to the password, strInPath ' to the file you want to encode/decode and strOutPath to ' the destination file.Public Sub XOREncDecFile(strKey As String, strInPath As String, strOutPath As String)  Dim strInput As String  Dim strOutput As String  Dim dblX As Double    Open strInPath For Binary As #1    strInput = Input(LOF(1), 1)  Close #1    For dblX = 1 To Len(strInput)    strKey = strKey & strKey    If Len(strKey) >= Len(strInput) Then      dblX = Len(strInput)    End If  Next dblX    For dblX = 1 To Len(strInput)    strOutput = strOutput & Chr(Asc(Mid(strInput, dblX, 1)) Xor Asc(Mid(strKey, dblX, 1)))  Next dblX    Open strOutPath For Binary As #1    Put #1, , strOutput  Close #1End Sub' Creates a Net shortcut like in the Favorites folder.Public Sub CreateINetShortcut(strPath As String, strName As String, strURL As String)      strPath = strName & ".url"      Open strPath For Output As #1     Print #1, "[InternetShortcut]"     Print #1, "URL=" & strURL   Close #1End Sub'Gets information about your system's memory'Call the function by itself.  It then loads some public variables with'the appropriate values.' UsedPhysicalMemory - what percentage of memory is currently in use' TotalPhysicalMemory - total physical memory in bytes' AvailablePhysicalMemory - available physical memory in bytes' TotalPageFile - number of bytes that the paging file can hold' AvailablePageFile - available space in the paging file in bytes' TotalVirtualMemory - the number of bytes in the virtual address space'                      accessible to a process while in user mode' AvailableVirtualMemory - the number of bytes in the virtual address'                          space accessible to a process while in user'                          mode that is unreserved and uncommittedPublic Sub GetMemoryInfo()  Dim MemStatus As MEMORYSTATUS  MemStatus.dwLength = Len(MemStatus)  GlobalMemoryStatus MemStatus  UsedPhysicalMemory = MemStatus.dwMemoryLoad  TotalPhysicalMemory = MemStatus.dwTotalPhys  AvailablePhysicalMemory = MemStatus.dwAvailPhys  TotalPageFile = MemStatus.dwTotalPageFile  AvailablePageFile = MemStatus.dwAvailPageFile  TotalVirtualMemory = MemStatus.dwTotalVirtual  AvailableVirtualMemory = MemStatus.dwAvailVirtualEnd Sub

Page 4 of 7

Comment and Contribute


(Maximum characters: 1200). You have characters left.



Enterprise Development Update

Don't miss an article. Subscribe to our newsletter below.

By submitting your information, you agree that developer.com may send you developer offers via email, phone and text message, as well as email offers about other products and services that developer believes may be of interest to you. developer will process your information in accordance with the Quinstreet Privacy Policy.


We have made updates to our Privacy Policy to reflect the implementation of the General Data Protection Regulation.
Thanks for your registration, follow us on our social networks to keep up-to-date