Make your own free website on

Vamsi's Visual Basic Snippets


Prime Numbers

Start Up

Create Controls at Run Time

Change windows resolution

Determine if a computer is connected to the net

Hide Mouse

Hide Task Bar

Open Close the CD Rom drive tray


Remove application from CTRL ALT DEL list

Send mail from VB

Shut Down

VB-World - Tips - Changing Internet Explorer

VB-World - Tips - Control the Panel

VB-World - Tips - Snap the Mouse

Gcd function

Control Panel

Adding to the Favourites

Disabling Ctrl+Alt+Del

Dial the Net Automatically

Move the Mouse Cursor

Registry Loading the names of all sub keys

Dump A String To a Text File

Dialog Free Downloads

Prime NumbersThis code outputs all prime numbers up to the limit of the VB double type to the debug window, a text file, and a text box. In addition, it has the ability to optionally include non-prime numbers, and demonstrates factorizing these into a sequence of prime factors. You can also specify the number to start at, allowing you to stop processing and get on with some work, and resume processing at a later time, starting where you left off.

To use the code, create a form with one button (cmdCancel) with a caption of "Start", one check-box (chkNonPrime) with a caption of "Include non-primes", and one text-box (txtPrime). Paste the code into the form's module, and run. Click the "Start" button to start listing primes, tick the checkbox to include non-primes, or enter a number in the textbox to specify a starting point.





 StartUp: This piece of code places creates an entry for the running application in the registry key Software\Microsoft\Windows\CurrentVersion\Run, so the application will run every time the current user logs on.




 Create Controls at RunTime

Version Compatibility:  Visual Basic 6  





Task: Change the Windows display resolution.






Task: Determine if a computer is connected to the Internet





Task: Hide the mouse from the user





Task: Hide windows taskbar





Task: Open/Close the CD-Rom drive tray





Task: Reboot the computer





Task: Remove application from CTRL-ALT-DEL list





Task: Send Mail from Visual Basic Using OLE Messaging





Task: Shut down the computer





Changing Internet Explorer

If your users have Internet Explorer, why not show off with a little programmatic tweaking?

To set the user’s start page, run the SetStartPage method, passing the new Web address.

To set the title of Internet Explorer, run SetWindowTitle, passing a new title.

This code works by delving into the registry and changing certain Internet Explorer keys.

Note: If the user has already started Internet Explorer and this code runs, the changes will not take place until the next reboot.


SetStartPage ("")
SetWindowTitle ("Vamsi's Homepage")


' Code to be placed in a module!

Declare Function RegCreateKey Lib _
    "advapi32.dll" Alias "RegCreateKeyA" _
    (ByVal HKey As Long, ByVal lpSubKey As _
    String, phkResult As Long) As Long

Declare Function RegCloseKey Lib _
    "advapi32.dll" (ByVal HKey As Long) As Long

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) As Long

Public Const REG_SZ = 1
Public Const HKEY_CURRENT_USER = &H80000001

Public Sub SaveString(HKey As Long, Path As String, _
    Name As String, Data As String)
    Dim KeyHandle As Long
    Dim r As Long
    r = RegCreateKey(HKey, Path, KeyHandle)
    r = RegSetValueEx(KeyHandle, Name, 0, _
        REG_SZ, ByVal Data, Len(Data))
    r = RegCloseKey(KeyHandle)

End Sub

Public Sub SetStartPage(URL As String)

    Call SaveString(HKEY_CURRENT_USER, _
        "Software\Microsoft\Internet Explorer\Main", _
        "Start Page", URL)
End Sub

Public Sub SetWindowTitle(Title As String)

    Call SaveString(HKEY_CURRENT_USER, _
        "Software\Microsoft\Internet Explorer\Main", _
        "Window Title", Title)
End Sub




Control the Panel

Need to run items from the Control Panel? This sneaky set of code snippets show you how to do everything, from launching the Display Properties through to starting the Dial-Up Networking Wizard - all in one line of code.

Simply scroll through the below list and copy-and-paste the command you require!

This code works by using the shell command to execute RunDLL32.exe, passing it special arguments pertaining to individual Control Panel items.


' Display the Control Panel
Call Shell("rundll32.exe shell32.dll,Control_RunDLL", vbNormalFocus)

