SQLの窓

2018年08月29日


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


関連する記事

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

仕様を確認したわけではありませんが、boundary は、境界識別する為のユニークな文字列であると思われます。http ヘッダで指定した文字列を x とすると --x が境界で、改行コードが付加されます。一番最後の境界は --x-- です。
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
<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>




タグ:Curl
posted by lightbox at 2018-08-29 14:26 | 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 + インターネット | このブログの読者になる | 更新情報をチェックする

2017年08月13日


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

Windows7,Windows8,Windows10
(いずれも64ビット) で動作しました。

※ Gmail の場合、安全性の低いアプリの許可を『有効』にする必要があります

▼ 有効にしないと以下のメッセージ
メッセージを SMTP サーバーに送信できませんでした。転送エラー コードは 0x80040217 です。サーバーからの応答は次のとおりです。not available
メールサービスとしては、Gmail と Yahoo メールが使用可能でした。有料メールでは nifty メールで動作を確認しています。( Hotmail は CDO では使用できず、一般的に TLS の 587 で使用できます ) コマンドプロンプトから、以下のようにしてテストしています cscript mail.vbs 最近 では、ssl を使わないとメール送信できませんので、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 2017-08-13 23:19 | VBS + インターネット | このブログの読者になる | 更新情報をチェックする

2015年02月06日


VBScript で Seesaaブログへ禁止ワード一括登録( アップロード )

2015-02-06 更新

Google Chrome で拡張子 .vbs が悪者扱いされるので、.wsf に変更して内容も更新しました。再度動作確認も行いました

2013/01/19 更新

Seesaa の最新仕様にあわせて更新しました。
パッケージにデフォルトの『禁止WORD.txt』を同梱しました
実行は、コマンドラインより実行するようにしたので、readme.txt をご覧ください

▼ readme.txt の内容
禁止WORD.txt は、ファイル名を変更せずに使って下さい。内容はいままで運用で使ったものをセットしていますが、適宜変更または追加して下さい。内容は酷い内容なので、ご注意ください。

コマンドプロンプトを開き、今開いているファイル(readme.txt)があるフォルダがカレントになるようにします。

Windows VISTA 以降なら、エクスプローラで、SHIFT キーを押しながらこのフォルダ右クリックして『コマンドウインドウをここで開く』を実行します

以下をコマンドラインから実行します

cscript ignore_words.wsf メールアドレス パスワード ブログID

ブログの ID は、自分のブログ一覧を表示して、ブログタイトルのリンクを取り出すと以下のようになります。

(例)
http://blog.seesaa.jp/cms/home/switch?blog_id=2868467&goto=/cms/article/regist/input

blog_id=2868467 とありますが、2868467 の部分を使用します。
処理としては、ブラウザの代りに処理させるので、実際のやりとりを HTML のコードをページ毎に読んで基本処理部分を構築しています。実際の送信処理で送られる内容は、F12 の開発者ツールで比較的簡単に確認できます。 VBScript では、扱うデータが SHIFT_JIS なので、ADODB.Stream を使って UTF-8 に変換した上で% エンコーディングを行っています。
<JOB>
<SCRIPT language="VBScript">
' ***********************************************************
' サーバーオブジェクトを使用しています
' ***********************************************************
Set objHTTP = Wscript.CreateObject("Msxml2.ServerXMLHTTP")
lResolve = 60 * 1000
lConnect = 60 * 1000
lSend = 60 * 1000
lReceive = 60 * 1000

' ***********************************************************
' キャラクタセット変換用
' ***********************************************************
Set Stream = Wscript.CreateObject("ADODB.Stream")
Set Stream2 = Wscript.CreateObject("ADODB.Stream")
' ***********************************************************
' URLエンコード用
' ***********************************************************
Set StreamBin = Wscript.CreateObject("ADODB.Stream")
' ***********************************************************
' POST データ読み込み用
' ***********************************************************
Set Fs = CreateObject( "Scripting.FileSystemObject" )
' ***********************************************************
' 正規表現用
' ***********************************************************
Set regEx = New RegExp

Wscript.Echo "開始します。しばらくお待ち下さい"

' ログインページの取得
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
'Wscript.Echo strPostKey

' ***********************************************************
' コマンドラインからの固有の情報の取得
' ***********************************************************
' Seesaa のログインユーザ( メールアドレス )
emailData = Wscript.Arguments(0)
' Seesaa のログインパスワード
passData = Wscript.Arguments(1)
' 登録したいブログの ID を指定します
blogData = Wscript.Arguments(2)

