別アプリケーションのRichTextの内容をコピーするには (ID：41945)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

書き換えました。
DLLを使って別アプリからデータを取得するができました。
こちらDelphi2007,Windows7で動作確認しました。

'TargetForm'=別アプリです。
'RichEdTest'=貼り付け先プログラムのフォームキャプションです。
//貼り付け先プログラム-----------------------------
unit UnitDLLTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, RichEdit;

const
  HkSub = 'Project1Sub.dll';  // フック用dll名

type
  TFuncStartHK = function (): HHOOK;
  TProcStopHK = procedure(var hHk: HHOOK);
  TFuncMsgID = Function :DWord;

TForm2 = class(TForm)
    Button1: TButton;
    RichEdit1: TRichEdit;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    MsgID:DWord;
    hHK:HHook;
  protected
    procedure WndProc(var AMsg: TMessage);override;
    procedure WMCopyData(var msg: TWMCopyData);
      message WM_COPYDATA;
  public
    { Public declarations }
  end;

////function StartHk(hHost: HWND): HHOOK; stdcall; external HkSub;
  function StartHk: HHOOK; stdcall; external HkSub;
  procedure StopHk(var hHk: HHOOK); stdcall; external HkSub;
  function UserMsgID: DWORD; stdcall; external HkSub;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
var
  hTgtApp: HWND;
  Atm: ATOM;
begin
  RichEdit1.Lines.Clear;

if hHk=0 then hHk := StartHk;
  if hHk=0 then ShowMessage('フック失敗')
  else begin
    hTgtApp := FindWindow(nil,'TargetForm');
    //Atm := GlobalAddAtom(PChar(ExtractFilePath(ParamStr(0))));
    if hTgtApp<>0 then PostMessage(hTgtApp, MsgID, WPARAM(Handle), LPARAM(Atm));
  end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  hHk := 0;
  MsgID := UserMsgID;
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
 StopHk(hHk);
end;

procedure TForm2.WMCopyData(var msg: TWMCopyData);
var
  MS:TMemoryStream;
begin
   MS := TMemoryStream.Create;
   try
     MS.Write(Msg.CopyDataStruct^.lpData^,Msg.CopyDataStruct^.cbData);
     MS.Position := 0;
     case Msg.CopyDataStruct^.dwData of
       141421356:RichEdit1.Lines.LoadFromStream(MS);
     end;
   finally
     MS.Free;
   end;
end;

procedure TForm2.WndProc(var AMsg: TMessage);
var i:integer;
begin
  if AMsg.Msg=UserMsgID then begin
    if AMsg.WParam<>0 then

SendMessage(HWND(AMsg.WParam), EM_STREAMOUT, SF_RTF, AMsg.LParam)
    else begin
      {
      ShowMessage('コピーしました');
      StopHk(hHk);
//      PostMessage(HWND_BROADCAST, WM_NULL, 0, 0);
      for i:=0 to 100 do begin  // ファイルが作成されるまで最大約10秒待機
        if FileExists(ExtractFilePath(ParamStr(0))+'tmpbuf.rtf') then break;
        Sleep(100);
      end;
      RichEdit1.Lines.LoadFromFile(ExtractFilePath(ParamStr(0))+'tmpbuf.rtf');
      }
    end;
  end;
  inherited WndProc(AMsg);
end;

end.

//DLL----------------------------------------------------
library Project1Sub;

{ DLL のメモリ管理に関する重要な注意：
  もしこの DLL が引数や返り値として String 型を使う関数/手続きをエクスポー
  トする場合、以下の USES 節とこの DLL を使うプロジェクトソースの USES 節
  の両方に、最初に現れるユニットとして ShareMem を指定しなければなりません。
  （プロジェクトソースはメニューから[プロジェクト｜ソース表示] を選ぶこと
  で表示されます）
  これは構造体やクラスに埋め込まれている場合も含め String 型を DLL とやり
  取りする場合に必ず必要となります。
  ShareMem は共用メモリマネージャである BORLNDMM.DLL とのインターフェース
  です。あなたの DLL と一緒に配布する必要があります。BORLNDMM.DLL を使うの
  を避けるには、PChar または ShortString 型を使って文字列のやり取りをおこ
  なってください。}
uses
  SysUtils,
  Classes,
  RichEdit,
  Windows,
  Messages;

var
  FStreamRec: TEditStream;

function UserMsgID: DWORD; stdcall;
begin
  Result := RegisterWindowMessage('USER_MESSAGE22360679');
end;

function EditStreamCallBack(dwCookie: Longint; pbBuff: PByte;
                            cb: Longint; var pcb: Longint): Longint; stdcall;
var
  FStream: TMemoryStream;
  //buf: array[0..MAX_PATH-1] of Char;//WideChar;

hTarget: HWND;
  CDS:TCopyDataStruct;
begin
  FStream := TMemoryStream.Create;
  try
    pcb := FStream.Write(pbBuff^, cb);

//GlobalGetAtomName(ATOM(dwCookie), @buf, MAX_PATH);
    //GlobalDeleteAtom(ATOM(dwCookie));
    //FStream.SaveToFile(String(buf)+'tmpbuf.rtf');

CDS.dwData := 141421356;
    CDS.cbData := FStream.Size;
    CDS.lpData := FStream.Memory;
    hTarget := FindWindow(nil,'RichEdTest');
    SendMessage(hTarget, WM_COPYDATA, 0, LPARAM(@CDS));

finally
    FStream.Free;
  end;
  //PostMessage(HWND_BROADCAST, UserMsgID, 0, 0);
  Result := 0;
end;

function AHookProc(nCode:integer; wP: WPARAM; lP: LPARAM):LRESULT; stdcall;
var
  hTarget,hRich: HWND;
  MsgID: DWORD;
begin
  if nCode=HC_ACTION then begin
    if wP=PM_NOREMOVE then begin
      MsgID := UserMsgID;
      if (PMsg(lP).message=MsgID) then begin
        if (PMsg(lP).wParam<>0) then begin
          hTarget := FindWindow(nil,'TargetForm');
          hRich := FindWindowEx(hTarget, 0, 'TRichEdit', nil);
          if hRich <> 0 then
          begin
            FStreamRec.dwCookie := PMsg(lP).lParam;
            FStreamRec.pfnCallback := @EditStreamCallBack;
            PostMessage(HWND(PMsg(lP).wParam), MsgID, WPARAM(hRich), LPARAM(@FStreamRec));
          end;
        end;
      end;
    end;
  end;
  Result := CallNextHookEx(0, nCode, wP, lP);
end;

function StartHk: HHOOK; stdcall;
var
  dwThread: DWORD;
begin
  dwThread := GetWindowThreadProcessId(FindWindow(nil,'TargetForm'));
  if dwThread=0 then Result := 0
  else Result := SetWindowsHookEx(WH_GETMESSAGE, Addr(AHookProc), HInstance, dwThread);
end;

procedure StopHk(var hHk: HHOOK); stdcall;
begin
  if hHk<>0 then UnhookWindowsHookEx(hHk);
  hHk := 0;
end;

exports
  StartHk,
  StopHk,
  UserMsgID;

{$R *.res}

begin
end.

←解決時は質問者本人がここをチェックしてください。

戻る