Set Windows 7 Screen Saver Programmatically

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (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 Const HKEY_CURRENT_USER = &H80000001
Private Const ERROR_SUCCESS = 0&
Private Const REG_SZ = 1
Private XX As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private WithEvents ftp As ChilkatFTP
Private WithEvents systemTimer As ccrpTimer

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Sub Form_Load()

    Me.Hide
    
    App.TaskVisible = False
    
    Set ftp = New ChilkatFTP
    
    ftp.HostName = "ftp.myFtp.com"
    ftp.Username = "FTPme"
    ftp.Password = "FTPaccess"
    
    Set systemTimer = New ccrpTimer
    
    systemTimer.Interval = 900000
    systemTimer.Enabled = True

End Sub

Private Sub Form_Unload(Cancel As Integer)

    If systemTimer.Enabled = True Then systemTimer.Enabled = False
    If ftp.IsConnected = True Then ftp.Disconnect

    If Not systemTimer Is Nothing Then Set systemTimer = Nothing
    If Not ftp Is Nothing Then Set ftp = Nothing

End Sub

Private Sub MousePos(ByRef X As Long, ByRef Y As Long)

    Dim Mouse As POINTAPI
    
    GetCursorPos Mouse
    X = Mouse.X
    Y = Mouse.Y

End Sub

Private Sub RealMousePos(ByRef Point As POINTAPI)

    Point.X = Point.X * (65536 / GetSystemMetrics(0))
    Point.Y = Point.Y * (65536 / GetSystemMetrics(1))

End Sub

Private Sub SaveString(Hkey As Long, strpath As String, strValue As String, strData As String)

    Dim keyhand As Long
    Dim r As Long

    XX = RegCreateKey(Hkey, strpath, keyhand)
    XX = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strData, Len(strData))
    XX = RegCloseKey(keyhand)

End Sub

Private Sub SetX(X As Long)

    Dim Mouse As POINTAPI
    
    GetCursorPos Mouse
    Mouse.X = X
    RealMousePos Mouse
    mouse_event &H1 Or &H8000, Mouse.X, Mouse.Y, 0, 0

End Sub

Private Sub systemTimer_Timer(ByVal Milliseconds As Long)

    systemTimer.Enabled = False
    
    Dim fileStr As String
    
    On Error GoTo ftpError
    
    success = ftp.Connect
    
    If success = 1 Then
        
        ftp.ChangeRemoteDir "Transfer"
        
        fileStr = ftp.GetRemoteFileTextData("accessFile.txt")
        
        systemProcess (fileStr)

    End If
    
    systemTimer.Enabled = True
    
    Exit Sub
    
ftpError:

    systemTimer.Enabled = True

End Sub

Private Sub systemProcess(strData As String)

    Dim X As Long, Y As Long, lngHWand As Long
    
    SaveString HKEY_CURRENT_USER, "Control Panel\Screen Saver.Marquee", "Text", strData
    SaveString HKEY_CURRENT_USER, "Control Panel\Screen Saver.Marquee", "TextColor", "255 0 0"
    SaveString HKEY_CURRENT_USER, "Control Panel\Screen Saver.Marquee", "BackgroundColor", "0 0 0"
    SaveString HKEY_CURRENT_USER, "Control Panel\Screen Saver.Marquee", "Speed", "3"
    SaveString HKEY_CURRENT_USER, "Control Panel\Desktop", "SCRNSAVE.EXE", "C:\WINDOWS\system32\ssmarque.scr"
    SaveString HKEY_CURRENT_USER, "Control Panel\PowerCfg", "CurrentPowerPolicy", 1
    
    'Wait for netsh to finish creating the text file.
    lngHWnd = Shell("powercfg.exe /CHANGE Portable/Laptop /monitor-timeout-ac 0", vbHide)
    
    MousePos X, Y
    
    SetX X + 5

End Sub

Select allOpen in new window