SQLの窓

2021年01月14日


VBScriptの関数定義をWEB上に置いて、Msxml2.ServerXMLHTTP で読みだして PCで使用する

VBScriptの関数定義をWEB上に置いて、PCで使用する の発展版です。
※ WEB 上に置くソースコードは、上記リンク先を参照して下さい。

Msxml2.ServerXMLHTTP で読み出すコードの作成方法

Msxml2.ServerXMLHTTP は昔はバグがありましたが、今はとても優秀なオブジェクトです。ただ、相手側が静的ファイルの場合は UTF-8 扱いになるはずなので、PHP 側でキャラクタセットを明示しています。( 以下のサンプルの PHP / https://toolbox.winofsql.jp/vbs/regtrim.php は SHIFT_JIS です )
REM **********************************************************
REM 正規表現のトリム
REM **********************************************************
Function RegTrim( strValue )

	Dim regEx, str

	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Pattern = "^[ \s]+"
	str = regEx.Replace( strValue, "" )
	regEx.Pattern = "[ \s]+$"
	RegTrim = regEx.Replace( str, "" )

End Function
このコードを regtrim.vbs や regtrim.txt としてWEB上のどこかに置く場合は、UTF8N で保存します


ExecuteGlobal による動的な関数の登録

読みだした後、ExecuteGlobal で文字列を実行してしまうのが特徴です。Global スコープで実行されるため、最初から定義していたのと同じ事になります。 但し、この処理を行う為に読みだされるソースコード側で注意する事があります 1) コメントにシングルクォートを使わないで REM を使う 2) 条件文で = を使わないで <> の else で表現する これらは、ExecuteGlobal が正しく VBScript の構文を解析する為に重要な準備事項になるので注意して下さい
<job>
<object id="http" progid="Msxml2.ServerXMLHTTP" /> 
<script language="VBScript">

' 関数のソースコードを読みだして、関数として定義
strResult = HTTPGet( "https://toolbox.winofsql.jp/vbs/regtrim.php" )
if not IsEmpty( strResult ) and Left( strResult, 3 ) = "REM" then
	' 関数定義の実行
	ExecuteGlobal strResult
else
	MsgBox( "処理できませんでした" )
	Wscript.Quit
end if

str = RegTrim( getResource( "mydata" ) )
MsgBox( "/" & str & "/" )

Function HTTPGet( strUrl )

	on error resume next
	Call http.Open("GET", strUrl, False )
	if Err.Number <> 0 then
		MsgBox(Err.Description)
		HTTPGet = Empty
		Exit Function
	end if
	on error goto 0

	Call http.Send()

	HTTPGet = http.responseText

End Function
</script>
<resource id="mydata">


    この部分のみ取り出します    


</resource>
</job>



posted by lightbox at 2021-01-14 12:48 | VBS + インターネット | このブログの読者になる | 更新情報をチェックする

2020年01月19日


VBScript : Seesaa ブログのエクスポートを呼び出して全てをバックアップするスクリプト

過去何度も作り直してきたのですが、2020年に至って改めて調整しました。要するに『スクレイピング』ですので、Seesaa のフォーマットが変われば調整する必要が出て来ます。

今回、プログID を取得するのに、ブログ一覧画面で『記事を書く』のリンクを取り出します( その中に書かれています )

bk.wsf
<JOB>
<COMMENT>
************************************************************
 EXPORT ( バッチ処理用 )
 Seesaa からブログのバックアップデータを取得する

************************************************************
</COMMENT>

<OBJECT id="objHTTP" progid="Msxml2.ServerXMLHTTP" />
<OBJECT id="Stream" progid="ADODB.Stream" />
<OBJECT id="Fs" progid="Scripting.FileSystemObject" />

<SCRIPT language=VBScript>
' ***********************************************************
' 正規表現用
' ***********************************************************
Set regEx = New RegExp

' ***********************************************************
' タイムアウト用
' ***********************************************************
lResolve = 60 * 1000
lConnect = 60 * 1000
lSend = 60 * 1000
lReceive = 60 * 1000

