Grol а с чего ты взял... что обязательно должно быть сообщение WM_Paste(или какое нить еще  ) при вставке(или наоборот) из буфера.
Вот компонент... для перехвата некоторых функций при работе с буфером обмена... для своего приложения(ClipboardHook.pas) - после инсталяции появится в Samples: | Код | unit ClipboardHook;
interface
uses
Windows, SysUtils, Classes, ExtCtrls;
type
TFOnOpenClipboard = procedure(Sender:TObject; hWndNewOwner:HWND; var opContinue:Boolean) of object;
TFOnGetClipboardData = procedure(Sender:TObject; hWndNewOwner:HWND; uFormat:DWord; 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;
FOnGetClipboardData:TFOnGetClipboardData;
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 OnGetClipboardData:TFOnGetClipboardData read FOnGetClipboardData write FOnGetClipboardData;
property OnSetClipboardData:TFOnSetClipboardData read FOnSetClipboardData write FOnSetClipboardData;
end;
procedure Register;
implementation
type
TcOpen=function(hWndNewOwner:HWND):Bool; stdcall;
TgcData=function(uFormat:DWord):THandle; stdcall;
TscData=function(uFormat:DWord; hMem:Thandle):THandle; stdcall;
TOP_H = packed record
Push:Byte;
Address:DWord;
Ret:Byte;
end;
var OC_Addr,GCD_Addr,SCD_Addr:Pointer;
OP:DWord;
cOpen,rcOpen,gcData,rgcData,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 Get_ClipboardData(uFormat:DWord):THandle; stdcall;
var c:Boolean;
Win:DWord;
begin
c:=true;
Win:=GetOpenClipboardWindow();
if (Win<>0)and(Assigned(TClipboardHook(sComponent).FOnGetClipboardData)) then
TClipboardHook(sComponent).FOnGetClipboardData(sComponent,Win,uFormat,c);
if c then
begin
WriteProcessMemory(OP,GCD_Addr,@rgcData,SizeOf(rgcData),WPM);
Result:=TgcData(GCD_Addr)(uFormat);
WriteProcessMemory(OP,GCD_Addr,@gcData,SizeOf(gcData),WPM);
end else Result:=0;
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');
GCD_Addr:=GetProcAddress(DLL,'GetClipboardData');
SCD_Addr:=GetProcAddress(DLL,'SetClipboardData');
if (OC_Addr<>nil)or(GCD_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 GCD_Addr<>nil then
begin
gcData.Push:=$68;
gcData.Address:=DWord(@Get_ClipboardData);
gcData.Ret:=$C3;
ReadProcessMemory(OP,GCD_Addr,@rgcData,SizeOf(rgcData),WPM);
WriteProcessMemory(OP,GCD_Addr,@gcData,SizeOf(gcData),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;
procedure Register;
begin
RegisterComponents('Samples', [TClipboardHook]);
end;
{##############################################################################}
end. |
Вот пример его использования:
-"Запрет" работы с буфером для всех TEdit;
-"Запрет" работы с буфером при вставке для TStringGrid;
-"Запрет" работы с буфером при копировании(вырезке) для TMemo; | Код | procedure TForm1.ClipboardHook1OpenClipboard(Sender: TObject;
hWndNewOwner: HWND; var opContinue: Boolean);
var ClassName:array [0..1024] of char;
i:integer;
begin
i:=GetClassName(hWndNewOwner,ClassName,1024);
if i<>0 then
begin
if AnsiCompareText('TEdit',Copy(ClassName,0,i))=0 then
opContinue:=false;
Edit1.Text:='OpenClipboard: '+Copy(ClassName,1,i);
end;
end;
procedure TForm1.ClipboardHook1GetClipboardData(Sender: TObject;
hWndNewOwner: HWND; uFormat: Cardinal; var opContinue: Boolean);
var ClassName:array [0..1024] of char;
i:integer;
begin
i:=GetClassName(GetParent(hWndNewOwner),ClassName,1024);
if i<>0 then
begin
if AnsiCompareText('TStringGrid',Copy(ClassName,1,i))=0 then
opContinue:=false;
i:=GetClassName(hWndNewOwner,ClassName,1024);
Edit1.Text:='WP_Paste: '+Copy(ClassName,1,i);
end;
end;
procedure TForm1.ClipboardHook1SetClipboardData(Sender: TObject;
hWndNewOwner: HWND; uFormat, hMem: Cardinal; var opContinue: Boolean);
var ClassName:array [0..1024] of char;
i:integer;
begin
i:=GetClassName(hWndNewOwner,ClassName,1024);
if i<>0 then
begin
if AnsiCompareText('TMemo',Copy(ClassName,0,i))=0 then
opContinue:=false;
Edit1.Text:='WP_Copy(Cut): '+Copy(ClassName,1,i);
end;
end; |
PS: По большому счету... данный код(компонент) тоже не панацея на все 100%
Удачи. |
перепробывал у меня ничего не получается. Подскажите мне буду очень вам благодарен за оказанную помощь!!! 
