「SQLログ取得.xls」Vectorのつづき。SQLConvert.exeのタスクトレイ入れ。今現在、どうしてもわからないことが1つ残っている。
「SQLログ取得.xls」Vectorのつづき。SQLConvert.exeのタスクトレイ入れ
１．SQLConvert.exeの立ち上がりの時間によりエラーが発生する。これにPGM的に対応する。（SendKeysなのでと思っていたら、AppActivateのエラーだった。そうか、SendKeysじゃエラーは出ないのだから、エラーが出るって事は自分でハンドリングできるってことだ。）
２．現在、最小化してあるが、タスクトレイに入れることにする。（自分的にはいろいろ試行錯誤の結果の最小化だったから納得していたが、エビデンスとるのに必ず最小化がエビデンスに入ってしまうのでまずい。）
ということでまた調査。この間これで2日ぐらいはまった。やっと落ち着いた（常駐化できた）のに。まだだめっていうこと。
これにともないいろいろな問題があったが、いい方向で収まった。でも今現在、どうしてもわからないことが1つ残っている。
＜＝タスクトレイに入っているSQLConvert.exeにどうやってSQL整形してもらうか。という、一番重要な部分。動かない。もう、難しい。（いろいろな組み合わせでGoogleったが）
- SendKeys "^q", Trueにタスクトレイに入っているSQLConvert.exeが反応しない。
- タスクトレイに入っているSQLConvert.exeはウインドウズハンドルが見つからない。以下のロジックが現在のウインドウズハンドルの一覧という（WEBから拾ってきた）のだが、この中に入っていない。ということはウインドウズハンドルでの操作はできない。
＜＝2/28 やっぱりどうにもならない。ざんねんだが最初の状態に戻すことにする。要するに常駐化してタスクトレイに入っているSQLConvert.exeをハンドリングするのは無理。という結論になった。
＜＝3/01 結局常駐化はやめた。最初の状態に戻した。”■Module8”は完全ボツなので削除した。
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare Function GetWindow Lib "user32" _
(ByVal hWnd As Long, ByVal uCmd As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nNameLength As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpText As String, ByVal nTextLength As Long) As Long
Private Const GW_HWNDFIRST = 0&
Private Const GW_HWNDLAST = 1&
Private Const GW_HWNDNEXT = 2&
Private Const GW_HWNDPREV = 3&
Private Const GW_OWNER = 4&
Private Const GW_CHILD = 5&
Sub GetVisibleWindows()
Dim hWndExcel As Long
Dim hWnd As Long
Dim nWndCnt As Long
Dim ClsName As String * 128
Dim WndName As String * 128
Dim rtn
hWndExcel = FindWindow("XLMAIN", Format$(Application.Caption))
hWnd = GetWindow(hWndExcel, GW_HWNDFIRST)
Do While hWnd <> 0
If IsWindowVisible(hWnd) <> 0 Then
nWndCnt = nWndCnt + 1
rtn = GetClassName(hWnd, ClsName, Len(ClsName))
Debug.Print nWndCnt & " （クラス名） " & Left(ClsName, InStr(1, ClsName, vbNullChar) - 1)
rtn = GetWindowText(hWnd, WndName, Len(WndName))
Debug.Print nWndCnt & " （タイトル） " & Left(WndName, InStr(1, WndName, vbNullChar) - 1)
End If
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Loop
End Sub今日の調査でできないことを除きいろいろ修正した。でも、これ、ボツになる予感。するとせっかくのソースたちがお蔵入りになって忘れ去られてしまうので、ここに記録しておくことにする。＜＝2/28 19：00 テストを繰り返したいたら、エクスプローラがハングした。一番怪しいのはTerminateProcess。強制終了とあるので。やっぱりこれも使えないみたいだ。
'■Module8
Option Explicit
' 2010/02/27 edit start 立ち上がってないとき、AppActivate SQLConvertでエラーが出るのでまだ待つように修正した。タスクトレイに入れた。直接修正
'----------------------------------------------------------------------------
'マウスのポインター移動
Private Declare Function SetCursorPos Lib "user32" _
(ByVal x As Long, ByVal y As Long) As Long
'----------------------------------------------------------------------------
'デスクトップウィンドウのサイズを取得する｡
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Const HORZRES = 8
Private Const VERTRES = 10
'----------------------------------------------------------------------------
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessID As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" ( _
ByVal hProcess As Long, _
ByVal uExitCode As Long _
) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long _
) As Long
Const SYNCHRONIZE = 1048576
Const NORMAL_PRIORITY_CLASS = &H20&
Const PROCESS_TERMINATE = &H1
Const PROCESS_QUERY_INFORMATION = &H400
'----------------------------------------------------------------------------
Dim hProcess As Long
' 2010/02/27 edit end 立ち上がってないとき、AppActivate SQLConvertでエラーが出るのでまだ待つように修正した。タスクトレイに入れた。直接修正
Dim SQLConvert As Variant
'SQLConvertを起動する
Sub SQLConvert_start()
Dim min, count
min = Application.Workbooks("SQLログ取得.xls").Worksheets("環境設定").Cells(6, 8)
If min <> "" And IsNumeric(min) Then
Else
min = 20 'デフォルト。20秒
End If
If min > 60 Then
min = 60 '60秒
End If
' 2010/02/27 edit start 立ち上がってないとき、AppActivate SQLConvertでエラーが出るのでまだ待つように修正した。タスクトレイに入れた。直接修正
' 自分が起動したSQLConvert.exeがあれば閉じる。
Call SQLConvert_end
' SQL成型
SQLConvert = Shell("C:\\PROGRA~1\\NodaSoft@\\SQLConvert\\SQLConvert.exe", vbNormalFocus)
hProcess = OpenProcess(SYNCHRONIZE Or PROCESS_TERMINATE, True, SQLConvert)
On Error GoTo ErrSQLConvert_start2
count = 0
MsgBox ("SQLConvert.exeを起動しています。" & min & "秒お待ちください。")
ErrSQLConvert_start1:
Application.wait Now + TimeValue("00:00:" & Format(min, "00")) 'min秒待つ
AppActivate SQLConvert
'Applicationキーによりショートカットメニューを表示する
Application.SendKeys "+{F10}", True 'SHIFT+F10
'DoEvents
Application.SendKeys "M", True 'タスクトレイに入れる。
'Application.SendKeys "% ", True 'ALT+SPACE
'Application.SendKeys "+N", True 'SHIFT+N '最小化
Exit Sub
ErrSQLConvert_start2:
count = count + 1
If count < 5 Then '4回以上かかったら終わりにする。
MsgBox ("SQLConvert.exeを起動しています。さらに" & min & "秒お待ちください。")
GoTo ErrSQLConvert_start1
End If
MsgBox ("SQLConvert.exeが起動できませんでした。手作業でメニューから起動してください。")
' 2010/02/27 edit end 立ち上がってないとき、AppActivate SQLConvertでエラーが出るのでまだ待つように修正した。タスクトレイに入れた。直接修正
End Sub
'SQLConvertを実行する
Sub SQLConvert_convert(min As Integer)
If min < 1 Then
min = 1 '1秒
ElseIf min > 60 Then
min = 60 '60秒
End If
' 2010/02/27 edit start タスクトレイに入れたので修正。
SendKeys "^q", True 'SQL整形。 ' ＜＝今日現在これが動かない。
'AppActivate SQLConvert
'SendKeys "{ENTER}", True '実行
' 2010/02/27 edit end タスクトレイに入れたので修正。
'min秒待つ。
Application.wait Now + TimeValue("00:00:" & Format(min, "00")) 'min秒待つ
End Sub
'SQLConvertを終了する
Sub SQLConvert_end()
If SQLConvert <> Empty Then '起動したSQLConvert.exeを起動したとき（通常値が入っているはず）
' 2010/02/27 edit start 立ち上がってないとき、AppActivate SQLConvertでエラーが出るのでまだ待つように修正した。タスクトレイに入れた。直接修正
' 補足：タスクトレイにあるからか、AppActivateでSendKeysはエラーになるので、TerminateProcessにした。
TerminateProcess hProcess, 0&
CloseHandle hProcess
SQLConvert = Empty
Call タスクトレイの終了SQLConvert消去
' 2010/02/27 edit end 立ち上がってないとき、AppActivate SQLConvertでエラーが出るのでまだ待つように修正した。タスクトレイに入れた。直接修正
End If
End Sub
' 2010/02/27 edit start 立ち上がってないとき、AppActivate SQLConvertでエラーが出るのでまだ待つように修正した。タスクトレイに入れた。直接修正
'強制終了にはTerminateProcessを使用しています。
'プロセスを終了させてもそいつのアイコンがタスクトレイに
'残ってしまいます。
'マウスカーソルをかざすと消えるのでこのように処理しています。
Private Sub タスクトレイの終了SQLConvert消去()
Dim a As Long
Dim x As Long
Dim y As Long
Dim x1 As Long
Dim y1 As Long
Dim n As Long
Dim T As Single
Dim T1 As Single
Dim hWnd As Long
Dim hDC As Long
Dim lngRet As Long
Dim lngWidth As Long
Dim lngHeight As Long
'デスクトップのウィンドウハンドルを取得
hWnd = GetDesktopWindow()
'デスクトップウィンドウのデバイスコンテキストを取得
hDC = GetDC(hWnd)
'幅と高さを取得
lngWidth = GetDeviceCaps(hDC, HORZRES)
lngHeight = GetDeviceCaps(hDC, VERTRES)
'デバイスコンテキストを開放
lngRet = ReleaseDC(hWnd, hDC)
x1 = lngWidth
y1 = lngHeight
a = SetCursorPos(x1, y1 * 0.98)
T1 = Timer
Do 'タイマーを入れる(重要)
T = Timer - T1
DoEvents
Loop Until T > 0.5
For n = 1 To 30 'アニメーション化
x = (x1 - 5 * n)
y = y1 * 0.98
a = SetCursorPos(x, y)
T1 = Timer
Do 'タイマーを入れる(重要)
T = Timer - T1
DoEvents
Loop Until T > 0.05
Next n
End Sub
' 2010/02/27 edit end 立ち上がってないとき、AppActivate SQLConvertでエラーが出るのでまだ待つように修正した。タスクトレイに入れた。直接修正補足：「タスクトレイの終了SQLConvert消去()」関数にコメント書いた。不思議なロジック。これでうまくいくのだ。手で「タスクトレイ」上でマウス動かしたときと同じ操作と同じになる。
02/27 15:00-19:00 21:00-04:30
02/28 19：30-19：30
02/01 02：00-02：00