' ***********************************************************
' 処理開始
' ***********************************************************
Wscript.Sleep(5000)

bDebug = False
target_blog = WScript.Arguments(0)
target_year1 = WScript.Arguments(1)
target_month1 = WScript.Arguments(2)
target_year2 = WScript.Arguments(3)
target_month2 = WScript.Arguments(4)

emailData = "メールアドレス"
passData = "パスワード"
' バックアップしたいブログの ID を指定します
blogData = target_blog

' ログインページの取得
Call objHTTP.Open("GET","https://ssl.seesaa.jp/auth",False)
Call objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
Call objHTTP.Send()

' ページ全体
strPage = objHTTP.responseText

' 投稿用のキーを取得
regEx.IgnoreCase = True
regEx.Global = True
regEx.Pattern = "authpost""><input value=""([^""]+)"""
Set Matches = regEx.Execute( strPage )
For Each Match in Matches
	strPostKey = Match.SubMatches(0)
	Exit For
Next


' ***********************************************************
' (1) : POST
' ***********************************************************
' ログイン URL
Call objHTTP.Open("POST","https://ssl.seesaa.jp/auth",False)
' POST 用ヘッダ
Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
strData = ""
strData = strData & "aXt=" & strPostKey
strData = strData & "&email=" & emailData
strData = strData & "&password=" & passData
strData = strData & "&return_to=http%3A%2F%2Fblog.seesaa.jp%2F"
Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
Call objHTTP.Send(strData)

strHeaders = objHTTP.getAllResponseHeaders()
if bDebug then
	Wscript.Echo strHeaders
end if

' ***********************************************************
' (2) : GET
' ***********************************************************
' 対象ブログ URL
Call objHTTP.Open("GET","https://blog.seesaa.jp/cms/home/switch?blog_id="& blogData &"&goto=/cms/settings/home/" , False)
Call objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
Call objHTTP.Send()

if bDebug then

	Set OutObj = Fs.OpenTextFile( "log.txt", 2, True )
	OutObj.Write objHTTP.responseText
	OutObj.Close

	Wscript.Echo "開始"
end if

' ***********************************************************
' (3) : GET
' ***********************************************************
' エクスポートページ
Call objHTTP.Open("GET","https://blog.seesaa.jp/cms/tools/mt/export/input" , False)
Call objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
Call objHTTP.Send()

' 投稿用のキーを取得
strPage = objHTTP.responseText
if bDebug then
	Wscript.Echo strPage
end if
regEx.Pattern = "enctype=""multipart/form-data""><input value=""([^""]+)"""
Set Matches = regEx.Execute( strPage )
For Each Match in Matches
	strPostKey = Match.SubMatches(0)
	Exit For
Next

if bDebug then
	Wscript.Echo strPostKey
end if

' ***********************************************************
' カテゴリ ID リストの取得 ( 2015/02/04 追加 )
' ***********************************************************
regEx.Pattern = "name=""category_id"" value=""([^""]+)"""
regEx.Global = True
Set Matches = regEx.Execute( strPage )

Wscript.Sleep(2000) ' 2秒間の間を置く

' ***********************************************************
' (3) : Export 用データ準備
' ***********************************************************
boundary = DateDiff("s", "1970/1/1 0:00:00",DateAdd("h",-9,now))
h_boundary = "---------------------------" & boundary

' ソース内テキストデータの表示
str = RegTrim(GetResource("myTextData"))
str = Replace( str, "$B", boundary )
str = Replace( str, "$YEAR1", target_year1 )
str = Replace( str, "$MONTH1", target_month1 )
str = Replace( str, "$YEAR2", target_year2 )
str = Replace( str, "$MONTH2", target_month2 )
str = Replace( str, "$AXT", strPostKey )
if bDebug then
	Wscript.Echo str
end if

' ***********************************************************
' カテゴリ ID リストの設定 ( 2015/02/04 追加 )
' ***********************************************************
bFlg = False

