winapi - 如何从 Lazarus 捕获剪贴板更改？

Question

如何从 Windows 中的 Lazarus 程序捕获对剪贴板所做的更改。例如，将剪贴板历史记录保存到文件中。

谢谢，

Answer 1

在 Lazarus 中和在任何 Windows 开发环境中都是一样的。您需要将自己添加到剪贴板查看器链中。

网上有很多文章描述了如何做到这一点。例如：

• http://delphi.about.com/od/windowsshellapi/a/clipboard_spy_2.htm
• http://www.developer.com/net/csharp/article.php/3359891/C-Tip-Monitoring-Clipboard-Activity-in-C.htm
• http://www.radsoftware.com.au/articles/clipboardmonitor.aspx

Answer 2

我找到了这个并设法让它工作，但忘记保存它，现在努力弄清楚我是如何让它工作的：

unit Unit1;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  Clipbrd, StdCtrls, Windows, Messages;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FNextClipboardOwner: HWnd;   // handle to the next viewer
    // Here are the clipboard event handlers
    function WMChangeCBChain(wParam: WParam; lParam: LParam):LRESULT;
    function WMDrawClipboard(wParam: WParam; lParam: LParam):LRESULT;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}
var
  PrevWndProc:windows.WNDPROC;

function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam;
  lParam: LParam): LRESULT; stdcall;
begin
  if uMsg = WM_CHANGECBCHAIN then begin
    Result := Form1.WMChangeCBChain(wParam, lParam);
    Exit;
  end 
  else if uMsg=WM_DRAWCLIPBOARD then begin
    Result := Form1.WMDrawClipboard(wParam, lParam);
    Exit;
  end;
  Result := CallWindowProc(PrevWndProc, Ahwnd, uMsg, WParam, LParam);
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  PrevWndProc := Windows.WNDPROC(SetWindowLong(Self.Handle, GWL_WNDPROC, PtrInt(@WndCallback)));
  FNextClipboardOwner := SetClipboardViewer(Self.Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ChangeClipboardChain(Handle, FNextClipboardOwner);
end;

function TForm1.WMChangeCBChain(wParam: WParam; lParam: LParam): LRESULT;
var
  Remove, Next: THandle;
begin
  Remove := WParam;
  Next := LParam;
  if FNextClipboardOwner = Remove then FNextClipboardOwner := Next
    else if FNextClipboardOwner <> 0 then
      SendMessage(FNextClipboardOwner, WM_ChangeCBChain, Remove, Next)
end;

function TForm1.WMDrawClipboard(wParam: WParam; lParam: LParam): LRESULT;
begin
  if Clipboard.HasFormat(CF_TEXT) Then Begin
    ShowMessage(Clipboard.AsText);
  end;
  SendMessage(FNextClipboardOwner, WM_DRAWCLIPBOARD, 0, 0);   // VERY IMPORTANT
  Result := 0;
end;

end.

上面的代码来自http://wiki.lazarus.freepascal.org/Clipboard，理论上它应该可以工作。它编译并运行，但剪贴板内容更改时不会弹出窗口。也许这里的其他人有更好的眼睛来找出原因。

Answer 3

在 Vista 和更高版本上，您应该使用 AddClipboardFormatListener() 而不是 SetClipboardViewer()。
这个工作示例最初由 ASerge 和 Remy 在 Lazarus 论坛上发布：不响应剪贴板更改 - windows

unit ClipboardListener;

{$mode objfpc}{$H+}

interface

uses
  Windows, Messages, Classes;

type
  { TClipboardListener }

  TClipboardListener = class(TObject)
  strict private
    FOnClipboardChange: TNotifyEvent;
    FWnd: HWND;
    class function GetSupported: Boolean; static;
    procedure WindowProc(var Msg: TMessage);
  public
    constructor Create;
    destructor Destroy; override;
    property OnClipboardChange: TNotifyEvent read FOnClipboardChange
      write FOnClipboardChange;
    class property Supported: Boolean read GetSupported;
  end;

implementation

uses SysUtils, LCLIntf;

var
  AddClipboardFormatListener: function(Wnd: HWND): BOOL; stdcall;
  RemoveClipboardFormatListener: function(Wnd: HWND): BOOL; stdcall;

procedure InitClipboardFormatListener;
var
  HUser32: HMODULE;
begin
  HUser32 := GetModuleHandle(user32);
  Pointer(AddClipboardFormatListener) :=
    GetProcAddress(HUser32, 'AddClipboardFormatListener');
  Pointer(RemoveClipboardFormatListener) :=
    GetProcAddress(HUser32, 'RemoveClipboardFormatListener');
end;

{ TClipboardListener }

constructor TClipboardListener.Create;
begin
  inherited;
  if GetSupported then
  begin
    FWnd := LCLIntf.AllocateHWnd(@WindowProc);
    if not AddClipboardFormatListener(FWnd) then
      RaiseLastOSError;
  end;
end;

destructor TClipboardListener.Destroy;
begin
  if FWnd <> 0 then
  begin
    RemoveClipboardFormatListener(FWnd);
    LCLIntf.DeallocateHWnd(FWnd);
  end;
  inherited;
end;

class function TClipboardListener.GetSupported: Boolean;
begin
  Result := Assigned(AddClipboardFormatListener) and
    Assigned(RemoveClipboardFormatListener);
end;

procedure TClipboardListener.WindowProc(var Msg: TMessage);
begin
  if (Msg.msg = WM_CLIPBOARDUPDATE) and Assigned(FOnClipboardChange) then
  begin
    Msg.Result := 0;
    FOnClipboardChange(Self);
  end;
end;

initialization
  InitClipboardFormatListener;
end.

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  ClipboardListener, Classes, Forms, StdCtrls;

type
  { TForm1 }

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FListener: TClipboardListener;
    procedure ClipboardChanged(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.ClipboardChanged(Sender: TObject);
begin
   Memo1.Lines.Append(timetostr(Now)+' ['+Clipboard.AsText+']')   
// Memo1.Lines.Append('Clipboard changed');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FListener := TClipboardListener.Create;
  FListener.OnClipboardChange := @ClipboardChanged;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FListener.Free;
end;

end.