Hook SetClipboardData from user32.dll

[randy]

Hi , i've this component that i want to use it in a DLL to achieve a system-wide hook :

Code: Select all

unit ClipboardHook;
interface
uses
  Windows, SysUtils, Classes, ExtCtrls;
type
 TFOnOpenClipboard = procedure(Sender:TObject; hWndNewOwner:HWND; var opContinue:Boolean) of object;
 TFOnSetClipboardData = procedure(Sender:TObject; hWndNewOwner:HWND; uFormat:DWord; hMem:THandle; var opContinue:Boolean) of object;
type
  TClipboardHook = class(TComponent)
  private
    { Private declarations }
    FOnOpenClipboard:TFOnOpenClipboard;
    FOnSetClipboardData:TFOnSetClipboardData;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    //------------------------------------------------
  published
    { Published declarations }
    property OnOpenClipboard:TFOnOpenClipboard read FOnOpenClipboard write FOnOpenClipboard;
    property OnSetClipboardData:TFOnSetClipboardData read FOnSetClipboardData write FOnSetClipboardData;
  end;
implementation
type
 TcOpen=function(hWndNewOwner:HWND):Bool; stdcall;
 TscData=function(uFormat:DWord; hMem:Thandle):THandle; stdcall;
 TOP_H = packed record
  Push:Byte;
  Address:DWord;
  Ret:Byte;
 end; 
var OC_Addr,SCD_Addr:Pointer;
    OP:DWord;
    cOpen,rcOpen,scData,rscData:TOP_H;
    WPM:DWord;
    sComponent:TObject;
{***************************Start:TClipboardHook***************************}
function Open_Clipboard(hWndNewOwner:HWND):Bool; stdcall;
var c:Boolean;
begin
 c:=true;
 if Assigned(TClipboardHook(sComponent).FOnOpenClipboard) then
  TClipboardHook(sComponent).FOnOpenClipboard(sComponent,hWndNewOwner,c);
 if c then
  begin
   WriteProcessMemory(OP,OC_Addr,@rcOpen,SizeOf(rcOpen),WPM);
   Result:=TcOpen(OC_Addr)(hWndNewOwner);
   WriteProcessMemory(OP,OC_Addr,@cOpen,SizeOf(cOpen),WPM);
  end else Result:=false;
end;
function Set_ClipboardData(uFormat:DWord; hMem:THandle):THandle; stdcall;
var c:Boolean;
    Win:DWord;
begin         
 c:=true;
 Win:=GetOpenClipboardWindow();
 if (Win<>0)and(Assigned(TClipboardHook(sComponent).FOnSetClipboardData)) then
  TClipboardHook(sComponent).FOnSetClipboardData(sComponent,Win,uFormat,hMem,c);
 if c then
  begin
   WriteProcessMemory(OP,SCD_Addr,@rscData,SizeOf(rscData),WPM);
   Result:=TscData(SCD_Addr)(uFormat,hMem);
   WriteProcessMemory(OP,SCD_Addr,@scData,SizeOf(scData),WPM);
  end else Result:=0;
