{******************************************************************************
*  First of all, thanks for registering of the dWinlock package.
*
*  LICENSE AGREEMENT
*  see file license.txt
*
*  Liability disclaimer:
*
*  THIS SOFTWARE IS DISTRIBUTED "AS IS" AND WITHOUT WARRANTIES AS TO
*  PERFORMANCE  OF MERCHANTABILITY OR ANY OTHER WARRANTIES WHETHER EXPRESSED
*  OR IMPLIED. YOU USE IT AT YOUR OWN RISK. THE AUTHOR WILL NOT BE LIABLE FOR
*  DATA LOSS, DAMAGES,  LOSS OF PROFITS OR ANY OTHER KIND OF LOSS WHILE USING
*  OR MISUSING THIS SOFTWARE.
*
*  Copyright  2002-2007  Dipl.-Ing. H.-D. Kassl  All rights reserved.
*
*  Kassl GmbH
*  27607 Langen (Germany)
*  phone: +49 4743 911021
*  fax  : +49 4743 911022
*
*  http://www.dwinlock.kassl.de
*  e-mail: dWinlock@Kassl.de
*
******************************************************************************}
unit dwl;
interface

uses
  {$IFDEF VER130}
  Forms,
  {$ENDIF}
  Windows, Messages, Classes, Controls, dwlCore;

const
 WM_DWLKEYDOWN = WM_USER + 444;
 WM_DWLKEYUP   = WM_USER + 445;

