2013年11月21日


Seesaa のカテゴリをソート(通常と逆順と記事が多い順)する VBScript で記述された IE 拡張





インストール場所は、通常 C:\laylaClass\menuex となります。 アンインストールは、アンインストール用のスクリプトを実行した後、C:\laylaClass\menuex\Seesaa_catsort.htm を削除して下さい。他のインストールされたファイルが無い場合は、C:\laylaClass\menuex も削除して下さい。

インストール









インストール用ソースコード
( ie_Seesaa_catsort_120417.wsf )
<JOB>
<COMMENT>
************************************************************
IE 拡張メニューインストーラ

■ Seesaa 用カテゴリソート

■著作権その他

このプログラムはフリーです。どうぞ自由に御使用ください。
著作権は作者である私(lightbox)が保有しています。
また、本ソフトを運用した結果については、作者は一切責任を
負えせんのでご了承ください。
************************************************************
</COMMENT>

<SCRIPT
	language="VBScript"
	src="http://homepage2.nifty.com/lightbox/laylaClass.vbs">
</SCRIPT>

<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************
Call laylaFunctionTarget( "http://homepage2.nifty.com/lightbox/" )
Call laylaLoadFunction( "baseFunction.vbs" )



' //////////////////////////////////////////////////////////
' インストール時の表示名
strProgName	= "Seesaa 用カテゴリソート"
' インストールファイル名( 拡張子は .htm となる )
strProgFile	= "Seesaa_catsort"
' メニューとウインドウのタイトルに表示する文字列
' レジストリに登録するのでユニークである必要があります
strRegName	= "Seesaa 用カテゴリソート"
' 対象となるコンンテンツ
nTargetType 	= &H4
' &H3F : UNKNOWNを除く全て
' &H1  : DEFAULT
' &H2  : IMAGE
' &H4  : CONTROL
' &H8  : TABLE
' &H10 : TEXTSELECT
' &H20 : ANCHOR
' &H40 : UNKNOWN

' 画面ありかどうか
bIsGUI = False
' //////////////////////////////////////////////////////////

print strProgName & " をインストールします"
if not OkCancel( "インストールしてもよろしいですか?" ) then
	Wscript.Quit
end if

' ファイルシステムオブジェクト作成
GetFso

strInstallPath1 = "c:\laylaClass"
strInstallPath2 = "c:\laylaClass\menuex"
strInstallPath3 = "c:\laylaClass\menuex\" & strProgFile & ".htm"
on error resume next
if not Fso.FolderExists( strInstallPath1 ) then
	Call Fso.CreateFolder( strInstallPath1 )
	if Err.Number <> 0 then
		ErrorFlg = True
	end if
end if
if not Fso.FolderExists( strInstallPath2 ) then
	Call Fso.CreateFolder( strInstallPath2 )
	if Err.Number <> 0 then
		ErrorFlg = True
	end if
end if
on error goto 0

Call PutTextFile( strInstallPath3, _
Replace(GetInline("MenuExt"),"$REGNAME", strRegName ) )

' レジストリ処理用オブジェクト作成
GetWshShell

on error resume next
WshShell.RegWrite _
	"HKCU\Software\Microsoft\Internet Explorer\MenuExt\"&strRegName&"\", _
	strInstallPath3, _
	"REG_SZ"
WshShell.RegWrite _
	"HKCU\Software\Microsoft\Internet Explorer\MenuExt\"&strRegName&"\Contexts", _
	nTargetType, _
	"REG_DWORD"

if bIsGUI then
	' この定義があると、画面あり
	WshShell.RegWrite _
	"HKCU\Software\Microsoft\Internet Explorer\MenuExt\"&strRegName&"\Flags", _
	&H1, _
	"REG_DWORD"
end if
on error goto 0

print "処理が終了しました"

Wscript.Quit

</SCRIPT>