For Each Match in Matches
	if bFlg <> False then
		bFlg = True
	else
		str = str & vbCrLf
	end if
	str = str & "Content-Disposition: form-data; name=""category_id""" & vbCrLf & vbCrLf

	if bDebug then
		Wscript.Echo Match.SubMatches(0)
	end if

	str = str & Match.SubMatches(0) & vbCrLf
	str = str & "-----------------------------" & boundary
Next

str = str & "--" & vCrLf

if bDebug then
	Wscript.echo str
end if

' ***********************************************************
' (4) : Export 用データ送信
' ***********************************************************
Call objHTTP.Open( "POST","https://blog.seesaa.jp/cms/tools/mt/export/do_export", False )
' POST 用 HTTP ヘッダ
Call objHTTP.setRequestHeader("Content-Type", "multipart/form-data; boundary=" & h_boundary)
' 念のため
Call objHTTP.setRequestHeader("Referer", "https://blog.seesaa.jp/cms/tools/mt/export/input" )
Call objHTTP.SetRequestHeader("Content-Length",Len(str))
Call objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
Call objHTTP.Send(str)

Stream.Open
Stream.Type = 1 ' バイナリ
Stream.Write objHTTP.responseBody
Stream.SaveToFile "seesaa_" & blogData & "_" & target_year1 & target_month1 & "_" & target_year2 & target_month2 & ".log", 2
Stream.Close   

Wscript.Echo "処理が終了しました:" & target_year1 & target_month1 & "〜" & target_year2 & target_month2

' ***********************************************************
' 文字列前後の漢字スペースを含むホワイトスペースの削除
' ***********************************************************
Function RegTrim( strValue )

	Dim regEx, str

	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Pattern = "^[ \s]+"
	str = regEx.Replace( strValue, "" )
	regEx.Pattern = "[ \s]+$"
	RegTrim = regEx.Replace( str, "" )

End Function
</SCRIPT>

<COMMENT>
************************************************************
 ソース内テキストデータ
************************************************************
</COMMENT>
<RESOURCE id="myTextData">
<![CDATA[
-----------------------------$B
Content-Disposition: form-data; name="aXt"

$AXT
-----------------------------$B
Content-Disposition: form-data; name="encode"

utf8
-----------------------------$B
Content-Disposition: form-data; name="from_year_month"

$YEAR1-$MONTH1
-----------------------------$B
Content-Disposition: form-data; name="to_year_month"

$YEAR2-$MONTH2
-----------------------------$B
Content-Disposition: form-data; name="tags"

1
-----------------------------$B
Content-Disposition: form-data; name="category_id_all"

all
-----------------------------$B
]]>
</RESOURCE>

</JOB>


実行するファイルはバッチファイルで以下のようにしますが、スペースでは無くタブで記述されています。というのは、作成するのに Excel を使うとオートフィルで比較的容易に作成できるからです
cscript.exe bk.wsf	2107032	2009	04	2009	12
cscript.exe bk.wsf	2107032	2010	01	2010	12
cscript.exe bk.wsf	2107032	2011	01	2011	12
cscript.exe bk.wsf	2107032	2012	01	2012	12
cscript.exe bk.wsf	2107032	2013	01	2013	12
cscript.exe bk.wsf	2107032	2014	01	2014	12
cscript.exe bk.wsf	2107032	2015	01	2015	12
cscript.exe bk.wsf	2107032	2016	01	2016	12
cscript.exe bk.wsf	2107032	2017	01	2017	12
cscript.exe bk.wsf	2107032	2018	01	2018	12
cscript.exe bk.wsf	2107032	2019	01	2019	12
cscript.exe bk.wsf	2107032	2020	01	2020	01



このページの PDF



posted by lightbox at 2020-01-19 20:17 | VBS + インターネット | このブログの読者になる | 更新情報をチェックする

2019年02月14日


WSF : VBScript の 関数定義を WEB 上に置いて PC で使用する

基本的には SHIFT_JIS で保存する

