'得到windows目录
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'修改system.ini
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Long
'得到system目录
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'设置屏幕保护
Private Const SPI_SETSCREENSAVETIMEOUT = 15
Private Const SPI_SETSCREENSAVEACTIVE = 17
Private Const SPIF_UPDATEINIFILE = &H1
Private Const SPIF_SENDWININICHANGE = &H2
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Long, ByVal fuWinIni As Long) As Long
'启动屏幕保护
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_SCREENSAVE = &HF140
Private Sub Form_Load()
'得到system目录
Dim sSave As String, Ret As Long
sSave = Space(255)
Ret = GetSystemDirectory(sSave, 255)
sSave = Left$(sSave, Ret)
'把屏保复制到系统目录
FileCopy App.Path & "\工程1.scr", sSave & "\工程1.SCR"
'得到windows目录
Dim Path As String, strSave As String
strSave = String(250, Chr$(0))
Path = Left$(strSave, GetWindowsDirectory(strSave, Len(strSave)))
'修改system.ini
Dim r As Long
Dim iniPath As String
iniPath$ = Path + "\system.ini"
r = WritePrivateProfileString("boot", "SCRNSAVE.EXE", sSave & "\工程1.SCR", iniPath)
'设置时间间隔为1分钟=60秒
lRet = SystemParametersInfo(SPI_SETSCREENSAVETIMEOUT, 60, ByVal 0&,
SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE)
'设置屏幕保护
retval = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, True, 0, 0)
'启动屏幕保护
Dim result As Long
result = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
End Sub |
