如何拦截剪切板的消息并取得剪切板内容？(100分)

spacepoint · 2003-06-09

   我的想法是这样：我的程序驻在后台，一旦有人进行了剪切或复制操作，那我的程序将得知这一操作并判断当前剪切板的内容是否为文本，如果是文本则取得之。我有试过钩子但不知道用那种类型钩子，请DFW们帮忙，最好能有代码。

FeelingLoad · 2003-06-09

想法： 1，拦截按键Ctrl+C,Ctrl+X； 2，拦截 WM_PASTE 消息； 3，你说的钩子CopyHook； //实现CopyHook接口 unit CopyMain; interface uses Windows, ComObj, ShlObj; type TCopyHook = class(TComObject, ICopyHook) protected function CopyCallback(Wnd: HWND; wFunc, wFlags: UINT; pszSrcFile: PAnsiChar; dwSrcAttribs: DWORD; pszDestFile: PAnsiChar; dwDestAttribs: DWORD): UINT; stdcall; end; TCopyHookFactory = class(TComObjectFactory) protected function GetProgID: string; override; procedure ApproveShellExtension(Register: Boolean; const ClsID: string); virtual; public procedure UpdateRegistry(Register: Boolean); override; end; implementation uses ComServ, SysUtils, Registry; { TCopyHook } // This is the method which is called by the shell for folder operations function TCopyHook.CopyCallback(Wnd: HWND; wFunc, wFlags: UINT; pszSrcFile: PAnsiChar; dwSrcAttribs: DWORD; pszDestFile: PAnsiChar; dwDestAttribs: DWORD): UINT; const MyMessage: string = 'Are you sure you want to mess with "%s"?'; begin // confirm operation Result := MessageBox(Wnd, PChar(Format(MyMessage, [pszSrcFile])), 'D4DG Shell Extension', MB_YESNO); end; { TCopyHookFactory } function TCopyHookFactory.GetProgID: string; begin // ProgID not needed for shell extension Result := ''; end; procedure TCopyHookFactory.UpdateRegistry(Register: Boolean); var ClsID: string; begin ClsID := GUIDToString(ClassID); inherited UpdateRegistry(Register); ApproveShellExtension(Register, ClsID); if Register then // add shell extension clsid to CopyHookHandlers reg entry CreateRegKey('directory/shellex/CopyHookHandlers/' + ClassName, '', ClsID) else DeleteRegKey('directory/shellex/CopyHookHandlers/' + ClassName); end; procedure TCopyHookFactory.ApproveShellExtension(Register: Boolean; const ClsID: string); // This registry entry is required in order for the extension to // operate correctly under Windows NT. const SApproveKey = 'SOFTWARE/Microsoft/Windows/CurrentVersion/Shell Extensions/Approved'; begin with TRegistry.Create do try RootKey := HKEY_LOCAL_MACHINE; if not OpenKey(SApproveKey, True) then Exit; if Register then WriteString(ClsID, Description) else DeleteValue(ClsID); finally Free; end; end; const CLSID_CopyHook: TGUID = '{66CD5F60-A044-11D0-A9BF-00A024E3867F}'; initialization TCopyHookFactory.Create(ComServer, TCopyHook, CLSID_CopyHook, 'D4DG_CopyHook', 'D4DG Copy Hook Shell Extension Example', ciMultiInstance, tmApartment); end.

特尔斐 · 2003-06-09

注册剪贴板监视链，稍后贴上源程序

spacepoint · 2003-06-10

to FeelingLoad     仔细看了您的代码，没明白是什么意思，新建一个工程，把这个Unit连上去也没什么作用。它的原理是怎么样的，怎么使用，能说得清楚一点吗？ to 特尔斐     期待着您的程序。

xygz · 2003-06-10

http://www.zbbbs.com/index.asp?classid=4&Nclassid=7 这里有段代码 这个东西在DFW的全文检索里很多，找一下就根本不必提这个问题

spacepoint · 2003-06-10

我的系统不如为什么就是不能检索，提说缺少什么什么对象

spacepoint · 2003-06-10

ok，解决了

特尔斐 · 2003-06-10