<COMMENT>
******** ここからがコード ********
</COMMENT>
<RESOURCE id="MenuExt">
<![CDATA[
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=SHIFT_JIS">
<title>$REGNAME</title>
<script language="VBScript">

	Dim RegName,obj,doc,win

	RegName = "Seesaa 用カテゴリソート"

	' SHIFTとCTRL用変数
	Dim keyflg1,keyflg2
	keyflg1 = False
	keyflg2 = False

Function setObj( src )
	Set obj = src
End Function
</script>
<script language="JavaScript">
setObj(external.menuArguments.event.srcElement);
</script>
<base target="_self">
</head>
<body>
<input id="btn" type=button onClick='keyflg1=window.event.shiftKey:keyflg2=window.event.ctrlKey'>
<script language="VBScript">

	' ボタンの呼び出し
	document.getElementById("btn").click()

	' ADO 用の定数
	Const adVarChar = 130	' Null で終了する Unicode 文字列
	Const adInteger = 3	' 4 バイトの符号付き整数

	' IEが表示しているページの document オブジェクト
	Set doc = external.menuArguments.document
	' IEが表示しているページの window オブジェクト
	Set win = external.menuArguments

	Dim colTable,objTable
	Dim colInput,colNum

	Set colInput = Nothing

	' テーブル要素の一覧
	Set colTable = doc.getElementsByTagName("TABLE")
	For Each objTable In colTable
		' カテゴリ一覧テーブルの選択
		if objTable.className = "entrytable" then
			Set colInput = objTable.getElementsByTagName("A")
			Set colINum = objTable.getElementsByTagName("INPUT")
			Exit For
		end if
	Next

	Dim Rs,nCount,nMax,I,aData()

	' colInput は、対象テーブル内の A オブジェクト
	if Not colInput is Nothing then

		' A の数
		nCount = colInput.length
		' 仕様上2つで一行
		nMax = nCount / 2

		' ソート用レコードセット作成
		Set Rs = CreateObject("ADODB.Recordset")
		' メモリテーブルを作成
		' CTRL( 数値ソート )
		if keyflg2 then
			Rs.Fields.Append "ソートキー", adInteger
		' それ以外はカテゴリ名による文字列ソート
		else
			Rs.Fields.Append "ソートキー", adVarChar,255
		end if
		Rs.Fields.Append "順序", adInteger
		Rs.Open

		' データ保存
		For I = 0 to nMax - 1
			' 行追加
			Rs.AddNew
			' CTRL
			if keyflg2 then
				Rs.Fields("ソートキー").Value = Cint(colInput(I*2+1).firstChild.nodeValue)
			' カテゴリ名による文字列ソート
			else
				Rs.Fields("ソートキー").Value = colInput(I*2).firstChild.nodeValue
			end if
			Rs.Fields("順序").Value = I
			Rs.Update

		Next

		' ソート指定
		if keyflg1 or keyflg2 then
			' 逆ソート
			Rs.Sort = "ソートキー desc"
		else
			Rs.Sort = "ソートキー"
		end if

		' ポインタを先頭に移動
		Rs.MoveFirst

		' 配列を現在必要な数で動的作成
		ReDim aData(nMax)

		' 元の順序に現在の 順序x10+100 を設定
		I = 0
		Do while not Rs.EOF

			aData(Rs.Fields("順序").Value) = I*10 + 100

			Rs.MoveNext
			I = I + 1

		Loop

		' レコードセットを閉じる
		Rs.Close

		' 現在のフィールドにソート順序を設定
		For I = 0 to Ubound(aData) - 1

			colINum(I).Value = aData(I)

		Next

	end if

</script>
</body>
</html>
]]>
</RESOURCE>

</JOB>

インストール後は、一旦 IE を終了させて下さい。

関連する記事

ADO を使ったメモリソート



【IE拡張の最新記事】
posted by at 19:40 | Comment(0) | IE拡張 | このブログの読者になる | 更新情報をチェックする


この記事へのコメント
コメントを書く
お名前:

ホームページアドレス:

コメント:

認証コード: [必須入力]


※画像の中の文字を半角で入力してください。
※ブログオーナーが承認したコメントのみ表示されます。