FC2ブログ

VBAでWebスクレイピング AlertボックスやShowModalウインドウをやっつけろ その1

通知バーもやっつけてます

さて、前回は
VBAやVBSでWebスクレイピング(結構本気のVBS版)
http://hymandr1200st.blog.fc2.com/blog-entry-1229.html
にて、VBAに制御を残しつつAlertボックスに対応するためのVBSについて書きました

今回はこれを実際に利用したサンプルについて書いてみたいと思います

なお、一度にすべてを書ききれない気がするので、まずは準備編ということでヨロ

〇やっつけるHTML等の準備
1.デスクトップにPopUpというフォルダを作ってください
2.前回書いたIECtrlSub.VBSをここに保存
3.後述するHTMLファイル2つをここに保存
4.次回記載予定のVBAを格納するxlsmファイル(名前は適当でかまいません)をここに保存

〇HTMLの動作確認
showModalDialog.htmlをIEで起動してください
あっ、お約束ですが、これIEでしか動作しません
window.showModalDialogはIE意外では廃止されています

そのPCのセキュリティー設定にもよりますが
showModalDialog.htmlを開くとJavaScriptを含むページを処理するかの「通知バー」が表示されると思います
今回は「ブロックされているコンテンツを許可」してください

つづいて、IEに表示されている「モーダルダイアログを開く」ボタンをクリック
すると、今回のテーマであるモーダルダイアログが表示されました
この状態で親ウインドウをクリックしてもモーダルダイアログに邪魔されて前面にならないことを確認してください

では表示されているモーダルダイアログの「自分自身のウインドウを閉じる」ボタンをクリック
WEBページからのメッセージというAlertボックスにhogeと表示されたはずです
ちなみにこのhogeはモーダルダイアログからの戻り値です

動作確認のポイントをまとめますと
Webスクレイピングでの課題とされてきた次の3要素をやっつけることを目的としています
1.UI通知バーへの応答
2.window.showModalDialogによるモーダルダイアログへの応答
3.Alertボックスへの応答

ちなみに、window.showModalDialogからAlertボックスへの応答が完了するまでは一連のJavaScriptで実行されているので、VBAで「モーダルダイアログを開く」をクリックしてはいけません
今回用意するVBAでは、「モーダルダイアログを開く」を先のIECtrlSub.VBSでクリックさせ、モーダルダイアログが表示されるのを待ち構えて処理するものです
なお、今回のサンプルではモーダルダイアログへの応答後に「必ずAlertボックスが表示される」前提で作っていますが、動作が不定の場合は何等か別の対策が必要となります

〇おまけ
UIオートメーション(通知バー)については日本語の資料が少なく
また、資料があっても難解です
今回はネットに転がっていた情報をつなぎ合わせたら動いた程度なので動作不良等もありうるところはご勘弁ください
また、以下に掲載するテスト用のHTMLもネットから拾ってきたものをそのまま掲載しました
作成者のページ(URL)を失念してしまいましたので記載できていません
情報がありましたらコメント願います

※以下のリンクをダウンロードまたはコピペしてください
親HTML
showModalDialog.html
親HTML
<html lang="ja">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<title>モーダルダイアログを開くサンプル</title>
<script type="text/javascript" charset="UTF-8">
  onload = function() {
    var btn = document.getElementById("btnOpen");
    btn.onclick = function() {
      var url = "ModalDialog.html";
      var winWidth = "400px";
      var winHeight = "300px";
      var options = "dialogWidth=" + winWidth + ";dialogHeight=\
  " + winHeight + ";center=1;status=1;scroll=1;resizable=1;\
  minimize=0;maximize=0;";
     
      // ボタンをグレーアウトする
      btn.disabled = true;
      var returnValue = showModalDialog(url, window, options);
      // 戻り値をアラート
      alert(returnValue);
    }
  }
</script>
</head>
<body>
<h1>モーダルダイアログを開くサンプル</h1>
<input type="button" id="btnOpen" value="モーダルダイアログを開く">
</body>
</html>


子HTML
ModalDialog.html
子HTML


<html lang="ja">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<title>モーダルダイアログ</title>
<script type="text/javascript" charset="UTF-8">
  onload = function() {
    // 自分自身のウインドウを閉じる
    document.getElementById("btnClose").onclick = CloseDialog;
    onunload = CloseDialog;
   
    function CloseDialog() {
      // 親ウインドウを取得する(IE用)
      if(!opener) {
        opener = dialogArguments;
      }
     
      // 親ウインドウのボタンのグレーアウトを解除する
      opener.document.getElementById("btnOpen").disabled = false;
      returnValue = "hoge";
      close();
    }
  }
</script>
</head>
<body>
<h1>モーダルダイアログ</h1>
<input type="button" id="btnClose" value="自分自身のウインドウを閉じる">
</body>
</html>
続きはまた次回に
( ̄ー ̄)/~~ジャ
関連記事

VBAやVBSでWebスクレイピング(結構本気のVBS版)

#VBSでオリジンを超える

さて前回は
Webスクレイピング準備 ウインドウやコントロールハンドルの列挙
http://hymandr1200st.blog.fc2.com/blog-entry-1228.html
にて

>ネットを検索すると「#32770をFindWindowしてSendKeysで応答せよ」といった的外れな(いや、失礼)回答しかなかったのでしばらく放置していた
と書きました

繰り返し申し上げます
「#32770をFindWindowしてSendKeysで応答せよ」は完全に的外れなんです!
「いま、地雷踏んだんだけど、だれか助けて!」と言っているのと同じ


と申しますのも
ページ上のJavaScriptによって表示されるAlertボックスやShowModalウインドウは
「それに対して誰かが応答しなければ制御がもとに戻らない」からです
そして、VBAやVBSは、特殊な例を除いてマルチスレッドな処理はできませんので。地雷を踏んだ瞬間、手も足も出せないのです

この対策をネットで検索すると
1.ページにニセのAlert関数を追加する(本当のAlertダイヤログを出させない)
2.Alertボックス表示を含むJavaScriptを遅延起動する
あたりが有名ですが

σ(゚∀゚)ワタシの職場の場合
1は、ベンダーのプログラムを書き換えることになるので契約違反
2は、セキュリティー対策ではじかれました

あくまでも、IEに対し「外側から(人間のようにふるまって)制御する」ことが求められています

そこで考えたのが
VBAからVBSを起動して「これ、やっつけといて」作戦

VBAで制御中のIEであれば、IEのハンドルは取得できているので
「このハンドルを持つIEをShellで探して、見つけたらJavaScriptを起動するクリックしといてな!」
というもの

ポイントとしては
1.VBSを呼び出す側で非同期でVBSを起動し(制御をVBSに渡さない)
2.依頼されたVBSが目的のクリックを実行するとIE.Busyになるのを着目し
3.依頼元がIE.Busyになるまでループでまって
4.Alertボックスに応答する

このうち、4のAlertボックスへの応答では
SendKeysのような誤爆覚悟の不安定なものではなく
前回記事にかいたようなAPIを利用して確実にPostMessageで対応すべきところと考えます


さて、以上のロジックについては、すでに職場のPCで実装すみなのですが
今回は呼ばれる側のVBSをつくっていて、ついつい脱線した作品をアップしておきます

