کد : دریافت وضعیت قفل بودن صفحه نمایش و یا اکانت
همینو با یک تایمر در برنامه خودتان اضافه کنید
Private IsW2kPlus As Boolean
Private Declare Sub LockWorkstation Lib "User32.dll" Alias "LockWorkStation" ()
Private Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" (ByVal lpszDesktop As Any, ByVal dwFlags As Long, ByVal fInherit As Long, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uiAction As Long, ByVal uiParam As Long, ByRef pvParam As Any, ByVal fWinIni As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Const SPI_GETSCREENSAVERRUNNING As Long = 114&
Private Const DESKTOP_READOBJECTS As Long = &H1
Private Const DESKTOP_CREATEWINDOW As Long = &H2
Private Const DESKTOP_CREATEMENU As Long = &H4
Private Const DESKTOP_HOOKCONTROL As Long = &H8
Private Const DESKTOP_JOURNALRECORD As Long = &H10
Private Const DESKTOP_JOURNALPLAYBACK As Long = &H20
Private Const DESKTOP_ENUMERATE As Long = &H40
Private Const DESKTOP_WRITEOBJECTS As Long = &H80
Private Const DESKTOP_SWITCHDESKTOP As Long = &H100
Private Sub cmdLockWorkstation_Click()
Me.Timer1.Enabled = False
Me.Timer1.Interval = 3000
Me.Timer1.Enabled = True
LockWorkstation
End Sub
Private Sub cmdJustMonitor_Click()
Me.Timer1.Enabled = False
Me.Timer1.Interval = 3000
Me.Timer1.Enabled = True
End Sub
Private Sub cmdStopMonitoring_Click()
Me.Timer1.Enabled = False
End Sub
Private Sub Form_Load()
Dim p_lngMajorVer As Long
Dim p_typOsVersionInfo As OSVERSIONINFO
' ------------------------------------------
' Set the length and make API call
' ------------------------------------------
p_typOsVersionInfo.dwOSVersionInfoSize = Len(p_typOsVersionInfo)
GetVersionEx p_typOsVersionInfo
' ------------------------------------------
' Get the details
' ------------------------------------------
p_lngMajorVer = p_typOsVersionInfo.dwMajorVersion
If p_lngMajorVer >= 5 Then IsW2kPlus = True Else IsW2kPlus = False
End Sub
Private Sub Timer1_Timer()
Dim p_lngHwnd As Long
Dim p_lngRtn As Long
Dim p_lngErr As Long
Dim p_lngScreenSaver As Long
Dim p_blnIsScreenSaver As Boolean
' ------------------------------------------
' First check for screen saver one of 2 ways,
' based of OS
' ------------------------------------------
If IsW2kPlus = False Then
' ---------------------------------------
' Pre W2K -- Note, will only be TRUE if
' the "Password Protected" box is
' checked.
' ---------------------------------------
p_lngHwnd = OpenDesktop(lpszDesktop:="screen-saver", dwFlags:=0, fInherit:=False, dwDesiredAccess:=DESKTOP_ENUMERATE)
If p_lngHwnd <> 0 Then p_blnIsScreenSaver = True Else p_blnIsScreenSaver = False
Else
' ---------------------------------------
' W2K+ -- Will determine if screen saver
' is running whether or not the
' "Password Protected" box is checked
' ---------------------------------------
p_lngRtn = SystemParametersInfo(uiAction:=SPI_GETSCREENSAVERR UNNING, uiParam:=0&, pvParam:=p_lngScreenSaver, fWinIni:=0&)
If p_lngRtn = 0 Then
Debug.Print Err.LastDllError
Else
p_blnIsScreenSaver = CBool(p_lngScreenSaver)
End If
End If
' ------------------------------------------
' If screen saver is *not* running, then
' check for locked workstation
' ------------------------------------------
If p_blnIsScreenSaver = True Then
If IsW2kPlus = False Then
Debug.Print "Screen saver is running..., Handle #" & p_lngHwnd
p_lngHwnd = CloseDesktop(p_lngHwnd)
Else
Debug.Print "Screen saver is running on W2K+"
End If
Else
p_lngHwnd = OpenDesktop(lpszDesktop:="Default", dwFlags:=0, fInherit:=False, dwDesiredAccess:=DESKTOP_SWITCHDESKTOP)
If p_lngHwnd = 0 Then
Debug.Print "Error with OpenDesktop: " & Err.LastDllError
Else
p_lngRtn = SwitchDesktop(hDesktop:=p_lngHwnd)
p_lngErr = Err.LastDllError
If p_lngRtn = 0 Then
If p_lngErr = 0 Then
Debug.Print "Desktop is locked: " & Err.LastDllError
Else
Debug.Print "Error with SwitchDesktop: " & Err.LastDllError
End If
Else
Debug.Print "Not locked!"
End If
p_lngHwnd = CloseDesktop(p_lngHwnd)
End If
End If
End Sub