'Display the Accessibility Properties
Call Shell("rundll32.exe shell32.dll,Control_RunDLL access.cpl", vbNormalFocus)

'Display Add/Remove Programs
Call Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl", vbNormalFocus)

'Show the Display Settings (Background)
Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0", vbNormalFocus)

'Show the Display Settings (Screensaver)
Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1", vbNormalFocus)

'Show the Display Settings (Appearance)
Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,2", vbNormalFocus)

'Show the Display Settings (Settings)
Call Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3", vbNormalFocus)

'Display Internet Properties
Call Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl", vbNormalFocus)

'Display Regional Settings
Call Shell("rundll32.exe shell32.dll,Control_RunDLL intl.cpl", vbNormalFocus)

'Display the Joystick Settings
Call Shell("rundll32.exe shell32.dll,Control_RunDLL joy.cpl", vbNormalFocus)

'Display the Mouse Settings
Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @0", vbNormalFocus)

'Display the Keyboard Settings
Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @1", vbNormalFocus)

'Display Printers
Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @2", vbNormalFocus)

'Display Fonts
Call Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @3", vbNormalFocus)

'Display Multimedia Settings
Call Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl", vbNormalFocus)

'Display Modem Settings
Call Shell("rundll32.exe shell32.dll,Control_RunDLL modem.cpl", vbNormalFocus)

'Display Dial-Up Networking Wizard (on Win9x)
Call Shell("rundll32.exe rnaui.dll,RnaWizard", vbNormalFocus)

'Display System Properties
Call Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl", vbNormalFocus)

'Run 'Add New Hardware' Wizard (on Win9x)
Call Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1", vbNormalFocus)

'Display 'Add New Printer' Wizard (on Win9x)
Call Shell("rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter", vbNormalFocus)

'Display Themes Settings
Call Shell("rundll32.exe shell32.dll,Control_RunDLL themes.cpl", vbNormalFocus)

'Display Time/Date Settings
Call Shell("rundll32.exe shell32.dll,Control_RunDLL timedate.cpl", vbNormalFocus)



Snap the Mouse

Snapping the mouse to a certain position on the screen is a great little trick.

It can help suggest a command button to the user or simply make your program easier to use. And this groovy code snippet shows you how to do just that...

To use, simply call the SnapMouse method, passing the hWnd of the object you want to centre the mouse over. You’ll find that most objects come with a .hWnd property.


SnapMouse (Command2.hWnd)


