VB code for automatic wallpaper replacement

I found a lot of codes related to wallpaper setting on the Internet, but they all seem to have some small defects. At least they can be debugged only after being modified on my computer. So I wrote the following code, it should be okay to take the length of each family.

'Statement about system settings
Private const spi_set1_wallpaper = 20
Private const spif_sendwininichange = & H2
Private const spif_updateinifile = & H1
Private declare function systemparametersinfo lib "USER32" alias "systemparametersinfoa" (byval uaction as long, byval uparam as long, byval lpvparam as any, byvalfuwinini as long) as long

'Statement about modifying the Registry
Const REG_SZ as long = 1
Const REG_BINARY = 3
Const REG_DWORD = 4
Const HKEY_CURRENT_USER = & h80000001
Private declare function regclosekey lib "advapi32.dll" (byval hkey as long) as long
Private declare function regopenkey lib "advapi32.dll" alias "regopenkeya" (byval hkey as long, byval lpsubkey as string, 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 regdeletekey lib "advapi32.dll" alias "regdeletekeya" (byval hkey as long, byval lpsubkey as string) as long
Private declare function regcreatekey lib "advapi32.dll" alias "regcreatekeya" (byval hkey as long, byval lpsubkey as string, phkresult as long) as long

Dim filearray () as string 'array of file names
Dim I as integer
Dim path as string 'Save the string of the wallpaper folder path

'Custom function for modifying the registry key value
Private sub setreg (rootstr as string, name as string, value as string, l as long)
Dim hkey as long
Dim temp as string * 255
Temp = Value & CHR $ (0)
Regopenkey HKEY_CURRENT_USER, rootstr, hkey
Regsetvalueex hkey, name, 0, REG_SZ, byval temp, l
Regclosekey hkey
End sub

'Get all wallpaper file names and put them in filearray
Private sub dirpath ()
Dim filenames as string

Path = "C:/Documents and Settings/Administrator/My Documents documents/shorttop_jpg/" 'modify this sentence and replace it with the path of your wallpaper folder.
Filenames = Dir (path + "*. jpg ")
Do While filenames <> ""
I = I + 1
Redim preserve filearray (I)
Filearray (I) = filenames
Filenames = dir': Call the Dir function again, without Parameters
Loop
End sub
Private sub form_load ()
Dim myvalue as integer
Dim cureentpic as string

'Set the program to self-start
Dim hkey as long
Dim temp as string * 255
Temp = app. Path + "/autodesktop.exe" & CHR $ (0)
Regopenkey HKEY_CURRENT_USER, "software/Microsoft/Windows/CurrentVersion/run", hkey
Regsetvalueex hkey, "Auto", 0, REG_SZ, byval temp, 255
Regclosekey hkey

Dirpath
Randomize
Myvalue = (I-1) * RND + 1
'Convert the file format from JPG to BMP.
Imgvector. Picture = loadpicture (path + filearray (myvalue ))
Cureentpic = path + "my.bmp"
Savepicture imgvector, cureentpic

Call systemparametersinfo (spi_set?wallpaper, 0, "", spif_updateinifile) 'clear the wallpaper settings
Systemparametersinfo spi_set1_wallpaper, 0, byval cureentpic, spif_updateinifile 'change the wallpaper
'Set the wallpaper to "stretch"
Setreg "Control Panel/desktop", "tilewallpaper", "0", 4
Setreg "Control Panel/desktop", "wallpaperstyle", "2", 4
'Save the wallpaper file name to the Registry
Setreg "Control Panel/desktop", "Wallpaper", cureentpic, 255
'Close the program
End
End sub