unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ListBox1: TListBox;
    procedure WMQueryEndSession(var Msg: TWMQueryEndSession); message WM_QueryEndSession;
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TSDBlockReasonCreate = function(fHandle: hWnd; pwszReason: LPCWSTR): Boolean;
  TSDBlockReasonDestroy = function(fHandle: hWnd): Boolean;

function VistaPlus: Boolean;
begin
     result := false;
     case Win32Platform of
          2: case Win32MajorVersion of
                  6: result := true;
             end;
     end;
end;

procedure TForm1.WMQueryEndSession(var Msg: TWMQueryEndSession);
var
   SDBlockReasonCreate: TSDBlockReasonCreate;
   SDBlockReasonDestroy: TSDBlockReasonDestroy;
   AppInfoChar, AppInfoWideChar: PWideChar;
   DLLHandle: THandle;
   FuncPtr: TFarProc;
   xInt: Integer;
begin
     inherited;

     if VistaPlus then begin
        ListBox1.Items.Add('IsVista');
        DLLHandle := LoadLibrary('user32.dll');
        FuncPtr := GetProcAddress(DLLHandle, 'ShutdownBlockReasonCreate');
        if FuncPtr <> nil then begin
            ListBox1.Items.Add('Create gefunden');
            @SDBlockReasonCreate := FuncPtr;
            GetMem(AppInfoChar, 255);
            AppInfoWideChar := StringToWideChar('Testanwendung läuft noch.', AppInfoChar, 255);
            if SDBlockReasonCreate(Form1.Handle, AppInfoWideChar) = true then
               ListBox1.Items.Add('Create ausgeführt + erfolgreich')
            else begin
               ListBox1.Items.Add('Create ausgeführt + nicht erfolgreich');
               ListBox1.Items.Add(IntToStr(GetLastError));
            end;
            FreeMem(AppInfoChar);
            FuncPtr := nil;
        end else ShowMessage('Funktion oder DLL nicht gefunden!');
        FreeLibrary(DLLHandle);
     end;

     for xInt := 25 downto 0 do begin
         Sleep(1000);
         if (xInt mod 5 = 0) and (xInt < 25) then
            ListBox1.Items.Add('Fünftel geschafft');
         Label1.Caption := IntToStr(xInt);
         Application.ProcessMessages;
     end;

     if VistaPlus then begin
        ListBox1.Items.Add('IsVista');
        DLLHandle := LoadLibrary('user32.dll');
        FuncPtr := GetProcAddress(DLLHandle, 'ShutdownBlockReasonDestroy');
        if FuncPtr <> nil then begin
            ListBox1.Items.Add('Destroy gefunden');
            @SDBlockReasonDestroy := FuncPtr;
            if SDBlockReasonDestroy(Form1.Handle) = true then
               ListBox1.Items.Add('Destroy ausgeführt + erfolgreich')
            else begin
               ListBox1.Items.Add('Destroy ausgeführt + nicht erfolgreich');
               ListBox1.Items.Add(IntToStr(GetLastError));
            end;
            FuncPtr := nil;
        end else ShowMessage('Funktion oder DLL nicht gefunden!');
        FreeLibrary(DLLHandle);
     end;
     Msg.Result := 1;
end;

end.