i’ve this component that i want to use it in a DLL to achieve a system-wide hook :
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
You can export functions simply by including an
exportsclause somewhere in your unit. To export the two functions in that code, add this at the bottom of your unit: