用VB設計更改屏幕保護的程序

杜運慶

　　制作一個本企業的屏幕保護，在客戶運行本企業的應用軟件的時候，為客戶更改屏幕保護，是個廣告宣傳的好辦法。在第一VB論壇(http://www.d1vb.com)上有很多朋友提出這個問題，現解答如下：

　　要更換屏幕保護，首先得做好一個屏幕保護(scr文件)，本例以 工程1.scr 這個文件為例。由于windows是把屏幕保護文件存放在system下，但記錄屏幕保護文件位置的文件卻是windows目錄下的system.ini，所以，首先需要找出系統的windows和system目錄的確切安裝位置。因此，可以分如下幾步進行：

　　1、找到windows和system目錄的安裝位置

　　2、把屏幕保護文件復制到system目錄下

　　3、在system.ini中的[boot]中寫入:

　　　　SCRNSAVE.EXE=C:\WINDOWS\SYSTEM\工程1.SCR

　　4、告訴系統切換屏幕保護。

　　下面的例子成功地改變了屏幕保護，全部源代碼如下：

'得到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

　　本例在vb6.0+win95下運行通過。