Program to turn off monitor

[HanneSThEGreaT]

Hacking Gina is possible

Here is the good and bad of it :


http://www.codeguru.com/forum/showth...highlight=gina

http://www.codeguru.com/forum/showth...highlight=gina

[TT(n)]

Should the app only respond the Win+L combo, or also when the workstation is locked programmatically?

It could be possible with a keyboard hook then.
I think most monitors support off, as if it were a screen saver option "None".
In Vb6, I noticed that it must be invoked by user input in some way, otherwise it just shuts off momentarily.
User input will also turn the monitor back on.

Const HWND_BROADCAST As Long = 65535
Const WM_SYSCOMMAND As Long = 274
Const SC_MONITORPOWER As Long = 61808
Const MONITOR_ON As Long = -1
Const MONITOR_OFF As Long = 2
Const MONITOR_STANBY As Long = 1

Private Declare Function apiSendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Sub Form_Click()
  On Error Resume Next
  Call apiSendMessage(HWND_BROADCAST, WM_SYSCOMMAND, SC_MONITORPOWER, MONITOR_OFF)
  Unload Me
End Sub

I assume in a keyboard hook you'll be looking for the Win-L combo, and since it's user induced then it should allow you to manipulate monitor power, without using a windows service or attempting a gina hack.

EDIT:
To sync with the screen saver, you can use the GetLastInputInfo API

Private Type PLASTINPUTINFO
    cbSize As Long
    dwTime As Long
End Type
Private Declare Function apiGetLastInputInfo Lib "user32" Alias "GetLastInputInfo" (ByRef plii As PLASTINPUTINFO) As Long
Private Declare Function apiGetTickCount Lib "kernel32" Alias "GetTickCount" () As Long

Private Function GetLastInput() As Long
    Dim li As PLASTINPUTINFO
    li.cbSize = Len(li)
    Call apiGetLastInputInfo(li)
    GetLastInput = (apiGetTickCount - li.dwTime)
End Function

[TT(n)]

So I had to check it out, and it works as requested. lol

Main app code:

Private Sub Form_Load()
    SetHook
End Sub

Private Sub Form_Unload(Cancel As Integer)
    UnHook
End Sub

Private Sub Command1_Click()
    MonitorOff
End Sub

Private Sub Timer1_Timer()
    tCount = GetLastInput
    If tCount >= GetScreenSaveTime Then MonitorOff
End Sub

Module code:

Const HWND_BROADCAST As Long = 65535
Const WM_SYSCOMMAND As Long = 274
Const SC_MONITORPOWER As Long = 61808
Const MONITOR_ON As Long = -1
Const MONITOR_OFF As Long = 2
Const MONITOR_STANBY As Long = 1
Const HC_GETNEXT As Long = 1
Const WH_KEYBOARD_LL As Long = 13
Const SPI_GETSCREENSAVETIMEOUT As Long = 14
Const TIME_MILLI As Long = 1000
Const KEYEVENTF_KEYUP As Long = 2
Private Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
Private Type PLASTINPUTINFO
    cbSize As Long
    dwTime As Long
End Type
Private Declare Function apiSendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function apiGetLastInputInfo Lib "user32" Alias "GetLastInputInfo" (ByRef plii As PLASTINPUTINFO) As Long
Private Declare Function apiGetTickCount Lib "kernel32" Alias "GetTickCount" () As Long
Private Declare Function apiSetWindowsKeyHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function apiUnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal hHook As Long) As Long
Private Declare Function apiCallNextKeyHookEx Lib "user32" Alias "CallNextHookEx" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function apiCopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef pDest As KBDLLHOOKSTRUCT, ByVal pSource As Long, ByVal cb As Long) As Long
Private Declare Function apiSystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Long, ByVal fuWinIni As Long) As Long
Private Declare Function apikeybd_event Lib "user32" Alias "keybd_event" (ByVal vKey As Long, ByVal bScan As Long, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) As Boolean
Private Declare Function apiGetMessageExtraInfo Lib "user32" Alias "GetMessageExtraInfo" () As Long
Public hKey As Long
Public tCount As Long
Private wDown As Boolean

Public Function SetHook() As Boolean
    hKey = apiSetWindowsKeyHookEx(WH_KEYBOARD_LL, AddressOf Callback, App.hInstance, 0)
    SetHook = CBool(hKey)
End Function

