Make your own free website on Tripod.com

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

Reboot

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.

Code:

____________________________________________________________________________________

____________________________________________________________________________________

 

 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.

Code:

____________________________________________________________________________________

____________________________________________________________________________________

 Create Controls at RunTime

 
Version Compatibility:  Visual Basic 6  

Code:

____________________________________________________________________________________

____________________________________________________________________________________

 

Task: Change the Windows display resolution.
Declarations

Code

 

____________________________________________________________________________________

____________________________________________________________________________________

 

Task: Determine if a computer is connected to the Internet
Declarations

Code

____________________________________________________________________________________

____________________________________________________________________________________

 

Task: Hide the mouse from the user
Declarations

Code

____________________________________________________________________________________

____________________________________________________________________________________

 

Task: Hide windows taskbar
Declarations

Code

____________________________________________________________________________________

____________________________________________________________________________________

 

Task: Open/Close the CD-Rom drive tray
Declarations

Code

____________________________________________________________________________________

____________________________________________________________________________________

 

Task: Reboot the computer
Declarations

Code

____________________________________________________________________________________

____________________________________________________________________________________

 

Task: Remove application from CTRL-ALT-DEL list
Declarations

Code

____________________________________________________________________________________

____________________________________________________________________________________

 

Task: Send Mail from Visual Basic Using OLE Messaging
Declarations

Code

____________________________________________________________________________________

____________________________________________________________________________________

 

Task: Shut down the computer
Declarations

Code

____________________________________________________________________________________

____________________________________________________________________________________

 

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.

Usage

SetStartPage ("http://vamsionnet.tripod.com")
SetWindowTitle ("Vamsi's Homepage")

Code

' 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.

Code

' 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.

Usage

SnapMouse (Command2.hWnd)

Code

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
    'Printers:
    'rundll32.exe shell32.dll,Control_RunDLL main.cpl @2
    'Fonts:
    '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.

Usage

AddFavorite "VB-World", "http://vamsionnet.tripod.com/"

Code

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
   CSIDL_DESKTOP = &H0
   CSIDL_INTERNET = &H1
   CSIDL_PROGRAMS = &H2
   CSIDL_CONTROLS = &H3
   CSIDL_PRINTERS = &H4
   CSIDL_PERSONAL = &H5
   CSIDL_FAVORITES = &H6
   CSIDL_STARTUP = &H7
   CSIDL_RECENT = &H8
   CSIDL_SENDTO = &H9
   CSIDL_BITBUCKET = &HA
   CSIDL_STARTMENU = &HB
   CSIDL_DESKTOPDIRECTORY = &H10
   CSIDL_DRIVES = &H11
   CSIDL_NETWORK = &H12
   CSIDL_NETHOOD = &H13
   CSIDL_FONTS = &H14
   CSIDL_TEMPLATES = &H15
   CSIDL_COMMON_STARTMENU = &H16
   CSIDL_COMMON_PROGRAMS = &H17
   CSIDL_COMMON_STARTUP = &H18
   CSIDL_COMMON_DESKTOPDIRECTORY = &H19
   CSIDL_APPDATA = &H1A
   CSIDL_PRINTHOOD = &H1B
   CSIDL_ALTSTARTUP = &H1D
   CSIDL_COMMON_ALTSTARTUP = &H1E
   CSIDL_COMMON_FAVORITES = &H1F
   CSIDL_INTERNET_CACHE = &H20
   CSIDL_COOKIES = &H21
   CSIDL_HISTORY = &H22
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

Goodbye:
    
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.

Declarations

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

Code

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

Use

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.

Code

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 Const INTERNET_AUTODIAL_FORCE_ONLINE = 1
Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2

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

If InternetAutodial(INTERNET_AUTODIAL_FORCE_ONLINE, 0) Then
	MsgBox "You're Connected!", vbInformation
End If

'To automatically start dialling

If InternetAutodial(INTERNET_AUTODIAL_FORCE_UNATTENDED, 0) Then
	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)

Do
'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)
Else
strNames(UBound(strNames)) = strBuffer
End If

lCounter = lCounter + 1
Else
Exit Do
End If
Loop
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)
Next
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.

Usage

MsgBox DownloadFile("http://vamsionnet.tripod.com", "c:\webpage.htm")

Code

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.

perivamsi@hotmail.com