System Lockout API

(5)

Loading ...

July 24th, 2008 9:30 am Print Email

Does your system lock due to screen saver settings at your company? Are your QTP Test scripts failing because of that? If yes then here is the solution for you.

Knowledge Inbox Prevent System Lockout is COM based component which allow your scripts to block system for getting locked. It is one of the most easy components one can use. How to use it? Just add the below line of code in a VBS attached to your test

Set oPreventSystemLock = CreateObject("KnowledgeInbox.SystemLockout")
oPreventSystemLock.PreventLockout = True

As soon as the object gets created the system does not go into locking mode. When the script ends the object is automatically destroyed and the system can now go into the locking mode. To disable the lockout you can destroy the object created earlier

Set oPreventSystemLock = Nothing

Properties Supported by SystemLockout class

“KnowledgeInbox.SystemLockout” object exposes access to two properties listed below

PreventLockout - When set to True the system does not go into locking mode till the object is alive. Default value is False
Interval - Interval in millisecond after which the prevention mechanism needs to be executed. By default this value is 30000 (30 sec). This should only be changed in case performance is an issue Usage of Properties

'Create the system lockout prevention object
Set oPreventSystemLock = CreateObject("KnowledgeInbox.SystemLockout")
 
'Execute prevention code every 60 sec
oPreventSystemLock.Interval = 60000
 
'Don't allow system to get locked
oPreventSystemLock.PreventLockout = True
 
MsgBox "Your system cannot get locked due to screen saver now. Click Ok to allow locking"
 
'Allow system to get locked
oPreventSystemLock.PreventLockout = False
 
'Destroy the object and allow system to get locked
Set oPreventSystemLock = Nothing

License

The component is FREE for PERSONAL use. For COMMERCIAL use the component is FREE but permission from Author is required for the same. Your code needs to mention the the Author name and provide this webpage reference to use the component for FREE.

Auto Installation through Scripts

Installing the setup on every machine executing your code might not be feasible solution. You can avoid the by saving the KInboxSysLck.dll in one of the folders present in QTP Tools->Options… and then use the following function to get the object

Dim oWShell, FSO
 
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oWShell = CreateObject("WScript.Shell")
 
Function GetSystemLockoutObject()
    On Error Resume Next
    Set GetSystemLockoutObject = CreateObject("KnowledgeInbox.SystemLockout")
    If Err.Number Then
        Err.Clear()
        Call InstallActiveXFile("%ProgramFiles%\KnowledgeInbox\SystemLockout API", _
                                PathFinder.Locate("KInboxSysLck.dll"))
    End If
 
    If Err.Number Then
        Call MsgBox("Failed to install KInboxSysLck.dll")
    Else
        Err.Clear()
        On Error GoTo 0
 
        Set GetSystemLockoutObject = CreateObject("KnowledgeInbox.SystemLockout")
    End If
End Function
 
Sub InstallActiveXFile(ByVal FolderName, ByVal SourceFile)
    FolderName = oWShell.ExpandEnvironmentStrings(FolderName)
    SourceFile = oWShell.ExpandEnvironmentStrings(SourceFile)
 
    Call CreateFolderRec(FolderName)
    Call FSO.CopyFile(SourceFile, FolderName, True)
    Dim DestFile
    DestFile = FolderName & Mid(SourceFile, InStrRev(SourceFile, "\"))
    Select Case LCase(Right(SourceFile, 4))
        Case ".exe"
            'ActiveX EXE file
            Call oWShell.Run(DQ(DestFile) & " /regserver")
        Case ".dll"
            Call oWShell.Run("regsvr32 " & DQ(DestFile))
    End Select
End Sub
 
Function DQ(ByVal Text)
    DQ = """" & Text & """"
End Function
 
Sub CreateFolderRec(ByVal FolderName)
    If Right(FolderName, 1) = "\" Then
        FolderName = Left(FolderName, Len(FolderName) - 1)
    End If
 
    If FSO.FolderExists(FolderName) Then
        Exit Sub
    Else
        Call CreateFolderRec(Mid(FolderName, 1, InStrRev(FolderName, "\") - 1))
        FSO.CreateFolder(FolderName)
    End If
End Sub
 
Set X = GetSystemLockoutObject()