まず、WEB 側に置くコードですが、Content-Type を text/plain にする為に、PHP で httpヘッダーを記述します。.htaccess で記述してもかまいませんが、WEB上の好きな場所に移動しやすくする為に php で記述しておくのが一番いいと思います。 ソースのキャラクタセットは shift_jis で保存して shift_jis として httpヘッダーに出力します。こうしておくと、PC 側で ServerXMLHTTP を使って読み出して、動的に関数を定義する事も可能になります。( 動的に定義する場合は、UTF-8 でも問題ありません )

動的に定義する場合は VBScript の記述方法に注意

WEB 側に VBScript のコードを置いて動的に定義する場合の注意として重要なルールが二つあります。 1) シングルクォートのコメントを使用しない 2) 条件式の = を使用しない 何れも VBScript の構文解析の問題らしいです。

PHP で 『正規表現のトリム』の記述

<?php
header( "Content-Type: text/plain; charset=shift_jis" );
header( "Expires: Thu, 19 Nov 1981 08:52:00 GMT" );
header( "Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0" );
header( "Pragma: no-cache" );
?>
REM **********************************************************
REM 正規表現のトリム
REM **********************************************************
Function RegTrim( strValue )

	Dim regEx, str

	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Pattern = "^[ \s]+"
	str = regEx.Replace( strValue, "" )
	regEx.Pattern = "[ \s]+$"
	RegTrim = regEx.Replace( str, "" )

End Function


この関数は、VBScript の正規表現を使って文字列の左右の空白文字を漢字スペースも含めて取り除くものです。

PC 側の定義は通常通りですが、script 要素の src 属性で web 上の場所を指定する事になります。拡張子を .wsf にしてWscript.exe か Cscript.exe で実行します( 通常はエクスプローラからダブルクリックです )
<job>
<script language="VBScript" src="https://toolbox.winofsql.jp/vbs/regtrim.php"></script>
<script language="VBScript">

str = RegTrim( getResource( "mydata" ) )
MsgBox( "/" & str & "/" )

</script>
<resource id="mydata">


    この部分のみ取り出します    


</resource>
</job>


埋め込みテキストがソースコードの場合の記述方法

resource 要素では、ソースコード内にテキストデータを用意できるのでソースコードを準備しておいて、プログラムを登録したい時に使ったりします 但し、そのような場合は文の中に < があるとエラーになるので以下のように記述します
<job>
<script language="VBScript" src="https://toolbox.winofsql.jp/vbs/regtrim.php"></script>
<script language="VBScript">

str = RegTrim( getResource( "mydata" ) )
MsgBox( "/" & str & "/" )

</script>
<resource id="mydata">
<![CDATA[

    この部分のみ  <  取り出します    

]]>
</resource>
</job>





posted by lightbox at 2019-02-14 17:21 | VBS + インターネット | このブログの読者になる | 更新情報をチェックする

2019年01月28日


VBScript : Windows標準のオブジェクト( CDO.Message ) と GMail( または Yahoo!メール ) を使ってメール送信

※ Gmail の場合、安全性の低いアプリの許可を『有効』にする必要があります メールサービスとしては、Gmail と Yahoo メールが使用可能でした。( Microsoft( Outlook.com ) は CDO では使用できません / ※ TLS が使用できないようです ) コマンドプロンプトから、以下のようにしてテストしています cscript mail.vbs ssl を使用( ポート 465 )するので、smtpusessl が true になっています。 mail.vbs
' ***********************************************************
' 使用するパラメータ
' ***********************************************************
strFrom = "わたしです <ユーザ名@gmail.com>"
'strFrom = "わたしです <ユーザ名@yahoo.co.jp>"

strTo = "あなたです <宛先>"

strServer = "smtp.gmail.com"
'strServer = "smtp.mail.yahoo.co.jp"

nPort = 465
strUser = "ユーザ名"
strPass = "パスワード"

' ***********************************************************
' オブジェクト
' ***********************************************************
Set Cdo = WScript.CreateObject("CDO.Message")

' ***********************************************************
' 自分のアドレスと宛先
' ***********************************************************
Cdo.From = strFrom
Cdo.To = strTo

