使用VB监测屏保状态

    信息安全管理正在实施。某一日临时检查，发现原来设置好的屏保状态竟然不翼而飞。
遂以VB编写一小程序，用于监测本机的屏保设置状态。一旦屏保设置不符合规定，就提示消息。
监测时间间隔为10s。

    程序功能简单，实现起来也很简单。
    编程工具：VB 6.0（Visual Stdio 6.0）
    测试环境：Win2000（JP）

    下面是代码：

‘------------------------------------------------------------------------------------------------------------
'Modual
'Name:CheckSCR
Option Explicit
'references add "Registry Access Functions" first

'注册DLL
Public Declare Function RegMyDLLServerObject _
Lib "C:/WINNT/system32/REGTOOL5.DLL" _
Alias "DllRegisterServer" () As Long
Public Declare Function UnRegMyDLLServerObject _
Lib "C:/WINNT/system32/REGTOOL5.DLL" _
Alias "DllUnregisterServer" () As Long



Dim myReg As New Registry


'GET ACTIVE STATE
Public Function getActiveState() As String
    Dim ScreenSaveActive As String
   
    myReg.GetKeyValue HKEY_CURRENT_USER, "Control Panel/Desktop", "ScreenSaveActive", ScreenSaveActive
    getActiveState = ScreenSaveActive
End Function


'GET SAVER NAME
Public Function getSaverName() As String
   
    Dim strSaverName As String
   
    myReg.GetKeyValue HKEY_CURRENT_USER, "Control Panel/Desktop", "SCRNSAVE.EXE", strSaverName
    getSaverName = strSaverName
End Function


'GET SECURE STATE
Public Function getSecureState() As String
    Dim ScreenSaverIsSecure As String
   
    myReg.GetKeyValue HKEY_CURRENT_USER, "Control Panel/Desktop", "ScreenSaverIsSecure", ScreenSaverIsSecure
    getSecureState = ScreenSaverIsSecure
End Function


'GET SAVER TIMEOUT
Public Function getSaverTimeout() As String
    Dim strScreenSaveTimeOut As String
   
    myReg.GetKeyValue HKEY_CURRENT_USER, "Control Panel/Desktop", "ScreenSaveTimeOut", strScreenSaveTimeOut
    getSaverTimeout = strScreenSaveTimeOut
End Function
‘------------------------------------------------------------------------------------------------------------
这里需要在工程的引用中添加“ Registry Access Functions”，对应的DLL为 REGTOOL5.DLL。

‘------------------------------------------------------------------------------------------------------------
‘Form
’Name：frm_hidden
‘添加控件：Timer/Name：timeCheck/Interval：10000

Option Explicit
  
Private Sub Form_Load()
    'Call UnRegMyDLLServerObject
    Call RegMyDLLServerObject
    Me.Hide
End Sub

'If the state is not right,
Private Sub timeCheck_Timer()
    Dim strActiveState As String
    Dim strSaverName As String
    Dim strSecureState As String
    Dim dbSaverTimeout As Double
   
    Dim strNowTime As String
    Dim strMinutes As String
    Dim intPos As Integer

    strNowTime = Now
    intPos = InStr(1, strNowTime, ":", vbTextCompare)
    strMinutes = Mid(strNowTime, intPos + 1, 2)
    'MsgBox strMinutes
   
    'When minutes are 00 then check the screensave's state.So it'll last one minute.
    'If strMinutes = "00" Then
       
        'ACTIVE STATE
        strActiveState = getActiveState()
        If strActiveState <> "1" Then
            If vbOK = MsgBox("Your screen saver is not actived!", vbOKOnly + vbCritical, "ERROR") Then
               
            End If
            Exit Sub
        End If
       
        'SAVER NAME
        strSaverName = getSaverName()
        If Len(strSaverName) = 0 Then
            MsgBox "Your computer now has NO screensaver been setted!", vbOKOnly + vbCritical, "ERROR"
            Exit Sub
        End If
       
        'SECURE STATE
        strSecureState = getSecureState()
        If Val(strSecureState) = 0 Then
            MsgBox "Your screensaver does NOT have password protected.", vbOKOnly + vbCritical, "ERROR"
            Exit Sub
        End If
       
        'SAVER TIMEOUT
        dbSaverTimeout = Val(getSaverTimeout())
        If dbSaverTimeout = 0 Then
            MsgBox "Please set your screensaver's timeout!", vbOKOnly + vbCritical, "ERROR"
            Exit Sub
        ElseIf dbSaverTimeout > 300 Then
            MsgBox "Your screensave's timeout is to long." & vbCrLf & _
                   "Please change it to 5 minutes.", vbOKOnly + vbExclamation, "WARNING"
            Exit Sub
        End If
    'End If
   
End Sub
‘------------------------------------------------------------------------------------------------------------

编译成EXE文件，便可以使用了。在没有安装VB的电脑上使用时，需要先把 REGTOOL5.DLL文件放置到 C:/WINNT/system32/目录下，在程序运行时，会对这个DLL进行注册，然后使用里面的功能。

下一步调查功能：
    在局域网中对域里的电脑的屏保状态进行监测，发现不符合规定的进行记录，或对其设置进行修正。