Wall changer

Wrote a wallpaper changer. Yes its vbscript and yes I felt the way many do about vbscript and its many variations but, it pays the bills so I'm dealin bitches!!!!!lol

dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
ExecuteGlobal fso.OpenTextFile("global_functions.vbs").ReadAll
set fso = nothing

if err.Number <> 0 then
    msgbox "ERROR INCLUDING FILE"
    WScript.Quit
end if

'On Error Resume Next
'Wallpaper Changer

dim objFileSystem
dim objWShell : set objWShell = CreateObject("WScript.Shell")

set objFileSystem = CreateObject("Scripting.FileSystemObject")

dim strError            : strError = ""
'dim arrArgs             : arrArgs = new Array()
dim strFullWallLocation    : strFullWallLocation = ""
dim objRegExp            : set objRegExp = createObject("VBScript.RegExp")
dim arrFileList

dim strExts                : strExts  = ".png|.bmp|.jpg"
dim arrExts                : arrExts = split(strExts, "|")
dim strDir                 : strDir = objWShell.CurrentDirectory & "\Walls\"
dim strFileName            : strFileName = "Wallpaper_List"
dim strFile                : strFile = ""
dim cnt                    : cnt = 0

dim strRandomWall        : strRandomWall = ""
dim strResultFullPath    : strResultFullPath = ""


set objFileSystem = CreateObject("Scripting.FileSystemObject")
dim objFolder
dim objFiles
dim objNewFile

set objFolder = objFileSystem.GetFolder(strDir)
set objFiles = objFolder.Files

'end of global declarations
'--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

'call to main
strError = lfMain

if not gfIsEmpty(strError) then
    msgbox strError
end if


function lfMain
   
    lfMain = ""
   
    if not objFileSystem.FileExists(strDir & strFileName) then
        set objNewFile = objFileSystem.CreateTextFile(strDir & strFileName & ".txt")
    else
        set objNewFile = objFileSystem.OpenTextFile(strDir & strFileName & ".txt", 2, true)
    end if
   
    objRegExp.global = true
    objRegExp.IgnoreCase = true
    objRegExp.Pattern = "^.*\.(png|jpg|bmp)$"
   
    for each fileIndex In objFiles
        if objRegExp.Test(fileIndex.Name) = true then
            objNewFile.WriteLine(fileIndex.Name)
        end if
    next

    objNewFile.close
   
    strResultFullPath = lfGetRandomWall(strDir, strFileName)
    do while mid(trim(strResultFullPath),len(strResultFullPath)-3)<>".bmp"
        strResultFullPath = lfGetRandomWall(strDir, strFileName)
    loop

    if objFileSystem.FileExists(strResultFullPath) then
        objWShell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper" , strResultFullPath
        gfUpdateRegistry
    end if
   
end function


function lfGetRandomWall(strDir, strFileName)
    strFile = gfGetFileList(strDir, strFileName)
    arrFileList = Split(strFile, chr(13))
    objRegExp.Pattern = objRegExp.Pattern = "^.*\.(png|jpg)$"
    strRandomWall = trim(Replace(arrFileList(gfRandomInt(lbound(arrFileList), ubound(arrFileList))),Chr(10), "" ))

    if objRegExp.Test(strFullWallLocation) = true then
        strFullWallLocation = lfConvert(strFullWallLocation)
    else
        strFullWallLocation = strDir & strRandomWall
    end if
   
    lfGetRandomWall = strFullWallLocation

end function


function lfConvert(strFullWallLocation)
    dim strConvertedWall : strConvertedWall = ""
    strConvertedWall = trim(objRegExp.Replace(strFullWallLocation,".bmp"))
    objWShell.Run "i_view32.exe " & strFullWallLocation & "/convert=" & strConvertedWall
    strFullWallLocation = strDir & strConvertedWall
    lfConvert = strFullWallLocation
   
end function

Bump if you want me to post a function from the global_functions or where to get the exe

Have you read your fanmail today?

I don't care really, just felt like posting it somewhere....

Dim my anus.