' ***********************************************************
' (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()
'Wscript.Echo strHeaders

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

' 以下デバッグ用
'Set OutObj = Fs.OpenTextFile( "log.txt", 2, True )
'OutObj.Write objHTTP.responseText
'OutObj.Close

' ***********************************************************
' (3) : GET
' ***********************************************************
' 投稿ページ
Call objHTTP.Open("GET","http://blog.seesaa.jp/cms/ignore_words/regist/input" , False)
Call objHTTP.setTimeouts(lResolve, lConnect, lSend, lReceive)
Call objHTTP.Send()

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

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

' ***********************************************************
' (3) : POST
' ***********************************************************
Set InObj = Fs.OpenTextFile( "禁止WORD.txt", 1 )

nCnt = 0
strData = "aXt=" & strPostKey
Do While not InObj.AtEndOfStream
	Buffer = InObj.ReadLine
	nCnt = nCnt + 1

	if strData <> "" then
		strData = strData & "&"
	end if

	strData = strData & "ignore_words=" & URLEncode( Buffer )

	if nCnt = 5 then
		' 5ワード毎に POST
		Call objHTTP.Open("POST","http://blog.seesaa.jp/cms/ignore_words/regist/input",False)
		Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
		Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
		Call objHTTP.Send(strData)
		nCnt = 0
		strData = "aXt=" & strPostKey
		Wscript.Sleep(2000) ' 2秒間の間を置く
	end if
Loop

if nCnt <> 0 then
	Call objHTTP.Open("POST","http://blog.seesaa.jp/cms/ignore_words/regist/input",False)
	Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
	Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
	Call objHTTP.Send(strData)
end if

InObj.Close

Wscript.Echo "終了しました"

' ***********************************************************
' SHIFT_JIS を UTF-8 に変換して URLエンコード
' ※ 全ての文字をパーセントエンコーディングします
' ***********************************************************
Function URLEncode(str)

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

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

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

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

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

	Buffer = ""
	' BOMを取り去る
	StreamBin.Read(3)
	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

	URLEncode = Buffer

End Function
</SCRIPT>
</JOB>




▼ 初回投稿時の実際の経緯
承認制にしているにも関わらず、週末にいきなりたくさんやってきます。ここ最近急に増えて来ていちいち削除するのが面倒になってきたので、VBScript で一括で禁止ワードをアップロードできるようにしました。

ワードは少しづつ追加していったものですが、26個ほどでピタリと止まっているので。

そのワードも公開したいところですが、とても出せるようなものでは無いので、ロ口工エの組み合わせで4つできる事だけは報告しておきます。( 同梱しています )


関連する記事

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



タグ:トラブル
posted by lightbox at 2015-02-06 22:49 | VBS + インターネット | このブログの読者になる | 更新情報をチェックする

2014年08月06日


VBScript で半角カナから全角カナへ変換するのに、php の mb_convert_kana を呼び出す

mb_convert_kana で変換できる内容は多岐に渡りますし、それを VBScript でわざわざ実装するコストはちょっともったいないので VBScript から http で呼び出して変換するサンプルです。
VBScript
Set objHTTP = Wscript.CreateObject("Msxml2.ServerXMLHTTP")
Set Stream = Wscript.CreateObject("ADODB.Stream")
Set Stream2 = Wscript.CreateObject("ADODB.Stream")
Set StreamBin = Wscript.CreateObject("ADODB.Stream")

Dim strTargetUrl : strTargetUrl = "http://localhost/user/convert_kana.php"

Wscript.Echo WEBConvSend("アイウエオガギグゲゴ","KV")

' ***************************
' 投稿
' ***************************
Function WEBConvSend(s,t)

	Dim strData

	strData = "t=" & t & "&s=" & URLEncode(s)

	Call objHTTP.Open("POST",strTargetUrl,False)
	Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
	Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
	Call objHTTP.Send(strData)

	WEBConvSend = objHTTP.ResponseText

End Function

' ***************************
' URLエンコード
' ***************************
Function 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 = "utf-8"
	' 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 = ""
	StreamBin.Read(3)
	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

	URLEncode = Buffer

End Function


PHP : convert_kana.php


タグ:VBScript PHP
posted by lightbox at 2014-08-06 16:49 | VBS + インターネット | このブログの読者になる | 更新情報をチェックする

VBScript : URLEncode( OAuth 用 rfc3986 )

VBScript で、コード内の文字列を UTF-8 に変換してから、一旦全てパーセントエンコードし、目的の仕様に沿って一部の文字を元に戻しています。

