API call ; I need to get the currentwallpaper ; This code may help

Posted on 2005-05-13
Last Modified: 2010-04-23
sorry i dont remembe where i got this code,,, but it dosnt work anyway (grin)
but im looking to get the currentwallpaper section to work, TIA

 Three functions, LoadWallpaper, ResetWallpaper, and CurrentWallpaper do what their name implies.
 Option Explicit

Private Const HKEY_CURRENT_USER = &H80000001
Private Const REG_SZ = 1

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
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
   "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
   ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, _
   lpcbData As Long) As Long
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 RegCloseKey Lib "advapi32.dll" (ByVal hKey _
   As Long) As Long

Public Sub LoadWallpaper(sFilename As String)

    SystemParametersInfo SPI_SETDESKWALLPAPER, 0, sFilename, _

End Sub

Public Sub ResetWallpaper()

    SystemParametersInfo SPI_SETDESKWALLPAPER, 0, CurrentWallpaper, 0

End Sub

Public Function CurrentWallpaper() As String

    Dim sValue As String
    Dim nReturn As Long
    Dim hKey As Long
    RegOpenKeyEx HKEY_CURRENT_USER, "Control panel\desktop", 0, 0, hKey
    nReturn = 1024
    sValue = Space(1024)
    RegQueryValueEx hKey, "Wallpaper", 0, REG_SZ, sValue, nReturn

    sValue = Mid(sValue, 1, nReturn)

    RegCloseKey hKey

    CurrentWallpaper = sValue

End Function

Sample Usage:
 LoadWallpaper "c:\windows\clouds.bmp"

Question by:5thcav
    LVL 13

    Accepted Solution

    (stolen from ) :)

    Imports Microsoft.Win32
        Public Function RegValue(ByVal Hive As RegistryHive, _
           ByVal Key As String, ByVal ValueName As String, _
           OptionalByRef ErrInfo As String = "") As String
          'DEMO USAGE

            'Dim sAns As String
            'Dim sErr As String = ""

            'sAns = RegValue(RegistryHive.LocalMachine, _
            '  "SOFTWARE\Microsoft\Windows\CurrentVersion", _
            '  "ProgramFilesDir", sErr)
            'If sAns <> "" Then
            '    Debug.WriteLine("Value = " & sAns)
            '    Debug.WriteLine("This error occurred: " & sErr)

            'End If

            Dim objParent As RegistryKey
            Dim objSubkey As RegistryKey
            Dim sAns As String
            Select Case Hive
                Case RegistryHive.ClassesRoot
                    objParent = Registry.ClassesRoot
                Case RegistryHive.CurrentConfig
                    objParent = Registry.CurrentConfig
                Case RegistryHive.CurrentUser
                    objParent = Registry.CurrentUser
                Case RegistryHive.DynData
                    objParent = Registry.DynData
                Case RegistryHive.LocalMachine
                    objParent = Registry.LocalMachine
                Case RegistryHive.PerformanceData
                    objParent = Registry.PerformanceData
                Case RegistryHive.Users
                    objParent = Registry.Users

            End Select

                objSubkey = objParent.OpenSubKey(Key)
                'if can't be found, object is not initialized
                If Not objSubkey Is Nothing Then
                    sAns = (objSubkey.GetValue(ValueName))
                End If

            Catch ex As Exception

                ErrInfo = ex.Message

                'if no error but value is empty, populate errinfo
                If ErrInfo = "" And sAns = "" Then
                    ErrInfo = _
                       "No value found for requested registry key"
                End If
            End Try
            Return sAns
        End Function

    Now adjust your function:
    Public Function CurrentWallpaper() As String
            Dim sAns As String
            Dim sErr As String = ""

            sAns = RegValue(RegistryHive.CurrentUser,  "Control Panel\Desktop", "Wallpaper", sErr)
            If sAns <> "" Then
                Return sAns
                Return "" ' error in sErr, could raise one if you wanted to
            End If
    End Function

    Good? :)
    LVL 7

    Author Comment

    we will soon see! :)
    LVL 7

    Author Comment


    Featured Post

    How your wiki can always stay up-to-date

    Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
    - Increase transparency
    - Onboard new hires faster
    - Access from mobile/offline

    Join & Write a Comment

    Introduction When many people think of the WebBrowser ( control, they immediately think of a control which allows the viewing and navigation of web pages. While this is true, it's a…
    It’s quite interesting for me as I worked with Excel using for some time. Here are some topics which I know want to share with others whom this might help. First of all if you are working with Excel then you need to Download the Following …
    To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…
    In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor ( If you're interested in additional methods for monitoring bandwidt…

    731 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    15 Experts available now in Live!

    Get 1:1 Help Now