Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0647: Herunterfahren des Systems abbrechen

VB 5/6-Tipp 0647: Herunterfahren des Systems abbrechen

 von Stefan Matyba

Schwierigkeitsgrad:

Verwendete API-Aufrufe: CallWindowProcA (CallWindowProc), SetWindowLongA (SetWindowLong)

Download: Download des Beispielprojektes [2,73 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------

Option Explicit

Private Sub Form_Load()
    Call Hook(Me.hwnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Unhook
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------


Declare Function CallWindowProc Lib "user32" Alias _
    "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
    ByVal hwnd As Long, ByVal MSG As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long

Declare Function SetWindowLong Lib "user32" Alias _
    "SetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Type POINTAPI
    x As Long
    y As Long
End Type

Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Private Const GWL_WNDPROC As Long = -4&
Private Const WM_QUERYENDSESSION As Long = &H11&
Private Const WM_CANCELMODE As Long = &H1F&

Private gHW As Long
Private lpPrevWndProc As Long

Public Sub Hook(hwnd As Long)
    gHW = hwnd
    lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub Unhook()
    Call SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
    
    Dim Antwort As VbMsgBoxResult

    If uMsg = WM_QUERYENDSESSION Then
        ' Alle Aktionen, die vor einem Shutdown des Systems
        ' ausgeführt werden sollen, müssen hierher!!!!

        ' fährt das System herunter:
        ' WindowProc = CallWindowProc(lpPrevWndProc, hw,
        '   uMsg, wParam, lParam)

        ' hält den Shutdown auf...
        ' WindowProc = CallWindowProc(lpPrevWndProc, hw,
        '   WM_CANCELMODE, wParam, wParam)

        ' Leider werden vorher alle anderen Programme beendet
        
        Antwort = MsgBox("Shutdown?", vbQuestion + vbYesNo, "Herunterfahren?")
        
        If Antwort = vbYes Then
            MsgBox "GoodBye", vbExclamation + vbOKOnly, "Ok"
            WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
        Else
            MsgBox "Shutdown aufgehalten!", vbExclamation + vbOKOnly, "Stop"
            WindowProc = CallWindowProc(lpPrevWndProc, hw, WM_CANCELMODE, wParam, wParam)
        End If
        
        Exit Function
    End If
    
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.