※ rfc3986 は、PHP 5.3.x における rawurlencode です。

関連する記事

   PHP / JavaScript / ASP / PowerShell / python / Framework(バージョン別) : 処理別の urlencode の結果の違い
 VBScript : Twitter API を呼び出して投稿する
Set Stream = Wscript.CreateObject("ADODB.Stream")
Set Stream2 = Wscript.CreateObject("ADODB.Stream")
Set StreamBin = Wscript.CreateObject("ADODB.Stream")

strData = "status=" & rfc3986_convert(URLEncode(strText))

' ********************************************
' SHIFT_JIS を UTF-8 に変換して URLエンコード
' ※ 全ての文字をパーセントエンコーディングします
' ********************************************
Function URLEncode(str)

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

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

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

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

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

	Buffer = ""
	' BOMを取り去る
	StreamBin.Read(3)
	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

	URLEncode = Buffer

End Function

' ********************************************
' 仕様を明確にする為に単純変換
' ********************************************
Function rfc3986_convert(str)

	Dim strResult,I,strWork

	strResult = str

	strResult = Replace(strResult,"%2D", "-")
	strResult = Replace(strResult,"%2E", ".")

	' 0〜9
	For I = &H30 to &H39
		strWork = Hex(I)
		strWork = "%" & Ucase(strWork)
		strResult = Replace(strResult,strWork, Chr(I))
	Next

	' A〜Z
	For I = &H41 to &H5A
		strWork = Hex(I)
		strWork = "%" & Ucase(strWork)
		strResult = Replace(strResult,strWork, Chr(I))
	Next

	strResult = Replace(strResult,"%5F", "_")

	' a〜z
	For I = &H61 to &H7A
		strWork = Hex(I)
		strWork = "%" & Ucase(strWork)
		strResult = Replace(strResult,strWork, Chr(I))
	Next

	strResult = Replace(strResult,"%7E", "~")
	
	rfc3986_convert = strResult

End Function


以下はいろいろな処理系の URLEncode か、またはそれに相当する変換の一部分です
1PHP : urlencode
2PHP : rawurlencode : 5.2.x
3PHP : rawurlencode : 5.3.x
4JavaScript : encodeURI
5JavaScript : encodeURIComponent
6ASP : Server.URLEncode
( Server.URLEncode(chr(I))で変換できない文字があります )
7PowerShell : [System.Web.HttpUtility]::UrlEncode
8python 2.6.2 : urllib.quote
9js2 と同じ : VS2010 Uri.EscapeDataString
10php3 と同じ : VS2012 Uri.EscapeDataString
11ps の ' が %27 : VS2010 HttpUtility.UrlEncode

    php1 php2 php3 js1 js2 asp ps py fw4 fw4.5 fw
    1 2 3 4 5 6 7 8 9 10 11
0   %00 %00 %00 %00 %00   %00 %00 %00 %00 %00
32   + %20 %20 %20 %20 + + %20 %20 %20 +
33 【!】 %21 %21 %21 ! ! %21 ! %21 ! %21 !
34 【"】 %22 %22 %22 %22 %22 %22 %22 %22 %22 %22 %22
35 【#】 %23 %23 %23 # %23 %23 %23 %23 %23 %23 %23
36 【$】 %24 %24 %24 $ %24 %24 %24 %24 %24 %24 %24
37 【%】 %25 %25 %25 %25 %25 %25 %25 %25 %25 %25 %25
38 【&】 %26 %26 %26 & %26 %26 %26 %26 %26 %26 %26
39 【'】 %27 %27 %27 ' ' %27 ' %27 ' %27 %27
40 【(】 %28 %28 %28 ( ( %28 ( %28 ( %28 (
41 【)】 %29 %29 %29 ) ) %29 ) %29 ) %29 )
42 【*】 %2A %2A %2A * * %2A * %2A * %2A *
43 【+】 %2B %2B %2B + %2B %2B %2B %2B %2B %2B %2B
44 【,】 %2C %2C %2C , %2C %2C %2C %2C %2C %2C %2C
45 【-】 - - - - - %2D - - - - -
46 【.】 . . . . . %2E . . . . .
47 【/】 %2F %2F %2F / %2F %2F %2F / %2F %2F %2F


posted by lightbox at 2014-08-06 11:10 | 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 ドロップシャドウの参考デモ
BUTTONS (CSS でボタン)
イラストAC
ぱくたそ
写真素材 足成
フリーフォント一覧
utf8 文字ツール
右サイド 終わり
base 終わり