別アプリケーションのRichTextの内容をコピーするには
解決別アプリケーションのリッチテキストの内容を書式を保持したままコピーしたく、
下記リンクを参考にしてためしてみましたがSendMessageで
「モジュール'Riched20.dll'のアドレス6565731AでアドレスFFFEF4E8に対する読み込み違反がおきました」と
エラーが表示しされてしまいます。
【参考リンク】
RitchEdit内容の一部移動をクリップボードを壊さないで行う
https://www.petitmonte.com/bbs/answers?question_id=2752
【ソース】
uses RichEdit;追加
TFormのprivateに変数追加
FStreamRec: TEditStream;
FStream: TMemoryStream;
function EditStreamCallBack(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): Longint; stdcall;
begin
try
case TEditStreamMode(dwCookie) of
esmWrite: begin
pcb:= Form1.FStream.Write(pbBuff^,cb);
end;
esmRead :begin
pcb:= Form1.FStream.Read(pbBuff^,cb);
end;
end;
Result:= 0;
except
Result:= 1;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
hTargetApp,hRich:HWND;
begin
hTargetApp := FindWindow(nil,'TargetForm');//別アプリのハンドル取得
hRich := FindWindowEx(hTargetApp,0,'TRichEdit',0);//別アプリのRichEditを取得
FStream.Clear;
FStreamRec.dwCookie := Longint(esmWrite);
//コピー
SendMessage(hRich,EM_STREAMOUT,SF_RTF,Longint(@FStreamRec));
//FStream.Position:=0;
//FStreamRec.dwCookie := Integer(esmRead);
////貼り付け
//RichEdit1.Perform( EM_STREAMIN,SF_RTF,Longint(@FStreamRec));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FStream := TMemoryStream.Create;
FStreamRec.pfnCallback := @EditStreamCallBack;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FStream);
end;
リンク先のソースを使ってコピーのときだけSendMessageを使用し、
コピー元のリッチテキストのハンドルを渡せばいいのかと思っていたのですができませんでした。
書式を保持して別アプリのリッチテキストの値を取得したらよいのでしょうか？
コピー元のアプリケーションはDelphiで作成しています。
【環境】
Windows7
Delphi2007
よろしくお願いいたします。
こんにちは，Mr.XRAYです．
こんな記事が，もし参考になれば．
[メッセージによるプロセス間通信]
http://mrxray.on.coocan.jp/Halbow/Notes/N012.html
Mr.XRayさん、いつもお世話になっております。
HPの掲示板で何度かお話させていただきました。
リンクありがとうございます。
これからじっくり読んでみます。
リンクのソースを見てみましたが、
今回の環境では、別アプリのソースはなく、Sender側から送ってやることはできませんでした。
また別アプリの情報を取得したいとき、コールバック関数を使った上のようなやり方ではだめなことがわかりました。
クリップボードを介してでないとだめなんでしょうかね？
>今回の環境では、別アプリのソースはなく、
ということになると難しいですね．きっと．
コードから判断すると，クリップボードは使いたくないんですよね？
う〜む．
>HPの掲示板で何度かお話させていただきました。
どうも，どうも，現在休業中です．
クリップボードを避ける理由は
全角ダブルクオート”をクリップボードにコピーして、
DelphiのRichEditに貼り付けると、なぜか半角ダブルクオートになってしまいます。
わかっているのが全角ダブルクオートと全角シングルクォートです。
ほかにもありそう。。。。ってことで、クリップボードを避けています。
XRayさん、休業中でこちらの掲示板にもお名前みかけるので
もしかしたらコメントいただけるかな？とちょっと期待していました＾＾
試してませんが、例えば、コールバック関数入りのフックDLLを読み込ませてからEM_STREAMOUTを送るとかではだめなんでしょうか？
こんにちは．
そうですねぇ，
RichEditの場合，書式は，コールバック関数の中で，ストリームに格納しなければ
ならないのがネックですね．
しかも，コールバック関数そのものも，対象となるRichEditで発生させなければ
なりませんから，今の場合，他のアプリ（別のプロセス）ですからねぇ．
DLL内でコールバック関数ですか．う〜ん．もしかしたら．．．
プロセス越えの操作は難しいですね．
悔しいけど，お手上げ状態です．
>もしかしたらコメントいただけるかな？とちょっと期待していました＾＾
期待しても，私のはほとんどゴミレスですから．(^^;
Novさん
レスありがとうございます。
DLLで・・・という方法、ここにVBベースで同じようなことをしているのを見つけました。
なのでできそうなことはわかりましたが、気持ちはクリップボードへ・・・
http://www.vbforums.com/showthread.php?t=449171
時間があったら挑戦してみます。
XRayさん
コメントいただけるだけで嬉しいですよ◎
時間があったので試してみました。
コールバック関数で内容をファイルに保存後、通知するようにしました。
共有メモリ的なものを使わずに簡単に済ませたかったので、少し見にくい
コードになっています。
(1)まずは、呼び出し側（フォームにTRichEditとTBottunが各１個）
const
HkSub = 'Project1Sub.dll'; // フック用dll名
function StartHk(hHost: HWND): HHOOK; stdcall; external HkSub;
procedure StopHk(var hHk: HHOOK); stdcall; external HkSub;
function UserMsgID: DWORD; stdcall; external HkSub;
procedure TForm1.FormCreate(Sender: TObject);
begin
hHk := 0;
MsgID := UserMsgID;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
StopHk(hHk);
end;
procedure TForm1.WndProc(var AMsg: TMessage);
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);
RichEdit1.Lines.LoadFromFile(ExtractFilePath(ParamStr(0))+'tmpbuf.rtf');
end;
end;
inherited WndProc(AMsg);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
hTgtApp: HWND;
Atm: ATOM;
begin
if hHk=0 then hHk := StartHk(Handle);
if hHk=0 then ShowMessage('フック失敗')
else begin
hTgtApp := FindWindow(nil,'TargetForm');
Atm := GlobalAddAtom(PWideChar(ExtractFilePath(ParamStr(0))));
if hTgtApp<>0 then PostMessage(hTgtApp, MsgID, WPARAM(Handle), LPARAM(Atm));
end;
end;
(2)次にDLL側（dllプロジェクトの*.dprに直接貼り付け）
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 WideChar;
begin
FStream := TMemoryStream.Create;
pcb := FStream.Write(pbBuff^, cb);
GlobalGetAtomName(ATOM(dwCookie), @buf, MAX_PATH);
GlobalDeleteAtom(ATOM(dwCookie));
FStream.SaveToFile(String(buf)+'tmpbuf.rtf');
FStream.Free;
PostMessage(HWND_BROADCAST, UserMsgID, 0, 0);
Result := 0;
end;
function AHookProc(nCode:integer; wP: WPARAM; lP: LPARAM):LRESULT; stdcall;
var
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
hRich := FindWindowEx(FindWindow(nil,'RichEdTest'), 0, 'TRichEdit', nil);
FStreamRec.dwCookie := PMsg(lP).lParam;
FStreamRec.pfnCallback := @EditStreamCallBack;
PostMessage(HWND(PMsg(lP).wParam), MsgID, WPARAM(hRich), LPARAM(@FStreamRec));
end;
end;
end;
end;
Result := CallNextHookEx(0, nCode, wP, lP);
end;
function StartHk(hHost: HWND): HHOOK; stdcall;
begin
Result := SetWindowsHookEx(WH_GETMESSAGE, Addr(AHookProc), HInstance, 0);
end;
procedure StopHk(var hHk: HHOOK); stdcall;
begin
if hHk<>0 then UnhookWindowsHookEx(hHk);
hHk := 0;
end;
exports
StartHk,
StopHk,
UserMsgID;
失敗した時の処理を考えていないので、あくまでテスト用としてお考えください。
おっ！ DLLを使ったコードがUPされましたね．
私の方は，コールバックを使用しなくてもいいメッセージを見つけました．
EM_SETTEXTEXというメッセージです．
これだと，EM_STREAMINとEM_STREAMOUTの両方の機能があるようです．
Delphiには定義がないので，その定義を追加しています．
もちろん，プロセス間の通信ですから，共有メモリを使用することになります．
まっ，そういうことでございます．
参考リンク
EM_SETTEXTEX
http://msdn.microsoft.com/en-us/library/windows/desktop/bb774284%28v=vs.85%29.aspx
SETTEXTEX構造体 EM_SETTEXTEXメッセージのWParamに使用する構造体
http://msdn.microsoft.com/en-us/library/windows/desktop/bb787954%28v=vs.85%29.aspx
第８章 他のアプリのウィンドウ情報の取得 - 共有メモリ これを使用しました．
http://mrxray.on.coocan.jp/Halbow/VCL08.html
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, RichEdit, ComCtrls;
type
TForm1 = class(TForm)
RichEdit1: TRichEdit;
RichEdit2: TRichEdit;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses CommonMemoryUnit;
{$R *.DFM}
type
PSetTextEx = ^TSetTextEx;
tagSetTextEx = record
flags : DWORD;
codepage : UINT;
end;
TSetTextEx = tagSetTextEx;
SETTEXTEX = tagSetTextEx;
const
EM_SETTEXTEX = WM_USER + 97;
ST_DEFAULT = 0;
ST_KEEPUNDO = 1;
ST_SELECTION = 2;
ST_NEWCHARS = 4;
ST_UNICODE = 3;
//=============================================================================
// 他のアプリのTRichEditにクリップボードを使用しないで転送
//
// EM_SETTEXTEXメッセージを使用すると，EM_STREAMINとEM_STREAMOUTメッセードのよ
// うにコールバック関数を使用しなくてもよい．しかも一回でよい
// だたし，このメッセージはDelphi XEには定義がないので，必要な構造体とともに
// 定義して使用
//
// Halbow資料館の共有メモリクラスCommonMemoryUnitを利用
//
// 動作確認環境
// Windows 7 U64(SP1) + Delphi 2007, Delphi XE
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
hTargetApp : HWND;
hRich : HWND;
AStream : TStringStream;
SetTextRec : TSetTextEx;
CM : TCommMemNT;
StrSize : Cardinal;
StrText : AnsiString;
begin
//受信側のRichEditのハンドルを取得
hTargetApp := FindWindow(nil, 'TargetForm');
hRich := FindWindowEx(hTargetApp, 0, 'TRichEdit', 0);
//TStringStreamを作成してRichEditの内容を保存
//これはリッチエディトの形式となっている
AStream := TStringStream.Create('');
RichEdit1.Lines.SaveToStream(AStream);
//ストリームのデータを文字列にしてAnsiString型に変換
//EM_SETTEXTEXのLParamの値はAnsiStringでなければならない
StrText := AStream.DataString;
StrSize := Length(StrText);
//共有メモリクラスを生成
CM := TCommMemNT.Create(hRich, StrSize);
try
//共有メモリに転送データを格納
CM.Write(0, PChar(StrText), StrSize);
//フラグを設定
SetTextRec.flags := ST_SELECTION;
SetTextRec.codepage := DWORD(-1);
//メッセージ実行
SendMessage(hRich, EM_SETTEXTEX, Integer(@SetTextRec), LPARAM(CM.MemPtr));
finally
CM.Free;
AStream.Free;
end;
end;
end.
参考リンクのHalbowさん作の CommonMemoryUnit を使用しています．
一度エディタにコピーしてから保存してください．
List3にコードがあります．それほど長いコードではないので，
このユニットを使用しなくても，直接書いてもいいと思います．
http://mrxray.on.coocan.jp/Halbow/ProgCode/CommonMemoryUnit.txt
この短時間にNovさん、XRayさんありがとうございます。
お二方のコードがあれば別アプリのRichEditからのコピーも貼り付けもOKになります。
Novさんのコードをまず試しました。
DLL側のfunction AHookProc内、
下記★位置のwParamが0になってしまい、コピーしましたと表示されるものの、
rtfがないのでエラーになってしまいます。
if (PMsg(lP).message=MsgID) then begin
if (PMsg(lP).wParam<>0) then begin ★
マルっとコピーで、
変更したところは下記の2点のみ。
・AHookProcの'RichEdTest'を呼び出し元のフォーム名に。
・GlobalAddAtom(PWideChar(ExtractFilePath(ParamStr(0))));をPCharに。
wParamが0になってしまう原因は何が考えられますか？
お忙しいところお手数をおかけしますがヒントいただけたら助かります。
自分で見直しても見にくいソースですね。
>wParamが0になってしまう原因は何が考えられますか？
コールバック関数がブロードキャストでポストするメッセージを
無視するために条件を設定しています。
次のような動作を想定しています。
(1)別アプリがフックでコールバック関数とRICHEDIT構造体をターゲットに読み込ませる
(2)保存先のパスをグローバルアトムに保存
(3)ユーザメッセージをターゲットに送り、フック関数で受ける
(4)フック関数が自メモリ内のコールバック関数と構造体のアドレスをユーザメッセージで別アプリに送る。このときWPARAM<>0でキャッチ。
(5)別アプリが(4)の情報でEM_STREAMOUTメッセージをターゲットに送る。
(6)コールバック関数が目的の処理（立地エディットの内容をグローバルアトムで指定された保存先に保存）をして、通知メッセージをブロードキャスト（別アプリに直接送ろうとしても到達しないため）で送る。（このときWPARAMが0）
(7)通知メッセージをWPARAM=0でキャッチ。
...都合３種類のメッセージを同一のユーザメッセージで行っているため、見にくいのかも知れません。
あと、StartHkの引数は無意味ですね。
個人的には、Mr.XRAY様のプランをお勧めします。
（dllを使うのはスマートじゃない気がするので...個人の意見です）
誤記です。「立地エディット」は「リッチエディット」です。済みません。
>・GlobalAddAtom(PWideChar(ExtractFilePath(ParamStr(0))));をPCharに。
済みません、見落としました。Ansi版ということですね？
なら、コールバックの次の変数も変えてください。
変更前）buf: array[0..MAX_PATH-1] of WideChar;
変更後）buf: array[0..MAX_PATH-1] of Char;
「コピーしました」と表示されているなら、メッセージの伝達は問題無いはずです。
>（dllを使うのはスマートじゃない気がするので...個人の意見です）
DLLを使用するこの方法は，興味ありますね．
DLLを使用するテストを使用しようとして，以下のような記事を見つけました．
[別のプロセスにコードを割り込ませる3つの方法]
http://japan.internet.com/developer/20050830/26.html
前に提示したコードでは，ストリームを新規に生成して保存していますが，
EM_STREAMOUTのコールバック呼び出しコードで，以下のようにすると，
テキスト(プレーンまたはRTF形式)が取得できます．
//-----------------------------------------------------------------------------
// EM_STREAMIN,EM_STREAMOUTメッセージ用コールバック関数
// EM_SETTEXTEXで貼り付けをする場合は，esmReadの処理は不要
//-----------------------------------------------------------------------------
function EditStreamCallBack(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): Longint; stdcall;
var
pGetText : Pointer;
GetText : String; //EM_SETTEXTEXで使用する時は，AnsiStringにする
begin
try
case TEditStreamMode(dwCookie) of
esmWrite:
begin
pcb := Form1.FStream.Write(pbBuff^,cb);
//リッチエディトのテキスト(RTF形式)の文字列取得
//EM_STREAMOUTのフラグにSFF_SELECTIONがあれば，選択テキストの取得となる
//フラグがSF_TEXTの時は，プレーンテキストの取得となる
//(EM_STREAMINにもSF_TEXTの指定が必要)
pGetText := Pointer(GetText);
GetMem(pGetText, cb);
try
Move(pbBuff^, pGetText^, cb);
GetText := PChar(pGetText);
finally
FreeMem(pGetText);
end;
end;
esmRead : pcb:= Form1.FStream.Read(pbBuff^,cb);
end;
Result:= 0;
except
Result:= 1;
end;
end;
Novさん
ありがとうございます。
DLLをリコンパイルしたら少し進みました。
WndProc(var AMsg: TMessage);内で、WParam<>0でないためSendMessageするところで読み込み違反が起きている状態です。
if AMsg.WParam<>0 then
SendMessage(HWND(AMsg.WParam), EM_STREAMOUT, SF_RTF, AMsg.LParam)
（１）〜（7）の動きをを手がかりにもう少し調べてみます。
フック関数のhRichが、取得できていないようですね。
何故かは分かりませんが、'RichEdTest'を呼び出し元のフォーム名に直されたときに、スペルミスが無いですか？
いずれにしても、hRich=0のとき、メッセージを送信しないようにすべきでした。
if hRich<>0 then begin
FStreamRec.dwCookie := PMsg(lP).lParam;
FStreamRec.pfnCallback := @EditStreamCallBack;
PostMessage(HWND(PMsg(lP).wParam), MsgID, WPARAM(hRich), LPARAM(@FStreamRec));
end;
みたいな感じで。
やっぱりだめでした。
WndProcのSendMessage後に読み込み違反です。
呼び出し元のRichEdTest（同じ名前にしました）のソースです。
フォームForm2のキャプションは[RichEdTest]にしてあります。
宣言部も問題ないと思うんですが・・・
unit UnitDLLTest;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, RichEdit;
const
HkSub = 'Project1Sub.dll'; // フック用dll名
type
TForm2 = class(TForm)
Button1: TButton;
RichEdit1: TRichEdit;
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;
public
{ Public declarations }
end;
function StartHk(hHost: HWND): 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
if hHk=0 then hHk := StartHk(Handle);
if hHk=0 then ShowMessage('フック失敗')
else begin
hTgtApp := FindWindow(nil,'TargetForm');//RichTextの内容を取得するウィンドウ
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.WndProc(var AMsg: TMessage);
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);
RichEdit1.Lines.LoadFromFile(ExtractFilePath(ParamStr(0))+'tmpbuf.rtf');
end;
end;
inherited WndProc(AMsg);
end;
end.
//-----------------------------------------------------------
library Project1Sub;
{ DLL のメモリ管理に関する重要な注意：
もしこの DLL が引数や返り値として String 型を使う関数/手続きをエクスポー
トする場合、以下の USES 節とこの DLL を使うプロジェクトソースの USES 節
の両方に、最初に現れるユニットとして ShareMem を指定しなければなりません。
（プロジェクトソースはメニューから[プロジェクト｜ソース表示] を選ぶこと
で表示されます）
これは構造体やクラスに埋め込まれている場合も含め String 型を DLL とやり
取りする場合に必ず必要となります。
ShareMem は共用メモリマネージャである BORLNDMM.DLL とのインターフェース
です。あなたの DLL と一緒に配布する必要があります。BORLNDMM.DLL を使うの
を避けるには、PChar または ShortString 型を使って文字列のやり取りをおこ
なってください。}
uses
SysUtils,
Classes,
RichEdit,
Windows;
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;
begin
FStream := TMemoryStream.Create;
pcb := FStream.Write(pbBuff^, cb);
GlobalGetAtomName(ATOM(dwCookie), @buf, MAX_PATH);
GlobalDeleteAtom(ATOM(dwCookie));
FStream.SaveToFile(String(buf)+'tmpbuf.rtf');
FStream.Free;
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 := 0;
hRich := 0;
hTarget := FindWindow(nil,'RichEdTest');//RichTextの内容を貼り付ける呼び出し元ウィンドウ
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(hHost: HWND): HHOOK; stdcall;
begin
Result := SetWindowsHookEx(WH_GETMESSAGE, Addr(AHookProc), HInstance, 0);
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.
WndProcで行っている
SendMessage(HWND(AMsg.WParam), EM_STREAMOUT, SF_RTF, AMsg.LParam)
のAMsg.WParamは読み取りしたいリッチエディットのハンドルが入るはずですか？
それとも貼り付け先のリッチエディットのハンドルですか？
今は貼り付け先のリッチエディットのハンドルが渡されています。
フック関数のhTargetは、読み取りたいリッチエディットがあるアプリ（ソースが無い方）のウインドウハンドルが正解です。
従って、WndProcのAMsg.WParamも、読み取りたいリッチエディットのウィンドウハンドルになるはずです。
あと、勘違いしにくいようにフック対象を限定したほうがよいかもしれません。
function StartHk: HHOOK; stdcall;
var
dwThread: DWORD;
begin
dwThread := GetWindowThreadProcessId(FindWindow(nil,'ソースが無い方'));
if dwThread=0 then Result := 0
else Result := SetWindowsHookEx(WH_GETMESSAGE, Addr(AHookProc), HInstance, dwThread);
end;
あっ、StartHkの引数を無くしたので、定義の方も合わせてくださいね。
すぐ気付くとは思いますが、念のため。
やややっと、うまくいきました。
StartHkを上のように変更したのと、
WndProcでRichEdit1.Lines.LoadFromFile(ExtractFilePath(ParamStr(0))+'\tmpbuf.rtf');に\マーク追加しました。
ありがとうございました。
XRAYさんのEM_SETTEXTEXと共有メモリを使ってやる方法を試したいと思います・・・
別プログラムに貼り付ける方法は書いていただいたので、同じように別プログラムから自プログラムのRichEditにはりつける場合です。
とりあえずお疲れ様でした。
当方はXE2ですが、ExtractFilePathの仕様が変わったんですね...
>当方はXE2ですが、ExtractFilePathの仕様が変わったんですね...
と思ったけど違いますね...GlobalAtomのAnsi版とUnicode版の違い？
>GlobalAtomのAnsi版とUnicode版の違い？
でも、dllで保存できているなら違うのか...なんででしょう？
今確認しようとやってみたんですが、
ExtractFilePath(ParamStr(0))は最後に\が付くから、
別に¥マーク追加しなくても大丈夫でした。
でもなんで開けたのだろう。。。
そして今また同じことを行うと読み込み違反・・・あらっ？
もしかすると、WndProcの
RichEdit1.Lines.LoadFromFile(ExtractFilePath(ParamStr(0))+'tmpbuf.rtf');
の前に、ファイルの存在確認をしたり、例外で対処したりしたほうがよいかもしれません。
for i:=0 to 100 do begin // ファイルが作成されるまで最大約10秒待機
if FileExists(ExtractFilePath(ParamStr(0))+'tmpbuf.rtf') then break;
Sleep(100);
end;
この後 ロード
みたいな感じで。
と思ったけど、少し違うような...
おそらくdllがファイルを書き込み終わる前に、別アプリが開こうとしているのでしょうから、そんな状況をスマートに解決する方法は、能力不足で回答できません、済みません。Sleep(適量)入れるぐらいしか思いつきません。
ちなみに、
(6)...通知メッセージをブロードキャスト（別アプリに直接送ろうとしても到達しないため）で送る。
とか書きましたが、何かの勘違いでした。
ですので、アトムを送らずに、受け取り側アプリのウィンドウハンドルを渡して、WM_COPYDATAを使えば、ファイルを使わずに受信できます。
尚、UNICODE版とANSI版で処理が微妙に違うと思うので、ソースは用意してません。
Novさん、ありがとうございます。
原因わかりました〜
AHookProcのFindWindow(nil,'TargetForm'); で指定するウィンドウ名が
「貼り付け側のウィンドウ」になってしまっていました。
「データをとってきたい貼り付け元」のウィンドウに指定したらOKでした。
※私の環境ではデータ取得対象のウィンドウ（別アプリ）は「TargetForm」です。
できたりできなかったりはDLLがロードされてリコンパイルできなかったぽいからです。
WM_COPYDATAに書き換えてみます。
書き換えました。
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.
蛇足ですが...
コールバック関数でメモリストリームを使用されてるのは、元のソースの名残だと思いますが、特に必要なさそうです。
cpData.lpData := pbBuff;
cpdata.cbData := cb;
にすれば、uses説のClassesが外せるので、dllサイズを縮小できます。
>uses説のClassesが外せるので、dllサイズを縮小できます。
どんな説だ...失礼しました、uses節です。誤記多いですね。
もっと根本的な誤記が...
cpData.lpData := pbBuff;
cpdata.cbData := cb;
は、
CDS.lpData := pbBuff;
CDS.cbData := cb;
のつもりでした。
こんにちは，Mr.XRAYです．
Atchoumさん，大ボケしてしまいました．
大きな勘違いをしてしまいました．
タイトルをよく読んだら，他のアプリから自アプリで受け取るのでしたね．
私の提示したコードは逆でした．スミマセン．
Atchoumさん，Novさん，こんちには．
>こちらDelphi2007,Windows7で動作確認しました。
Windows XP(SP3) + Delphi XE でも動作確認しました．
報告まで．
こんにちわ！
Novさんのアドバイス対応しました。
このあたり不慣れなもので、ありがたいです。
XRayさん、確認ありがとうございます。
逆の動作（自アプリから別アプリにはりつけ）も必要なので参考になります。
今、XRAYさんのDLLを使わないバージョン別アプリから取得調査中で
EM_GETTEXTLENGTHEX、EM_GETTEXTEXを使えばいいのかなとやってみたんですが、
別アプリをハンドルとして渡してEM_GETTEXTLENGTHEXをしてもうまく取れないみたいで0になってしまいます。SleepをSendMessageのあといれると取れたり。
方向性としてはEM_GETTEXTLENGTHEX、EM_GETTEXTEXを使うでただしいですか？
procedure TForm1.Button10Click(Sender: TObject);
var
hTargetApp : HWND;
hRich : HWND;
TextLengthEx: TGetTextLengthEx;
intLen:integer;
begin
hTargetApp := FindWindow(nil, 'TargetForm');
hRich := FindWindowEx(hTargetApp, 0, 'TRichEdit', 0);
if hRich <> 0 then
begin
TextLengthEx.flags := GTL_USECRLF or GTL_NUMBYTES;
TextLengthEx.codepage := CP_ACP;
intLen := SendMessage(hRich, EM_GETTEXTLENGTHEX, Integer(@TextLengthEx), 0);
showmessage(IntTostr(intLen));
end;
end;
こんにちは．
>方向性としてはEM_GETTEXTLENGTHEX、EM_GETTEXTEXを使うでただしいですか？
フフッ，実はですね．できません．
EM_GETTEXTLENGTHEX、EM_GETTEXTEXは，プレーンテキストのみの取得です．
もちろん，他のRichEditのも，ただし他のアプリのは共有メモリを使用する必要があります(確認済)．
TRichEditは，RTFコードを変換して，エディタ部分に表示しているので，
コールバック関数内でないと取得できないということになるようです．
これまで，Atchoumさんがやったように，つまり，DLL内の処理ということになりますね．
残念ながら．
世間を惑わせてしまったレスをしてしまい，申し訳ありませんでした．m(_ _)m
XRayさんレスありがとうございます。
ちょっとね、そんな気がしていたんです。
でもとっても勉強になりました。
ではでは解決済みにいたします。
Novさん、XRayさん、ありがとうございました。
解決した後ですが、もうひとつ。
DLL内でFindWindowするとき'TargetForm'（取得元ウィンドウ）,'RichEdTest'（貼り付け先ウィンドウ）と固定値になっているのを
汎用性をもたせたく、StartHKに引数追加して渡してみたんですが、
文字が貼り付けられません。
呼び出し側
StartHk(Pchar('TargetForm'),PChar('RichEdTest'));
DLL側
var
FTargetWindowName:string;
FSendWindowName:string;
function StartHk(ATargetWindowName,ASendWindowName:PChar): HHOOK; stdcall;
begin
FTargetWindowName := ATargetWindowName;
FSendWindowName := ASendWindowName;
hTarget := FindWindow(nil,PChar(FTargetWindowName));
dwThread := GetWindowThreadProcessId(hTarget);//TargetForm
if dwThread=0 then Result := 0
else Result := SetWindowsHookEx(WH_GETMESSAGE, Addr(AHookProc), HInstance, dwThread);
end;
何かやり方間違っていますでしょうか？
dllのグローバル変数は、呼び出し側プロセスのみアクセス可能です。
従って、StartHkを呼び出すのは別アプリなので、フックされた側の
アプリと共通の値にはなりません。
根本的な解決には共有メモリが必要ですね（またはグローバルアトムにするとか）。
尚、フック時点での汎用性ということであれば、ハンドル渡しで解決できますが、他の部分は工夫が必要でしょう。
また、考え出したらきりがありませんが、ターゲットアプリの複数起動とか、
TRichEditを複数持つ場合とかの対策も必要になるかもしれません。
フック関数では、そのままではグローバルアトムの参照しようがありませんね。
共有メモリを使用せずに済ますには、ユーザメッセージをもうひとつ登録して、フック関数経由でdllのグローバル変数に保存させることは可能かと。
こんにちは．Mr.XRAYです．
>DLL内でFindWindowするとき'TargetForm'（取得元ウィンドウ）,'RichEdTest'（貼り付>>け先ウィンドウ）と固定値になっているのを
>汎用性をもたせたく、StartHKに引数追加して渡してみたんですが、
ということで，やってみました．
[TRichEdit の他のアプリとの送受信]
http://mrxray.on.coocan.jp/Others/RichEdit_SendOrReceive.htm
で，請求書はどちらに送付したらいいでしょうか？
ん？ 他の人も見ているわけだ．
「ええぃ！ 持ってけっ泥棒！」(ふっ，古い... 笑)
>「ええぃ！ 持ってけっ泥棒！」
大変失礼なことを書いてしまいました．
Novさんのコードがあったからこそテストできたのです．
Novさん，ありがとうございます！
おはようございます。
Novさん
いつもありがとうございます。
>dllのグローバル変数は、呼び出し側プロセスのみアクセス可能です。
別のアプリケーションのやり取りは情報が少ないため基礎的なことが
わかっていなくて申し訳ありません。
XRayさん
記事になってる！早速見ます。
XRayさんのサイト、書籍になったらいいのに・・・
>XRayさんのサイト、書籍になったらいいのに・・・
「女将さん，笑わしちゃあいけませんぜ，おらぁ，六十四州空の下，股旅草鞋を
履くやくざ者でござんす．ごめんなすっておくんなせぃ」
出版物にするには無理があると思います．残念ながら...
675_他のアプリとの RichEdit のリッチテキスト ( RTF ) 送受信
http://mrxray.on.coocan.jp/Delphi/plSamples/675_RichEdit_SendOrReceive.htm#
をみつつ、また勉強しています。
別アプリから自アプリのRichEditにコピーする場合についてです。
GetRichText.dllを使っています。
別アプリに乗っているRichEditが6個あるときに、
連続でStartHookOtherRichを呼ぶと、6個中、2個または1個のRichEditしかコピーされません。
While文で自アプリのRichEditが空の間はStartHookOtherRichをずっと投げてみたんですがそれでも取得できませんでした。
回避方法ありますか？
こんにちは．
>連続でStartHookOtherRichを呼ぶと、6個中、2個または1個のRichEditしかコピーされません。
原理的にそうなりますね．2個できたのは偶然でしょう，きっと (^^;
>回避方法ありますか？
さて，どうしましょう？
考えてみますか．
試しに、StartHookOtherRichのUnhookWindowsHookExの後ろで、
PostMessage(hSenderAppWnd, WM_NULL, 0, 0);
（StopHookOtherRichを呼んでいる場合は、そちらも同様に）をしたらどうなりますか？
こんにちは．
>考えてみますか．
と思って，DLLの関数の仕様変更を考えたのですが，やめました．m(_ _)m
あくまでも，サンプルなので...
>2個または1個のRichEditしかコピーされません。
これは，複数のリッチテキストを連結したいということですよね？
でしたら，できません．DLL内の処理が，上書きモードになっていますから．
挿入モードにするには，DLL内の以下の部分を変更します．
> //受け取り側に転送
> SetTextRec.flags := ST_DEFAULT; //ここをST_SELECTIONにする
> SetTextRec.codepage := CP_ACP;
また，2個になってしまうのは，タイミングの問題だと思われます．
前の処理が終了してから，次のフックを開始してください．
単に，StartHookOtherRich関数を呼ぶだけだと，処理が強制的にフック終了され，前の
処理の途中で次の作業に入ってしまいます．
例えば，以下のような感じで．
//=============================================================================
// 複数のRichEditのリッチテキストを自アプリで受信する
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
hTargetApp : HWND;
hTargetRich : HWND;
i : Integer;
begin
if Sender <> nil then begin
RichEdit1.Lines.Clear;
hCounter := 0;
// hTargetAppList (対象の他のアプリのハンドルを格納する TList)
// hTargetRichList (対象の他のアプリのRichEditのハンドルを格納するTList);
// に各々値を調べて格納する
// hCountは自アプリのRichEditに取り込んだ数を記録するカウンタでグローバル変数
end;
if hCounter < hTargetAppList.Count then begin
hTargetApp := HWND(hTargetRichList[hCounter]);
hTargetRich := HWND(hTargetRichList[hCounter]);
MsgID := StartHookOtherRich(Handle, RichEdit1.Handle, hTargetApp, hTargetRich);
hCounter := hCounter + 1;
end;
end;
//=============================================================================
// TApplicationEventsコンポのOnMessageイベント処理
// DLL内の処理終了の通知を受け取ったらフック終了
//=============================================================================
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if Msg.message = MsgID then begin
StopHookOtherRich; // 実際にはなくても，内部で自動処理される(単一受信の場合は便利)
Button1Click(nil); // 次の処理
end;
end;
言い忘れていました．
ST_SELECTION は，現在のキャレット位置に挿入します．
したがって，他のアプリから受信後，その受信したテキストの後ろに追加する場合，
キャレット位置を変更する必要があるかも知れません．多分．
ついでに，
>RichEditのハンドルを格納するTList)
TListにハンドルの値を格納するのは，例えば，hTargetRichがハンドル値とした場合，
以下のようにセットできます．
hTargetRichList.Add(Pointer(hTargetRich));
たびたび，こんにちは．Mr.XRAYです．
>キャレット位置を変更する必要があるかも知れません．多分．
やってみました．必要ないようです．自動でテキストの最後にくるようです．
>と思って，DLLの関数の仕様変更を考えたのですが，やめました．m(_ _)m
>あくまでも，サンプルなので...
考え直しました．
よく考えてみたら，挿入モードにしておけば，上書きにする場合，テキストを
クリアしてから送受信すればいいのですよね．
で，DLL内のコードを修正して，修正版をUPしました．
お世話になっております。
レスありがとうございます。
Novさん
PostMessage投げてみましたが状態変わらず、1個か2個の取得になっていました。
XRayさん
ApplicationEvents1Messageで次の処理を呼ぶようにしたら
6個すべてのRichEdit内容が取得できました。
実は取得元のRichEditは何層かのパネルの上に載っているため、対象RichEditまでたどり着くために再帰しながらStartHookをよんでいました。
処理を簡潔にするために、対象のRichEditのハンドルを取得してから、シンプルにStartHookするように改めました。
またいろいろいじってみます。
ありがとうございました。
| ツイート |  |