我许一个诺言就得了80分^&^ ，看来得贴点代码了。 其实在WIN32中监视剪贴板非常容易，只在用到两个API函数，处理 两条消息。 两个API： SetClipboardViewer 将一个窗口设为剪贴板查看器 ChangeClipboardChain 改变剪贴板监视链，一般用于取消你注册的剪贴板查看器 两条消息： WM_CHANGECBCHAIN 当剪贴板监视链发生改变时，这条消息将发送到剪贴板查看器窗口 应该在这里记录它的LPARAM（一个窗口句柄，指向下一个贴板查看 器窗口）备用。 WM_DRAWCLIPBOARD 当系统剪贴板发生改变时，这条消息将发送到剪贴板查看器窗口， 在这里面处理所有的监视逻辑。 下面是实现代码： unit main; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, DB, ADODB, ComCtrls, ToolWin, ImgList, ActnList, ExtCtrls,   StdCtrls, DBCtrls, Menus; type   TfrmMain = class(TForm)     //...省略无关的代码   private     { Private declarations }     //...省略无关的代码     procedure OnWM_CHANGECBCHAIN(var Msg:TMessage);message WM_CHANGECBCHAIN;     procedure OnWM_DRAWCLIPBOARD(var Msg:TMessage);message WM_DRAWCLIPBOARD;     //...省略无关的代码   public     { Public declarations }     function HasText:boolean;     function GetText:string;     function HasPicture(var Format:Word):boolean;     //...省略无关的代码   end; var   frmMain: TfrmMain; implementation {$R *.dfm} procedure TfrmMain.FormCreate(Sender: TObject); begin    //将本窗体注册到剪贴板监视链中    FNextClipBrdViewerWnd :=SetClipboardViewer(Handle);    FWatchClipbrd :=true;    FAutoSaveClipBrdText :=true; end; procedure TfrmMain.FormDestroy(Sender: TObject); begin    //还原剪贴板监视链    ChangeClipboardChain(Handle,FNextClipBrdViewerWnd); end; //处理剪贴板消息 procedure TfrmMain.OnWM_DRAWCLIPBOARD(var Msg: TMessage); const   OldText:string='';   //类型常量（相当于VB中的静态变量），要开编译器选项                        //即Syntax options中的Assignable typed constants要                        //选中才能通过编译 var   s:string; begin    if not FWatchClipbrd then exit;    //这里只取文本，其实你可以监视任何放入剪贴板的东东        s :=GetText;    if OldText<>s then    begin                   //reBox为一文本框       reBox.PasteFromClipboard;       OldText :=s;    end; end; procedure TfrmMain.OnWM_CHANGECBCHAIN(var Msg: TMessage); begin    FNextClipBrdViewerWnd :=msg.LParam; //更新下一个剪贴板查看窗口句柄 end; function TfrmMain.GetText: string; var   Data:THandle; begin    Result:='';    OpenClipboard(Application.Handle);    try       Data :=GetClipboardData(CF_TEXT);       if Data<>0 then Result:=PChar(GlobalLock(Data));    finally       if Data<>0 then GlobalUnlock(Data);       CloseClipboard;    end; end; function TfrmMain.HasText: boolean; begin    Result :=IsClipboardFormatAvailable(CF_TEXT); end; procedure TfrmMain.SetAutoSaveClipBrdText(const Value: boolean); begin    FAutoSaveClipBrdText := Value; end; procedure TfrmMain.SetWatchClipbrd(const Value: boolean); begin   FWatchClipbrd := Value; end; function TfrmMain.HasPicture(var Format:Word): boolean; var   fmt:Word; begin    OpenClipboard(Application.Handle);    try      fmt:=EnumClipboardFormats(0);      while fmt<>0 do      begin         if TPicture.SupportsClipboardFormat(fmt) then         begin            Format :=fmt;            Result :=true;            exit;         end;         fmt:=EnumClipboardFormats(fmt);      end;    finally      CloseClipboard;    end; end; end.

如何拦截剪切板的消息并取得剪切板内容？(100分)

spacepoint

Unregistered / Unconfirmed

FeelingLoad

Unregistered / Unconfirmed

特尔斐

Unregistered / Unconfirmed

spacepoint

Unregistered / Unconfirmed

xygz

Unregistered / Unconfirmed

spacepoint

Unregistered / Unconfirmed

spacepoint

Unregistered / Unconfirmed

特尔斐

Unregistered / Unconfirmed

Similar threads