تعطيل/ تشغيل زر قائمة إبدا StartButton

كود :
{********** Begin WHookDef.dpr **************}

{ Interface unit for use with WINHOOK.DLL }

unit WHookDef;

interface

uses
  Windows;

function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall;
function FreeHook: Boolean; stdcall;

implementation

function SetHook; external 'WINHOOK.DLL' Index 1;
function FreeHook; external 'WINHOOK.DLL' Index 2;

end.

{********** End WHookDef.dpr **************}


{********** Begin Winhook.dpr **************}

{ The project file }

{ WINHOOK.dll }
library Winhook;

uses
  WHookInt in 'Whookint.pas';

exports
  SetHook index 1,
  FreeHook index 2;
end.

{********** End Winhook.dpr **************}


{********** Begin WHookInt.pas **************}

unit WHookInt;

interface

uses
  Windows, Messages, SysUtils;

function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall; export;
function FreeHook: Boolean; stdcall; export;
function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint stdcall; export;

implementation


// Memory map file stuff

{
  The CreateFileMapping function creates unnamed file-mapping object
  for the specified file.
}

function CreateMMF(Name: string; Size: Integer): THandle;
begin
  Result := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, Size, PChar(Name));
  if Result <> 0 then
  begin
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      CloseHandle(Result);
      Result := 0;
    end;
  end;
end;

{ The OpenFileMapping function opens a named file-mapping object. }

function OpenMMF(Name: string): THandle;
begin
  Result := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(Name));
  // The return value is an open handle to the specified file-mapping object.
end;

{
 The MapViewOfFile function maps a view of a file into
 the address space of the calling process.
}

function MapMMF(MMFHandle: THandle): Pointer;
begin
  Result := MapViewOfFile(MMFHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0);
end;

{
  The UnmapViewOfFile function unmaps a mapped view of a file
  from the calling process's address space.
}

function UnMapMMF(P: Pointer): Boolean;
begin
  Result := UnmapViewOfFile(P);
end;

function CloseMMF(MMFHandle: THandle): Boolean;
begin
  Result := CloseHandle(MMFHandle);
end;


// Actual hook stuff

type
  TPMsg = ^TMsg;

const
  VK_D = $44;
  VK_E = $45;
  VK_F = $46;
  VK_M = $4D;
  VK_R = $52;

  MMFName = 'MsgFilterHookDemo';

type
  PMMFData = ^TMMFData;
  TMMFData = record
    NextHook: HHOOK;
    WinHandle: HWND;
    MsgToSend: Integer;
  end;

  // global variables, only valid in the process which installs the hook.
var
  MMFHandle: THandle;
  MMFData: PMMFData;

function UnMapAndCloseMMF: Boolean;
begin
  Result := False;
  if UnMapMMF(MMFData) then
  begin
    MMFData := nil;
    if CloseMMF(MMFHandle) then
    begin
      MMFHandle := 0;
      Result := True;
    end;
  end;
end;

{
  The SetWindowsHookEx function installs an application-defined
  hook procedure into a hook chain.

  WH_GETMESSAGE Installs a hook procedure that monitors messages
  posted to a message queue.
  For more information, see the GetMsgProc hook procedure.
}

function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall;
begin
  Result := False;
  if (MMFData = nil) and (MMFHandle = 0) then
  begin
    MMFHandle := CreateMMF(MMFName, SizeOf(TMMFData));
    if MMFHandle <> 0 then
    begin
      MMFData := MapMMF(MMFHandle);
      if MMFData <> nil then
      begin
        MMFData.WinHandle := WinHandle;
        MMFData.MsgToSend := MsgToSend;
        MMFData.NextHook := SetWindowsHookEx(WH_GETMESSAGE, MsgFilterFunc, HInstance, 0);

        if MMFData.NextHook = 0 then
          UnMapAndCloseMMF
        else
          Result := True;
      end
      else
      begin
        CloseMMF(MMFHandle);
        MMFHandle := 0;
      end;
    end;
  end;
end;


{
  The UnhookWindowsHookEx function removes the hook procedure installed
  in a hook chain by the SetWindowsHookEx function.
}

function FreeHook: Boolean; stdcall;
begin
  Result := False;
  if (MMFData <> nil) and (MMFHandle <> 0) then
    if UnHookWindowsHookEx(MMFData^.NextHook) then
      Result := UnMapAndCloseMMF;
end;



