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

Автор: 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.