SQLの窓

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 + インターネット | このブログの読者になる | 更新情報をチェックする
バッチ処理

Microsoft Office
container 終わり

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

Android SDK ポケットリファレンス
改訂版 Webデザイナーのための jQuery入門
今すぐ使えるかんたん ホームページ HTML&CSS入門
CSS ドロップシャドウの参考デモ
PHP正規表現チェッカー
Google Hosted Libraries
cdnjs
BUTTONS (CSS でボタン)
イラストAC
ぱくたそ
写真素材 足成
フリーフォント一覧
utf8 文字ツール
右サイド 終わり
base 終わり