<JOB>
<COMMENT>
************************************************************
■ maglog 記事ページ読み出し
base : WEB アクセススケルトン( web_access.wsf )
■ 著作権その他
このプログラムはフリーです。どうぞ自由に御使用ください。
著作権は作者である私(lightbox)が保有しています。
また、本ソフトを運用した結果については、作者は一切責任を
負えせんのでご了承ください。
************************************************************
</COMMENT>
<OBJECT id="objHTTP" progid="Msxml2.XMLHTTP" />
<OBJECT id="Stream" progid="ADODB.Stream" />
<OBJECT id="Stream2" progid="ADODB.Stream" />
<OBJECT id="StreamBin" progid="ADODB.Stream" />
<OBJECT id="Fso" progid="Scripting.FileSystemObject" />
<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************
bDebug = False
user = "ユーザー"
pass = "パスワード"
strBlogName = "lightbox"
strArticleNo = "713301"
strTargetUrl1 = "http://maglog.jp/"&strBlogName&"/index.php?&module=Login&action=LoginDef"
strTargetUrl2 = "https://passport.vector.co.jp/passport/passport.php?p=VP_PROC_LOGIN_EXECUTE&f=VT"
strTargetUrl3 = "http://maglog.jp/"&strBlogName&"/index.php?module=Article&action=Edit&article_id="&strArticleNo
' 追加書き込み
Set LogFile = Fso.OpenTextFile( "web_access.log", 8, True )
LogFile.WriteLine( "処理を開始しました" )
' ***********************************************************
' (1) : GET
' ***********************************************************
Call objHTTP.Open("GET",strTargetUrl1, False)
Call objHTTP.Send()
strHeaders = objHTTP.getAllResponseHeaders()
LogFile.WriteLine( strHeaders & vbCrLf )
if bDebug then
Wscript.Echo strHeaders
end if
Call WriteBinData("page1.htm", objHTTP.responseBody )
' ***********************************************************
' (2) : POST
' ***********************************************************
Call objHTTP.Open("POST",strTargetUrl2,False)
' POST 用ヘッダ
Call objHTTP.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
strData = ""
strData = strData & "VP_UID="&user
strData = strData & "&VP_PW="&pass
Call objHTTP.SetRequestHeader("Content-Length",Len(strData))
Call objHTTP.Send(strData)
strHeaders = objHTTP.getAllResponseHeaders()
LogFile.WriteLine( strHeaders & vbCrLf )
if bDebug then
Wscript.Echo strHeaders
end if
Call WriteBinData("page2.htm", objHTTP.responseBody )
' ***********************************************************
' (3) : GET
' ***********************************************************
Call objHTTP.Open("GET",strTargetUrl3, False)
Call objHTTP.Send()
strHeaders = objHTTP.getAllResponseHeaders()
LogFile.WriteLine( strHeaders & vbCrLf )
if bDebug then
Wscript.Echo strHeaders
end if
Call WriteBinData("page3.htm", objHTTP.responseBody )
' ***********************************************************
' 処理終了
' ***********************************************************
LogFile.WriteLine( "処理を終了しました" & vbCrLf & vbCrLf )
LogFile.Close()
Wscript.Echo "処理が終了しました"
Wscript.Quit
' ***********************************************************
' ソース内テキストデータの取得
' ***********************************************************
Function GetMyText( strName )
GetMyText = RegTrim(GetResource(strName))
End Function
' ***********************************************************
' 文字列前後の漢字スペースを含むホワイトスペースの削除
' ***********************************************************
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
' ***********************************************************
' ランダムな文字列
' ***********************************************************
Function Nonce( )
Dim base_str,str,I,nLen,Random
base_str = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
base_str = base_str & "abcdefghijklmnopqrstuvwxyz0123456789"
nLen = Len(base_str)
str = ""
For I = 1 to 32
Randomize
Random = 1 + Int(Rnd * nLen)
str = str & Mid(base_str,Random,1)
Next
Nonce = str
End function
' **********************************************************
' Unix タイムスタンプ
' **********************************************************
Function UnixTimestamp( )
UnixTimestamp = DateDiff("s", "1970/1/1 0:00:00",DateAdd("h",-9,now))
End Function
' ***********************************************************
' boundary 作成 ( Unix タイムスタンプ そのままでも可 )
' ***********************************************************
Function GetBoundary( )
GetBoundary = "---------------------------" & UnixTimestamp()
End Function
' ***********************************************************
' バイナリデータの保存( 上書き )
' ***********************************************************
Function WriteBinData( strFile, BinData )
Stream.Open
Stream.Type = 1 ' バイナリ
Stream.Write BinData
Stream.SaveToFile strFile, 2
Stream.Close
End Function
' ***********************************************************
' fromCharset を toCharset に変換して URLエンコード
' ※ 全ての文字をパーセントエンコーディングします
' ***********************************************************
Function URLEncode(str,fromCharset,toCharset)
Stream.Open
Stream.Charset = fromCharset
Stream.WriteText str
' コピーの為にデータポインタを先頭にセット
Stream.Position = 0
Stream2.Open
Stream2.Charset = toCharset
Stream.CopyTo Stream2
Stream.Close
' コピーの為にデータポインタを先頭にセット
Stream2.Position = 0
' バイナリで開く
StreamBin.Open
StreamBin.Type = 1
' テキストをバイナリに変換
Stream2.CopyTo StreamBin
Stream2.Close
' 読み込みの為にデータポインタを先頭にセット
StreamBin.Position = 0
Buffer = ""
if UCase( toCharset ) = "UTF-8" then
StreamBin.Read(3)
end if
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
</SCRIPT>
<COMMENT>
************************************************************
ソース内テキストデータ
************************************************************
</COMMENT>
<RESOURCE id="myTextData">
<![CDATA[
]]>
</RESOURCE>
</JOB>
上の画面は、Seesaa のブログ管理画面ですが、本来右上に広告があり、右サイド には、「アバターをブログに貼ろう！」と言うような 一連のSeesaa 側のコンテ ンツがありますが、これを削除してからキャプチャしています。 これを行うには、Firefox に Firebug をインストールしてから画面を表示して、 そのコンテンツにカーソルを合わせて右クリックします。
そうするとポップアップメニューに「要素を調査」という項目があるので選択し ます。すると、Firebug が表示されて、その要素が HTML 上で選択されます。 HTML の構成ツリー上でカーソルを動かすと、実際の画面上で位置表示がされます ので、正確に必要無いコンテンツの位置で右クリックしてポップアップメニュー を表示し、「要素を削除」を実行します。
そうすると、その要素が削除された画面が一時的に出来上がります。
このような操作を繰り返す事によって、必要なコンテンツのみが表示される画像 を作成する事ができます