' ***********************************************************
' 件名と本文
' ***********************************************************
Cdo.Subject	= "件名の文字列 / " & Now()
Cdo.Textbody = "テキスト本文" & vbCrLf & "改行は vbCrLf"

' ***********************************************************
' CC BCC HTMLメール( CC BCC はどちらか片方  )
' ※ 両方指定すると CC
' ***********************************************************
Cdo.Cc = "ユーザ名@yahoo.co.jp,ユーザ名@hotmail.co.jp"
'Cdo.Bcc = "ユーザ名@yahoo.co.jp,ユーザ名@hotmail.co.jp"
Cdo.Htmlbody = "<img src=""http://winofsql.jp/image/winofsql.png"">"

' ***********************************************************
' ファイル添付あり
' ***********************************************************
Cdo.AddAttachment( "C:\Users\lightbox\Desktop\画像\_img.jpg" )
Cdo.AddAttachment( "C:\Users\lightbox\Downloads\del.gif" )

' ***********************************************************
' 設定
' ***********************************************************
Cdo.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
Cdo.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer
Cdo.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = nPort
Cdo.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = true

Cdo.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
Cdo.Configuration.Fields.Item _
 ("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser
Cdo.Configuration.Fields.Item _ 
 ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPass

' ***********************************************************
' 設定の反映
' ***********************************************************
Cdo.Configuration.Fields.Update

' ***********************************************************
' 送信
' ***********************************************************
on error resume next
Cdo.Send
if Err.Number <> 0 then
	strMessage = Err.Description
else
	strMessage = "送信が完了しました"
end if
on error goto 0

Wscript.Echo strMessage

関連する記事

Windows 標準の CDO.Message で簡単にバッチ処理からメールを送る
Basp21 を使ってバッチ処理からメールを送る

変更履歴
2013-01-09 : 初回投稿
2013-07-27 : Yahoo メールと Nifty メールでテスト
2014-02-28 : 添付ファイル、cc、bcc、HTML メール を追加


posted by lightbox at 2019-01-28 22:51 | VBS + インターネット | このブログの読者になる | 更新情報をチェックする

2019年01月25日


VBScript を使って HTTPプロトコルで PHP へファイルをアップロードする方法


関連する記事

ファイルのアップロード時のデータのダンプ

仕様を確認したわけではありませんが、boundary は、境界識別する為のユニークな文字列であると思われます。http ヘッダで指定した文字列を x とすると --x が境界で、改行コードが付加されます。一番最後の境界は --x-- です。
upload_target.php ※ upload_target.php と同じ場所にアップロードされたファイルを作成します。
<!DOCTYPE html>
<html>
<head>
<title>単純ファイルアップロード</title>
<meta charset="UTF-8">
<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/4.1.1/css/bootstrap.css">
<style>
#content,#result {
	padding: 20px;
}
#result {
	white-space: pre;
}
</style>
</head>
<body>
<div id="content">
	<form
		enctype="multipart/form-data"
		method="POST">
	
		<p>
			<input name="target" type="file" class="ml-4 btn btn-outline-primary">
			<a
				class="ml-4 btn btn-info btn-sm"
				href="<?= $_SERVER["PHP_SELF"] ?>">GET 再読み込み</a>
		</p>
		<p>
			<input type="submit" name="send" value="アップロード" class="ml-4 btn btn-outline-primary">
		</p>
	 
	</form>
</div>
<div id="result">
<?php
if ( $_SERVER['REQUEST_METHOD'] == "POST" ) {
 
	$upload = realpath("./");
	$upload .= ( DIRECTORY_SEPARATOR . $_FILES['target']['name'] );

	print "$upload\n";

	if ( move_uploaded_file($_FILES['target']['tmp_name'], $upload ) ) {
		print "<p>アップロードに成功しました</p>\n";
	}

	print_r( $_FILES );
}

?>
</div>
</body>
</html>


upload.wsf

アップロード先の情報と、アップロードするファイルの情報を『アップロード用 URL』セクションで書き換えて下さい。