Public Function UnHook() As Boolean
    If hKey <> 0 Then
      If apiUnhookWindowsHookEx(hKey) = 1 Then hKey = 0 'Unhook keyboard and free keyboard handle if unhooked  'If return foreground was specified then return it
    End If
End Function

Public Function GetLastInput() As Long
    Dim li As PLASTINPUTINFO
    li.cbSize = Len(li)
    Call apiGetLastInputInfo(li)
    GetLastInput = (apiGetTickCount - li.dwTime)
End Function

Public Function MonitorOff() As Boolean
  Call apiSendMessage(HWND_BROADCAST, WM_SYSCOMMAND, SC_MONITORPOWER, MONITOR_OFF)
End Function

Public Function GetScreenSaveTime() As Long
   Call apiSystemParametersInfo(SPI_GETSCREENSAVETIMEOUT, 0, GetScreenSaveTime, 0)
   If GetScreenSaveTime <= 0 Then GetScreenSaveTime = 1
   GetScreenSaveTime = TIME_MILLI * GetScreenSaveTime
End Function

Private Function Callback(ByVal Code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    Static hStruct As KBDLLHOOKSTRUCT
    Call apiCopyMemory(hStruct, lParam, Len(hStruct))
    If hStruct.flags = 1 Then wDown = True
    If hStruct.flags = 129 Then wDown = False
    If wDown = True And hStruct.vkCode = 76 Then
    
      Call apikeybd_event(hStruct.vkCode, 0, KEYEVENTF_KEYUP, apiGetMessageExtraInfo)  'lift key up.
      Call apikeybd_event(91, 0, KEYEVENTF_KEYUP, apiGetMessageExtraInfo)  'lift key up.
      Call apikeybd_event(92, 0, KEYEVENTF_KEYUP, apiGetMessageExtraInfo)  'lift key up. 

      MonitorOff
      Callback = HC_GETNEXT
      Exit Function
    End If
    Callback = apiCallNextKeyHookEx(hKey, Code, wParam, lParam) 'Call next key hook if no action
End Function

The keyup is important right before stalling the SendMessage for power off. Otherwise the power off is only momentary.

[dglienna]

INSTALATION:
I
1. Copy the msgina.dll file from windows\system32 to a safe location
2. Rename the dll in this archive to msgina.dll and overwrite the one in system32.
3. Reboot
backup: overwrite the original msgina back to system32, reboot

I'd bet that doesn't work in Vista or Win 7

[TT(n)]

I'd bet that doesn't work in Vista or Win 7

Good point, you probably would need different gina hacks to work on all OS's.

My example works in VB.NET, so that the Win+L combo actually keeps the monitor off/Sleep.
But in VB6, I could not get it to stay always asleep on Vista/7. Maybe with enough fiddling.
In the case that a vb.net example is now needed it could look like this:

{Since he posted C# code}

Public Class Form1
    Const WM_SYSCOMMAND As Int32 = 274
    Const SC_MONITORPOWER As Int32 = 61808
    Const HWND_BROADCAST As Int32 = 65535
    Const MONITOR_ON As Int32 = -1
    Const MONITOR_OFF As Int32 = 2
    Const MONITOR_STANBY As Int32 = 1
    Const HC_GETNEXT As Int32 = 1
    Const WH_KEYBOARD_LL As Int32 = 13
    Const SPI_GETSCREENSAVETIMEOUT As Int32 = 14
    Const TIME_MILLI As Int32 = 1000
    Const KEYEVENTF_KEYUP As Int32 = 2
    Private Structure KBDLLHOOKSTRUCT
        Public vkCode, scanCode, flags, time, dwExtraInfo As Int32
    End Structure
    Private Structure PLASTINPUTINFO
        Public cbSize, dwTime As Int32
    End Structure
    Private Declare Function apiSendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hWnd As Int32, ByVal msg As Int32, ByVal wParam As Int32, ByVal lParam As Int32, ByVal fuFlags As Int32, ByVal uTimeout As Int32, ByVal lpdwResult As Int32) As Int32 'sends the specified message to a window or windows. The function calls the window procedure for the specified window and, if the specified window belongs to a different thread, does not return until the window procedure has processed the message or the specified time-out period has elapsed. If the window receiving the message belongs to the same queue as the current thread, the window procedure is called directly the time-out value is ignored.
    Private Declare Function apiSendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Int32, ByVal msg As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Int32
    Private Declare Function apiGetLastInputInfo Lib "user32" Alias "GetLastInputInfo" (ByRef plii As PLASTINPUTINFO) As Int32
    Private Declare Function apiGetTickCount Lib "kernel32" Alias "GetTickCount" () As Int32
    Private Declare Function apiSystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Int32, ByVal uParam As Int32, ByRef lpvParam As Int64, ByVal fuWinIni As Int32) As Int32
    Private Declare Function apikeybd_event Lib "user32" Alias "keybd_event" (ByVal vKey As Int32, ByVal bScan As Int32, ByVal dwFlags As Int32, ByVal dwExtraInfo As Int32) As Boolean
    Private Declare Function apiGetMessageExtraInfo Lib "user32" Alias "GetMessageExtraInfo" () As Int32
    Private Declare Function apiCallNextKeyHookEx Lib "user32" Alias "CallNextHookEx" (ByVal hHook As Int32, ByVal nCode As Int32, ByVal wParam As Int32, ByVal lParam As KBDLLHOOKSTRUCT) As Int32
    Private Declare Function apiSetWindowsKeyHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Int32, ByVal lpfn As KeyboardHookDelegate, ByVal hmod As Int32, ByVal dwThreadId As Int32) As Int32
    Private Declare Function apiUnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal hHook As Int32) As Int32
    Private Delegate Function KeyboardHookDelegate(ByVal Code As Int32, ByVal wParam As Int32, ByRef lParam As KBDLLHOOKSTRUCT) As Int32
    <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.FunctionPtr)> Private kcallback As KeyboardHookDelegate
    Public hKey As Int32
    Public tCount As Int32
    Private wDown As Boolean

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ' MonitorOff()
        ' Environment.Exit(0)
        Timer1.Enabled = True
        SetHook()
    End Sub

    Private Sub Form1_FormClosed(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
        UnHook()
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        tCount = GetLastInput()
        If tCount >= GetScreenSaveTime() Then MonitorOff()
        Me.Text = tCount.ToString
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        MonitorOff()
    End Sub

    Private Function SetHook() As Boolean
        kcallback = New KeyboardHookDelegate(AddressOf Callback) 'Set new hook delegate
        hKey = apiSetWindowsKeyHookEx(WH_KEYBOARD_LL, kcallback, System.Runtime.InteropServices.Marshal.GetHINSTANCE(System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)).ToInt32, 0) 'Set keyboard hook for verifying the time that a virtual key was pressed
        SetHook = CBool(hKey)
    End Function

    Private Function UnHook() As Boolean
        If hKey <> 0 Then
            If apiUnhookWindowsHookEx(hKey) = 1 Then hKey = 0 'Unhook keyboard and free keyboard handle if unhooked
        End If
    End Function

    Private Function GetLastInput() As Int32
        Dim li As New PLASTINPUTINFO
        li.cbSize = Len(li)
        apiGetLastInputInfo(li)
        GetLastInput = (apiGetTickCount - li.dwTime)
    End Function

    Private Function MonitorOff() As Boolean
        apiSendMessage(HWND_BROADCAST, WM_SYSCOMMAND, SC_MONITORPOWER, MONITOR_OFF) ' apiSendMessageTimeout(HWND_BROADCAST, WM_SYSCOMMAND, SC_MONITORPOWER, 2, 0, 400, 0)
    End Function

    Private Function GetScreenSaveTime() As Int32
        Dim sct As Int64 = 0
        apiSystemParametersInfo(SPI_GETSCREENSAVETIMEOUT, 0, sct, 0)
        If sct <= 0 Then sct = 1
        GetScreenSaveTime = sct * TIME_MILLI
    End Function

    Private Function Callback(ByVal Code As Int32, ByVal wParam As Int32, ByRef lParam As KBDLLHOOKSTRUCT) As Int32
        On Error Resume Next
        If lParam.flags = 1 Then wDown = True
        If lParam.flags = 129 Then wDown = False
        If wDown = True And lParam.vkCode = 76 Then
            apikeybd_event(lParam.vkCode, 0, KEYEVENTF_KEYUP, apiGetMessageExtraInfo)  'lift key up.
            apikeybd_event(Keys.LWin, 0, KEYEVENTF_KEYUP, apiGetMessageExtraInfo)  'lift key up.
            apikeybd_event(Keys.RWin, 0, KEYEVENTF_KEYUP, apiGetMessageExtraInfo)  'lift key up.
            MonitorOff()
            Return HC_GETNEXT
        End If
        Return apiCallNextKeyHookEx(hKey, Code, wParam, lParam) 'Call next key hook if no action
    End Function


End Class