mmhook.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: [phone]                   =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 15.02.98 - 03:31:31 $                                        =}
{========================================================================}
unit MMHook;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Classes,
    Controls,
    Messages,
    Forms,
    MMObj,
{$IFDEF BUILD_ACTIVEX}
    AxCtrlsUtil,
{$ENDIF}
    MMUtils;


type
    {== TMMWndProcComponent ===================================================}
    TMMWndProcComponent = class(TMMNonVisualComponent)
    private
       FOldWndProc     : TFarProc;
       FNewWndProc     : TFarProc;
       FHookWnd        : HWND;
       FOwnerForm      : TForm;
       FHooked         : Boolean;

    protected
       procedure HookOwner; virtual;
       procedure UnHookOwner; virtual;
       procedure HookWndProc(var Message: TMessage); virtual;
       function  CallPrevWndProc(Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; virtual;
{$IFDEF BUILD_ACTIVEX}
       procedure MMParentWindowChanged(var M: TMessage); message MM_PARENTWINDOWCHANGED;
{$ENDIF}

       property HookWnd    : HWND read FHookWnd;
       property OwnerForm  : TForm read FOwnerForm;
       property FormOK     : Boolean read FHooked write FHooked;

    public
       constructor Create(aOwner: TComponent); override;
       destructor  Destroy; override;
    end;

implementation

const
   HookList: TList = nil;

{------------------------------------------------------------------------------}
procedure AddHook(Comp: TMMWndProcComponent);
begin
   if (HookList = nil) then HookList := TList.Create;

   HookList.Add(Comp);
end;

{------------------------------------------------------------------------------}
function RemoveHook(Comp: TMMWndProcComponent): Boolean;
var
   i: integer;

begin
   Result := False;

   HookList.Remove(Comp);

   for i := 0 to HookList.Count-1 do
   begin
      { !!! remove the current component from the Hook chain !!! }
      if (TMMWndProcComponent(HookList[i]).FOldWndProc = Comp.FNewWndProc) then
      begin
         TMMWndProcComponent(HookList[i]).FOldWndProc := Comp.FOldWndProc;
         Result := True;
      end;
   end;

   if (HookList.Count = 0) then
   begin
      HookList.Free;
      HookList := nil;
   end;
end;

{== TMMWndProcComponent =======================================================}
constructor TMMWndProcComponent.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);

   FHookWnd     := 0;
   FHooked      := False;

{$IFNDEF BUILD_ACTIVEX}
   if not (Owner is TForm) then
      raise Exception.Create('Owner must be a Form');
{$ENDIF}

   if (Owner <> nil) and (Owner is TForm) then
   begin
      FOwnerForm := Owner as TForm;
   end;
end;

{-- TMMWndProcComponent -------------------------------------------------------}
destructor TMMWndProcComponent.Destroy;
begin
   UnHookOwner;

   inherited Destroy;
end;

{-- TMMWndProcComponent -------------------------------------------------------}
procedure TMMWndProcComponent.HookOwner;
begin
   if not FHooked and (FOwnerForm <> nil) then
   begin
      { hook the parents WndProc }
      FHookWnd    := FOwnerForm.Handle;
   end;

   if not FHooked and (FHookWnd <> 0) then
   begin
      FNewWndProc := MakeObjectInstance(HookWndProc);
      FOldWndProc := TFarProc(SetWindowLong(FHookWnd,GWL_WNDPROC,LongInt(FNewWndProc)));

      AddHook(Self);

      FHooked := True;
   end;
end;

{-- TMMWndProcComponent -------------------------------------------------------}
procedure TMMWndProcComponent.UnHookOwner;
begin
   if FHooked then
   begin
      FHooked := False;

      { unhook the parents WndProc }
      if FHookWnd <> 0 then
      begin
         if not RemoveHook(Self) then
            SetWindowLong(FHookWnd, GWL_WNDPROC, LongInt(FOldWndProc));

         FreeObjectInstance(FNewWndProc);

         if (FOwnerForm <> nil) then FHookWnd := 0;
      end;
   end;
end;

{-- TMMWndProcComponent -------------------------------------------------------}
function TMMWndProcComponent.CallPrevWndProc(Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
   if FHooked then
   Result := CallWindowProc(FOldWndProc,FHookWnd,Msg,wParam,lParam);
end;

{-- TMMWndProcComponent -------------------------------------------------------}
procedure TMMWndProcComponent.HookWndProc(var Message: TMessage);
begin
   with Message do
   Result := CallPrevWndProc(Msg,wParam,lParam);
end;

{$IFDEF BUILD_ACTIVEX}
{-- TMMWndProcComponent -------------------------------------------------------}
procedure TMMWndProcComponent.MMParentWindowChanged(var M: TMessage);
begin
  if (FOwnerForm <> nil) then
  begin
     if FHookWnd <> M.WParam then
     begin
        UnHookOwner;
        FHookWnd := M.WParam;
        if FHookWnd <> 0 then
           HookOwner;
     end;
  end;
end;
{$ENDIF}

end.