type
  TdwKeyEvent       = procedure (ReceivingWnd: HWND;Key: Word; Shift: TShiftState)of object;
  TdwMouseEvent     = procedure (ReceivingWnd: HWND;Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;

  TdWinlock = class(TComponent)
  private
    FnoAltEsc: boolean;
    FnoCtrlEsc: boolean;
    FnoRButton: boolean;
    FnoAltTab: boolean;
    FnoTaskTray: boolean;
    FnoAppkey: boolean;
    FnoTaskLinks: boolean;
    FnoWinkeys: boolean;
    FnoStartbutton: boolean;
    FnoStartMenu : boolean;
    FnoCtrlAltDel: boolean;
    FnoDesktop: boolean;
    FnoTaskbar: boolean;
    FnoAltF4: boolean;
    FVersion: string;
    FOnKeyUp: TdwKeyEvent;
    FOnKeyDown: TdwKeyEvent;
    FnoAltReturn: boolean;
    FnoAccessibilityShortcuts: boolean;
    FOnMouseUp: TdwMouseEvent;
    FOnMouseDown: TdwMouseEvent;
    FasFrontApp: boolean;
    FnoTaskRebar: boolean;
    FNoShutdown: boolean;
    FOnShutdown: TdwlQueryEndSessionCallbackMethod;
    procedure SetnoAltEsc(Value: boolean);
    procedure SetnoAltTab(Value: boolean);
    procedure SetnoAppkey(Value: boolean);
    procedure SetnoCtrlAltDel(Value: boolean);
    procedure SetnoCtrlEsc(Value: boolean);
    procedure SetnoDesktop(Value: boolean);
    procedure SetnoRButton(Value: boolean);
    procedure SetnoStartbutton(Value: boolean);
    procedure SetnoStartMenu(Value : boolean);
    procedure SetnoTaskbar(Value: boolean);
    procedure SetnoTaskLinks(Value: boolean);
    procedure SetnoTaskTray(Value: boolean);
    procedure SetnoWinkeys(Value: boolean);
    procedure SetnoAltF4(const Value: boolean);
    procedure SetVersion(const Value: string);
    procedure SetnoAltReturn(Value: boolean);
    procedure SetnoAccessibilityShortcuts(Value: boolean);
    procedure SetOnKeyDown(const Value: TdwKeyEvent);
    procedure SetOnKeyUp(const Value: TdwKeyEvent);
    procedure SetOnMouseDown(const Value: TdwMouseEvent);
    procedure SetOnMouseUp(const Value: TdwMouseEvent);
    procedure SetFrontApplication(const Value: boolean);
    procedure SetNumLock(const Value: boolean);
    procedure SetnoTaskRebar(const Value: boolean);
    function GetNumLock: boolean;
    function GetCapsLock: boolean;
    procedure SetCapsLock(const Value: boolean);
    function GetScrollLock: boolean;
    procedure SetScrollLock(const Value: boolean);
    procedure SetKeyEvent;
    procedure SetNoShutdown(const Value: boolean);
    procedure SetOnShutdown(const Value: TdwlQueryEndSessionCallbackMethod);
  //  function OnShutdownDefault(wParam, lParam: integer): integer; stdcall;
  protected
    Handle  : HWND;
    procedure DisableItem(Item:integer; disable: boolean);
    function  IsDisableItem(Item:integer): boolean;
    procedure Loaded; override;
    function  DisableShortcut(window: HWND; vk: integer; Modifiers: integer; disable: boolean): boolean;
    procedure WndProc(var Message: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   RestoreAll;
    function    UninstallDwl: boolean;
    function    InstallDwl: boolean;
    function    isDwlInstalled: boolean;
    procedure   DisableKey(Wnd: HWND; VK_Code: integer; MF: integer; disable : boolean);
    function    IsKeyDisabled(Wnd: HWND; VK_Code: integer; MF: integer): boolean;
    function    EnableAutologin(DefUser, Pass: string; Enable: boolean; Domain: string): boolean; // writes autologon setting on 2k/xp systems
    function    IsAdmin: boolean;  // returns true if user has rights to modify system config
    procedure   DisableDesktopIcon(index: integer); // hides a desktop icon
    function    DesktopIconCount : integer;
    procedure   RestoreDesktopIcons; // reverses DisableDesktopIcons()
    procedure   SetStartMenu(Wnd: HWnd);
    function    GetItemHandle(Item: integer): HWnd;

    procedure   DoKeyEvent(Wnd: HWND; Down, VK, MF: integer);
    property    noTaskRebar: boolean read FnoTaskRebar write SetnoTaskRebar;
    property    NumLock: boolean read GetNumLock write SetNumLock;
    property    CapsLock: boolean read GetCapsLock write SetCapsLock;
    property    ScrollLock: boolean read GetScrollLock write SetScrollLock;
    property    asFrontApp: boolean read fasFrontApp write SetFrontApplication;
  published
    property noCtrlAltDel: boolean read FnoCtrlAltDel write SetnoCtrlAltDel;
    property noAltTab: boolean read FnoAltTab write SetnoAltTab;
    property noAltEsc: boolean read FnoAltEsc write SetnoAltEsc;
    property noAltF4:  boolean read FnoAltF4  write SetnoAltF4;
    property noCtrlEsc: boolean read FnoCtrlEsc write SetnoCtrlEsc;
    property noWinkeys: boolean read FnoWinkeys write SetnoWinkeys;
    property noAppkey: boolean read FnoAppkey write SetnoAppkey;
    property noRButton: boolean read FnoRButton write SetnoRButton;
    property noTaskbar: boolean read FnoTaskbar write SetnoTaskbar;
    property noTaskLinks: boolean read FnoTaskLinks write SetnoTaskLinks;
    property noTaskTray: boolean read FnoTaskTray write SetnoTaskTray;
    property noAltReturn: boolean read FnoAltReturn write SetnoAltReturn;
    property noAccessibilityShortcuts: boolean read FnoAccessibilityShortcuts write SetnoAccessibilityShortcuts;
    property noShutdown: boolean read fNoShutdown write SetNoShutdown;
    property noDesktop: boolean read FnoDesktop write SetnoDesktop;
    property noStartbutton: boolean read FnoStartbutton write SetnoStartbutton;
    property noStartmenu : boolean read FnoStartMenu write SetnoStartMenu;
    property Version: string read FVersion write SetVersion;

    // dWinlock events
    property OnShutdown : TdwlQueryEndSessionCallbackMethod read fOnShutdown write SetOnShutdown;
    property OnKeyDown  : TdwKeyEvent   read FOnKeyDown write SetOnKeyDown;
    property OnKeyUp    : TdwKeyEvent   read FOnKeyUp write SetOnKeyUp;
    property OnMouseDown: TdwMouseEvent read FOnMouseDown write SetOnMouseDown;
    property OnMouseUp  : TdwMouseEvent read FOnMouseUp write SetOnMouseUp;
  end;

  procedure Register;

implementation

  uses
    SysUtils,
   {$IFDEF CIL}  // Delphi 8 .Net
      Borland.Vcl.WinUtils,
   {$ENDIF}
   registry;

{$IFDEF CIL}  // Delphi 8 .Net
  {$R TdWinLock.bmp}
{$ENDIF}


procedure Register;
begin
  RegisterComponents('System', [TdWinlock]);
end;

//______________________________________________________________________________
function MakeShiftState(Modifiers: cardinal): TShiftState;
begin
  result := [];
  if (Modifiers and MOD_SHIFT > 0)   then result := result + [ssShift];
  if (Modifiers and MOD_ALT > 0)     then result := result + [ssAlt];
  if (Modifiers and MOD_CONTROL > 0) then result := result + [ssCtrl];
end;
//______________________________________________________________________________

{ TdWinlock }
//______________________________________________________________________________
constructor TdWinlock.create(AOwner: TComponent);
begin
  inherited;
  FVersion        := IntToStr(DWL_MAJORVERSION)+'.'+IntToStr(DWL_SUBVERSION);
  FasFrontApp     := false;
  Handle          := 0;
end;
//______________________________________________________________________________

destructor TdWinlock.destroy;
begin
  if not(csDesigning in Componentstate) then
  begin
    RestoreAll;       // restore to orginal settings (normal Windows)
    if Handle <> 0 then
      DeAllocateHWnd(Handle);
    {$IFDEF CIL}
      wlExit;
    {$ENDIF}
  end;
  inherited;
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoAltEsc(Value: boolean);
begin
  FnoAltEsc := Value;
  DisableShortcut(0,VK_ESCAPE,MOD_ALT,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoAltTab(Value: boolean);
begin
  FnoAltTab := Value;
  DisableShortcut(0,VK_TAB,MOD_ALT,Value);
  DisableShortcut(0,VK_TAB,MOD_ALT or MOD_SHIFT,Value);
  DisableShortcut(0,VK_TAB,MOD_ALT or MOD_WIN,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoAppkey(Value: boolean);
begin
  FnoAppkey := Value;
  DisableShortcut(0,VK_APPS,0,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoCtrlAltDel(Value: boolean);
begin
  FnoCtrlAltDel := Value;
  if not(csDesigning in Componentstate) then
    FnoCtrlAltDel := DisableShortcut(0,VK_DELETE,MOD_CONTROL or MOD_ALT,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoAltF4(const Value: boolean);
begin
  FnoAltF4 := Value;
  DisableShortcut(0,VK_F4,MOD_ALT,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoCtrlEsc(Value: boolean);
begin
  FnoCtrlEsc := Value;
  DisableShortcut(0,VK_ESCAPE,MOD_CONTROL,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoDesktop(Value: boolean);
begin
  FnoDesktop := Value;
  DisableItem(wlDESKTOP,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoRButton(Value: boolean);
begin
  FnoRButton := Value;
  DisableShortcut(0,VK_RBUTTON,0,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoStartMenu(Value : boolean);
begin
  FnoStartMenu := Value;
  DisableItem(wlSTARTMENU,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoStartbutton(Value: boolean);
begin
  FnoStartbutton := Value;
  DisableItem(wlSTARTBUTTON,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoTaskbar(Value: boolean);
begin
  FnoTaskbar := Value;
  DisableItem(wlTASKBAR,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoTaskLinks(Value: boolean);
begin
  FnoTaskLinks := Value;
  DisableItem(wlTASKLINKS,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoTaskTray(Value: boolean);
begin
  FnoTaskTray := Value;
  DisableItem(wlTASKTRAY,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoWinkeys(Value: boolean);
begin
  FnoWinkeys := Value;
  DisableShortcut(0,0,MOD_WIN,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoAltReturn(Value: boolean);
begin
  FnoAltReturn := Value;
  DisableShortcut(0,VK_RETURN,MOD_ALT,Value);
end;
//______________________________________________________________________________
procedure TdWinlock.SetFrontApplication(const Value: boolean);
begin
  if fasFrontApp = Value then
    exit;
  fasFrontApp := Value;
  if (csDesigning in Componentstate) then
  begin
    if FasFrontApp then
       if not (csLoading in Componentstate) then
       if MessageBox(0,'No other applications (including the desktop)'+#13#10+
                   'will be launched on next system start'+#13#10+
                   'after starting this program' +#13#10+
                   'Do you want to do this?'
                   ,'Info',MB_YESNO or MB_ICONQUESTION) <> idYES then
          fasFrontApp := false;
    exit;
  end;

  if fasFrontApp then
  begin
    with TRegistry.Create do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      Access := KEY_READ or KEY_SET_VALUE;
      if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Runonce',false) then
        WriteString('dWinlockFrontApp',Paramstr(0));
      Free;
    end;
  end else
  begin
    with TRegistry.Create do
    begin
      RootKey := HKEY_LOCAL_MACHINE;
      Access := KEY_READ or KEY_SET_VALUE;
      if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Runonce',false) then
        DeleteValue('dWinlockFrontApp');
      Free;
    end;
  end;
end;
//______________________________________________________________________________

procedure TdWinlock.SetnoTaskRebar(const Value: boolean);
begin
  FnoTaskRebar := Value;
  DisableItem(wlTASKREBAR,Value);
end;
//______________________________________________________________________________

procedure TdWinlock.SetNumLock(const Value: boolean);
begin
  wlSetKeyState(VK_NUMLOCK,ord(Value));
end;
//______________________________________________________________________________

procedure TdWinlock.SetKeyEvent;
var
 KeyDown : integer;
 KeyUP   : integer;
begin
  if (csDesigning in Componentstate) then
    exit;
  KeyDown := 0;
  KeyUp   := 0;
  if assigned (FOnKeyDown)   then   Keydown :=  WM_DWLKEYDOWN;
  if assigned (FOnKeyUp)     then   KeyUp   :=  WM_DWLKEYUP;
  if assigned (FOnMouseDown) then   Keydown :=  WM_DWLKEYDOWN;
  if assigned (FOnMouseUp)   then   KeyUp   :=  WM_DWLKEYUP;
  if Handle = 0 then
    Handle := AllocateHWnd(WNDProc);
  wlSetKeyPostMessage(Handle,KeyDown,KeyUp);
end;

procedure TdWinlock.SetOnKeyDown(const Value: TdwKeyEvent);
begin
  FOnKeyDown := Value;
  SetKeyEvent;
end;
//______________________________________________________________________________

procedure TdWinlock.SetOnKeyUp(const Value: TdwKeyEvent);
begin
  FOnKeyUp := Value;
  SetKeyEvent;
end;
//______________________________________________________________________________

procedure TdWinlock.SetOnMouseDown(const Value: TdwMouseEvent);
begin
  FOnMouseDown := Value;
  SetKeyEvent;
end;
//______________________________________________________________________________

procedure TdWinlock.SetOnMouseUp(const Value: TdwMouseEvent);
begin
  FOnMouseUp := Value;
  SetKeyEvent;
end;
//______________________________________________________________________________


procedure TdWinlock.DisableItem(Item: integer; disable: boolean);
begin
  if not(csDesigning in Componentstate) then
   if not ((csLoading in Componentstate) and (disable = false)) then
    wlDisableItem(Item,integer(disable));
end;
//______________________________________________________________________________
function TdWinlock.DisableShortcut(window: HWND; vk, Modifiers: integer; disable: boolean): boolean;
begin
  result:=false;
  if not(csDesigning in Componentstate) then
    if not ((csLoading in Componentstate) and (disable = false)) then
    result:= wlDisableKey(window,vk,Modifiers,integer(disable))<>0;
end;
//______________________________________________________________________________
procedure TdWinlock.Loaded;
begin
  inherited;
//  if not(csDesigning in Componentstate) then
//    wlSetNoShutdown(true, OnShutdownDefault);
end;
//______________________________________________________________________________

procedure TdWinlock.RestoreAll;
begin
  wlRestoreAll;
end;
//______________________________________________________________________________

function TdWinlock.IsDisableItem(Item: integer): boolean;
begin
  result := wlIsItemDisabled(Item) = 1;
end;
//______________________________________________________________________________

function TdWinlock.UninstallDwl: boolean;
begin
  result := wlUninstallDwl(0) <>0;
end;
//______________________________________________________________________________

function TdWinlock.InstallDwl: boolean;
begin
  result := wlInstallDwl(0)<>0;
end;
//______________________________________________________________________________

function TdWinlock.isDwlInstalled: boolean;
begin
  result := wlIsDwlInstalled = 1;
end;
//______________________________________________________________________________
function TdWinlock.IsAdmin: boolean;
begin
  result:= wlIsAdmin;
end;
//______________________________________________________________________________
function TdWinlock.EnableAutologin(DefUser: string; Pass: string; Enable: boolean; Domain: string): boolean;
begin
  if Enable then
    result :=  wlEnableAutologin(DefUser,Pass,1,Domain) = 1
  else
    result :=  wlEnableAutologin(DefUser,Pass,0,Domain) = 1;
end;
//______________________________________________________________________________
procedure TdWinlock.DisableDesktopIcon(index: integer);
begin
  wlDisableDesktopIcon(index);
end;
//______________________________________________________________________________

function TdWinlock.DesktopIconCount: integer;
begin
  result := wlDesktopIconCount;
end;

//______________________________________________________________________________
procedure TdWinlock.RestoreDesktopIcons;
begin
  wlRestoreDesktopIcons;
end;
//______________________________________________________________________________

procedure TdWinlock.SetVersion(const Value: string);
begin
  //
end;
//______________________________________________________________________________

function IsMouseKey(Key: integer; var MouseButton: TMouseButton): boolean;
begin
  result := (Key = VK_RBUTTON) or (Key = VK_LBUTTON) or (Key = VK_MBUTTON);
  if result then
    case Key of
      VK_LBUTTON: MouseButton := mbLeft;
      VK_RBUTTON: MouseButton := mbRight;
      else MouseButton := mbMiddle;
    end;
end;
//______________________________________________________________________________

function TdWinlock.GetNumLock: boolean;
begin
  result := wlGetKeyState(VK_NUMLOCK) = 1;
end;

function TdWinlock.GetCapsLock: boolean;
begin
  result := wlGetKeyState(VK_CAPITAL) = 1;
end;

procedure TdWinlock.SetCapsLock(const Value: boolean);
begin
  wlSetKeyState(VK_CAPITAL,ord(Value));
end;

function TdWinlock.GetScrollLock: boolean;
begin
  result := wlGetKeyState(VK_SCROLL) = 1;
end;

procedure TdWinlock.SetScrollLock(const Value: boolean);
begin
  wlSetKeyState(VK_SCROLL,Ord(Value));
end;

procedure TdWinlock.SetStartMenu(Wnd: HWnd);
begin
  wlSetStartMenu(Wnd);
end;

function  TdWinlock.GetItemHandle(Item: integer): HWnd;
begin
  result := wlGetItemHandle(Item);
end;

procedure TdWinlock.DisableKey(Wnd: HWND; VK_Code, MF: integer; disable : boolean);
begin
  wlDisableKey(Wnd, VK_Code, MF, integer(disable));
end;

function TdWinlock.IsKeyDisabled(Wnd: HWND; VK_Code, MF: integer): boolean;
begin
  result := wlIsKeyDisabled(Wnd, VK_Code, MF) = 1;
end;

procedure TdWinlock.DoKeyEvent(Wnd: HWND; Down, VK, MF: integer);
var
  shift: TShiftState;
  MouseButton: TMouseButton;
  pt: TPoint;
begin
  shift := MakeShiftState(MF);
  if Down = 1 then   // if Key down
  begin
    if IsMouseKey(vk,MouseButton) then
    begin
      if assigned(FOnMouseDown) then
      begin
        GetCursorPos(pt);
        FOnMouseDown(Wnd,MouseButton,shift,pt.x,pt.y);
      end;
    end
    else
      if assigned(FOnKeyDown) then
        FOnKeyDown(Wnd,vk,shift);
  end
  else              // if key up
  begin
    if IsMouseKey(vk,MouseButton) then
    begin
      if assigned(FOnMouseUP) then
      begin
        GetCursorPos(pt);
        FOnMouseUp(Wnd,MouseButton,shift,pt.x,pt.y);
      end
    end
    else
      if assigned(FOnKeyUP) then
        FOnKeyUP(Wnd,vk,shift);
  end;
end;

procedure TdWinlock.SetnoAccessibilityShortcuts(Value: boolean);
begin
  FnoAccessibilityShortcuts := Value;
  DisableItem(wlAccessibility,Value);
end;
//______________________________________________________________________________
procedure TdWinlock.WndProc(var Message: TMessage);
begin
  With Message do
    case Msg of
      WM_DWLKEYDOWN:      DoKeyEvent(WParam,1,LOWORD(LParam), HIWORD(LPAram));
      WM_DWLKEYUP:        DoKeyEvent(WParam,0,LOWORD(LParam), HIWORD(LPAram));
      WM_QUERYENDSESSION: Message.Result := 1;
    end;
end;
(*
//______________________________________________________________________________
function TdWinlock.OnShutdownDefault(wParam,lParam: integer): integer; stdcall;
begin
  if fNoShutdown then
    result := 0 // block shutdown;
  else
    result := 1;
end;
*)
//______________________________________________________________________________
procedure TdWinlock.SetNoShutdown(const Value: boolean);
begin
  fNoShutdown := Value;
  DisableItem(wlShutdown,Value);
end;
//______________________________________________________________________________
procedure TdWinlock.SetOnShutdown(const Value: TdwlQueryEndSessionCallbackMethod);
begin
  fOnShutdown := Value;
  if (csDesigning in Componentstate) then
    exit;
  wlSetShutdownCallback(fOnShutdown);
end;

end.