元々の仕様であれば、おそらく50行ぐらいのVBSでできたはずなんですが(笑)
なかでも、VBSでオリジンを超えるロジックがおもしろいかな

この下からデスクトップにVBSというフォルダを作って以下の3つのVBSファイルを保存
●IECtrlSub.VBS
Option Explicit
'-------------------------------------------------------------------------------
' VBAなどで制御中のIEに対しAlertボックスなどの応答を求めるJavaScriptが起動されると
' これを起動した本人に制御が戻るのは、応答した後になります
' このVBSはIEを制御中のVBAなどから「非同期」で起動することにより
' (処理が反映されるのを待つ必要はありますが)起動元が制御を失わず処理を続行できる
' ように作りました
' でね、作り込んでいるうちに「これってVBAいらねんじゃね」ってぐらい多機能に(汗)
'-------------------------------------------------------------------------------

'●最初に
'このVBSが処理の対象にできるのは常に最後に捕まえたひとつのIEです
'命令によって次々にIEを開くことはできても新たにIEを捕まえた時点で過去の参照は廃棄されます
'唯一の例外として、PushIEとPopIEの組み合わせでは捕捉中IEを一時退避・復帰させています
'これは親子関係にある別窓の処理を想定したものです

'●命令の基本
'コマンドラインの引数に以下の形式でセットします
'"Set Text \スケスケ パンティー\ ID yschsp 0"

'1.命令はダブルコーテーションで囲む
'2.先頭に命令内容、続けて命令の捕捉項目を必要なだけ空白区切りで加える
'3.捕捉項目に\や空白を含む場合は\で囲む(エスケープシーケンス)
'4.捕捉項目に\を含む場合は\\とする
'5.ダブルコーテーションで囲んだ上記の命令を空白区切りで複数追加すれば連続動作となる
' コマンドラインにて(パスはデスクトップのVBSというフォルダを想定)
' CScrip_%USERPROFILE%\Desktop\VBS\IECtrlSub.VBS_"命令1"_"命令2"_"命令3" (アンダーバーはスペースの意)

'●命令例 先頭は命令定数 数字:は詳細番号
'IE項目操作系
'0:Set 1:Text 2:Value 3:検索方法 4:検索値 5:IDX 指定した項目に文字列をセット
'0:Set 1:Index 2:Value 3:検索方法 4:検索値 5:IDX 指定した項目のListIndexをセット
'0:Focus 1:検索方法 2:検索値 3:IDX 指定した項目にフォーカスをセット
'0:Click 1:検索方法 2:検索値 3:IDX 指定した項目をクリック
'0:FireEvent 1:EventName 2:検索方法 3:検索値 4:IDX 指定した項目にイベントを発砲
' Node検索においてIDで検索する場合は、本来IDXは不要ですが書式の統一のため0などを設定してください

'IE自身操作系
'0:IEGETH 1:ハンドル ハンドル指定でIE取得
'0:IEGETT 1:タイトル タイトル指定でIE取得
'0:NEWIE 新規IEを開く
'0:Go 1:URL 指定したURLにページ変遷
'0:IEQ 捕捉中のIEを終了
'0:WBIE 1:Busy状態 True or else 2:タイムアウト 指定したIEのBusyが指定状態になるまで待機
'0:PushIE その時点で捕まえているIEを退避
'0:PopIE 退避したIEを復帰
'0:WFIE 1:画面タイトル 2:タイムアウト タイトル指定でIEが見つかるまで待機
'0:WLIE 1:画面ハンドル 2:タイムアウト ハンドル指定でIEが喪失するまで待機(省略時は保持中のIE)
'0:ExGblFnc 1:関数定義ファイルのパス グローバル関数を動的に宣言します
'0:Exec 1:関数定義ファイルのパス グローバル関数を動的に宣言しかつ起動します
'0:GetRefS 1:EventType 2:起動関数 3:検索方法 4:検索値 5:IDX ノードにイベントをしかけます
'0:GetRefW イベント待ちループ

'特殊命令系
'0:Sleep 1:指定ミリ秒お休み スリープ
'0:WACTP 1:プロセスID プロセスID指定でウインドウを最前面にする
'0:WACTT 1:ウインドウタイトル(Documentではない) タイトル指定でウインドウを最前面にする
'0:SendInt 1:指定ミリ秒 SendKeysの送信間隔(初期値0.5秒)
'0:SendKeys 1:スペース区切りの送信データ 略
'0:CallMeIni 1:同期非同期の別 2:親IEのハンドル指定 3:Logファイル CallMe動作時の環境変更
' CallMe動作時の環境はVBS起動時に以下の初期値を持っているので変更が無ければ省略可能です
' 1同期実行 2利用中のIEハンドルを強制する 3Logファイルを指定しない
' Logファイル指定に\や空白が入るときは以下のようにエスケープ処理をする
' Logファイル指定例 \Log=>>D:\\log.txt\
'0:CallMe 1:必要な命令郡 自VBSを外部VBSとして別起動します

'●起動例1
'新規にIEを取得してヤフオクページに移動し、検索文字をセット、検索ボタンをクリック
'1 CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS "NewIE"
'2 CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS "GO https://auctions.yahoo.co.jp/"
'3 CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS "Set Text \スケスケ パンティー\ ID yschsp 0"
'4 CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS "Click ID acHdSchBtn 0"
' 5では4のボタンクリックに変えてイベント発砲で処理することもできます
'5 CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS "FireEvent OnClick ID acHdSchBtn 0"

'●起動例2
'上記1から4の命令を1回の起動で処理する
'6 CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS /WaitB:500 /WaitA:1000 "NewIE" "GO https://auctions.yahoo.co.jp/" "Set Text \スケスケ パンティー\ ID yschsp 0" "Click ID acHdSchBtn 0"
' 名前付き引数Waitは連続動作の時間間隔です、'事前、事後待ち時間の調整をします
' 基本命令を連続動作させる場合の調整に利用( /WaitB:事前 /WaitA:事後 数字はミリ秒)
' 名前付き引数は引数のどの位置にいれても構いません
' 引数の長さは、一説には260文字と聞きましたがうちのテストではそれ以上長くてもOKでした

'7 CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS "NewIE" "WACTP 0" "SendInt 1000" "SendKeys {tab} https://auctions.yahoo.co.jp/ {enter}"
' SendKeysは続くスペース区切りの各項目を最前面のウインドウに送信します
' 上記の例ではIEを新規に開き、IEを最前面にして、キーの送信間隔を1秒(初期値0.5秒)に設定
' tabキー送信によりアドレスバーにフォーカスを移動、URLを入力してエンター

'8 以下は同期CallMeのサンプルです
' CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS "NewIE" "CallMeIni Handle \Log=>>G:\\Log2.txt\" "CallMe \GO https://auctions.yahoo.co.jp/\ \Set Text \\スケスケ パンティー\\ ID yschsp 0\ \Click ID acHdSchBtn 0\" "GO https://auctions.yahoo.co.jp/" "Set Text \防水 グローブ\ ID yschsp 0" "Click ID acHdSchBtn 0"