end;
{****************************End:TClipboardHook****************************}
{##############################################################################}
constructor TClipboardHook.Create(AOwner:TComponent);
var Dll:DWord;
begin
 inherited Create(Aowner);
 if (csDesigning in ComponentState) then exit;
 sComponent:=Self;
 DLL:=LoadLibrary('user32.dll');
 if DLL<>0 then
  begin
   OC_Addr:=GetProcAddress(DLL,'OpenClipboard');
   SCD_Addr:=GetProcAddress(DLL,'SetClipboardData');
   if (OC_Addr<>nil)or(SCD_Addr<>nil) then
    begin      
     OP:=OpenProcess(PROCESS_ALL_ACCESS,false,GetCurrentProcessID);
     if OP<>0 then
      begin
       if OC_Addr<>nil then
        begin
         cOpen.Push:=$68;
         cOpen.Address:=DWord(@Open_Clipboard);
         cOpen.Ret:=$C3;
         ReadProcessMemory(OP,OC_Addr,@rcOpen,SizeOf(rcOpen),WPM);
         WriteProcessMemory(OP,OC_Addr,@cOpen,SizeOf(cOpen),WPM);
        end;
       if SCD_Addr<>nil then
        begin
         scData.Push:=$68;
         scData.Address:=DWord(@Set_ClipboardData);
         scData.Ret:=$C3;
         ReadProcessMemory(OP,SCD_Addr,@rscData,SizeOf(rscData),WPM);
         WriteProcessMemory(OP,SCD_Addr,@scData,SizeOf(scData),WPM);
        end;
      end;
    end;
   FreeLibrary(Dll);
  end;
end;
destructor TClipboardHook.destroy;
begin
 if (OC_Addr<>nil) then WriteProcessMemory(OP,OC_Addr,@rcOpen,SizeOf(rcOpen),WPM);
 if OP<>0 then CloseHandle(OP);
 inherited destroy;
end;
{##############################################################################}
end.

can someone help me in putting all these stuffs into a DLL ( without the Component ) ,i mean only the functions .

many thanks

[madshi]

You shouldn't use "Classes.pas" in a system-wide hook, IMHO. Keep the hook dll as small as possible. If possible, even try to avoid using SysUtils.

If you want to do this with madCodeHook, check out the demos shipping with madCodeHook, to give you a good starting point. It's actually quite easy...

[randy]

Thank you madshi , yes i want to use this with madCodeHook ,

But please can ou just help me in implementing OnSetClipboardData procedure in madCodeHook simple , and i will do the rest my self .

many thanks

[madshi]

Something like this, written from the top of my head, not tested compiled:

Code: Select all

library YourHookDll;

uses Windows, madCodeHook;

var SetClipboardDataNext : function (uFormat: dword; hMem: THandle) : THandle; stdcall;

function SetClipboardDataCallback(uFormat: dword; hMem: THandle) : THandle; stdcall;
begin
  result := SetClipboardDataNext(uFormat, hMem);
end;

begin
  HookAPI('user32.dll', 'SetClipboardData');
end.

Very easy, isn't it?

[randy]

madshi i did it in this way ( without using madCodeHook cause all is still is test stage ) :

Code: Select all

library HookDll;

uses
  Windows;


type
 TcOpen=function(hWndNewOwner:HWND):Bool; stdcall;
 TscData=function(uFormat:DWord; hMem:Thandle):THandle; stdcall;
 TOP_H = packed record
  Push:Byte;
  Address:DWord;
  Ret:Byte;
 end; 
var OC_Addr,SCD_Addr:Pointer;
    OP:DWord;
    cOpen,rcOpen,scData,rscData:TOP_H;
  
  
function Open_Clipboard(hWndNewOwner:HWND):Bool; stdcall;
var c:Boolean;
begin
 c:=true;
 if c then
  begin
   WriteProcessMemory(OP,OC_Addr,@rcOpen,SizeOf(rcOpen),WPM);
   Result:=TcOpen(OC_Addr)(hWndNewOwner);
   WriteProcessMemory(OP,OC_Addr,@cOpen,SizeOf(cOpen),WPM);
  end else Result:=false;
end;

function Set_ClipboardData(uFormat:DWord; hMem:THandle):THandle; stdcall;
var c:Boolean;
    Win:DWord;
begin    
 c:=true;
 if c then
  begin
   WriteProcessMemory(OP,SCD_Addr,@rscData,SizeOf(rscData),WPM);
   Result:=TscData(SCD_Addr)(uFormat,hMem);
   WriteProcessMemory(OP,SCD_Addr,@scData,SizeOf(scData),WPM);
  end else Result:=0;
end;

function HookClipboardOperations: Boolean;
var Dll:DWord;
begin
 DLL:=LoadLibrary('user32.dll');
 if DLL<>0 then
  begin
   OC_Addr:=GetProcAddress(DLL,'OpenClipboard');
   SCD_Addr:=GetProcAddress(DLL,'SetClipboardData');
   if (OC_Addr<>nil)or(SCD_Addr<>nil) then
    begin      
     OP:=GetCurrentProcess;
     //OpenProcess(PROCESS_ALL_ACCESS,false,GetCurrentProcessID);
     if OP<>0 then
      begin
       if OC_Addr<>nil then
        begin
         cOpen.Push:=$68;
         cOpen.Address:=DWord(@Open_Clipboard);
         cOpen.Ret:=$C3;
         ReadProcessMemory(OP,OC_Addr,@rcOpen,SizeOf(rcOpen),WPM);
         WriteProcessMemory(OP,OC_Addr,@cOpen,SizeOf(cOpen),WPM);
        end;
       if SCD_Addr<>nil then
        begin
         scData.Push:=$68;
         scData.Address:=DWord(@Set_ClipboardData);
         scData.Ret:=$C3;
         ReadProcessMemory(OP,SCD_Addr,@rscData,SizeOf(rscData),WPM);
         WriteProcessMemory(OP,SCD_Addr,@scData,SizeOf(scData),WPM);
        end;
      end;
    end;
   FreeLibrary(Dll);
  end;
end;

function HookProc(code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  if FHook <> 0 then
  begin
    if code < HC_ACTION then
      Result := CallNextHookEx(FHook,code,wParam,lParam)
    else
    begin
      if (not FHooked) and (code >= HC_ACTION) then
      begin
        FHooked := true;
        HookClipboardOperations;
      end;
      Result := CallNextHookEx(FHook,code,wParam,lParam);
    end;
  end
  else
    Result := 0;
end;

procedure InstallHook; stdcall;
begin
 FHook := SetWindowsHookEx(WH_GETMESSAGE,HookProc,hInstance,0);
end;

procedure UnInstallHook; stdcall;
begin
  if FHook <> 0 then
    UnhookWindowsHookEx(FHook);
   if (OC_Addr<>nil) then WriteProcessMemory(OP,OC_Addr,@rcOpen,SizeOf(rcOpen),WPM);
 if OP<>0 then CloseHandle(OP); 
end;

procedure EntryPointProc(reason: integer);
var
  str: pChar;
begin
  case reason of
    DLL_PROCESS_ATTACH:
      begin
        InstallHook();
      end;
    DLL_THREAD_ATTACH:
      begin
      end;
    DLL_PROCESS_DETACH:
      begin
      UnInstallHook();
      end;
    DLL_THREAD_DETACH:
      begin
      end;
  end;
end;
exports
  InstallHook,
  UnInstallHook,
  HookProc;
begin
  DllProc := @EntryPointProc;
  EntryPointProc(DLL_PROCESS_ATTACH);
end.

When i inject the DLL i can Intercept and hook SetClipboardData API , but the Problem is when i close the application( the injector ) after calling UnInstallHook of course the DLL is not Uninjected from the system that means each time a Paste operation is called/invoked the active window ( that's calling Paste operation ) is hanged .

please any solution for this ?

many thanks

[madshi]

Sorry, I can't help if you don't use madCodeHook.