2

我有这个组件，我想在 DLL 中使用它来实现系统范围的钩子：

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.

有人可以帮我把所有这些东西都放到一个 DLL 中（没有组件），我的意思是只有函数。

非常感谢

4

1 回答 1

1

exports您可以简单地通过在单元中的某处包含一个子句来导出函数。要导出该代码中的两个函数，请将其添加到单元的底部：

exports
  Open_Clipboard,
  Set_ClipboardData;
于 2012-04-13T20:42:20.787 回答