' CallMe命令はこのVBSを外部ファイルとして別に起動するものです
' VBAからVBSを起動するのと同じ考えによるもの
' 上記の例では、新規にIEを開き、CallMeIniにより、CallMe動作時の環境を
' 捕まえているIEを特定(Handle)し、ログファイルをGドライブにlog2.txtとする環境設定を実施
' \エスケープの使い方に注意してください
' つづくCallMe命令では初期値の同期モードでCallMeを起動
' (CallMeが同期実行なので)終了後にそのIEで別検索して終了
' SleepやWaitとSendKeysを組み合わせて非同期起動すると幸せになれるかもしれません
' 5分後に今開いているIEにAlt+F4を送るとか、OKボタンを押すとか

'9 以下は非同期CallMeのサンプルです
'ヤフオク、ヤフートップの順で新規IEを開きます(この時点で捕まえているIEはヤフートップです)
'PushIEは捕まえているヤフートップを退避します。続くWFIEではタイトル指定でヤフオクのIEを取りに行き
'必要な検索を実施します。(この時点で捕まえているIEはヤフオクです)
'CallMe動作環境を非同期にセットし、ヤフオクのIEで別の検索を非同期に実施後終了させます
'非同期起動なので、すぐに次の命令が実施されます。PopIEはで退避していたヤフートップIEを復帰させます
'復帰したIE(ヤフートップ)をグーグルに変遷します。画面の動きを確認のため1秒待機
'どうでしょう?動作環境にもよると思いますが、CallMeのなかで終了命令がだされたIEの方が後に終了しませんでしたか

' CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS "NewIE" "GO https://auctions.yahoo.co.jp/" "NewIE" "GO https://www.yahoo.co.jp/" "PushIE" "WFIE \ヤフオク! - 日本最大級のネットオークション・フリマアプリ\ 10" "Set Text \防水 グローブ\ ID yschsp 0" "Click ID acHdSchBtn 0" "CallMeIni NoSync \Log=>>G:\\Log.txt\" "CallMe \GO https://auctions.yahoo.co.jp/\ \Set Text \\スケスケ パンティー\\ ID yschsp 0\ \Click ID acHdSchBtn 0\ \IEQ\" "PopIE" "Go https://www.google.com/?hl=ja" "Sleep 1000" "IEQ"

'10 GetRefSとGetRefWは開発途中のものです。下記起動例とこのVBSソースのコメントを見てご検討ください
' CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS "NewIE" "GO https://auctions.yahoo.co.jp/" "Set Text \スケスケ パンティー\ ID yschsp 0" "GetRefS onclick getrefBrake ID ygmhlog 0" "GetRefS onclick getref01 ID acHdSchBtn 0" "GetRefW"
' ヒント、左上のヤフオク!画像ボタンをクリックすると待機を終了します

'11 以下の例は外部VBSファイルを動的に読み込んで中に記述されているmyFunction実行するものです
' MyFunction.VBSファイルの中にはコンパイルエラーの無いmyFunctionという名のSubまたはfunctionが必須です
' CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS "Exec %USERPROFILE%\Desktop\VBS\MyFunction.VBS"

'12 以下の例はオリジン制限を超えたIEの連携を実現します
' それぞれのドメインが違うサイトをこのVBSが連携します
' CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS "ExGblFnc %USERPROFILE%\Desktop\VBS\GetRefLib.VBS" "NewIE" "GO https://search.rakuten.co.jp/search/mall/" "Set Text \三角ビキニ\ ID ri-cmn-hdr-sitem 0" "GetRefS OnClick GetRefRAK2YH ID ri-cmn-hdr-button 0" "PushIE" "NewIE" "GO https://auctions.yahoo.co.jp/" "Set Text \スケスケ パンティー\ ID yschsp 0" "GetRefS OnClick GetRefYH2RAK ID acHdSchBtn 0" "GetRefW"

'●VBAから起動する場合 上記文字列を変数に入れて起動します
'strCmd = 上記文字列 ダブルコーテーションの数に注意ね:間違いやすいです
'Call = Shell(strCmd)

'●参考
'バッチファイルから起動する場合 まさか使う人はいないと思いますが(笑)一応動きます
'命令の動作確認にはCMD.exeコンソールのコマンドラインから起動し、コンソールログを見ると便利です
'コンソールでの起動時に標準出力をファイルにする(>>G:\Log.txt)をつけると
'コンソールの標準出力がテキストファイルになるので連続動作の確認などが楽になります

Dim GBL_objIE 'インターネットエクスプローラー
Dim GBL_binIEFlg 'IE取得の有無
Dim GBL_objOldIE '退避用インターネットエクスプローラー
Dim GBL_binGetRefWait

Call Main()

'-------------------------------------------------------------------------------
'Main
'-------------------------------------------------------------------------------
Private Sub Main()
'オブジェクト等を格納する変数
Dim i '作業用添え字
Dim j '作業用添え字
Dim rtn '作業用戻り値
Dim lngWaitBefore '事前待ち時間
Dim lngWaitAfter '事後待ち時間
Dim lphWnd 'IE特定のハンドル
Dim lngPID '作業用プロセスID
Dim lngSendInt 'SendKeyの送信間隔

'CallMe動作環境変数
Dim intCallMeSync '起動モード
Dim intCallMeHandle 'ハンドル指定モード
Dim strCallMeLog 'LogFile指定
'CallMe動作環境変数初期化
intCallMeSync = 0 '同期実行
intCallMeHandle = 0 '利用中のIEハンドルを強制する
strCallMeLog = "" 'Logファイルを指定しない

'-------------------------------------------------------------------------------
'引数全体の確認
'-------------------------------------------------------------------------------
If WScript.Arguments.Count = 0 then
WScript.echo(Now & " " & "引数をセットしてください")
WScript.Quit(-1) 'エラーを返す
End If

'事前待ち時間調整
lngWaitBefore = 0
If WScript.Arguments.Named.Exists("WaitB") Then
'強制数値変換
lngWaitBefore = CNum("L",WScript.Arguments.Named.Item("WaitB"),0)
End If

'事後待ち時間調整
lngWaitAfter = 0
If WScript.Arguments.Named.Exists("WaitA") Then
'強制数値変換
lngWaitBefore = CNum("L",WScript.Arguments.Named.Item("WaitA"),0)
End If

'-------------------------------------------------------------------------------
'命令郡を無名引数から取得
'(ほとんどエラーチェックをしていませんのでご自身で動作を検証ください)
'-------------------------------------------------------------------------------
Dim strTemp() '引数配列
ReDim strTemp(0)
If WScript.Arguments.Unnamed.Count > 0 Then
For i = 0 To WScript.Arguments.Unnamed.Count - 1
ReDim Preserve strTemp(i) '領域拡張
strTemp(i) = WScript.Arguments.Unnamed(i)
WScript.echo(Now & " " & "Your Order" & i + 1 & " : " & WScript.Arguments.Unnamed(i))
Next
End If

'-------------------------------------------------------------------------------
'引数配列から命令配列の生成と命令の実行
'-------------------------------------------------------------------------------
'初期化
Dim strOrder() '命令配列
ReDim strOrder(0)
GBL_binIEFlg = False
Dim strMSG
Dim objNode

