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

Google

<< Windows10 : VBScri… | TOP | JDK がインストール… >>

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

VBScriptドキュメント

【VBS + インターネットの最新記事】

【VBScript関連のカテゴリ】

posted by lightbox at 2020-01-19 20:17 | VBS + インターネット |

Seesaa ブログ

	SQLServer の BCP で INT IDENTITY 列に csv からリストアする
	MySQL に PIPES_AS_CONCAT を設定して、CSV を出力する SQL
	Chrome ポリシー : レジストリ : ( ChatGPT 解説 )
	PL/SQL : 最も簡単な CSV 出力の記述
	VBScript を『管理者として実行する』には、Shell の runas ( 右クリックメニューの実行と同等 ) で実現します / Jscript も追加
	fake sendmail for windows を使って、PHP でごく普通に( mb_send_mail で )メール送信
	TCPDF をダウンロードして、Windows の任意のフォルダで TCPDF 同梱のサンプルを実行する為の設定
	JavaScript : window オブジェクトのプロパティとしてグローバル変数を定義する
	TCPDF をダウンロードして、フリーフォントを埋め込み型で使用する方法
	汎用型 : JSON データより履歴書のフォームを出力するサンプル
	ChatGPT でトップまでスクロールするブックマークレット
	Replit : cs-list
	Replit : js-web-speech
	Replit : js-csv-read-utf8
	Replit : text-editor
	指定した位置でレジストリエディタを開く為の VBScript をダウンロードします
	JScript / VBScript : 指定したフォルダ内のフォルダ毎の使用済みサイズを読める範囲でレポートする
	デスクトップを部分キャプチャした時に切り取り&スケッチを起動してキャプチャ画像に枠線を付加させる。
	#Zoom の必殺技 : 相手に自分の Zoom 関連のウインドウを見せる
	GAS でユーザ作成 : 組織は "orgUnitPath": "/組織名A/組織名B"

	一部のファイル形式がブロックされる(GMail)
	Creating Shortcut Menu Handlers
	Microsoft Word のキーボードショートカット
	Excel のショートカットキーとファンクションキー
	サイトへの不自然なリンクを否認する新しいツールの提供を開始しました

logical error

2020年01月19日

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

logical　error