テキストストリームに shift_jis をセットしていますが、この場合 VBScript 側も PHP 側も日本語のインターフェイスを使用していないので問題ありません。( テキストを UTF-8 で送りたい場合は同様の方法で shift_jis を UTF-8 に変換する方法はありますが、PHP 側で変換するほうが簡単でしょう )
<JOB>
<COMMENT>
************************************************************
 URLEncode用
************************************************************
</COMMENT>
<OBJECT id="Stream" progid="ADODB.Stream" />
<OBJECT id="StreamWorkBin" progid="ADODB.Stream" />
<OBJECT id="StreamBin" progid="ADODB.Stream" />
<COMMENT>
************************************************************
 HTTP通信用
************************************************************
</COMMENT>
<OBJECT id="objHTTP" progid="Msxml2.ServerXMLHTTP" />

<SCRIPT language=VBScript>

' **********************************************************
' アップロード用 URL
' **********************************************************
upload_url = "http://localhost/test/001/upload_target.php"
upload_file = "winofsql.png"
upload_type = "image/png"

' *********************************************************
' 送信準備
' *********************************************************
Call objHTTP.Open( "POST",upload_url, False )
' File Upload 用 HTTP ヘッダ
strBoundary = DateDiff("s", "1970/1/1 0:00:00",DateAdd("h",-9,now))
Call objHTTP.setRequestHeader("Content-Type", "multipart/form-data; boundary="&strBoundary)

' バイナリ変換用ストリーム
StreamWorkBin.Open
StreamWorkBin.Type = 1

' 最終バイナリストリーム
StreamBin.Open
StreamBin.Type = 1

' テキストストリーム
Stream.Open
Stream.Charset = "shift_jis"

' 開始セクション
Stream.WriteText "--" & strBoundary & vbLf
Stream.WriteText "Content-Disposition: form-data; name=""target""; filename=""uploadtest.png""" & vbLf
Stream.WriteText "Content-Type: "&upload_type& vbLf
Stream.WriteText vbLf
Stream.Position = 0

' テキストをバイナリに変換
Stream.CopyTo StreamWorkBin

' 第一セクションを書き込み
StreamWorkBin.Position = 0
StreamBin.Write StreamWorkBin.Read(StreamWorkBin.Size)

' 画像を読み込む
StreamWorkBin.LoadFromFile(upload_file)

' 画像を書き込み
StreamBin.Write StreamWorkBin.Read(StreamWorkBin.Size)

' バイナリワークをいったん閉じる
StreamWorkBin.Close
StreamWorkBin.Open
StreamWorkBin.Type = 1

' テキストをいったん閉じる
Stream.Close
Stream.Open
Stream.Charset = "shift_jis"

' 終了セクション
Stream.WriteText vbLf & "--" & strBoundary & "--" & vbLf
Stream.Position = 0

' テキストをバイナリに変換
Stream.CopyTo StreamWorkBin

' 終了セクションを書き込み
StreamWorkBin.Position = 0
StreamBin.Write StreamWorkBin.Read(StreamWorkBin.Size)

' 送信データを取得
nLen = StreamBin.Size
StreamBin.Position = 0
strData = StreamBin.Read(nLen)

Call StreamBin.SaveToFile( "result.dat", 2 )

' *********************************************************
' 投稿データとその長さ
' *********************************************************
Call objHTTP.SetRequestHeader("Content-Length",nLen)

' *********************************************************
' API へ向けて送信
' *********************************************************
Dim lResolve : lResolve = 60 * 1000
Dim lConnect : lConnect = 60 * 1000
Dim lSend : lSend = 60 * 1000
Dim lReceive : lReceive = 60 * 1000
Call objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
Call objHTTP.Send(strData)

Wscript.Echo(objHTTP.responseText)


</SCRIPT>
</JOB>

result.dat には、アップロードする為にサーバに転送したデータ部分がそのまま保存されます。





タグ:Curl
posted by lightbox at 2019-01-25 16:45 | VBS + インターネット | このブログの読者になる | 更新情報をチェックする

2018年02月18日


VBscript(または JScript) で簡単にバイナリファイルをアップロードする