For i = 0 To UBound(strTemp)
'--------------------------------------
'エスケープ文字に対応して項目の切り出し
'--------------------------------------
'空白区切りで項目を取り出す
'ただし\で囲まれた空白は区切りとみなさない
'CSVの展開にも使えるロジックです
Call SplitByDLM(strTemp(i), strOrder, " ", "\")

'--------------------------------------
'処理メッセージ
'--------------------------------------
strMSG = "Now:"
For j = 0 To UBound(strOrder)
strMSG = strMSG & " " & j & ":" & strOrder(j)
Next
WScript.echo(Now & " " & strMSG)

'--------------------------------------
'事前待ち時間調整
'--------------------------------------
If lngWaitBefore <> 0 Then
WScript.Sleep lngWaitBefore
End If

'--------------------------------------
'命令の実行
'--------------------------------------
Select Case UCase(strOrder(0)) '命令配列の先頭を取り出して大文字に統一

'----IE自身操作系
Case "IEGETH"
GBL_binIEFlg = IEGet("H",strOrder(1),GBL_objIE) 'ハンドル指定でIE取得

Case "IEGETT"
GBL_binIEFlg = IEGet("T",strOrder(1),GBL_objIE) 'タイトル指定でIE取得

Case "NEWIE" '新規IEを開く
Set GBL_objIE = WScript.CreateObject("InternetExplorer.Application", "objIE_")
GBL_objIE.Navigate "about:blank"
GBL_objIE.Visible = True
GBL_binIEFlg = True

Case "GO" 'ページの移動
Call WaitIE(GBL_objIE)
GBL_objIE.Navigate strOrder(1)
rtn = True

Case "IEQ" '捕捉中のIEを終了
GBL_objIE.Quit
GBL_binIEFlg = False

Case "PUSHIE" '捕捉中のIEを退避
Set GBL_objOldIE = GBL_objIE

Case "POPIE" '退避中のIEを復帰
Set GBL_objIE = GBL_objOldIE

Case "WBIE" '指定したIEのBusyが指定状態になるまで待機
'AlertやDhowModal表示中のIEは常にBusyなので処理を待機できます
rtn = WaitBusyIE(strOrder(1),CNum("I",strOrder(2),1))

Case "WFIE" 'タイトル指定でIEが見つかるまで待機
rtn = WaitFindIE(strOrder(1),CNum("I",strOrder(2),1))

Case "WLIE" 'ハンドル指定でIEが喪失するまで待機
'1:ハンドル 2:タイムアウト
lphWnd = CNum("L",strOrder(1),0)
If lphWnd = 0 Then 'ハンドル指定が無ければ捕捉中のIE
If GBL_objIE Is Nothing Then 'すでに捕捉中のIEがなければなにもしない
Else
rtn = WaitLostIE(GBL_objIE.hWnd,CNum("I",strOrder(2),1))
End If
Else
rtn = WaitLostIE(lphWnd,CNum("I",strOrder(2),1))
End If
Case "EXGBLFNC" 'グローバル関数を動的に宣言します
rtn = ExecuteGlobalFunc(strOrder(1))

Case "EXEC" 'グローバル関数を動的に宣言します
rtn = ExecProc(strOrder(1))

Case "GETREFS" 'ノードにイベントをしかけます
Call GetIEElement(GBL_objIE,strOrder(3),strOrder(4),strOrder(5),objNode)
rtn = GetRefSet(objNode,strOrder(1),strOrder(2))

Case "GETREFW" 'GBL_binGetRefWait=Trueになるまでループします
'GetRefBrakeはGetRefSetでIEのどこかにセットしてください
Call GetRefWait(GBL_objIE)

'----特殊命令系
Case "SLEEP" 'スリープ
WScript.Sleep CNum("L",strOrder(1),1000)

Case "WACTP" 'プロセスID指定でウインドウを最前面にする
lngPID = CNum("L",strOrder(1),0)
Call WinActByPID(lngPID)

Case "WACTT" 'タイトル指定でウインドウを最前面にする
Call WinActByTitle(strOrder(1))

Case "SENDINT" 'キーの送信間隔設定
lngSendInt = CNum("L",strOrder(1),500)

Case "SENDKEYS" '最前面のウインドウにキーを送信(漢字対応)
Call SendKeysProc(lngSendInt,strOrder)

Case "CALLMEINI" 'CallMe動作環境設定
Call CallMeIniProc(intCallMeSync,intCallMeHandle,strCallMeLog,strOrder)

Case "CALLME" '自スクリプトを外部スクリプトとして起動
Call CallMeProc(intCallMeSync,intCallMeHandle,strCallMeLog,strOrder)

'----IE項目操作系
Case Else 'IEの項目操作命令郡
If GBL_binIEFlg = False Then 'IEが未取得なら取りに行く
GBL_binIEFlg = IEGet("",0,GBL_objIE)
End If

'IEを見つけたかチェック
If GBL_binIEFlg = False Then
Call ABEND("指定されたIEが見つかりません",strOrder)
End If

'IEの利用可能状態まち
Call WaitIE(GBL_objIE)

'操作対象取得
If GetIENodeProc(UCase(strOrder(0)),strOrder,objNode) = False Then
Call ABEND("操作対象エラー",strOrder)
End If

'対象の操作
If SetIENodeProc(UCase(strOrder(0)),strOrder,objNode) = False Then
Call ABEND("対象の操作エラー",strOrder)
End If

End Select

'--------------------------------------
'事後待ち時間調整
'--------------------------------------
If lngWaitAfter <> 0 Then
WScript.Sleep lngWaitAfter
End If

Next

Set GBL_objIE = Nothing
Set GBL_objOldIE = Nothing

WScript.echo(Now & " " & "正常終了")
WScript.Quit(0) '正常終了を返す

End Sub

'-------------------------------------------------------------------------------
'IE取得
'-------------------------------------------------------------------------------
Private Function IEGet(strMode,strKey,prmIE)
Dim objShell 'シェル
Dim objWindow 'シェルのウインドウ
Dim tempIE '作業用IE
Dim lphWnd

'戻り値初期化
Set prmIE = Nothing
IEGet = False

'シェルのオブジェクトを作成する
Set objShell = CreateObject("Shell.Application")

'ハンドル指定時のハンドル整形
If UCase(strMode) = "H" Then
lphWnd = CNum("L",strKey,0)
End If

'イベント取得IE
Set tempIE = WScript.CreateObject("InternetExplorer.Application", "objIE_")

'シェルのウインドウを検査
For Each objWindow In objShell.Windows
'TypeNameでオブジェクト変数のタイプが'HTMLDocumentだったらIEだ

On Error Resume Next '実行時エラー対策(TypeNameが実行時エラーになるときがある)
Dim strTemp
strTemp = TypeName(objWindow.document)
'WScript.echo(Now & " " & strTemp)
On Error Goto 0 '実行時エラー対策終了

If strTemp = "HTMLDocument" Then

'見つけたウインドウを(IE)を代入
Set tempIE = objWindow

Select Case UCase(strMode)
Case "T"
If tempIE.document.Title = strKey Then
IEGet = True
Set prmIE = tempIE
Exit For
End If

Case "H"
'IEハンドルの指定が0なら最初に見つけたIEに動作します
If lphWnd = 0 Then
IEGet = True
Set prmIE = tempIE
Exit For
Else
'見つけたウインドウのハンドルが引数のハンドルに一致するか
If tempIE.hWnd = lphWnd Then

IEGet = True
Set prmIE = tempIE
Exit For
End If
End If
Case Else
IEGet = True
Set prmIE = tempIE
Exit For

End Select
End If
Next

'使ったObjectの解放
Set tempIE = Nothing
Set objShell = Nothing
Set objWindow = Nothing

End Function

'-------------------------------------------------------------------------------
'IE状態待ち
'-------------------------------------------------------------------------------
Private Sub WaitIE(prmIE)
'IEのウインドウ状態の確認
' Alertボックスの表示中とかだと、そもそもIEの操作が不能なのでここで止まります
Do While (prmIE.Busy) Or (prmIE.readyState < 4)
WScript.Sleep 100
Loop

'IEドキュメントの状態確認
Do While prmIE.document.readyState <> "complete"
WScript.Sleep 100
Loop
End Sub

'-------------------------------------------------------------------------------
'操作対象の取得
'-------------------------------------------------------------------------------
Private Function GetIENodeProc(UOrder,strOrder,objNode)
'命令の出し方には様々なバリエーションが考えられます
'必要があれば以下の部分を改良してください

'命令例 先頭は命令定数 数字:は引数添え字番号
'0:Set 1:Text 2:Value 3:検索方法 4:検索値 5:IDX 指定した項目に文字列をセット
'0:Set 1:Index 2:Value 3:検索方法 4:検索値 5:IDX 指定した項目のListIndexをセット
'0:Focus 1:検索方法 2:検索値 3:IDX 指定した項目にフォーカスをセット
'0:Click 1:検索方法 2:検索値 3:IDX 指定した項目をクリック
'0:FireEvent 1:EventName 2:検索方法 3:検索値 4:IDX 指定した項目にイベントを発砲


GetIENodeProc = False

Select Case UOrder
Case "SET" '値のセット
GetIENodeProc = GetIEElement(GBL_objIE,strOrder(3),strOrder(4),strOrder(5),objNode)
Case "FOCUS" 'フォーカスを与える
GetIENodeProc = GetIEElement(GBL_objIE,strOrder(1),strOrder(2),strOrder(3),objNode)
Case "CLICK" 'クリック
GetIENodeProc = GetIEElement(GBL_objIE,strOrder(1),strOrder(2),strOrder(3),objNode)
Case "FIREEVENT" 'イベント発砲処理
GetIENodeProc = GetIEElement(GBL_objIE,strOrder(2),strOrder(3),strOrder(4),objNode)
Case "GETREFS" 'ノードにイベントをしかけます
GetIENodeProc = GetIEElement(GBL_objIE,strOrder(3),strOrder(4),strOrder(5),objNode)
Case "GETREFW" 'ノードにイベントをしかけて待機します
GetIENodeProc = GetIEElement(GBL_objIE,strOrder(3),strOrder(4),strOrder(5),objNode)
End Select

End Function

'-------------------------------------------------------------------------------
'対象の操作
'-------------------------------------------------------------------------------
Private Function SetIENodeProc(UOrder,strOrder,objNode)

SetIENodeProc = False

Select Case UOrder
Case "SET" '値のセット
SetIENodeProc = SetValue(objNode,strOrder(1),strOrder(2))
Case "FOCUS" 'フォーカスを与える
objNode.focus
SetIENodeProc = True
Case "CLICK" 'クリック
objNode.click
SetIENodeProc = True
Case "FIREEVENT" 'イベント発砲処理
SetIENodeProc = FireEvent(objNode,strOrder(1))
End Select
End Function

'-------------------------------------------------------------------------------
'操作対象項目を得る
'-------------------------------------------------------------------------------
Private Function GetIEElement(objNode,strType,strName,strIDX,rtnItem)
'操作対象項目の取得

GetIEElement = False '戻り値初期化

'Nodeインデックス整形
Dim intIDX
intIDX = CNum("I",strIDX,0)

On Error Resume Next '実行時エラー対策

Select Case UCase(strType) '大文字に統一
Case "ID"
Set rtnItem = objNode.Document.GetElementByID(strName)
Case "TAGNAME"
Set rtnItem = objNode.Document.GetElementsByTagName(strName)(intIDX)
Case "CLASSNAME" 'Not For IE
Set rtnItem = objNode.Document.GetElementsByClassName(strName)(intIDX)
Case "NAME"
Set rtnItem = objNode.Document.GetElementsByName(strName)(intIDX)
Case Else
GetIEElement = False
End Select

On Error Goto 0

'操作対象項目の確認
If IsEmpty(rtnItem) Then

ElseIf rtnItem Is Nothing Then

Else
GetIEElement = True
End If

End Function

'-------------------------------------------------------------------------------
'値のセット
'-------------------------------------------------------------------------------
Private Function SetValue(objItem,strCmd,strValue)
'セットタイプの制御

SetValue = False '戻り値初期化

Select Case UCase(strCMD) '大文字に統一
Case "TEXT"
objItem.Value = strValue
SetValue = True
Case "INDEX"
objItem.selectedIndex = Cint(strValue)
SetValue = True
End Select

End Function

'-------------------------------------------------------------------------------
'イベント発砲処理
'-------------------------------------------------------------------------------
Private Function FireEvent(objItem,strOrder)

FireEvent = True '戻り値初期化

Dim objEVT 'イベントオブジェクト
Set objEVT = GBL_objIE.document.createEvent("HTMLEvents")

'副命令の制御
strOrder = UCase(strOrder) '大文字に統一
Select Case strOrder
Case "ONSELECT"
objEVT.initEvent "select", True, False
Case "ONCHANGE"
objEVT.initEvent "change", True, False
Case "ONSUBMIT"
objEVT.initEvent "submit", True, False
Case "ONFOCUS"
objEVT.initEvent "focus", True, False
Case "ONCLICK"
objEVT.initEvent "click", True, False
Case "ONMOUSEDOWN"
objEVT.initEvent "mousedown", True, False
Case "ONMOUSEUP"
objEVT.initEvent "mouseup", True, False
Case "ONMOUSEOVER"
objEVT.initEvent "mouseover", True, False
Case "ONMOUSEOUT"
objEVT.initEvent "mouseout", True, False
Case Else
FireEvent = False '戻り値設定
End Select

If FireEvent = True Then
objItem.dispatchEvent objEVT 'イベント発砲
End If

Set objEVT = Nothing
End Function

'-------------------------------------------------------------------------------
'異常終了
'-------------------------------------------------------------------------------
Private Sub ABEND(strMSG,strData)
Dim i

If IsArray(strData) Then
For i = 0 To UBound(strData)
strMSG = strMSG & " " & i & ":" & strData(i)
Next
Else
strMSG = strMSG & strData
End If

WScript.echo(Now & " " & strMSG)
WScript.Quit(-1) 'エラーを返す

End Sub

'-------------------------------------------------------------------------------
'SendKey実行
'-------------------------------------------------------------------------------
Private Sub SendKeysProc(lngSendInt,arKeys)
'最前面ウインドウにキーを送信します
'メモ
'SendKeys "ABC" A→B→Cとキーを押した
'SendKeys "{ENTER}" Enterキーを押した
'SendKeys "{F2}" [F2]キーを押した
'SendKeys "+(AB)" Shiftキーを押しながらA→Bと押した
'SendKeys "%{F4}" Alt+[F4]キーを押した

Dim objWsh
Set objWsh = WScript.CreateObject("WScript.Shell")

DIm i
Dim strKey
Dim strCMD

'IEでキー入力を再現する
'指定されたキーの数だけループ
For i = 1 To UBound(arKeys) 'arKeys(0)はSendKeysが入っている
strKey = arKeys(i)
'漢字が混じっていればクリップボード経由でキーを送る
If Len(strKey) <> LenByte(strKey) Then
WScript.echo(Now & " " & "Send漢字:" & strKey)
'クリップボードに文字を送る
strCMD = "cmd.exe /c Echo " & strKey & " | Clip"
Call objWsh.Run(strCMD,0,True) '同期実行
'Cntl+Vで送信
objWsh.SendKeys "^v"
Else
WScript.echo(Now & " " & "SendASC:" & strKey)
objWsh.SendKeys strKey
End If
WScript.Sleep lngSendInt
Next

Set objWsh = Nothing

End Sub

'-------------------------------------------------------------------------------
'漢字文字含むかを長さで判定
'-------------------------------------------------------------------------------
Private Function LenByte(strValue)

Dim i
Dim strTemp
Dim bytes
Dim code

LenByte = 0

If Trim(strValue) <> "" Then
For i = 1 To Len(strValue)
strTemp = Mid(strValue, i, 1)
bytes = 1
code = AscW(strTemp)
If (code And &HFF00) <> 0 Then
'半角カタカナ以外は、2バイト
If (code < &HFF61) or (code > &HFF9F) Then
bytes = 2
End If
End If
LenByte = LenByte + bytes
Next
End If

End Function

'-------------------------------------------------------------------------------
'WinActByTitle
'-------------------------------------------------------------------------------
Private Function WinActByTitle(strTitle)
'指定したウインドウタイトルのウインドウを最前面にする
'完全一致するものがなければ、その文字がタイトルに含まれるものを最前面にする
'誤爆注意
'ドキュメントのタイトルではなく、ウインドウのタイトル

WinActByTitle = True

Dim objWsh
Set objWsh = WScript.CreateObject("WScript.Shell")

'プロセスの最前面化
Dim timeOut
timeOut = Now + TimeSerial(0, 0, 5)

'見つけたプロセスを最前面に表示
Do While Not objWsh.AppActivate(strTitle)
WScript.Sleep 500
If Now > timeOut Then
WScript.echo(Now & " " & "指定されたIEをアクティブにできませんでした:" & strTitle)
WScript.echo(Now & " " & "Alertボックスなどに邪魔されていませんか?")
WScript.Quit (-1) 'エラーを返す
WinActByTitle = False
Exit Do
End If
Loop

Set objWsh = Nothing

End Function

'-------------------------------------------------------------------------------
'WinActByPID
'-------------------------------------------------------------------------------
Private Function WinActByPID(lngPID)
'指定したプロセスIDのウインドウを最前面にする
'プロセスIDが指定された場合はIEのものに限らず最前面にする
'プロセスIDが省略された場合は起動中のIEのうち、最初に見つかったものを最前面にする

'注意1
'IEでは、ひとつのプロセス上で複数のスレッドにより複数のウインドウをもつ場合があります
'(例:起動中のIEに対しCntl+Nなどで新しいウインドウを開いた場合)
'したがってプロセスIDを指定してウインドウを最前面になるよう指示しても
'必ずしも目的のウインドウが最前面になるとは限りません
'ひとつのプロセスIDで複数のウインドウが開いている場合の操作結果は、
'そのプロセスIDで最後に操作(最前面であった)ものと思われます
'(例1:Cntl+Nなどで新しいウインドウを開いた場合は、その開いたウインドウ)
'(例2:ひとつのウインドウにマルチタブで表示している)
'本件処理については、「動いてよかった」程度にお考え下さい
'注意2
'Alertボックスを表示中のIEのプロセスを指定した場合、制御が戻ってこないようです
'IEではAlertボックスはIEとは別プロセスで動作し、IEが最前面になろうとすると
'Alertボックス自身が割り込んで最前面になろうとするためと思われます

WinActByPID = True

Dim lngTargetPID

If lngPID <> 0 Then 'プロセス指定があるか
lngTargetPID = lngPID '指定プロセスを最前面にする
Else '起動中のIEを探します
lngTargetPID = GetIEProcID() '最初に見つけたIEのプロセスを取得
If lngTargetPID = 0 Then
If lngTargetPID = 0 Then
WScript.echo(Now & " " & "IEのプロセスが見つかりません")
WScript.Quit (-1) 'エラーを返す
WinActByPID = False
Exit Function
End If
End If
End If

'プロセスの最前面化
Dim objWsh
Set objWsh = WScript.CreateObject("WScript.Shell")

Dim timeOut
timeOut = Now + TimeSerial(0, 0, 5)

'見つけたプロセスを最前面に表示
Do While Not objWsh.AppActivate(lngTargetPID)
WScript.Sleep 500
If Now > timeOut Then
WScript.echo(Now & " " & "指定されたIEをアクティブにできませんでした:" & lngTargetPID)
WScript.echo(Now & " " & "Alertボックスなどに邪魔されていませんか?")
WScript.Quit (-1) 'エラーを返す
WinActByPID = False
Exit Do
End If
Loop

Set objWsh = Nothing

End Function

'-------------------------------------------------------------------------------
'IEProcessID取得
'-------------------------------------------------------------------------------
Private Function GetIEProcID()

GetIEProcID = 0 'プロセスID初期化

'拾いものなので説明省略
Dim wLoc
Dim wSvc
Dim wEnu
Dim wIns

'WMIを利用して起動中のアプリ一覧を得る
Set wLoc = CreateObject("WbemScripting.SWbemLocator")
Set wSvc = wLoc.ConnectServer
Set wEnu = wSvc.InstancesOf("Win32_Process")

'起動中のIEを検査
For Each wIns In wEnu
'IEのプロセスを探す
If Not IsEmpty(wIns.ProcessId) Then
If wIns.Description = "iexplore.exe" Then
GetIEProcID = wIns.ProcessId
Exit For
End If
End If
Next

'使ったObjectの解放
Set wLoc = Nothing
Set wEnu = Nothing
Set wSvc = Nothing

End Function

'-------------------------------------------------------------------------------
'CallMe動作時の環境変更
'-------------------------------------------------------------------------------
Private Sub CallMeIniProc(intCallMeSync,intCallMeHandle,strCallMeLog,strOrder)
'CallMe動作時の環境を設定します

'初期値
'intCallMeSync = 0 '同期実行
'intCallMeHandle = 0 '利用中のIEハンドルを強制する
'strCallMeLog = "" 'Logファイルを指定しない

'ハンドル強制するが初期値になっている理由
'自分自身のVBSを外部VBSとして起動する目的は、今捕まえているIEを非同期処理で
'「やっつけておいてください」ということにほかなりません
'同期・非同期の別を問わず、「ほかのIEを処理」するのであればシェルを連打すればいいだけですので
'ここでは捕まえているIEに対する操作を初期値にします

'命令例 先頭は命令定数 数字:は引数添え字番号
'0:CallMe 1:Sync 2:Handle 3:\Log=>>G:\\Log.txt\
' Logファイル指定にディレクトリを示す\が入るときは上記のようにエスケープ処理をする

Dim i
Dim strTemp

For i = 1 To UBound(strOrder)
Select Case UCase(strOrder(i))
Case "SYNC" '同期起動
intCallMeSync = 0
Case "NOSYNC" '非同期起動
intCallMeSync = 1
Case "HANDLE" '利用中のIEハンドルを強制する
intCallMeHandle = 0
Case "NOHANDLE" '利用中のIEハンドルを強制しない
intCallMeHandle = 1
Case Else
'LogFile指定判定
'重要:誤った指定をするとファイルの上書きなどが発生します
If Left(UCase(strOrder(i)),3) = "LOG" Then
strCallMeLog = Mid(strOrder(i),5,256)
Else
Call ABEND("CallMeIni命令の引数LOGが不正です",strOrder)
End If
End Select
Next

End Sub

'-------------------------------------------------------------------------------
'自VBSを外部実行
'-------------------------------------------------------------------------------
Private Sub CallMeProc(intCallMeSync,intCallMeHandle,strCallMeLog,strOrder)
'----------------------
'地雷は他人に踏ませる!
'----------------------
Dim strTemp '作業用
Dim objWsh
Dim filePath
Dim i
Dim strCMD
Dim intRtn


'別のVBScriptファイル起動用のオブジェクトを生成
Set objWsh = WScript.CreateObject("WScript.Shell")

'自VBSのフルパスを取得
filePath = WScript.ScriptFullName

'Logファイル対応のためCMD経由で起動
strCMD = "cmd /c CScript " & filePath

'今捕まえているIEのハンドルを指定する場合
'ハンドル指定でIEを取得する命令を強制追加
If intCallMeHandle = 0 Then
strCMD = strCMD & " " & """" & "IEGetH " & GBL_objIE.hWnd & """"
End If

'引数命令郡の整形
For i = 1 To UBound(strOrder)
strCMD = strCMD & " " & """" & strOrder(i) & """"
Next

'Logファイル指定
strCMD = strCMD & strCallMeLog

'起動モード選択 CMD窓は非表示
If intCallMeSync = 1 Then
WScript.echo(Now & " " & "CallMe非同期実行[" & strCMD & "]")
'intRtn = objWsh.Run(strCMD,0) '非同期実行
objWsh.Run strCMD,0 '非同期実行
Else
WScript.echo(Now & " " & "CallMe同期実行[" & strCMD & "]")
intRtn = objWsh.Run(strCMD,0,True) '同期実行
End If

End Sub

'-------------------------------------------------------------------------------
'エスケープ文字に対応して項目の切り出し
'-------------------------------------------------------------------------------
Private Function SplitByDLM(strLine,ByRef rtnArry,strDLM,strESC)
'受け取った命令文字列を\エスケープで分解
'空白区切り分解にあたり\で囲まれた中は除く
Dim i '作業用添え字
Dim strTemp '作業用文字列
Dim arTemp() '作業用文字列配列
Dim lngLen '引数の長さ
Dim lngESCcnt 'エスケープ文字出現回数
Dim lngOldPoint '前回文字切り出し位置

'各種初期化
ReDim rtnArry(0) '戻り値配列
ReDim arTemp(0)
lngESCcnt = 0
lngOldPoint = 0

'項目の検査
lngLen = Len(strLine)
If lngLen = 0 Then
rtnArry = Split("",strDLM)
Exit Function
End If

'デリミタによる切り出し
For i = 1 To lngLen
'1文字ごとに
strTemp = Mid(strLine,i,1)
If strTemp = strESC Then
'エスケープ文字なら出現回数を加算
lngESCcnt = lngESCcnt + 1
ElseIF strTemp = strDLM Then 'デリミタか
If lngESCcnt Mod 2 = 0 Then
'エスケープ文字が偶数回状態だったら前回位置から文字を切り出し
'作業用文字配列拡張
ReDim Preserve arTemp(UBound(arTemp) + 1)
'前回位置から長さ等を調整
arTemp(UBound(arTemp)) = Mid(strLine,lngOldPoint+1,i - lngOldPoint - 1)
lngOldPoint = i '今回位置を記録
End If
End If

If i = lngLen Then '項目の終端だったら残り文字を切り出し
'作業用文字配列拡張
ReDim Preserve arTemp(UBound(arTemp) + 1)
'前回位置から残り全部を転送
arTemp(UBound(arTemp)) = Mid(strLine,lngOldPoint+1,i - lngOldPoint)
End If
Next

'エスケープ文字の削除と圧縮処理
For i = 1 To UBound(arTemp)
strTemp = arTemp(i)
'両端がエスケープ文字なら
If (Left(strTemp,1) = strESC) And (Right(strTemp,1) = strESC) Then
strTemp = Mid(strTemp,2,Len(strTemp) - 2) '中抜き
ReDim Preserve rtnArry(i - 1) '戻り値配列拡張
'含まれるエスケープ文字の圧縮
rtnArry(i - 1) = Replace(strTemp,strESC & strESC,strESC)
Else
ReDim Preserve rtnArry(i - 1) '戻り値配列拡張
rtnArry(i - 1) = strTemp
End If
Next

SplitByDLM = UBound(rtnArry) '使ってないけど配列数を返す

End Function

'-------------------------------------------------------------------------------
'IEのBusy状態を監視し待機
'-------------------------------------------------------------------------------
Private Function WaitBusyIE(strMode,intTime)

WaitBusyIE = True

Dim binMode
If UCase(strMode) = "TRUE" Then
binMode = True
Else
binMode = False
End If

Dim timeOut
timeOut = Now + TimeSerial(0, 0, intTime)
Do Until GBL_objIE.Busy = binMode
WScript.Sleep 500
If Now > timeOut Then
WaitBusyIE = False
Exit Do
End If
Loop

End Function

'-------------------------------------------------------------------------------
'タイトルでIE取得待ち
'-------------------------------------------------------------------------------
Private Function WaitFindIE(strTitle,intTime)
'起動中のIEから指定したタイトルのIEが見つかるまで待機しIEを返します
'親ウインドウから開かれた子ウインドウを想定
'この命令が発行されると、WaitLostIEが実施されるまで子ウインドウが処理対象となる

Dim timeOut
timeOut = Now + TimeSerial(0, 0, intTime)
Do While Not IEGet("T",strTitle,GBL_objIE) 'タイトル指定でIE取得
WScript.Sleep 500
If Now > timeOut Then
Exit Do
End If
Loop

'IE取得状況の確認
If GBL_objIE Is Nothing Then
WaitFindIE = False 'タイムアウト
Else
WaitFindIE = True
End If

End Function

'-------------------------------------------------------------------------------
'ハンドルでIE喪失待ち
'-------------------------------------------------------------------------------
Private Function WaitLostIE(lphWnd,intTime)
'起動中のIEから指定したIEハンドルが見つからなくなるまで待機返します
Dim TempIE

Dim timeOut
timeOut = Now + TimeSerial(0, 0, intTime)
Do While IEGet("H",lphWnd,TempIE) 'ハンドル指定でIE取得
WScript.Sleep 500
If Now > timeOut Then
Exit Do
End If
Loop

'IE取得状況の確認
If TempIE Is Nothing Then
WaitLostIE = True
Else
WaitLostIE = False 'タイムアウト
End If
Set TempIE = Nothing

End Function


'-------------------------------------------------------------------------------
'数値変換
'-------------------------------------------------------------------------------
Private Function CNum(strType,strData,erNum)

If Not IsNumeric(strData) Then
CNum = erNum
Exit Function
End If

If Not IsNumeric(erNum) Then
erNum= 0
End If

Select Case strType
Case "L"
CNum = CLng(strData)
Case "I"
CNum = CInt(strData)
Case Else
CNum = erNum
End Select

End Function

'-------------------------------------------------------------------------------
'ここから下は実験中
'-------------------------------------------------------------------------------

'-------------------------------------------------------------------------------
'ExecuteGlobalFunc
'-------------------------------------------------------------------------------
Private Function ExecuteGlobalFunc(strPath)

Dim externalScript
Set externalScript = CreateObject("Scripting.FileSystemObject").OpenTextFile(strPath)

ExecuteGlobal externalScript.ReadAll
externalScript.close

ExecuteGlobalFunc = True
End Function

'-------------------------------------------------------------------------------
'GetRefSet
'-------------------------------------------------------------------------------
Private Function GetRefSet(objNode,strEvent,strFunc)
'ノードにイベントをしかけます

'VBSのGetRefという関数を詳しく説明した資料がない中
'その利用例に、Domのイベントを横取りしてくるというのがありました
'Nodeに対して発生させたいイベントの種類と、そのイベント発生時に実行される
'自分のVBSの中の関数を宣言できます 関数は宣言時点で存在しなければなりません

GetRefSet = False

Select Case UCase(strEvent)
Case "ONCLICK"
objNode.onclick = GetRef(strFunc)
GetRefSet = True
End Select


End Function

'-------------------------------------------------------------------------------
'GetRefWait
'-------------------------------------------------------------------------------
Private Function GetRefWait(objNode)
'ノードにイベントをしかけて待機します
'ページのリロードなどで、イベントをしかけたNodeが無効になるまで待機します

'Dim rtn
'rtn = GetRefSet(objNode,strEvent,strFunc)

GBL_binGetRefWait = False

'-------------------------------
'IEの終了イベントを動的に定義 このループを実行するのであれば、IE終了イベントの捕捉は必須なので作成します
'WScript.CreateObject("InternetExplorer.Application", "objIE_")で作成したIEでは
'常に作成時の接頭詞onjIE_でイベントが発生します
'入れ物である変数名が変わっても変化しません
Dim strGetRefFunc
strGetRefFunc = "Sub objIE_OnQuit(): WScript.echo(Now & "" OnQuit""): GBL_binGetRefWait = True: End Sub"
ExecuteGlobal strGetRefFunc
'-------------------------------

WScript.echo(Now & " " & "GetRefWaitが待機開始しました")

Do Until (IsEmpty(objNode)) Or (objNode Is Nothing) Or (GBL_binGetRefWait = True)
WScript.Sleep 1000
Loop

WScript.echo(Now & " " & "GetRefWaitが終了しました")
WScript.Quit(0)

GetRefWait = True

End Function

'-------------------------------------------------------------------------------
'GetRefBrake
'-------------------------------------------------------------------------------
Private Function GetRefBrake()
'GetRefWaitを中止させる例です
'入力インターフェースを持たないVBSですが
'捕捉したIEの状態監視や、イベントフックにより、VBS自身の制御が可能です

WScript.echo(Now & " " & "GetRefBrakeが起動されました")

If GBL_binGetRefWait Then
GBL_binGetRefWait = False
Else
GBL_binGetRefWait = True
End If

End Function

'-------------------------------------------------------------------------------
'GetRef01
'-------------------------------------------------------------------------------
Private Function GetRef01()
Dim rtn

WScript.echo(Now & " " & "GetRef01が起動されました")
rtn = MSGBOX("本当にクリックしていいんですか?",vbOKCancel)
If rtn = vbCancel Then
'起動された自分にFalseを返すとイベントを中止(バブリングしません)
GetRef01 = False
End If
End Function

'-------------------------------------------------------------------------------
'GetRef02
'-------------------------------------------------------------------------------
Private Sub GetRef02()

WScript.echo(Now & " " & "GetRef02が起動されました")

End Sub

'-------------------------------------------------------------------------------
Function ExecProc(strPath)
' CScript %USERPROFILE%\Desktop\VBS\IECtrlSub.VBS "Exec %USERPROFILE%\Desktop\VBS\MyFunction.VBS"

Dim externalScript
Set externalScript = CreateObject("Scripting.FileSystemObject").OpenTextFile(strPath)

ExecuteGlobal externalScript.ReadAll
externalScript.close

Call myFunction()
ExecProc = True
End Function

Private Function myFunction()
msgbox "Old"
End Function
'-------------------------------------------------------------------------------
●MyFunction.VBS
'MyFunction.VBS
'-------------------------------------------------------------------------------
'MyFunction
'-------------------------------------------------------------------------------
Private Function MyFunction()
MsgBox "Hellow"
End Function

●GetRefLib.VBS
'GetRefLib.VBS
'-------------------------------------------------------------------------------
'GetRefYH2RAK
'-------------------------------------------------------------------------------
Private Sub GetRefYH2RAK()
'GBL_objIEのボタンがクリックされた
'GBL_objOldIEに検索内容を転送しクリック
'GBL_objIEのページのリロードが発生しGetRefが無効となるので再度セット

WScript.echo(Now & " " & "Rakutenショッピングでも検索しときますね")
GBL_objOldIE.Document.GetElementByID("ri-cmn-hdr-sitem").value = GBL_objIE.Document.GetElementByID("yschsp").value
GBL_objOldIE.Document.GetElementByID("ri-cmn-hdr-button").Click

End Sub

'-------------------------------------------------------------------------------
'GetRefRAK2YH
'-------------------------------------------------------------------------------
Private Sub GetRefRAK2YH()

WScript.echo(Now & " " & "ヤフオクでも検索しときますね")
GBL_objIE.Document.GetElementByID("yschsp").value = GBL_objOldIE.Document.GetElementByID("ri-cmn-hdr-sitem").value
GBL_objIE.Document.GetElementByID("acHdSchBtn").Click

End Sub

'-------------------------------------------------------------------------------
Sub objIE_DownloadComplete()
' WScript.Echo "Download Complete"
End Sub

'-------------------------------------------------------------------------------
Sub objIE_DocumentComplete(browser, url)
'NewIEなどでabout:Blankを開いたばかりではobjIEが存在しないことの対策
On Error Resume Next
If url = GBL_objIE.LocationURL Then
If Left(url,29) ="https://auctions.yahoo.co.jp/" Then
WScript.echo(Now & " " & "再バインド" & url)
GBL_objIE.Document.GetElementByID("acHdSchBtn").onclick = GetRef("GetRefYH2RAK")
End If
ElseIf url = GBL_objOldIE.LocationURL Then
If Left(url,41) ="https://search.rakuten.co.jp/search/mall/" Then
WScript.echo(Now & " " & "再バインド" & url)
GBL_objOldIE.Document.GetElementByID("ri-cmn-hdr-button").onclick = GetRef("GetRefRAK2YH")
End If
End If
End Sub

ここまで

長すぎて頭から煙が出そう

( ̄ー ̄)/~~ジャ
関連記事
おもちゃ箱
Count from 2010/01/14

にほんブログ村 バイクブログ ドゥカティへ


カレンダー
06 | 2019/07 | 08
- 1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31 - - -
最新記事
最新コメント
カテゴリ
月別アーカイブ
リンク
検索フォーム
RSSリンクの表示
ブロとも申請フォーム

この人とブロともになる

全記事表示リンク

全ての記事を表示する