Переслать текст в другую программу



Автор: Xavier Pacheco

unit Readmain;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Menus, StdCtrls;
{ The WM_COPYDATA Windows message is not defined in the 16-bit Messages }
{ unit, although it is available to 16-bit applications running under   }
{ Windows 95 or NT.  This message is discussed in the Win32 API online  }
{ help. }
const
WM_COPYDATA = $004A;
type
TMainForm = class(TForm)
ReadMemo: TMemo;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
procedure Exit1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure About1Click(Sender: TObject);
private
procedure OnAppMessage(var M: TMsg; var Handled: Boolean);
procedure WMCopyData(var M: TMessage); message WM_COPYDATA;
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
uses RegMsg, AboutU;
type
{ The TCopyDataStruct record type is not defined in WinTypes unit, }
{ although it is available in the 16-bit Windows API when running  }
{ under Windows 95 and NT. The lParam of the WM_COPYDATA message   }
{ points to one of these. }
PCopyDataStruct = ^TCopyDataStruct;
TCopyDataStruct = record
dwData: DWORD;
cbData: DWORD;
lpData: Pointer;
end;
procedure TMainForm.OnAppMessage(var M: TMsg; var Handled: Boolean);
{ OnMessage handler for Application object. }
begin
{ The DDGM_HandshakeMessage message is received as a broadcast to     }
{ all applications.  The wParam of this message contains the handle   }
{ of the window which broadcasted the message.  We respond by posting }
{ the same message back to the sender, with our handle in the wParam. }
if M.Message = DDGM_HandshakeMessage then
begin
PostMessage(M.wParam, DDGM_HandshakeMessage, Handle, 0);
Handled := True;
end;
end;
procedure TMainForm.WMCopyData(var M: TMessage);
{ Handler for WM_COPYDATA message }
begin
{ Check wParam to ensure we know WHO sent us the WM_COPYDATA message }
if PCopyDataStruct(M.lParam)^.dwData = DDGM_HandshakeMessage then
{ When WM_COPYDATA message is received, the lParam points to}
ReadMemo.SetTextBuf(PChar(PCopyDataStruct(M.lParam)^.lpData));
end;
procedure TMainForm.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnMessage := OnAppMessage;
end;
procedure TMainForm.About1Click(Sender: TObject);
begin
AboutBox;
end;
end.
unit CopyMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Menus;
type
TMainForm = class(TForm)
DataMemo: TMemo;
BottomPnl: TPanel;
BtnPnl: TPanel;
CloseBtn: TButton;
CopyBtn: TButton;
MainMenu1: TMainMenu;
File1: TMenuItem;
CopyData1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
procedure CloseBtnClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure CopyBtnClick(Sender: TObject);
private
{ Private declarations }
protected
procedure WndProc(var Message: TMessage); override;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
uses AboutU, RegMsg;
// The following declaration is necessary because of an error in
// the declaration of BroadcastSystemMessage() in the Windows unit
function BroadcastSystemMessage(Flags: DWORD; Recipients: PDWORD;
uiMessage: UINT; wParam: WPARAM; lParam: LPARAM): Longint; stdcall;
external 'user32.dll';
var
Recipients: DWORD = BSM_APPLICATIONS;
procedure TMainForm.WndProc(var Message: TMessage);
var
DataBuffer: TCopyDataStruct;
Buf: PChar;
BufSize: Integer;
begin
if Message.Msg = DDGM_HandshakeMessage then
begin
{ Allocate buffer }
BufSize := DataMemo.GetTextLen + (1 * SizeOf(Char));
Buf := AllocMem(BufSize);
{ Copy memo to buffer }
DataMemo.GetTextBuf(Buf, BufSize);
try
with DataBuffer do
begin
{ Fill dwData with registered message as safety check }
dwData := DDGM_HandshakeMessage;
cbData := BufSize;
lpData := Buf;
end;
{ NOTE: WM_COPYDATA message must be *sent* }
SendMessage(Message.wParam, WM_COPYDATA, Handle,
Longint(@DataBuffer));
finally
FreeMem(Buf, BufSize);
end;
end
else
inherited WndProc(Message);
end;
procedure TMainForm.CloseBtnClick(Sender: TObject);
begin
Close;
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
BtnPnl.Left := BottomPnl.Width div 2 - BtnPnl.Width div 2;
end;
procedure TMainForm.About1Click(Sender: TObject);
begin
AboutBox;
end;
procedure TMainForm.CopyBtnClick(Sender: TObject);
begin
{ Call for any listening apps }
BroadcastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
@Recipients, DDGM_HandshakeMessage, Handle, 0);
end;
end.
Скачать весь проект

Далее: Перехватывать сообщения Windows до Application.Run »»