[Webinar] Streamline your web hosting managementRegister Today

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 203
  • Last Modified:

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

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"

  • 2
1 Solution
(stolen from http://www.freevbcode.com/ShowCode.asp?ID=4487 ) :)

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

        '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? :)
5thcavAuthor Commented:
we will soon see! :)
5thcavAuthor Commented:

Featured Post

The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now