ＰＡＴ Ｖ６０投票支援ソフトを作成したときのノウハウについてまとめてみました。
■他のアプリを起動する方法
ＡＰＩのCreateProcessを使用して起動します。ＶＢのＳｈｅｌｌ関数でも起動できますが、ここではCreateProcessを使用する方法を説明します。最初に、CreateProcessで使用する定数と構造体の宣言を記述します。
Public Const NORMAL_PRIORITY_CLASS As Long = &H20 Public Const IDLE_PRIORITY_CLASS As Long = &H40 Public Const HIGH_PRIORITY_CLASS As Long = &H80 Public Const REALTIME_PRIORITY_CLASS As Long = &H100 Public Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type Public Type STARTUPINFO cb As Long lpReserved As String lpDesktop As String lpTitle As String dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As Long hStdInput As Long hStdOutput As Long hStdError As Long End Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As Long End Type次に、ＶＢでCreateProcessを使うために関数宣言をします。
Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long何だか長ったらしい宣言文ですが、ＶＢでＡＰＩを使うためにはこの宣言が必要です。
ＶＢ６の場合は、アドインでＡＰＩビューアを追加するか、またはツールのＡＰＩビューアを起動すればこの宣言をコピーして使用できます。
余談ですが、．ＮＥＴの場合はＡｎｙの指定でエラーになってしまったのですが、ＮＵＬＬを指定する引数が多いので宣言を下記のようにして
エラー回避しました。
Public Declare Function CreateProcessLong Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Long, lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Long, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Longそれでは、CreateProcessを使用してWindowsの電卓を起動してみます。
Dim lRet As Long
Dim Pa As SECURITY_ATTRIBUTES
Dim Ta As SECURITY_ATTRIBUTES
Dim Si As STARTUPINFO
Dim Pi As PROCESS_INFORMATION
Si.cb = Len(Si)
CreateProcess(vbNullString, "C:\WINNT\SYSTEM32\CALC.EXE", Pa, Ta, 1&,
NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, Si, Pi)
If lRet = 0 Then
Call MsgBox("電卓が起動できませんでした。", vbCritical Or vbMsgBoxSetForeground)
End If
http://yokohama.cool.ne.jp/chokuto/urawaza/api/CreateProcess.html
■２重起動を防止する
いくつか方法があるみたいなのですが、ここではＡＰＩのFindWindowを使用してアプリが起動されているかチェックする方法を説明します。Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long１番目の引数にはクラス名、２番目の引数にはウィンドウ名を指定します。
指定したクラス名、ウィンドウ名のウィンドウが存在する時は、ウィンドウのハンドルが返ります。存在しない時は、ＮＵＬＬが返ります。
これを実行して起動中のアプリのウィンドウが存在するかチェックすれば、２重起動を防止できます。
ウィンドウ名は、起動済みアプリのタイトルバーの文字です。Spy++を使えば簡単にウィンドウ名等の情報が取得できます。
それでは、２重起動をチェックしてWindowsの電卓を起動してみます。
Dim lRet As Long
Dim hWnd As Long
Dim Pa As SECURITY_ATTRIBUTES
Dim Ta As SECURITY_ATTRIBUTES
Dim Si As STARTUPINFO
Dim Pi As PROCESS_INFORMATION
' 2重起動ﾁｪｯｸ
hWnd = FindWindow(vbNullString, "電卓")
If hwnd = 0 Then
Si.cb = Len(Si)
lRet = CreateProcess(vbNullString, "C:\WINNT\SYSTEM32\CALC.EXE", Pa, Ta, 1&,
NORMAL_PRIORITY_CLASS, ByVal 0&, vbNullString, Si, Pi)
If lRet = 0 Then
Call MsgBox("電卓が起動できませんでした。", vbCritical Or vbMsgBoxSetForeground)
End If
End If
■Spy++
ウィンドウの情報を取得するには、Spy++を使用します。ウィンドウメッセージを取得したり、ボタンの情報等が取得できます。以前は英語版だったのですが、最近は日本語ヘルプも表示されたりするのでかなり便利です。
（１） Spy++の起動
最初に、電卓の情報を表示してみます。電卓を起動後にSpy++を起動すると下記のような画面が表示されます。
たくさんのウィンドウの情報が表示されるので、この中から"電卓"と言う名前を探します。
左側の＋をクリックすると電卓の各パーツ（コントロール）が表示されると思います。
次にこの"電卓"の位置でマウスを右クリックするとポップアップウィンドウが表示されるので、「プロパティ」をクリックします。
ウィンドウキャプションに"電卓"の文字が表示されています。これがウィンドウ名です。
ウィンドウハンドルは、FindWindowを実行した時に返されるハンドルです。
上側のタブのクラスをクリックするとクラス名等の情報が表示されます。
（２） ウィンドウメッセージを見てみる
Ｗｉｎｄｏｗｓの画面処理では、WM_XXXXX というようなウィンドウメッセージが飛び交っています。
ボタンの上にマウスのポインタを移動させれば、そのボタンに「マウスが移動してきたぞ！」とメッセージが送られます。
左ボタンが押されれば「おまえの上で左ボタンが押されたぞ！」とメッセージが送られます。
Spy++で、このメッセージを見る事ができるのでやってみます。
最初に電卓のパーツ（コントロール）の１６進チェックボタンの上でマウスを右クリックしてポップアップの「メッセージ」をクリックします。
次にマウスを電卓アプリの１６進チェックボタンの上に静かに移動させます。ボタンの上にマウスが移動した瞬間にSpy++の
メッセージウィンドウに大量の情報が表示されると思います。これがボタンに関係するウィンドウメッセージです。
マウスがボタンの上に移動しただけで大量に送られるメッセージ．．．これが他のアプリを制御するミソです。
■制御したいコントロールのハンドルを取得する
ウィンドウ名が"hWndTest"、ボタンのクラス名が"Button"で、"OK"、"キャンセル"の２つのボタンが存在するアプリケーションからボタンのハンドルを取得する方法です。
ＡＰＩのGetWindowを使用してハンドルを取得しますが、GetWindowではハンドルが取得できるだけなので、実際には、
取得したハンドルからクラス名、ウィンドウ名を取得して、クラス名が"Button"でウィンドウ名が"OK"または"キャンセル"であると判断します。
Public Const WM_GETTEXT As Long = &HD
Public Const WM_GETTEXTLENGTH As Long = &HE
Public Const GW_HWNDNEXT As Long = 2
Public Const GW_CHILD As Long = 5
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String,
ByVal lpWindowName As String) As Long
Public Declare Function GetWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long,
ByVal wParam As Long, lParam As Any) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long,
ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long,
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
' ウィンドウ名を取得する
Public Function fnGetWindowName(hWnd As Long) As String
Dim lRet As Long
Dim stBuf As String
Dim byBuf() As Byte
lRet = SendMessage(hWnd, WM_GETTEXTLENGTH, 0, 0)
If lRet = 0 Then
fnGetWindowName = "": Exit Function
End If
ReDim byBuf(lRet + 2)
Call SendMessage(hWnd, WM_GETTEXT, lRet + 1, byBuf(0))
stBuf = fnByteToStr(byBuf(), lRet)
fnGetWindowName = stBuf
End Function
' クラス名を取得する(256文字まで)
Public Function fnGetClassName(hWnd As Long) As String
Dim i As Integer, j As Integer
Dim stBuf As String
Dim stClass As String * 260
stBuf = "": stClass = ""
i = GetClassName(hWnd, stClass, 256)
If i > 0 Then
j = InStr(stClass, Chr(0))
stBuf = Left(stClass, j - 1)
End If
fnGetClassName = stBuf
End Function
' バイト配列の文字列をString型文字列に変換する
Public Function fnByteToStr(byBuf() As Byte, lMax As Long) As String
Dim i As Long, j As Long
Dim stBuf As String
i = 0
Do While True
DoEvents
If byBuf(i) = 0 Then Exit Do
i = i + 1
Loop
stBuf = StrConv(MidB(byBuf, 1, i), vbUnicode)
fnByteToStr = stBuf
End Function
' コントロールのハンドルを取得する
Public Function fnGetWindowHandle(AppStr As String, ClassStr As String, NameStr As String) As Long
Dim hWnd As Long, hChild As Long
Dim stBuf As String, stClass As String
Dim bStart As Boolean
Dim lRet As Long
hWnd = FindWindow(vbNullString, AppStr) ' 親ウィンドウを探す
If hWnd > 0 Then
bStart = False
Do While True
DoEvents
If bStart = False Then
hChild = GetWindow(hWnd, GW_CHILD) ' 最初に最上位の子ウィンドウを取得
bStart = True
Else
hChild = GetWindow(hChild, GW_HWNDNEXT) ' 次の子ウィンドウを取得
End If
If hChild = 0 Then Exit Do
' クラス名とウィンドウ名を取得して比較する
stBuf = fnGetWindowName(hChild)
stClass = fnGetClassName(hChild)
If stClass = ClassStr And stBuf = NameStr Then
fnGetWindowHandle = hChild ' 一致した
Exit Do
End If
Loop
End If
End Function
' メイン処理
Public Sub Main()
Dim hWnd As Long
hWnd = fnGetWindowHandle("hWndTest", "Button", "OK")
End Sub
■コントロールにメッセージを送信する
コントロールのハンドルが取得できれば、SendMessage または PostMessage を使用してメッセージを送信します。エディットボックスの場合
Call SendMessage(hWnd, WM_SETTEXT, 0, "TEST")ボタンの場合
Call PostMessage(hWnd, WM_ACTIVATE, WA_ACTIVE, 0) Call PostMessage(hWnd, BM_CLICK, 0, 0)
http://yokohama.cool.ne.jp/chokuto/urawaza/api/SendMessage.html
http://yokohama.cool.ne.jp/chokuto/urawaza/api/PostMessage.html
■コントロールの状態を取得する
ＤＩＳＡＢＬＥ状態のコントロールにメッセージを送らないようにするために、ボタンやエディットボックスの表示状態を取得する方法です。ＡＰＩのGetWindowLongを使用して、ウィンドウに関する情報を取得します。
Public Const GWL_STYLE As Long = (-16)
Public Const WS_DISABLED As Long = &H8000000
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long,
ByVal nIndex As Long) As Long
Dim hWnd As Long, lRet As Long
Dim bSts As Boolean
' ここでhWndにコントロールのハンドルをセットしておく
lRet = GetWindowLong(hWnd, GWL_STYLE) ' ウィンドウスタイルを取得
If (lRet And WS_DISABLED) = WS_DISABLED Then
bSts = False ' DISABLE
Else
bSts = True ' ENABLE
End If
http://yokohama.cool.ne.jp/chokuto/urawaza/api/GetWindowLong.html
■ＸＰでの動作検証 2006/08/06追加
投票支援ソフトをＸＰで動作させた時に、投票データが正常にセットできない不具合を確認したので調査してみました。現象としては、ＰＡＴ起動後に投票画面が開いていない状態で自動投票ボタンを押して投票データをセットしようとすると、
最初から数回分の投票入力が遅延されて、
なおかつ途中のデータセットで”ずれ”のような現象が起こってエラーになってしまうという現象です。
この現象は、必ず毎回発生するわけではなく、正常に投票データがセットされる時もあります。
また、Ｗｉｎ２０００の開発環境では経験した事がありませんでした。
最初は、開発マシンにインストールされているウィルスチェックソフトの影響ではないかと思って、
ウィルスチェックソフトを停止した状態でテストしてみたのですが、特に現象が改善されるような事はありませんでした。
開発マシンでは、ＸＰのビジュアルスタイルを適用していたので、たまたまクラシックスタイルに変更してみたところ現象が
改善されたような気がしたのですが、その後も動作テストを続けていると、クラシックスタイルでも同様の現象が
確認されたので直接の原因ではなかったようです。
[ 不具合が発生する時の状態 ]
| ① | 投票画面が開いていない状態でＰＡＴメニューの”投票”ボタンにBM_CLICKメッセージを送信して投票画面を開くと、 画面は正常に開くが、その後、投票画面に送信するメッセージが遅延されたようになる。 ただし、他に起動されているアプリの状態で発生したり、発生しなかったりする。 |
| ② | BM_CLICKメッセージを送信して投票画面を開いた時に、タスクバーにウィンドウ名が表示されるのが遅い。 同様の操作を、手動でマウスを操作した時はすぐにタスクバーにウィンドウ名が表示される。 このタスクバーに表示されるまでの遅延時間が、①のメッセージ遅延時間のようである。 （投票画面を開くために送信するメッセージが足りないのでは．．．） |
| ③ | 投票画面での項目移動、データセットをする時にキーストロークをシュミレートして送信しているが、正常に動作しない時がある。 たとえば式別で枠連を選択したい時に、ウィンドウ名をチェックしながら右矢印キーをシュミレートしていたが、 この方法だと投票画面の表示更新が遅く、正常にセットされない時がある。 |
[ 対策 ]
投票画面で正常にデータ設定できない事を解決するために、キーストロークをシュミレートして送信するのではなく、
WM_LBUTTONDOWNとWM_LBUTTONUPを送信して項目をセットするように変更してみました。
この方法で項目設定するほうが確実のようです。
方法としては、APIのGetClientRectを使用してコントロールの座標を取得後、コントロールの中心座標を計算して
WM_LBUTTONDOWNとWM_LBUTTONUPを送信するものです。
' POINT構造体
Public Type POINT
X As Long
Y As Long
End Type
' RECT構造体
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' API宣言
Public Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
' コントロールの中心位置をクリックする
' hWndはコントロールのハンドル
Public Function fnClickItem(hWnd As Long) As Integer
Dim Rc As RECT
Dim Cent As POINT
Dim lParam As Long
Call GetClientRect(hWnd, Rc)
Cent.X = Rc.Left + ((Rc.Right - Rc.Left) \ 2)
Cent.Y = Rc.Top + ((Rc.Bottom - Rc.Top) \ 2)
lParam = (Cent.Y * 65536) + Cent.X
Call PostMessage(hWnd, WM_LBUTTONDOWN, MK_LBUTTON, lParam)
Call PostMessage(hWnd, WM_LBUTTONUP, MK_LBUTTON, lParam)
End Function
以上の対策をしたソフトをＷｉｎ９５／９８／２０００／ＸＰで動作させてみましたが正常に動作しました。若干、投票データのセットが早くなったように気がしますが、気のせいかもしれません。
今後は、投票画面を開いた後の遅延時間について調べてみたいと思います。
