前の章へ| 総目次へ
| 次の章へ 
｜[質 問] スタートボタンから起動できる「ファイルやフォルダの検索」の結果、表示されるウィンドウのリストビュー部分の情報を自アプリの中に取り込みたい。どうしたらよいですか。
ここでは、上記の質問の回答を示そうと思う。でも、まっすぐ、最短距離を行くのではなく、あちこち寄り道しながら、いろいろなことを試してみよう。他のプロセスがつくったウィンドウの情報をいかにして自分のアプリに取り込むか、というかなり一般的な問題であるからだ。OS を通して、他アプリのつくったウィンドウを眺めると、それはウィンドウハンドルを持つウィンドウに過ぎないので、裸のウィンドウとして扱わなければならない。自前のウィンドウクラスをつかったウィンドウの場合は、これから情報を引き出すのは至難の業といえる。得られる情報は一般に、ウィンドウハンドルだけだからだ。しかし、標準コントロールやコモンコントロール、およびそれらのラッパーとしてつくられたウィンドウの場合は、どのようなメッセージを送るとどのような情報がえられるかが、ある程度知ることができる。上記の質問の場合は、対象となるウィンドウは、コモンコントロールの一つであるリストビューなので MSDN や Win32.hlp などからコーディングに役に立つ情報が得られる。
前の章へ| 総目次へ
| 次の章へ ｜最初は、自アプリの場合から始めよう。簡単な例として、TStatusbar のテキストを取得することから始める。もちろん、VCL のプロパティーやメソッドを使わないで取得することを試してみよう。Form1 に Statusbar1 と Memo1、Button1、Button2 を置いて以下のようにする。
List 1
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
StatusBar1: TStatusBar;
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
Commctrl;
procedure TForm1.FormCreate(Sender: TObject);
var
SP:TStatusPanel;
begin
SP := Statusbar1.Panels.Add;
SP.Width := 100;
SP.Text := 'あいうえお';
SP := Statusbar1.Panels.Add;
SP.Width := 120;
SP.Text := '1234567890ABCxyz';
SP := Statusbar1.Panels.Add;
SP.Width := -1;
SP.Text := '３番目のパネル';
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
Memo1.Clear;
for i := 0 to Statusbar1.Panels.Count-1 do
Memo1.Lines.Add(Statusbar1.Panels[i].Text);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
numPanel,Len,i:integer;
pBuf:PChar;
s:string;
begin
Memo1.Clear;
numPanel := SendMessage(Statusbar1.Handle,SB_GETPARTS,0,0);
GetMem(pBuf,200);
try
for i := 0 to numPanel-1 do begin
Len := LOWORD(SendMessage(Statusbar1.Handle,SB_GETTEXT,i,LPARAM(pBuf)));
SetString(s,pBuf,Len);
Memo1.Lines.Add(s);
end;
finally
FreeMem(pBuf);
end;
end;
end.
実行して、右図に示すように Button1 と Button2 を押すと同じ結果が得られる。コードを見ると明らかなように、Button1Click では、VCL のプロパティーを使って、各パネルのテキストを取得している。Button2Click では、Handle 以外は一切 VCL のプロパティーを使わずに同様にテキストを取得している。このように他アプリのコントロールを OS を通してみるとそのハンドルだけを使って情報を取得しなければならない。
コードを見てみよう。Button2Click では、Statusbar1 に２つのメッセージを送っている。まず、パネルの数を取得するために SB_GETPARTS を送っている。ここの API の ２５−２ ステータスバーをコードでつくる から引用すると
SB_GETPARTS wParam = (WPARAM) nParts; lParam = (LPARAM) (LPINT) aRightCoord;
は分割部分のＸ座標を取得する｡ wParam には取得する部分の数を指定する｡ 現在の分割数が分からないときは、wParam、lParam ともにゼロを設定すると、このメッセージの戻り値として実際の分割個数を取得できる。その後あらためて、取得した個数を wParam に設定し､ lParam には、wParamで指定した以上の要素を含むゼロベースの integer 配列の最初の要素のアドレスを指定すると各分割部分のＸ座標が得られる｡ ここでは、分割数＝パネルの数 を取得するのに用いた。SB_GETPARTS のような単純なメッセージでは、他アプリのコントロールにも全く同じようにして送ることができる。それは、このようなメッセージで、やりとりする情報が、予めメッセージに付随している数値だけだからである。これに対して、SB_GETTEXT の場合は事情が異なる。
SB_GETTEXT wParam = (WPARAM) iPart; lParam = (LPARAM) (LPSTR) szText;
これは表示されているテキストを取得する｡ wParam には、取得するテキストが表示されている分割部分のゼロベースのインデックスを指定する｡ lParam には、文字列を受け取る PChar 型のバッファを integer にキャストして指定する｡ 成功すると、戻り値の下位ワードに文字数が返される｡
ここで重要なことは、lParam を通して設定するバッファメモリを使って文字列を取得する、ということである。つまり、バッファメモリを用意して、コントロールにメッセージを送って、そのウィンドウ関数のなかでこのバッファに書き込んでもらっているわけである。自プロセスのコントロールの場合は、上の例のように GetMem() で用意したバッファや、SetLength() をつかった string 型の変数を PChar() でキャストしたものなどをつかって書き込んでもらえる。しかし、他プロセスの場合は、そうはいかない。メモリの仮想アドレス空間はプロセスごとに定義されているので、一方のプロセスで確保したメモリのアドレスを他方のプロセスに渡しても、そのアドレスは受け取った方のプロセスにとっては無意味であるからだ。これに書き込もうとすると、アクセス違反でどちらかのアプリが強制終了される。そこで、単純な数値以外のメモリ領域を必要とするものを他アプリとメッセージを使ってやりとりするためには、どちらからも読み書き可能なメモリ（共有メモリ）を使用することが必須となる。これがここの主題である。
今回のような目的で「共有メモリ」を使う場合、重要なことはもう一つある。上に述べたように、標準コントロールやコモンコントロールは特定のメッセージにどのように応答するかをすでにプログラムされている。したがって、渡されたメモリは、メッセージを受け取った時点でそのコントロールが読み書き可能になっていなければならない。普通のプロセス間通信の場合、相互に情報をやりとりするプログラムは、プロセス間通信を行うことを予め知っているので、どのような方式でも相互に読み書きするようにプログラムできるだろう。しかし、今回のように、メッセージを受け取るコントロールは、そのメッセージが自プロセスから送られたものなのか、他プロセスから送られたものなのかいちいち判断しない。したがって、送る方のプログラムが予め受け取るコントロールが読み書きできるようにしてメモリを確保する必要がある。ややこしいことに、これを実現する方法が Windows95/98/Me と WindowsNT/2000/XP で異なるのである。
[ Windows95/98/Me ] の場合 メモリマップドファイルを使う。９X 系では、メモリマップドファイルは、システム共通領域に確保されるので、 送り側でポインタを渡せば、受け取り側で問題なく読み書きできる。 [ WindowsNT/2000/XP ] の場合 メモリマップドファイルは使えない。受け取り側でも MapViewOfFile を実行しないと読み書きできないからで ある。そのかわり、９X 系では実装されていない VirtualAllocEx() という API をつかって、受け取り側のプロ セスのなかにメモリを確保してそのアドレスを渡して読み書きしてもらう。
それでは具体的にやってみよう。筆者の現在のメインマシンは Windows2000 Pro なので、VirtualAllocEx() を使う例から始める。まず、ステータスバーを持つフォームのアプリを作成しよう。
List 2
unit TargetMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls;
type
TTargetForm = class(TForm)
StatusBar1: TStatusBar;
procedure FormCreate(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
TargetForm: TTargetForm;
implementation
{$R *.DFM}
procedure TTargetForm.FormCreate(Sender: TObject);
var
SP:TStatusPanel;
begin
SP := Statusbar1.Panels.Add;
SP.Width := 100;
SP.Text := 'あいうえお';
SP := Statusbar1.Panels.Add;
SP.Width := 120;
SP.Text := '1234567890ABCxyz';
SP := Statusbar1.Panels.Add;
SP.Width := -1;
SP.Text := '３番目のパネル';
end;
end.
これは前のプログラムでボタンとメモを取り去ったものだ。ウィンドウハンドルを見つけやすいように、オブジェクトインスペクタで Form1 の Name を 'TargetForm' にしておく。そうすると、このフォームをＯＳから見たときもウィンドウクラスが 'TTargetForm' になるので FindWindow() で見つけやすい。これを右図のようになるようにして、Receiver.dpr として保存しコンパイルしておく。
つぎに、メッセージを送って上記のステータスバーのテキストを取得するアプリを作成する。Form1 に Memo1 と Button1 、Button2 を置いて以下のようにする。
List 3
unit SenderMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
Commctrl;
procedure TForm1.Button1Click(Sender: TObject);
var
hTargetForm,hStatusbar:HWND;
numPart,i,Len:integer;
AllocSize:DWORD;
pCommon:Pointer;
dwProcessId:DWORD;
hProcess:THandle;
PC:PChar;
s:string;
numRead:DWORD;
begin
hTargetForm := FindWindow('TTargetForm',nil);
hStatusbar := FindWindowEx(hTargetForm,0,'TStatusbar',nil);
if hStatusbar = 0 then begin
ShowMessage('Target Statusbar is not found');
exit;
end;
numPart := SendMessage(hStatusbar,SB_GETPARTS,0,0);
AllocSize := 200;
GetWindowThreadProcessId(hStatusbar,@dwProcessId);
hProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE,false, dwProcessId);
pCommon := VirtualAllocEx(hProcess,nil,AllocSize,
MEM_RESERVE or MEM_COMMIT,PAGE_READWRITE);
GetMem(PC,AllocSize);
Memo1.Clear;
for i := 0 to numPart-1 do begin
Len := LOWORD(SendMessage(hStatusbar,SB_GETTEXT,i,LPARAM(pCommon)));
ReadProcessMemory(hProcess,pCommon,PC,200,numRead);
SetString(s,PC,Len);
Memo1.Lines.Add(s);
end;
FreeMem(PC);
VirtualFreeEx(hProcess,pCommon,0,MEM_RELEASE);
CloseHandle(hProcess);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
hTargetForm,hStatusbar:HWND;
AllocSize:DWORD;
pCommon:Pointer;
dwProcessId:DWORD;
hProcess:THandle;
s:string;
numWrite:DWORD;
begin
hTargetForm := FindWindow('TTargetForm',nil);
hStatusbar := FindWindowEx(hTargetForm,0,'TStatusbar',nil);
if hStatusbar = 0 then begin
ShowMessage('Target Statusbar is not found');
exit;
end;
AllocSize := 50;
GetWindowThreadProcessId(hStatusbar,@dwProcessId);
hProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE,false, dwProcessId);
pCommon := VirtualAllocEx(hProcess,nil,AllocSize,
MEM_RESERVE or MEM_COMMIT,PAGE_READWRITE);
s := '文字列を設定しました';
WriteProcessMemory(hProcess,pCommon,PChar(s),Length(s)+1,numWrite);
SendMessage(hStatusbar,SB_SETTEXT,1,LPARAM(pCommon));
VirtualFreeEx(hProcess,pCommon,0,MEM_RELEASE);
CloseHandle(hProcess);
end;
end.
これを Sender.dpr としてコンパイルする。そして、先ほどの Receiver.exe を起動してから、Sender.exe を実行し、Button1 を押すと右図のようになり、プロセスの垣根を越えてウィンドウの情報を取得できたことが分かる。
次に Button2 を押すと、Receiver.exe のステータスバーの真ん中のパネルのテキストが '文字列を設定しました' に書き換えられる。このようにして、プロセスを越えて情報を送ることができたことが分かるだろう。もう一度 Button1 を押すと、今設定したテキストも取得できることを確かめてほしい。
コードが雑然としていて読みにくいかも知れないのでコメントを付けてみよう。
procedure TForm1.Button1Click(Sender: TObject);
var
hTargetForm,hStatusbar:HWND;
numPart,i,Len:integer;
AllocSize:DWORD;
pCommon:Pointer;
dwProcessId:DWORD;
hProcess:THandle;
PC:PChar;
s:string;
numRead:DWORD;
begin
hTargetForm := FindWindow('TTargetForm',nil); // TargetForm のハンドルを取得
hStatusbar := FindWindowEx(hTargetForm,0,'TStatusbar',nil); // 目的のステータスバーのハンドルを取得
if hStatusbar = 0 then begin
ShowMessage('Target Statusbar is not found');
exit;
end;
numPart := SendMessage(hStatusbar,SB_GETPARTS,0,0); // パネルの数を取得
AllocSize := 200; // 確保する共有メモリのサイズを設定
GetWindowThreadProcessId(hStatusbar,@dwProcessId); // ステータスバーをつくったプロセスＩＤを取得
hProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE,false, dwProcessId); // プロセスＩＤからプロセスハンドルを取得する
pCommon := VirtualAllocEx(hProcess,nil,AllocSize,
MEM_RESERVE or MEM_COMMIT,PAGE_READWRITE); // 相手プロセス内にメモリを確保する
GetMem(PC,AllocSize); // ローカルバッファメモリを確保する
Memo1.Clear;
for i := 0 to numPart-1 do begin
Len := LOWORD(SendMessage(hStatusbar,SB_GETTEXT,i,LPARAM(pCommon))); // 各パネルのテキストを取得する
ReadProcessMemory(hProcess,pCommon,PC,200,numRead); // 書き込んでもらったテキストをバッファにコピー
SetString(s,PC,Len); // バッファから string に変換する
Memo1.Lines.Add(s); // 表示
end;
FreeMem(PC); // ローカルバッファを解放する
VirtualFreeEx(hProcess,pCommon,0,MEM_RELEASE); // 「共有メモリ」を解放する
CloseHandle(hProcess); // プロセスハンドルを閉じる
end;このように、VirtualAllocEx() を使って、相手プロセス内にメモリを確保して、それに読み書きするのはほぼ定型的な手続きなのでそのまま覚えるとよい。各 API の機能やパラメータなどはヘルプや MSDN などで調べてほしい。
前節のコードで、相手プロセスの中にメモリ領域を確保して、それに読み書きするのは定型的な手続きなので、これを小さなクラスにまとめてしまおう。そうすると、コードは格段に読みやすくなる。Sender のプログラムを以下のように書き換える。
まず、「共有メモリ」を確保、読み書き、廃棄するクラスを CommonMemoryUnit.pas に以下のようにつくった。
List 4
unit CommonMemoryUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Dialogs;
type
TCommMemNT = class(TObject)
private
FMemPtr:pointer;
FhProcess:THandle;
FdwProcessId:DWORD;
FSize:integer;
protected
procedure Open(AllocSize:integer);
procedure Close;
public
constructor Create(hTarget:HWND;AllocSize:integer);
destructor Destroy;override;
procedure ZeroClear;
procedure Write(offset:integer;Source:pointer;Length:DWORD);
procedure Read(offset:integer;Destination:pointer;Length:DWORD);
procedure ReOpen(ReAllocSize:integer);
property MemPtr:pointer read FMemPtr;
property Size:integer read FSize;
end;
implementation
{ TCommMemNT }
constructor TCommMemNT.Create(hTarget: HWND; AllocSize: integer);
begin
GetWindowThreadProcessId(hTarget,@FdwProcessId);
FhProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE,false,FdwProcessId);
Open(AllocSize);
FSize := AllocSize;
end;
destructor TCommMemNT.Destroy;
begin
Close;
CloseHandle(FhProcess);
inherited;
end;
procedure TCommMemNT.Open(AllocSize: integer);
begin
FMemPtr := VirtualAllocEx(FhProcess,nil,AllocSize,
MEM_RESERVE or MEM_COMMIT,PAGE_READWRITE);
end;
procedure TCommMemNT.Close;
begin
VirtualFreeEx(FhProcess,FMemPtr,0,MEM_RELEASE);
end;
procedure TCommMemNT.ReOpen(ReAllocSize: integer);
var
ptr:pointer;
begin
GetMem(ptr,FSize);
Read(0,ptr,FSize);
Close;
Open(ReAllocSize);
if FSize <= ReAllocSize then
Write(0,ptr,FSize)
else
Write(0,ptr,ReAllocSize);
FreeMem(ptr);
FSize := ReAllocSize;
end;
procedure TCommMemNT.Read(offset: integer; Destination: pointer;
Length: DWORD);
var
numRead:DWORD;
begin
if (offset+Length)>FSize then begin
ShowMessage('読み込み範囲がサイズを超えています');
exit;
end;
ReadProcessMemory(FhProcess,pointer(integer(FMemPtr)+offset),Destination,
Length,numRead);
end;
procedure TCommMemNT.Write(offset: integer; Source: pointer;
Length: DWORD);
var
numWrite:DWORD;
begin
if (offset+Length)>FSize then begin
ShowMessage('書き込み範囲がサイズを超えています');
exit;
end;
WriteProcessMemory(FhProcess,pointer(integer(FMemPtr)+offset),Source,
Length,numWrite);
end;
procedure TCommMemNT.ZeroClear;
var
ptr:pointer;
begin
GetMem(ptr,FSize);
ZeroMemory(ptr,FSize);
Write(0,ptr,FSize);
FreeMem(ptr);
end;
end.
これは前のコードと対応付けると簡単に分かるだろう。これをつかって、前回と同じことをしてみよう。SenderMain.pas の全リストを以下に示す。
List 5
unit SenderMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
Commctrl,CommonMemoryUnit;
procedure TForm1.Button1Click(Sender: TObject);
var
hTargetForm,hStatusbar:HWND;
numPart,i,Len:integer;
AllocSize:DWORD;
CM:TCommMemNT;
PC:PChar;
s:string;
begin
hTargetForm := FindWindow('TTargetForm',nil);
hStatusbar := FindWindowEx(hTargetForm,0,'TStatusbar',nil);
if hStatusbar = 0 then begin
ShowMessage('Target Statusbar is not found');
exit;
end;
numPart := SendMessage(hStatusbar,SB_GETPARTS,0,0);
AllocSize := 200;
CM := TCommMemNT.Create(hStatusbar,AllocSize);
GetMem(PC,AllocSize);
Memo1.Clear;
for i := 0 to numPart-1 do begin
Len := LOWORD(SendMessage(hStatusbar,SB_GETTEXT,i,LPARAM(CM.MemPtr)));
CM.Read(0,PC,Len);
SetString(s,PC,Len);
Memo1.Lines.Add(s);
end;
FreeMem(PC);
CM.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
hTargetForm,hStatusbar:HWND;
AllocSize:DWORD;
CM:TCommMemNT;
s:string;
begin
hTargetForm := FindWindow('TTargetForm',nil);
hStatusbar := FindWindowEx(hTargetForm,0,'TStatusbar',nil);
if hStatusbar = 0 then begin
ShowMessage('Target Statusbar is not found');
exit;
end;
AllocSize := 50;
CM := TCommMemNT.Create(hStatusbar,AllocSize);
s := '文字列を設定しました'+#0;
CM.Write(0,PChar(s),Length(s));
SendMessage(hStatusbar,SB_SETTEXT,1,LPARAM(CM.MemPtr));
CM.Free;
end;
end.
Receiver.exe を実行しておいて、これを実行すると、前のプログラムを同じ動作をすることが確かめられる。メモリの管理をクラスにしてしまうと、インスタンスの作成と同時に面倒な手続きが自動化され、また、インスタンスの破棄とともに、ハンドルのクローズやメモリの解放を自動化することができる。
前に述べたように、9X 系では VirtualAllocEx() が実装されていないので、メモリマッピングファイルを使う。Sender の全リストを以下に示す。
List 6
unit SenderMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
Commctrl;
procedure TForm1.Button1Click(Sender: TObject);
var
hTargetForm,hStatusbar:HWND;
hFileMapping:THandle;
pCommon:pointer;
numPart,i,Len:integer;
AllocSize:DWORD;
s:string;
begin
hTargetForm := FindWindow('TTargetForm',nil);
hStatusbar := FindWindowEx(hTargetForm,0,'TStatusbar',nil);
if hStatusbar = 0 then exit;
numPart := SendMessage(hStatusbar,SB_GETPARTS,0,0);
AllocSize := 200;
hFileMapping := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,AllocSize,nil);
pCommon := MapViewOfFile(hFileMapping,FILE_MAP_ALL_ACCESS,0,0,0);
Memo1.Clear;
for i := 0 to numPart-1 do begin
Len := LOWORD(SendMessage(hStatusbar,SB_GETTEXT,i,LPARAM(pCommon)));
SetString(s,PChar(pCommon),Len);
Memo1.Lines.Add(s);
end;
UnmapViewOfFile(pCommon);
CloseHandle(hFileMapping);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
hTargetForm,hStatusbar:HWND;
hFileMapping:THandle;
pCommon:pointer;
AllocSize:DWORD;
s:string;
begin
hTargetForm := FindWindow('TTargetForm',nil);
hStatusbar := FindWindowEx(hTargetForm,0,'TStatusbar',nil);
if hStatusbar = 0 then exit;
AllocSize := 100;
hFileMapping := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,AllocSize,nil);
pCommon := MapViewOfFile(hFileMapping,FILE_MAP_ALL_ACCESS,0,0,0);
s := 'やっほー！';
MoveMemory(pCommon,PChar(s),Length(s));
SendMessage(hStatusbar,SB_SETTEXT,2,LPARAM(pCommon));
UnmapViewOfFile(pCommon);
CloseHandle(hFileMapping);
end;
end.
前につくった Receiver.exe とともに実行して、Button1 Button2 Button1 の順で押すと、右図のようになる。ここでは WindowsMe で実行した。このように、9X 系では、CreateFileMapping() でつくられるマッピングオブジェクトはシステム共通領域に確保されるので、Sender 側で MapViewOfFile() して得たポインタの値は、異なるプロセスである Receiver からでもアクセスできるのである。
それでは NT 系のときと同じように共有メモリの管理部分をクラスにしてみよう。
List 7
unit CommonMemoryUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Dialogs;
type
TCommMem9X = class(TObject)
private
FMemPtr:pointer;
FHandle:THandle;
FSize:integer;
protected
procedure Open(AllocSize:integer);
procedure Close;
public
constructor Create(AllocSize:integer);
destructor Destroy;override;
procedure ZeroClear;
procedure Write(offset:integer;Source:pointer;Length:DWORD);
procedure Read(offset:integer;Destination:pointer;Length:DWORD);
procedure ReOpen(ReAllocSize:integer);
property MemPtr:pointer read FMemPtr;
property Size:integer read FSize;
end;
implementation
{ TCommMem9X }
constructor TCommMem9X.Create(AllocSize: integer);
begin
Open(AllocSize);
FSize := AllocSize;
end;
destructor TCommMem9X.Destroy;
begin
Close;
inherited;
end;
procedure TCommMem9X.ZeroClear;
begin
ZeroMemory(FMemPtr,FSize);
end;
procedure TCommMem9X.Open(AllocSize: integer);
begin
FHandle := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,AllocSize,nil);
FMemPtr := MapViewOfFile(FHandle,FILE_MAP_ALL_ACCESS,0,0,0);
end;
procedure TCommMem9X.Close;
begin
UnmapViewOfFile(FMemPtr);
CloseHandle(FHandle);
FHandle := 0;
end;
procedure TCommMem9X.ReOpen(ReAllocSize: integer);
var
ptr:pointer;
begin
if FHandle = 0 then
Open(ReAllocSize)
else begin
GetMem(ptr,FSize);
CopyMemory(ptr,FMemPtr,FSize);
Close;
Open(ReAllocSize);
if FSize <= ReAllocSize then
CopyMemory(FMemPtr,ptr,FSize)
else
CopyMemory(FMemPtr,ptr,ReAllocSize);
FreeMem(ptr);
FSize := ReAllocSize;
end;
end;
procedure TCommMem9X.Read(offset: integer; Destination: pointer;
Length: DWORD);
begin
if (offset+Length)>FSize then begin
ShowMessage('読み込み範囲がサイズを超えています');
exit;
end;
CopyMemory(Destination,pointer(integer(FMemPtr)+offset),Length);
end;
procedure TCommMem9X.Write(offset: integer; Source: pointer;
Length: DWORD);
begin
if (offset+Length)>FSize then begin
ShowMessage('書き込み範囲がサイズを超えています');
exit;
end;
CopyMemory(pointer(integer(FMemPtr)+offset),Source,Length);
end;
end.これをつかって同じことをするプログラムを以下に示す。
List 8
unit SenderMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
Commctrl,CommonMemoryUnit;
procedure TForm1.Button1Click(Sender: TObject);
var
hTargetForm,hStatusbar:HWND;
CommMem:TCommMem9X;
numPart,i,Len:integer;
AllocSize:DWORD;
s:string;
begin
hTargetForm := FindWindow('TTargetForm',nil);
hStatusbar := FindWindowEx(hTargetForm,0,'TStatusbar',nil);
if hStatusbar = 0 then exit;
AllocSize := 200;
CommMem := TCommMem9X.Create(AllocSize);
numPart := SendMessage(hStatusbar,SB_GETPARTS,0,0);
Memo1.Clear;
for i := 0 to numPart-1 do begin
Len := LOWORD(SendMessage(hStatusbar,SB_GETTEXT,i,LPARAM(CommMem.MemPtr)));
SetString(s,PChar(CommMem.MemPtr),Len);
Memo1.Lines.Add(s);
end;
CommMem.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
hTargetForm,hStatusbar:HWND;
CommMem:TCommMem9X;
AllocSize:DWORD;
s:string;
begin
hTargetForm := FindWindow('TTargetForm',nil);
hStatusbar := FindWindowEx(hTargetForm,0,'TStatusbar',nil);
if hStatusbar = 0 then exit;
AllocSize := 100;
CommMem := TCommMem9X.Create(AllocSize);
s := 'やっほー！';
MoveMemory(CommMem.MemPtr,PChar(s),Length(s)+1);
SendMessage(hStatusbar,SB_SETTEXT,2,LPARAM(CommMem.MemPtr));
CommMem.Free;
end;
end.実行結果は前回と同じものになる。
前節までにつくった、TCommMemNT と TCommMem9X クラスは、コンストラクタと private フィールド以外は全く同じ外装をしていることに気が付いただろうか。どちらも TObject から派生している。ここでは、全く同じコードで NT 系でも 9X 系でも動作するように少し改変してみよう。両方のクラスの派生もととして TObject ではなく、TCommonMemory という名前の抽象クラスをつくろう。そして、それから派生して TCommMemNT と TCommMem9X クラスを実装部に作り、実行時に動的にプラットフォームを判断して、TCommonMemory のインスタンスとして、TCommMemNT か TCommMem9X のインスタンスをかえすことにしよう。そうすると、多態性を利用して、実質のメソッドは具体クラスの TCommMemNT か TCommMem9X のものが実行されるだろう。さっそく始めよう。以下に、CommonMemoryUnit.pas の全リストを示す。
List 9
unit CommonMemoryUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Dialogs;
type
TCommonMemory = class(TObject)
private
FMemPtr:pointer;
FSize:integer;
protected
procedure Open(AllocSize:integer);virtual;abstract;
procedure Close;virtual;abstract;
public
constructor Create(hTarget:HWND;AllocSize:integer);virtual;abstract;
procedure ZeroClear;virtual;abstract;
procedure Write(offset:integer;Source:pointer;Length:integer);virtual;abstract;
procedure Read(offset:integer;Destination:pointer;Length:integer);virtual;abstract;
procedure ReOpen(ReAllocSize:integer);virtual;abstract;
property MemPtr:pointer read FMemPtr;
property Size:integer read FSize;
end;
function GetCommonMemory(hTarget:HWND;AllocSize:integer):TCommonMemory;
implementation
//------------------------------------------------------
type
TCommMemNT = class(TCommonMemory)
private
FhProcess:THandle;
FdwProcessId:DWORD;
protected
procedure Open(AllocSize:integer);override;
procedure Close;override;
public
constructor Create(hTarget:HWND;AllocSize:integer);override;
destructor Destroy;override;
procedure ZeroClear;override;
procedure Write(offset:integer;Source:pointer;Length:integer);override;
procedure Read(offset:integer;Destination:pointer;Length:integer);override;
procedure ReOpen(ReAllocSize:integer);override;
end;
//------------------------------------------------------
TCommMem9X = class(TCommonMemory)
private
FHandle:THandle;
protected
procedure Open(AllocSize:integer);override;
procedure Close;override;
public
constructor Create(hTarget:HWND;AllocSize:integer);override;
destructor Destroy;override;
procedure ZeroClear;override;
procedure Write(offset:integer;Source:pointer;Length:integer);override;
procedure Read(offset:integer;Destination:pointer;Length:integer);override;
procedure ReOpen(ReAllocSize:integer);override;
end;
//------------------------------------------------------
function GetCommonMemory(hTarget:HWND;AllocSize:integer):TCommonMemory;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
result := TCommMemNT.Create(hTarget,AllocSize)
else
result := TCommMem9X.Create(hTarget,AllocSize);
end;
//------------------------------------------------------
{ TCommMemNT }
constructor TCommMemNT.Create(hTarget: HWND; AllocSize: integer);
begin
GetWindowThreadProcessId(hTarget,@FdwProcessId);
FhProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE,false,FdwProcessId);
Open(AllocSize);
FSize := AllocSize;
end;
destructor TCommMemNT.Destroy;
begin
Close;
CloseHandle(FhProcess);
inherited;
end;
procedure TCommMemNT.Open(AllocSize: integer);
type
TFuncAlloc = function (hProcess: THandle; lpAddress: Pointer;
dwSize, flAllocationType: DWORD; flProtect: DWORD): Pointer; stdcall;
var
Handle:THandle;
FuncAlloc:TFuncAlloc;
begin
Handle := LoadLibrary('kernel32.dll');
@FuncAlloc := GetProcAddress(Handle,'VirtualAllocEx');
FMemPtr := FuncAlloc(FhProcess,nil,AllocSize,
MEM_RESERVE or MEM_COMMIT,PAGE_READWRITE);
FreeLibrary(Handle);
end;
procedure TCommMemNT.Close;
type
TFuncFree = function (hProcess: THandle; lpAddress: Pointer;
dwSize, dwFreeType: DWORD): Pointer; stdcall;
var
Handle:THandle;
FuncFree:TFuncFree;
begin
Handle := LoadLibrary('kernel32.dll');
@FuncFree := GetProcAddress(Handle,'VirtualFreeEx');
FuncFree(FhProcess,FMemPtr,0,MEM_RELEASE);
FreeLibrary(Handle);
end;
procedure TCommMemNT.ReOpen(ReAllocSize: integer);
var
ptr:pointer;
begin
GetMem(ptr,FSize);
Read(0,ptr,FSize);
Close;
Open(ReAllocSize);
if FSize <= ReAllocSize then
Write(0,ptr,FSize)
else
Write(0,ptr,ReAllocSize);
FreeMem(ptr);
FSize := ReAllocSize;
end;
procedure TCommMemNT.Read(offset: integer; Destination: pointer;
Length: integer);
var
numRead:DWORD;
begin
if (offset+Length)>FSize then begin
ShowMessage('読み込み範囲がサイズを超えています');
exit;
end;
ReadProcessMemory(FhProcess,pointer(integer(FMemPtr)+offset),Destination,
Length,numRead);
end;
procedure TCommMemNT.Write(offset: integer; Source: pointer;
Length: integer);
var
numWrite:DWORD;
begin
if (offset+Length)>FSize then begin
ShowMessage('書き込み範囲がサイズを超えています');
exit;
end;
WriteProcessMemory(FhProcess,pointer(integer(FMemPtr)+offset),Source,
Length,numWrite);
end;
procedure TCommMemNT.ZeroClear;
var
ptr:pointer;
begin
GetMem(ptr,FSize);
ZeroMemory(ptr,FSize);
Write(0,ptr,FSize);
FreeMem(ptr);
end;
//------------------------------------------------------
{ TCommMem9X }
constructor TCommMem9X.Create(hTarget:HWND;AllocSize: integer);
begin
Open(AllocSize);
FSize := AllocSize;
end;
destructor TCommMem9X.Destroy;
begin
Close;
inherited;
end;
procedure TCommMem9X.ZeroClear;
begin
ZeroMemory(FMemPtr,FSize);
end;
procedure TCommMem9X.Open(AllocSize: integer);
begin
FHandle := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,AllocSize,nil);
FMemPtr := MapViewOfFile(FHandle,FILE_MAP_ALL_ACCESS,0,0,0);
end;
procedure TCommMem9X.Close;
begin
UnmapViewOfFile(FMemPtr);
CloseHandle(FHandle);
FHandle := 0;
end;
procedure TCommMem9X.ReOpen(ReAllocSize: integer);
var
ptr:pointer;
begin
if FHandle = 0 then
Open(ReAllocSize)
else begin
GetMem(ptr,FSize);
CopyMemory(ptr,FMemPtr,FSize);
Close;
Open(ReAllocSize);
if FSize <= ReAllocSize then
CopyMemory(FMemPtr,ptr,FSize)
else
CopyMemory(FMemPtr,ptr,ReAllocSize);
FreeMem(ptr);
FSize := ReAllocSize;
end;
end;
procedure TCommMem9X.Read(offset: integer; Destination: pointer;Length: integer);
begin
if (offset+Length)>FSize then begin
ShowMessage('読み込み範囲がサイズを超えています');
exit;
end;
CopyMemory(Destination,pointer(integer(FMemPtr)+offset),Length);
end;
procedure TCommMem9X.Write(offset: integer; Source: pointer;Length: integer);
begin
if (offset+Length)>FSize then begin
ShowMessage('書き込み範囲がサイズを超えています');
exit;
end;
CopyMemory(pointer(integer(FMemPtr)+offset),Source,Length);
end;
end.このユニットの interface 部は、実装部を持たない抽象クラス TCommonMemory と 関数 GetCommonMemory() だけである。
まず、GetCommonMemory() の実装を見てみよう。
function GetCommonMemory(hTarget:HWND;AllocSize:integer):TCommonMemory;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
result := TCommMemNT.Create(hTarget,AllocSize)
else
result := TCommMem9X.Create(hTarget,AllocSize);
end;
これは、動的に実行環境を判断して、TCommonMemory クラスのインスタンスとして、具体クラス TCommMemNT または TCommMem9X のインスタンスを返す関数である。外からこのユニットを使うには、この関数だけが実行できる。つぎに TCommMemNT クラスの Open と Close メソッドを見てみよう。
procedure TCommMemNT.Open(AllocSize: integer);
type
TFuncAlloc = function (hProcess: THandle; lpAddress: Pointer;
dwSize, flAllocationType: DWORD; flProtect: DWORD): Pointer; stdcall;
var
Handle:THandle;
FuncAlloc:TFuncAlloc;
begin
Handle := LoadLibrary('kernel32.dll');
@FuncAlloc := GetProcAddress(Handle,'VirtualAllocEx');
FMemPtr := FuncAlloc(FhProcess,nil,AllocSize,
MEM_RESERVE or MEM_COMMIT,PAGE_READWRITE);
FreeLibrary(Handle);
end;
procedure TCommMemNT.Close;
type
TFuncFree = function (hProcess: THandle; lpAddress: Pointer;
dwSize, dwFreeType: DWORD): Pointer; stdcall;
var
Handle:THandle;
FuncFree:TFuncFree;
begin
Handle := LoadLibrary('kernel32.dll');
@FuncFree := GetProcAddress(Handle,'VirtualFreeEx');
FuncFree(FhProcess,FMemPtr,0,MEM_RELEASE);
FreeLibrary(Handle);
end;
Win9X 系では kernel32.dll に VirtualAllocEx と VirtualFreeEx が実装されていないので、この二つの API は静的にリンクすることはできない。したがって LoadLibrary()、GetProcAddress()、FreeLibrary() を使って動的にリンクする必要がある。あとの実装部は、前のコードとほぼ同じである。このユニットをつかって、テストしてみよう。まえにつくった Receiver.exe のスタータスバーのテキストの取得・設定を試してみる。
List 10
unit SenderMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
Commctrl,CommonMemoryUnit;
procedure TForm1.Button1Click(Sender: TObject);
var
hTargetForm,hStatusbar:HWND;
numPart,i,Len:integer;
AllocSize:DWORD;
CM:TCommonMemory;
PC:PChar;
s:string;
begin
hTargetForm := FindWindow('TTargetForm',nil);
hStatusbar := FindWindowEx(hTargetForm,0,'TStatusbar',nil);
if hStatusbar = 0 then begin
ShowMessage('Target Statusbar is not found');
exit;
end;
numPart := SendMessage(hStatusbar,SB_GETPARTS,0,0);
AllocSize := 200;
CM := GetCommonMemory(hStatusbar,AllocSize);
GetMem(PC,AllocSize);
Memo1.Clear;
for i := 0 to numPart-1 do begin
Len := LOWORD(SendMessage(hStatusbar,SB_GETTEXT,i,LPARAM(CM.MemPtr)));
CM.Read(0,PC,Len);
SetString(s,PC,Len);
Memo1.Lines.Add(s);
end;
FreeMem(PC);
CM.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
hTargetForm,hStatusbar:HWND;
AllocSize:DWORD;
CM:TCommonMemory;
s:string;
begin
hTargetForm := FindWindow('TTargetForm',nil);
hStatusbar := FindWindowEx(hTargetForm,0,'TStatusbar',nil);
if hStatusbar = 0 then begin
ShowMessage('Target Statusbar is not found');
exit;
end;
AllocSize := 50;
CM := GetCommonMemory(hStatusbar,AllocSize);
s := '文字列を設定しました'+#0;
CM.Write(0,PChar(s),Length(s));
SendMessage(hStatusbar,SB_SETTEXT,1,LPARAM(CM.MemPtr));
CM.Free;
end;
end.
このコードは、筆者が試せる環境として Windows2000 pro と WindowsMe で期待通りに動作する。右図は、WindowsMe での実行時の様子である。
前節までで、他アプリがつくったウィンドウの情報を取得するために必要となる共有メモリについての準備ができたので、ここでは、いよいよ、冒頭の質問に対する回答を示すことにしよう。スタートボタンから起動できる「ファイルやフォルダの検索」の結果示されるダイアログは、Windows2000 では以下のようなものである。
このダイアログのうち、必要なのはリストビューに相当する部分である。必要とするウィンドウのハンドルを取得するには、OS から見てこのダイアログがどのような構造になっているかを知る必要がある。ここでは、第６章 ウィンドウの階層について でつくった WindowTree.exe を利用してみる。結果を以下に示す。
この結果を見ると、トップレベルウィンドウは、'CabinetWClass' というクラス名で、ウィンドウテキストが'検索結果'であることが分かる。また、その子ウィンドウの層のなかで 'SysListView32' クラスは一つしかないことが分かった。このことを利用して、リストビューのハンドルを取得し、それを使って情報を取得できる。ここでは、やはり 第６章 ウィンドウの階層について の中でつくった WinSearch.pas の中の関数を利用してハンドルを取得しよう。以下に全リストを示す。
List 11
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ListView1: TListView;
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
uses
CommCtrl,WinSearch,CommonMemoryUnit;
function GetListView:HWND;
var
hTarget:HWND;
begin
hTarget := FindWindow('CabinetWClass','検索結果');
result := FindChildOfClass(hTarget,'SysListView32');
end;
procedure TForm1.Button1Click(Sender: TObject);
var
hListView,hHeader:HWND;
numColumn,numItem,i,j:integer;
LVC,LVCBuf:TLVColumn;
LVI:TLVItem;
CM:TCommonMemory;
PC:PChar;
s:string;
begin
hListView := GetListView;
hHeader := ListView_GetHeader(hListView);
if hHeader = 0 then exit;
numColumn := Header_GetItemCount(hHeader);
if numColumn = -1 then exit;
GetMem(PC,MAX_PATH);
CM := GetCommonMemory(hListView,100+MAX_PATH);
LVC.mask := LVCF_WIDTH or LVCF_TEXT or LVCF_FMT;
LVC.pszText := pointer(integer(CM.MemPtr)+SizeOf(TLVColumn));
LVC.cchTextMax := MAX_PATH;
for i := 0 to numColumn-1 do begin
CM.Write(0,@LVC,SizeOf(TLVColumn));
ListView_GetColumn(hListView,i,TLVColumn(CM.MemPtr^));
CM.Read(0,@LVCBuf,SizeOf(TLVColumn));
CM.Read(SizeOf(TLVColumn),PC,LVC.cchTextMax);
SetString(s,PC,StrLen(PC));
with ListView1.Columns.Add do begin
Caption := s;
Width := LVCBuf.cx;
case (LVCBuf.fmt and $F) of
LVCFMT_LEFT :Alignment := taLeftJustify;
LVCFMT_RIGHT :Alignment := taRightJustify;
LVCFMT_CENTER:Alignment := taCenter;
end;
end;
end;
numItem := ListView_GetItemCount(hListView);
if numItem = 0 then begin
FreeMem(PC);
CM.Free;
exit;
end;
LVI.mask := LVIF_TEXT;
LVI.pszText := pointer(integer(CM.MemPtr)+SizeOf(TLVItem));
LVI.cchTextMax := MAX_PATH;
for i := 0 to numItem-1 do begin
LVI.iItem := i;
LVI.iSubItem := 0;
CM.Write(0,@LVI,SizeOf(TLVItem));
ListView_GetItem(hListView,TLVItem(CM.MemPtr^));
CM.Read(SizeOf(TLVItem),PC,MAX_PATH);
SetString(s,PC,StrLen(PC));
with ListView1.Items.Add do begin
Caption := s;
for j := 1 to numColumn-1 do begin
LVI.iSubItem := j;
CM.Write(0,@LVI,SizeOf(TLVItem));
ListView_GetItem(hListView,TLVItem(CM.MemPtr^));
CM.Read(SizeOf(TLVItem),PC,MAX_PATH);
SetString(s,PC,StrLen(PC));
SubItems.Add(s);
end;
end;
end;
FreeMem(PC);
CM.Free;
end;
end.
実行して、Button1 を押すと上図のようになり、情報の取得に成功する。アイコンを除いて、ヘッダー部分のテキスト、各カラムの幅とテキストの配置、各項目のテキストが完全に取得できている。
コードを見てみよう。リストビューのハンドルの取得は、ダイアログの構造が Windows のバージョンに依存するかもしれないので、別関数で行っている。
function GetListView:HWND;
var
hTarget:HWND;
begin
hTarget := FindWindow('CabinetWClass','検索結果');
result := FindChildOfClass(hTarget,'SysListView32');
end;
このうち、FindChildOfClass() は WinSearch.pas の中にある関数で、親ウィンドウのなかの子ウィンドウの層の中から指定のクラス名を持つものを返す。リストビューのハンドルを取得できたら、カラムの数を求めるために、ヘッダーコントロールにアクセスして、その Item の数を求める。
hHeader := ListView_GetHeader(hListView); if hHeader = 0 then exit; numColumn := Header_GetItemCount(hHeader); if numColumn = -1 then exit;
つぎに、共有メモリとそこから取得できた文字列をコピーするためのバッファメモリを用意する。
GetMem(PC,MAX_PATH); CM := GetCommonMemory(hListView,100+MAX_PATH);
つぎに、各カラムの幅、テキスト、テキストの配置を取得するために ListView_GetColumn() を使い、得られた情報をもとに、ListView1 にカラムの設定を行う。
LVC.mask := LVCF_WIDTH or LVCF_TEXT or LVCF_FMT;
LVC.pszText := pointer(integer(CM.MemPtr)+SizeOf(TLVColumn));
LVC.cchTextMax := MAX_PATH;
for i := 0 to numColumn-1 do begin
CM.Write(0,@LVC,SizeOf(TLVColumn));
ListView_GetColumn(hListView,i,TLVColumn(CM.MemPtr^));
CM.Read(0,@LVCBuf,SizeOf(TLVColumn));
CM.Read(SizeOf(TLVColumn),PC,LVC.cchTextMax);
SetString(s,PC,StrLen(PC));
with ListView1.Columns.Add do begin
Caption := s;
Width := LVCBuf.cx;
case (LVCBuf.fmt and $F) of
LVCFMT_LEFT :Alignment := taLeftJustify;
LVCFMT_RIGHT :Alignment := taRightJustify;
LVCFMT_CENTER:Alignment := taCenter;
end;
end;
end;ListView_GetColumn() は、CommCtrl.pas でインポートされるマクロである。Ｃ では、プリプロセッサによるマクロを定義できるが、Delphi はワンパスコンパイラなのでマクロの機能がない。したがって、ListView_GetColumn() のような SendMessage() をラップしたマクロは、Delphi では以下のような関数として実装されている。
function ListView_GetColumn(hwnd: HWND; // リストビューのハンドル
iCol: Integer; // カラムのインデックス
var pcol: TLVColumn // 情報を設定してもらう TLVColumn 型のレコード
): Bool;
この第三パラメータが、リストビューに書き込んでもらう部分であるので、共有メモリを使わなくてはならない。TLVColumn 型のレコードは以下のようなものである。
type
PLVColumnA = ^TLVColumnA;
PLVColumn = PLVColumnA;
tagLVCOLUMNA = packed record
mask: UINT; // 取得・設定する情報のマスク
fmt: Integer; // カラムのテキスト配置
cx: Integer; // カラムのテキスト
pszText: PAnsiChar; // テキストのためのバッファポインタ
cchTextMax: Integer; // pszText の最大サイズ
iSubItem: Integer; // サブアイテムのインデックス
iImage: Integer; // イメージのインデックス
iOrder: Integer; // カラムのインデックス（左端＝ゼロ）
end;
tagLVCOLUMN = tagLVCOLUMNA;
_LV_COLUMNA = tagLVCOLUMNA;
_LV_COLUMN = _LV_COLUMNA;
TLVColumnA = tagLVCOLUMNA;
TLVColumn = TLVColumnA;
LV_COLUMN = LV_COLUMNA;
mask フィールドは取得・設定する情報の種類を以下の定数のいくつかで設定する。（ 複数あるときは or で結合する）
const LVCF_FMT = $0001; // fmt フィールドが有効 LVCF_WIDTH = $0002; // cx フィールドが有効 LVCF_TEXT = $0004; // pszText と cchTextMax フィールドが有効 LVCF_SUBITEM = $0008; // iSubItem フィールドが有効 LVCF_IMAGE = $0010; // iImage フィールドが有効 LVCF_ORDER = $0020; // iOrder フィールドが有効
ここでは以下のように設定した。
LVC.mask := LVCF_WIDTH or LVCF_TEXT or LVCF_FMT; LVC.pszText := pointer(integer(CM.MemPtr)+SizeOf(TLVColumn)); LVC.cchTextMax := MAX_PATH;
したがって、カラムの幅とテキスト、およびテキストの配置を取得している。LVC.pszText の部分は、文字列を受け取るためのバッファであるが、共有メモリの中のこのレコード型の次の領域を先頭として指定している。このように設定したレコード型の内容を共有メモリの先頭に書き込んでから、それを使って ListView_GetColumn() を実行する。このときの第二パラメータは、取得するカラムのインデックスを設定する。（ここでは i で巡回している）
CM.Write(0,@LVC,SizeOf(TLVColumn));
ListView_GetColumn(hListView,i,TLVColumn(CM.MemPtr^));
このようにして取得した情報を共有メモリから取り出す。
CM.Read(0,@LVCBuf,SizeOf(TLVColumn));
CM.Read(SizeOf(TLVColumn),PC,LVC.cchTextMax);
SetString(s,PC,StrLen(PC));
ここでは、LVCBuf に返ってきた TLVColumn 型レコードの内容を写し取り、また PC のバッファメモリにテキスト部分をコピーしている。そしてそれを SetString() で Delphi の string 型に変換している。最後に、取得したカラムの幅と配置とテキストを使って、ListView1 にカラムを追加している。
with ListView1.Columns.Add do begin
Caption := s;
Width := LVCBuf.cx;
case (LVCBuf.fmt and $F) of
LVCFMT_LEFT :Alignment := taLeftJustify;
LVCFMT_RIGHT :Alignment := taRightJustify;
LVCFMT_CENTER:Alignment := taCenter;
end;
end;
fmt 部分に返ってくる定数は以下のようなものである。
const LVCFMT_LEFT = $0000; // テキストは左配置（デフォルト） LVCFMT_RIGHT = $0001; // テキストは右配置 LVCFMT_CENTER = $0002; // テキストは中央配置 LVCFMT_JUSTIFYMASK = $0003; // テキスト配置を取得するためのマスク（ここではこれを使わず ＄F を使用） LVCFMT_IMAGE = $0800; // カラムはイメージを持っている
以上をカラムの数だけ繰り返して、カラム部分の情報の取得は終わりである。つぎにしなければならないことは、リストビューの項目のテキストを取得することである。
numItem := ListView_GetItemCount(hListView);
if numItem = 0 then begin
FreeMem(PC);
CM.Free;
exit;
end;
このようにして、項目の数を取得する。項目のテキストを取得するには CommCtrl.pas に ListView_GetItemText() という便利なマクロがある。しかし、これは今回は使えない。上述のように Delphi はマクロを関数として実装しているので ListView_GetItemText() 関数は、その中で情報を取得するためのレコード型をローカル変数として使っている。これは共有メモリではないので、他プロセスのウィンドウは情報を書き込むことができない。ここでは、もっとも汎用的な
function ListView_GetItem(hWnd: HWND; // リストビューのハンドル
var pItem: TLVItem // 情報を書き込んでもらうレコード
): Bool;
を使う必要がある。TLVItem は以下のようなレコード型である。
type
PLVItemA = ^TLVItemA;
PLVItem = PLVItemA;
tagLVITEMA = packed record
mask: UINT; // 情報を取得・設定するためのマスク（以下を参照）
iItem: Integer; // 項目のインデックス
iSubItem: Integer; // サブ項目のインデックス（左端はゼロで VCL の TListItem.Caption に相当、１以上は SubItems に相当する）
state: UINT; // 選択状態などの情報
stateMask: UINT; // 選択状態など情報を設定するときのマスク
pszText: PAnsiChar; // テキストバッファへのポインタ
cchTextMax: Integer; // pszText の最大サイズ
iImage: Integer; // イメージのインデックス
lParam: LPARAM; // オプションパラメータ
iIndent: Integer; // インデントサイズ（単位はイメージの幅）
end;
tagLVITEM = tagLVITEMA;
_LV_ITEMA = tagLVITEMA;
_LV_ITEM = _LV_ITEMA;
TLVItemA = tagLVITEMA;
TLVItem = TLVItemA;
LV_ITEMA = tagLVITEMA;
LV_ITEM = LV_ITEMA;
ここで mask に設定できるのは以下の定数の組み合わせである。
const LVIF_TEXT = $0001; // pszText フィールドが有効 LVIF_IMAGE = $0002; // iImage フィールドが有効 LVIF_PARAM = $0004; // lParam フィールドが有効 LVIF_STATE = $0008; // state フィールドが有効 LVIF_INDENT = $0010; // iIndent フィールドが有効 LVIF_NORECOMPUTE = $0800; // コールバックを使う
ここでは以下のように設定した。
LVI.mask := LVIF_TEXT; LVI.pszText := pointer(integer(CM.MemPtr)+SizeOf(TLVItem)); LVI.cchTextMax := MAX_PATH;
つまり、テキストだけを取得し、そのバッファは、共有メモリのなかの先頭から SizeOf(TLVItem) の位置である。
for i := 0 to numItem-1 do begin
LVI.iItem := i; // 項目のインデックス（ｉで巡回）
LVI.iSubItem := 0; // 最初は Caption 部分
CM.Write(0,@LVI,SizeOf(TLVItem)); // 共有メモリに LVI を書き込む
ListView_GetItem(hListView,TLVItem(CM.MemPtr^)); // テキスト取得（Caption 部分）
CM.Read(SizeOf(TLVItem),PC,MAX_PATH); // バッファにコピー
SetString(s,PC,StrLen(PC)); // string 型に変換
with ListView1.Items.Add do begin // ListView1 に項目追加
Caption := s; // Caption を設定
for j := 1 to numColumn-1 do begin // サブ項目の数だけ j で巡回
LVI.iSubItem := j; // 以下 Caption 取得のときと同じ
CM.Write(0,@LVI,SizeOf(TLVItem));
ListView_GetItem(hListView,TLVItem(CM.MemPtr^));
CM.Read(SizeOf(TLVItem),PC,MAX_PATH);
SetString(s,PC,StrLen(PC));
SubItems.Add(s);
end;
end;
end;
このようにして項目のテキストが得られた。最後に、共有メモリとバッファメモリを解放する。
FreeMem(PC); CM.Free;
これでおしまいである。まったく同じコードが Win9X 系でも動作することが期待できる。以下は、上の exe ファイルをフロッピーにコピーして WindowsMe で実行した結果である。
Windows2000 のときと比較すると 関連情報 のカラムが一つ少ないことを除けば、ほぼ同じである。
この章では、他プロセスがつくったウィンドウの情報を取得するための一般的な手段を調べるために、共有メモリについて調べ、プラットフォームに依存しないコードを書くために、小さなクラスをつくった。それをつかって 検索結果 のダイアログのリストビュー部分のテキストを取得することを試した。
最後に、ここでつくった CommonMemoryUnit.pas のリンクを示しておきます。