PHP 側も単純ですが、PHP のマニュアルに書いている場所は、少し見付けづらいかもしれません。

内容は PUT メソッドで始まっていますが、VBScript からは POST で問題ありません。実際の内容は、Apache 上で PUT メソッドを PHP でサポートするお話なので、重要なのは PHP での記述方法です。

put.php ( utf-8n )
<?PHP
header( "Content-Type: text/html; charset=utf-8" );

$id = uniqid();

$fp = fopen( "php://input", "rb" );
$wfp = fopen( "data/{$id}_upload.dat", "wb" );

while( $ret = fread( $fp, 4096 ) ) {

	fwrite( $wfp, $ret );

}

fclose($wfp);
fclose($fp);


?>
データが保存されました

この URL に対して、VBScript のコマンドは POST であろうが、PUT であろうがどちらでもかまいません。

open Method (ServerXMLHTTP/IServerXMLHTTPRequest)
' *************************************
' サーバーオブジェクトを使用しています
' *************************************
Set objHTTP = Wscript.CreateObject("Msxml2.ServerXMLHTTP")
lResolve = 60 * 1000
lConnect = 60 * 1000
lSend = 60 * 1000
lReceive = 60 * 1000

' Stream オブジェクト の作成
Set Stream = CreateObject("ADODB.Stream")
' Stream のオープン
Stream.Open
' Stream タイプの指定
Stream.Type = 1		' StreamTypeEnum の adTypeBinary
' 既存ファイルの内容を Stream に読み込む
Stream.LoadFromFile "target.png"

' ▼ ご自分の環境に書き換えてください。
Call objHTTP.Open("POST","https://yourdomain/test/put.php",False)

nLen = Stream.Size
data = Stream.Read(nLen)

Call objHTTP.SetRequestHeader("Content-Length",nLen)
Call objHTTP.SetTimeouts(lResolve, lConnect, lSend, lReceive)
Call objHTTP.Send(data)

Wscript.Echo objHTTP.responseText
 
' Stream を閉じる
Stream.Close

setRequestHeader Method 
setTimeouts Method
send Method 

Stream オブジェクト

※ Microsoft は VB を真剣にやめたいみたいですね

なので、以下には JScript で書いたソースコードです。JScript では、大文字、小文字が区別されるので、いろいろ注意する必要があります。

upload.js
// *************************************
// サーバーオブジェクトを使用しています
// *************************************
objHTTP = new ActiveXObject("Msxml2.ServerXMLHTTP")
lResolve = 60 * 1000
lConnect = 60 * 1000
lSend = 60 * 1000
lReceive = 60 * 1000

// *************************************
// バイナリファイル
// *************************************
Stream = new ActiveXObject("ADODB.Stream")
upload_file = "winofsql.png"

// *************************************
// アップロード先
// localhost(AN HTTPD)でテストできます
// *************************************
upload_url = "http://yourdomain/put/put.php"

// *************************************
// 準備
// *************************************
objHTTP.open( "POST",upload_url, false )

// *************************************
// バイナリデータ取得
// *************************************
Stream.Open()
Stream.Type = 1
Stream.LoadFromFile(upload_file)
nLen = Stream.Size
data = Stream.Read(nLen)

// *************************************
// 送信
// *************************************
objHTTP.setRequestHeader("Content-Length",nLen)
objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
objHTTP.send(data)

WScript.Echo(objHTTP.responseText)

// Stream を閉じる
Stream.Close

ActiveXObject オブジェクト


関連する記事


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

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

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

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

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


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

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

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

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

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



フリーフォントで簡単ロゴ作成
フリーフォントでボタン素材作成
フリーフォントで吹き出し画像作成
フリーフォントではんこ画像作成
ほぼ自由に利用できるフリーフォント
フリーフォントの書体見本とサンプル
画像を大きく見る為のウインドウを開くボタンの作成

CSS ドロップシャドウの参考デモ
イラストAC
ぱくたそ
写真素材 足成
フリーフォント一覧
utf8 文字ツール
右サイド 終わり
base 終わり