(*
    GetMsgProc(
    nCode: Integer;  {the hook code}
    wParam: WPARAM;  {message removal flag}
    lParam: LPARAM  {a pointer to a TMsg structure}
    ): LRESULT;  {this function should always return zero}

    { See help on ==> GetMsgProc}
*)

function MsgFilterFunc(Code: Integer; wParam, lParam: Longint): Longint;
var
  MMFHandle: THandle;
  MMFData: PMMFData;
  Kill: boolean;
begin
  Result := 0;
  MMFHandle := OpenMMF(MMFName);
  if MMFHandle <> 0 then
  begin
    MMFData := MapMMF(MMFHandle);
    if MMFData <> nil then
    begin
      if (Code < 0) or (wParam = PM_NOREMOVE) then
        {
          The CallNextHookEx function passes the hook information to the
          next hook procedure in the current hook chain.
        }
        Result := CallNextHookEx(MMFData.NextHook, Code, wParam, lParam)
      else
      begin
        Kill := False;

        { Examples }
        with TMsg(Pointer(lParam)^) do
        begin
          // Kill Numbers
          if (wParam >= 48) and (wParam <= 57) then Kill := True;
          // Kill Tabulator
          if (wParam = VK_TAB) then Kill := True;
        end;

        { Example to disable all the start-Key combinations }
        case TPMsg(lParam)^.message of
          WM_SYSCOMMAND: // The Win Start Key (or Ctrl+ESC)
            if TPMsg(lParam)^.wParam = SC_TASKLIST then Kill := True;

          WM_HOTKEY:
            case ((TPMsg(lParam)^.lParam and $00FF0000) shr 16) of
              VK_D,      // Win+D        ==> Desktop
              VK_E,      // Win+E        ==> Explorer
              VK_F,      // Win+F+(Ctrl) ==> Find:All (and Find: Computer)
              VK_M,      // Win+M        ==> Minimize all
              VK_R,      // Win+R        ==> Run program.
              VK_F1,     // Win+F1       ==> Windows Help
              VK_PAUSE:  // Win+Pause    ==> Windows system properties
                Kill := True;
            end;
        end;
        if Kill then TPMsg(lParam)^.message := WM_NULL;
        Result := CallNextHookEx(MMFData.NextHook, Code, wParam, lParam)
      end;
      UnMapMMF(MMFData);
    end;
    CloseMMF(MMFHandle);
  end;
end;


initialization
  begin
    MMFHandle := 0;
    MMFData   := nil;
  end;

finalization
  FreeHook;
end.

{********** End WHookInt.pas **************}


{ *******************************************}
{ ***************** Demo   ******************}
{ *******************************************}

{

** HostApp.Exe **
HostApp.dpr
       |-----FrmMainU.pas

}

{********** Begin HostApp.dpr **************}

{ Project file }

program HostApp;

uses
  Forms,
  FrmMainU in 'FrmMainU.pas' {FrmMain};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TFrmMain, FrmMain);
  Application.Run;
end.

{********** End HostApp.dpr **************}


{********** Begin FrmMainU.pas **************}

unit FrmMainU;

interface

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

const
  HookDemo = 'WINHOOK.dll';

const
  WM_HOOKCREATE = WM_USER + 300;

type
  TFrmMain = class(TForm)
    Panel1: TPanel;
    BtnSetHook: TButton;
    BtnClearHook: TButton;
    procedure BtnSetHookClick(Sender: TObject);
    procedure BtnClearHookClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FHookSet: Boolean;
    procedure EnableButtons;
  public

  end;

var
  FrmMain: TFrmMain;

function SetHook(WinHandle: HWND; MsgToSend: Integer): Boolean; stdcall;
  external HookDemo;

function FreeHook: Boolean; stdcall; external HookDemo;

implementation

{$R *.DFM}

procedure TFrmMain.EnableButtons;
begin
  BtnSetHook.Enabled   := not FHookSet;
  BtnClearHook.Enabled := FHookSet;
end;

// Start the Hook
procedure TFrmMain.BtnSetHookClick(Sender: TObject);
begin
  FHookSet := LongBool(SetHook(Handle, WM_HOOKCREATE));
  EnableButtons;
end;

// Stop the Hook
procedure TFrmMain.BtnClearHookClick(Sender: TObject);
begin
  FHookSet := FreeHook;
  EnableButtons;
  BtnClearHook.Enabled := False;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  EnableButtons;
end;

end.

{********** End FrmMainU.pas **************}