Are You Safer Now? Listing 1

The AutoRun routine will tell Windows to automatically start your application (or not) whenever the current user logs in. Pass a user-recognizable string as the ProductName, and a full command line (with any needed parameters) as the CmdLine. If you're still using VB5, you can download VB5 implementations of the VB6 string functions > from my Web site. Be aware that trying to set an autorun for all users will require administrative privileges. It's a good idea to always enclose the fully qualified filespec of your executable with quotes, in case it contains spaces.
' Registry API declares
Private 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
Private 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         
Private Declare Function RegDeleteValue Lib "advapi32.dll" _
   Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As _
   String) As Long
Private Declare Function RegFlushKey Lib "advapi32.dll" _
   (ByVal hKey As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
   (ByVal hKey As Long) As Long

' A few constants used with registry APIs
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const ERROR_SUCCESS As Long = 0&
Private Const REG_SZ As Long = 1

' Reg Key Security Options
Private Const DELETE = &H10000
Private Const READ_CONTROL = &H20000
Private Const WRITE_DAC = &H40000
Private Const WRITE_OWNER = &H80000
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_READ = _
   ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS _
   Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const KEY_WRITE = _
   ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) _
   And (Not SYNCHRONIZE))
Private 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))
Private Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))

Public Function AutoRun( _
   ByVal ProductName As String, _
   ByVal CmdLine As String, _
   Optional Enabled As Boolean = True) _
   As Boolean

   Dim nRet As Long
   Dim hKey As Long
   Dim RunKey As String

   ' Need to build this string at runtime, to avoid
   ' McAfee triggering a Trojan alert!
   RunKey = Join(Array("SOFTWARE", "Microsoft", _
            "Windows", "CurrentVersion", "Run"), "\")

   ' Open a key and set a value within it.
   If RegOpenKeyEx(HKEY_CURRENT_USER, RunKey, 0&, KEY_ALL_ACCESS, hKey) _
      = ERROR_SUCCESS Then

      ' Should this key be added or deleted?
      If Enabled Then
         ' Attempt to write autorun command line.
         nRet = RegSetValueEx(hKey, ProductName, 0&, REG_SZ, _
                ByVal CmdLine, Len(CmdLine))
         Call RegFlushKey(hKey)
         Call RegCloseKey(hKey)
      Else
         ' Attempt to delete this value.
         nRet = RegDeleteValue(hKey, ProductName)
         ' Return result of RegDeleteValue call.
         Call RegCloseKey(hKey)
      End If

      ' Return result of RegSetValueEx or RegDeleteValue call.
      AutoRun = (nRet = ERROR_SUCCESS)
   End If
End Function
comments powered by Disqus
Most   Popular
Upcoming Events

.NET Insight

Sign up for our newsletter.

Terms and Privacy Policy consent

I agree to this site's Privacy Policy.