Private Declare Function SetCursorPos Lib "user32" _
    (ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function GetWindowRect Lib "user32" _
    (ByVal hWnd As Long, lpRect As RECT) As Long

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Public Sub SnapMouse(ByVal hWnd As Long)
    Dim lpRect As RECT
    GetWindowRect hWnd, lpRect
    SetCursorPos lpRect.Left + (lpRect.Right - lpRect.Left) \ 2, _
        lpRect.Top + (lpRect.Bottom - lpRect.Top) \ 2

End Sub



There are two functions. The other one is below Math_GCF.
Public Function Math_GCF(number1 As Double, number2 As Double) As Double
If number1 > number2 Then a = number2
If number2 > number1 Then a = number1
If number1 = number2 Then a = number1
n1 = number1: n2 = number2
h = n2 / n1
h2 = n1 / n2
If n1 > n2 Then
If Math_IsInteger(Val(h2)) Then Math_GCF = n2: Exit Function
End If
If n2 > n1 Then
If Math_IsInteger(Val(h)) Then Math_GCF = n1: Exit Function
End If
y = Math_LCM(number1, number2)
y = Val(y)
x = 1
Do: DoEvents
y = Math_LCM(Val(n1), Val(n2)) / Val(x)
b = n1 / x
c = n2 / x
If Math_IsInteger(Val(y)) Then
If Math_IsInteger(Val(b)) Then
If Math_IsInteger(Val(c)) Then
GCF = x
End If
End If
End If
x = x + 1
Loop Until x = a
Math_GCF = GCF
If n1 > n2 Then
Y1 = Math_LCM(Val(n1), Val(n2))
Y1 = Val(Y1) / Val(n2)
b = n1 / n2
c = n2 / n2
If Math_IsInteger(Val(Y1)) Then
If Math_IsInteger(Val(b)) Then
If Math_IsInteger(Val(c)) Then
GCF = n2
End If
End If
End If
End If
If n1 < n2 Then
Y1 = Math_LCM(Val(n1), Val(n2))
Y1 = Val(Y1) / Val(n1)
b = n1 / n1
c = n2 / n1
If Math_IsInteger(Val(Y1)) Then
If Math_IsInteger(Val(b)) Then
If Math_IsInteger(Val(c)) Then
GCF = n1
End If
End If
End If
End If
Math_GCF = GCF
End Function
Public Function Math_IsInteger(number as double) as double
n1 = Trim(str(number))
n = InStr(1, n1, ".")
If n = 0 Then Math_IsInteger = True
If n > 0 Then Math_IsInteger = False
End Function



    // Name: Control Panel
    // Description:access some control panel
    //     applets 
    // By: Vamsi Krishna
    Attribute VB_Name = "ControlPanel32"
    'Control Panel( CONTROL.EXE )
    'Control Panel:
    'rundll32.exe shell32.dll,Control_RunDLL
    'Accessability Options( ACCESS.CPL )
    'Accessability Properties (Keyboard):
    'rundll32.exe shell32.dll,Control_RunDLL access.cpl,,1
    'Accessability Properties (Sound):
    'rundll32.exe shell32.dll,Control_RunDLL access.cpl,,2
    'Accessability Properties (Display):
    'rundll32.exe shell32.dll,Control_RunDLL access.cpl,,3
    'Accessability Properties (Mouse):
    'rundll32.exe shell32.dll,Control_RunDLL access.cpl,,4
    'Accessability Properties (General):
    'rundll32.exe shell32.dll,Control_RunDLL access.cpl,,5
    'Add/Remove Programs( APPWIZ.CPL )
    'Add/Remove Programs Properties (Install/Uninstall):
    'rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1
    'Add/Remove Programs Properties (Windows Setup):
    'rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,2
    'Add/Remove Programs Properties (Startup Disk):
    'rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,3
    'Display Options( DESK.CPL )
    'Display Properties (Background):
    'rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0
    'Display Properties (Screen Saver):
    'rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,1
    'Display Properties (Appearance):
    'rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,2
    'Display Properties (Settings):
    'rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,3
    'Regional Settings( INTL.CPL )
    'Regional Settings Properties (Regional Settings):
    'rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,0
    'Regional Settings Properties (Number):
    'rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,1
    'Regional Settings Properties (Currency):
    'rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,2
    'Regional Settings Properties (Time):
    'rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,3
    'Regional Settings Properties (Date):
    'rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,4
    'Joystick Options( JOY.CPL )
    'Joystick Properties (Joystick):
    'rundll32.exe shell32.dll,Control_RunDLL joy.cpl
    'Mouse/Keyboard/Printers/Fonts Options( MAIN.CPL )
    'Mouse Properties:
    'rundll32.exe shell32.dll,Control_RunDLL main.cpl @0
    'Keyboard Properties:
    'rundll32.exe shell32.dll,Control_RunDLL main.cpl @1
    'rundll32.exe shell32.dll,Control_RunDLL main.cpl @2
    'rundll32.exe shell32.dll,Control_RunDLL main.cpl @3
    'Mail and Fax Options( MLCFG32.CPL )
    'Microsoft Exchange Profiles (General):
    'rundll32.exe shell32.dll,Control_RunDLL mlcfg32.cpl
    'Multimedia/Sounds Options( MMSYS.CPL )
    'Multimedia Properties (Audio):
    'rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,0
    'Multimedia Properties (Viedo):
    'rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,1
    'Multimedia Properties (MIDI):
    'rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,2
    'Multimedia Properties (CD Music):
    'rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,3
    'Multimedia Properties (Advanced):
    'rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,4
    ' = = = = = = = = = = = = = = = = = = = = = = = = = = =
    'Sounds Properties:
    'rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl @1
    'Modem Options( MODEM.CPL )
    'Modem Properties (General):
    'rundll32.exe shell32.dll,Control_RunDLL modem.cpl
    'Network Options( NETCPL.CPL )
    'Network (Configuration):
    'rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl
    'Password Options( PASSWORD.CPL )
    'Password Properties (Change Passwords):
    'rundll32.exe shell32.dll,Control_RunDLL password.cpl
    'System/Add New Hardware Options( SYSDM.CPL )
    'System Properties (General):
    'rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,0
    'System Properties (Device Manager):
    'rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,1
    'System Properties (Hardware Profiles):
    'rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,2
    'System Properties (Performance):
    'rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,3
    ' = = = = = = = = = = = = = = = = = = = = = = = = = = =
    'Add New Hardware Wizard:
    'rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl @1
    'Date and Time Options( TIMEDATE.CPL )
    'Date/Time Properties:
    'rundll32.exe shell32.dll,Control_RunDLL timedate.cpl
    'Microsoft Mail Postoffice Options( WGPOCPL.CPL )
    'Microsoft Workgroup Postoffice Admin:
    'rundll32.exe shell32.dll,Control_RunDLL wgpocpl.cpl
    Dim Shared XFS As Integer
    Sub ControlPanel(Filename As String)
    Dim T As Double
    On Error Resume Next
    T = Shell(Filename, 5)
    End Sub



Adding to the Favourites

Fancy adding your Web site to the list of Favourites?

This sneaky commented code snippet shows you how.

To run, simply call AddFavorite, passing your site name and Web address. This code works by grabbing the location of the Favorite folder with the help of a couple of API calls. It then creates an Internet 'link' file in that location, using the passed site name and address.


AddFavorite "VB-World", ""


Private Declare Function SHGetSpecialFolderLocation _
    Lib "shell32.dll" (ByVal hwndOwner As Long, _
   ByVal nFolder As SpecialShellFolderIDs, _
   pidl As Long) As Long
Private Declare Function SHGetPathFromIDList _
    Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
    (ByVal pidl As Long, _
    ByVal pszPath As String) As Long

Private Declare Sub CoTaskMemFree Lib "ole32.dll" _
    (ByVal pv As Long)

Public Enum SpecialShellFolderIDs
End Enum

Public Sub AddFavorite(SiteName As String, URL As String)

Dim pidl As Long
Dim intFile As Integer
Dim strFullPath As String

On Error GoTo Goodbye

intFile = FreeFile
strFullPath = Space(255)

'Check the API for the folder existence and location

If SHGetSpecialFolderLocation(0, CSIDL_FAVORITES, pidl) = 0 Then

	If pidl Then

		If SHGetPathFromIDList(pidl, strFullPath) Then

			' Trim any null characters

			If InStr(1, strFullPath, Chr(0)) Then
				strFullPath = Mid(strFullPath, 1, _
					InStr(1, strFullPath, Chr(0)) - 1)
			End If

			' Add back slash, if none exists

			If Right(strFullPath, 1) <> "\" Then
				strFullPath = strFullPath & "\"
			End If

			' Create the link

			strFullPath = strFullPath & SiteName & ".URL"
			Open strFullPath For Output As #intFile
			Print #intFile, "[InternetShortcut]"
			Print #intFile, "URL=" & URL
			Close #intFile

		End If

		CoTaskMemFree pidl

	End If

End If

End Sub

Disabling Ctrl-Alt-Delete and Ctrl-Esc

It is often useful in Visual Basic programs to be able to disable the Ctrl-Alt-Delete key sequence. It is easily done by persuading Windows that a screen saver is running. This code also disables Ctrl-Esc, that is used to activate the Start Menu.


Copy this code into the declarations section of your project.

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


Sub DisableCtrlAltDelete(bDisabled As Boolean)
    Dim X As Long
    X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub


To disable Ctrl-Alt-Delete:

Call DisableCtrlAltDelete(True)

To enable Ctrl-Alt-Delete:

Call DisableCtrlAltDelete(False)

Dial the Net Automatically

Does your application need to connect to the Internet?

Most code snippets simply show you how to display a typical connection dialog box. This method has three basic flaws; it doesn't force a dial-up, often requires the name of the connection and doesn't let you know when a connection has been made.

Thankfully this code snippet solves all those problems by using Internet Explorer's own automatic dial-up settings.

If you double-click the Internet Options icon in the Control Panel, you'll notice the Connections tab hosts a list of possible dial-up connections.

This snippet utilises a couple of little-known API calls that can automatically dial-up and disconnect from the default connection in that list – just like Internet Explorer does if it needs to connect to the Net.

Note: If the 'Never Dial a Connection' option is selected, this code will not be able to connect. It does as Internet Explorer does, and Internet Explorer simply wouldn't connect if that option was selected.

It's worth noting that this code pauses until the connection is actually made - or not, as the case may be. And that's definitely a good thing.


This code is designed to be placed inside a Form with a Command Button.

Private Declare Function InternetAutodial Lib "wininet.dll" _
(ByVal dwFlags As Long, ByVal dwReserved As Long) As Long


Private Declare Function InternetAutodialHangup Lib "wininet.dll" _
(ByVal dwReserved As Long) As Long

Private Sub Command1_Click()

'To prompt the user to connect to the Net

	MsgBox "You're Connected!", vbInformation
End If

'To automatically start dialling

	MsgBox "You're Connected!", vbInformation
End If

'To disconnect an automatically dialled connection

If InternetAutodialHangup(0) Then
   MsgBox "You're Disconnected!", vbInformation
End If

End Sub

How can I move the mouse cursor?

You can use the SetCursorPos Api function. It accepts two parameters. These are the x position and the y position in screen pixel coordinates. You can get the size of the screen by calling GetSystemMetrics function with the correct constants. This example puts the mouse cursor in the top left hand corner.

t& = SetCursorPos(0,0)

This will only work if the formula has bee declared in the declarations section:

Declare Function SetCursorPosition& Lib "user32" _
(ByVal x As Long, ByVal y As Long)



Loading the Names of All Sub-Keys

Public Function GetAllKeys(hKey As Long, _
strPath As String) As Variant
Dim lRegResult As Long
Dim lCounter As Long
Dim hCurKey As Long
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim strNames() As String
Dim intZeroPos As Integer
lCounter = 0
lRegResult = RegOpenKey(hKey, strPath, hCurKey)

'initialise buffers (longest possible length=255)
lDataBufferSize = 255
strBuffer = String(lDataBufferSize, " ")
lRegResult = RegEnumKey(hCurKey, _
lCounter, strBuffer, lDataBufferSize)

If lRegResult = ERROR_SUCCESS Then

'tidy up string and save it
ReDim Preserve strNames(lCounter) As String

intZeroPos = InStr(strBuffer, Chr$(0))
If intZeroPos > 0 Then
strNames(UBound(strNames)) = Left$(strBuffer, intZeroPos - 1)
strNames(UBound(strNames)) = strBuffer
End If

lCounter = lCounter + 1
Exit Do
End If
GetAllKeys = strNames
End Function

This function works using the RegEnumKey function. You pass a number to the function and it returns the name of the sub key holding that position. These are numbered from 0, starting with the oldest, so you can get some idea of the age of keys using this API call. It initialises the buffer, and then makes the call. If the call returns ERROR_SUCCESS, there was a key at that number, but if it returns something else, there was either a problem, or all the keys have been retrieved.  It adds the retrieved name to an array, and continues. If there was an error, it exits the loop, otherwise it just keeps going.
The function returns an array of names in a variant. You would use it as follows:

Dim SubKeys As Variant
Dim KeyLoop As Integer
SubKeys = GetAllKeys(HKEY_CURRENT_USER, vbNullString)

If VarType(SubKeys) = vbArray + vbString Then
For KeyLoop = 0 To UBound(SubKeys)
Debug.Print SubKeys(KeyLoop)
End If


Dump String To File

Sub Dump_String_To_File (ByVal strString As String, ByVal strFile As String)
Dim fileFile As Integer
fileFile = FreeFile
Open strFile For Output As fileFile
Write #fileFile, strString
Close fileFile
Dim intReturn
On Error Resume Next
intReturn = Shell("c:\apps\utility\textpad\txtpad16.exe " & strFile, 1)
On Error Goto 0
End Sub



Dialog-Free Downloads

So you want to grab an Internet file, but think the Inet control is buggier than an ant's nest?

Need to start an online download but want to skip those annoying user dialog boxes?

This slice of code uses a sneaky API call to solve all your worries.

Just call the DownloadFile function, passing it your URL and local filename. The function will then use the API to download the file and return a True if successful.


MsgBox DownloadFile("", "c:\webpage.htm")


Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
    "URLDownloadToFileA" (ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long

Public Function DownloadFile(URL As String, _
    LocalFilename As String) As Boolean

    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True

End Function


This page was created by Vamsi Krishna.