2014年11月27日


Cron の代替え : VBScript でタイマー処理

同一スクリプトで、別々の処理は一応可能のようですが、厳密には非同期では無く一つの処理を実行中は他の処理は待たされるようなので、本来の非同期処理が必要な場合は、外部アプリケーション(スクリプト)を呼び出す形にして下さい。

Windows には、昔から「スケジューラ」というサービスがあり、Cron と同じ事が可能です。しかし、Windows 純正で、URL を呼び出すとなると、それなりに知識も必要ですし、そもそもWindows のスケジューラは、非常に解りにくい不便なしろもので、できればあまり使用したく無いです。

そこで、VBScript のみを使って簡単なスケジューラを作り、そこからさらに VBScript で任意の URL を呼び出します。

10秒毎の非同期別スレッド処理のサンプル
' このセクションは、cscript.exe で処理を強制させるものです
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str <> "CSCRIPT.EXE" then
	str = WScript.ScriptFullName
	Set WshShell = CreateObject( "WScript.Shell" )
	Call WshShell.Run( "cmd.exe /c cscript.exe """ & str & """ & pause", 3 )
	WScript.Quit
end if

Dim Disp : Disp = True	' False にすると、秒単位の表示はしなくなります
Set WshShell = WScript.CreateObject("WScript.Shell")

Set SINK = WScript.CreateObject("WbemScripting.SWbemSink","SINK_")
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
objWMIService.ExecNotificationQueryAsync _
 SINK, _
 "SELECT * FROM  __InstanceModificationEvent " & _
 "WHERE TargetInstance ISA 'Win32_LocalTime'"

Wscript.Echo "非同期別スレッドタイマー処理を開始します"
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str = "CSCRIPT.EXE" then
	' Cscript.exe で、CTRL+C で終わらせる
	Do
		WScript.Sleep 10000
	Loop
end if

' この処理は、毎秒非同期のスレッドから呼び出されます
Sub SINK_OnObjectReady(objLatestEvent, objAsyncContext)

	' 10秒毎の非同期別スレッド処理
	if objLatestEvent.TargetInstance.Second MOD 10 = 0 then
		' ここが 10秒毎に呼び出されます
		WshShell.Run( "wscript httpget.vbs http://xxxxx.jp/xxxxx.php" )
	end if

	if Disp then
		' 秒単位に呼び出されるこのルーチンで毎回表示
		Wscript.Echo "Time: " & _
			objLatestEvent.TargetInstance.Hour & ":" & _
			objLatestEvent.TargetInstance.Minute & ":" & _
			objLatestEvent.TargetInstance.Second
	end if
End Sub



httpget.vbs
if Wscript.Arguments.Count = 0 then
	Wscript.Echo "httpget url [savepath]"
	Wscript.Quit
end if

' ダウンロード用のオブジェクト
Set objSrvHTTP = Wscript.CreateObject("Msxml2.ServerXMLHTTP")

' 第1引数は URL
strUrl = Wscript.Arguments(0)
if Wscript.Arguments.Count = 1 then
	' 第2引数が無い場合は、URL の最後の部分
	' ( カレントにダウンロード )
	aData = Split(strUrl,"/")
	strFile = aData(Ubound(aData))
else
	' 第2引数がある場合はそれをローカルファイルとする
	strFile = Wscript.Arguments(1)
end if

' ダウンロード要求
on error resume next
Call objSrvHTTP.Open("GET", strUrl, False )
if Err.Number <> 0 then
'	Wscript.Echo Err.Description
	Wscript.Quit
end if
objSrvHTTP.Send
if Err.Number <> 0 then
	' おそらくサーバーの指定が間違っている
'	Wscript.Echo Err.Description
	Wscript.Quit
end if
on error goto 0

if objSrvHTTP.status = 404 then
'	Wscript.Echo "URL が正しくありません(404)"
	Wscript.Quit
end if

' バイナリデータ保存用オブジェクト
Set Stream = Wscript.CreateObject("ADODB.Stream")
Stream.Open
Stream.Type = 1	' バイナリ
' 戻されたバイナリをファイルとしてストリームに書き込み
Stream.Write objSrvHTTP.responseBody
' ファイルとして保存
Stream.SaveToFile strFile, 2
Stream.Close



関連する記事

VBScript : 30秒後のイベント処理
VBScript : 10秒毎に処理を実行する( 時刻指定も可能 )
VBScript : スクリプトを終了しないようにする



posted by at 2014-11-27 23:09 | Comment(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2010年12月17日


レンタルサーバーの MySQLに VBScript で更新

レンタルサーバーは簡単な PHP が必要ですが、既存のアプリケーションでもかまいません。
通常は、POST で処理されるので、その場合は、以下も参照して下さい。

VBScript でバッチ mixi ボイス投稿

今回は、以下の程度の PHP を用意して呼び出しも URL を作成するだけの簡単な処理です。
$link = mysql_connect($host, $user, $pass);
if ( !$link ) {
	print mystr( "接続エラー" );
	exit();
}
mysql_select_db( $db, $link );
$result = mysql_query($_GET['text']);
mysql_free_result($result);
mysql_close($link);

これを呼び出す為に、open Method (IXMLHTTPRequest) を使用しますが、必ず
このオブジェクトを使って、ServerXMLHTTP は使用しないで下さい。
ServerXMLHTTP は、連続使用ができないという不思議なバグがあります。
今は正しく動くようです

基本認証が必要無い場合は、Call objHTTP.Open("GET",strTargetUrl & strData,False)
でかまいません。更新文字列は UPDATE を先にすれば存在しない場合は結果的になにもしま
せんので、後の INSERT が成功します。既に存在する場合は後の insert がエラーになります
が、重複が許可される場合は新規に追加されるでしょう。

実際は、プログラムでそのへんをコントロールして存在チェックが必要無いようにする事で
レスポンスに無駄がなくなります。

※ どうしても存在チェックが必要な場合はいったん呼び出して、結果をチェックする必要
※ が出てきますが、そのような設計だと、整合性が保たれる保証の確率が下がるので避けま
※ しょう。
Dim objHTTP,Stream,Stream2,StreamBin

' ***********************************************************
' ( 連続実行を想定しているので、クライアント用オブジェクト )
' ***********************************************************
Set objHTTP = Wscript.CreateObject("MSXML2.XMLHTTP")
' ***********************************************************
' キャラクタセット変換用
' ***********************************************************
Set Stream = Wscript.CreateObject("ADODB.Stream")
Set Stream2 = Wscript.CreateObject("ADODB.Stream")
' ***********************************************************
' URLエンコード用
' ***********************************************************
Set StreamBin = Wscript.CreateObject("ADODB.Stream")

Dim strTargetUrl : strTargetUrl = "URL"
Dim strUser :strUser = "user"
Dim strPass : strPass = "pass"

' ***********************************************************
' 投稿
' ***********************************************************
Function WEBSend(strSql)

	Dim strData

	strData = "?text=" & EUC_URLEncode(strSql)

	Call objHTTP.Open("GET",strTargetUrl & strData,False,strUser,strPass)
	Call objHTTP.Send()

End Function


' ADOの事前処理

strUpdate = "update mytable "
strUpdate = strUpdate & " set "
strUpdate = strUpdate & "cno = " & objRs1.Fields( "cno" ).Value & ","
strUpdate = strUpdate & "cname = '" & objRs1.Fields( "cname" ).Value & "',"
strUpdate = strUpdate & "udate = '" & objRs1.Fields( "udate" ).Value & "',"
strUpdate = strUpdate & "comment = '" & objRs1.Fields( "comment" ).Value & "'"
strUpdate = strUpdate & " where cno = " & objRs1.Fields( "cno" ).Value

Call WEBSend( strUpdate )

strUpdate = "insert into mytable (cno,cname,udate,comment)"
strUpdate = strUpdate & " values("
strUpdate = strUpdate & objRs1.Fields( "cno" ).Value & ","
strUpdate = strUpdate & "'" & objRs1.Fields( "cname" ).Value & "',"
strUpdate = strUpdate & "'" & objRs1.Fields( "udate" ).Value & "',"
strUpdate = strUpdate & "'" & objRs1.Fields( "comment" ).Value & "')"

Call WEBSend( strUpdate )

' ADOの終了処理


' ***********************************************************
' SHIFT_JIS を EUC-JP に変換して URLエンコード
' ***********************************************************
Function EUC_URLEncode(str)

	Dim Buffer,LineBuffer,i,CWork

	Stream.Open
	Stream.Charset = "shift_jis"
	' shift_jis で入力文字を書き込む
	Stream.WriteText str
	' コピーの為にデータポインタを先頭にセット
	Stream.Position = 0
 
	Stream2.Open
	Stream2.Charset = "euc-jp"
	' shift_jis を euc-jp に変換
	Stream.CopyTo Stream2
	Stream.Close

	' コピーの為にデータポインタを先頭にセット
	Stream2.Position = 0

	' バイナリで開く
	StreamBin.Open
 	StreamBin.Type = 1

	' テキストをバイナリに変換
	Stream2.CopyTo StreamBin
	Stream2.Close

	' 読み込みの為にデータポインタを先頭にセット
	StreamBin.Position = 0

	Buffer = ""
	Do while not StreamBin.EOS
		LineBuffer = StreamBin.Read(16)
 
		For i = 1 to LenB( LineBuffer )
			CWork = MidB(LineBuffer,i,1)
			Cwork = AscB(Cwork)
			Cwork = Hex(Cwork)
			Cwork = Ucase(Cwork)
			if Len(Cwork) = 1 then
				Buffer = Buffer & "%0" & Cwork
			else
				Buffer = Buffer & "%" & Cwork
			end if
		Next
 
	Loop

	StreamBin.Close

	EUC_URLEncode = Buffer

End Function



posted by at 2010-12-17 16:36 | Comment(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2010年11月02日


VBScript : WSH で JSON 文字列からデータを取得する

WSH では、VBScript から JavaScript が呼べます。経験則からして、JavaScript の
関数を上方に先に書く必要があります。Json の文字列は () で挟んで eval すると
結果が Json オブジェクトになりますが、Json 文字列のセキュリティを考えるのなら
ば、prototype.js のメソッドを使うといいと思います。

VBScript から、VB の配列で参照したいプロパティの階層をセットして渡します。
<JOB>

<SCRIPT language="JavaScript">

function getJson( json_str, arr_vb_obj ) {

	' arr_vb_obj は、VBArray(セーフ配列)
	' arr_vb は、JScript 内での VBArrayラッパー
	var arr_vb = new VBArray(arr_vb_obj);

	' JScript の配列に変換
	var arr = arr_vb.toArray();

	' JSON 文字列をオブジェクト化
	var json = eval("(" + json_str + ")");

	' 階層構造の JSON を順次撮りだす処理
	' この場合は結果として  "データ" を取り出す
	for( var i = 0; i < arr.length; i++ ) {

		json = json[arr[i]]

	}

	return json;
}
</SCRIPT>

<SCRIPT language="VBScript">

	arr = Array("aaa","bbb","ccc")


	json = "{ ""aaa"" : { ""bbb"" : { ""ccc"" : ""データ"" }}}"

	MsgBox(getJson( json, arr ))

</SCRIPT>

</JOB>


posted by at 2010-11-02 21:20 | Comment(0) | VBScript | このブログの読者になる | 更新情報をチェックする
Seesaa の各ページの表示について
Seesaa の 記事がたまに全く表示されない場合があります。その場合は、設定> 詳細設定> ブログ設定 で 最新の情報に更新の『実行ボタン』で記事やアーカイブが最新にビルドされます。

Seesaa のページで、アーカイブとタグページは要注意です。タグページはコンテンツが全く無い状態になりますし、アーカイブページも歯抜けページはコンテンツが存在しないのにページが表示されてしまいます。

また、カテゴリページもそういう意味では完全ではありません。『カテゴリID-番号』というフォーマットで表示されるページですが、実際存在するより大きな番号でも表示されてしまいます。

※ インデックスページのみ、実際の記事数を超えたページを指定しても最後のページが表示されるようです

対処としては、このようなヘルプ的な情報を固定でページの最後に表示するようにするといいでしょう。具体的には、メインの記事コンテンツの下に『自由形式』を追加し、アーカイブとカテゴリページでのみ表示するように設定し、コンテンツを用意するといいと思います。


※ エキスパートモードで表示しています

アーカイブとカテゴリページはこのように簡単に設定できますが、タグページは HTML 設定を直接変更して、以下の『タグページでのみ表示される内容』の記述方法で設定する必要があります

<% if:page_name eq 'archive' -%>
アーカイブページでのみ表示される内容
<% /if %>

<% if:page_name eq 'category' -%>
カテゴリページでのみ表示される内容
<% /if %>

<% if:page_name eq 'tag' -%>
タグページでのみ表示される内容
<% /if %>
この記述は、以下の場所で使用します