SQLの窓 イラストAC フリー素材

2016年11月27日

【VBS + Excel】シンプルな詳細設計書のフォーマット。1) Excel のダウンロード、2) VBScript で作成するサンプル

▼ B4 基本設計書セット


これは、Excle(2010) ブックをダウンロードします。
( ※ プログラム一覧、概要書、テーブル一覧、テーブル設計、画面設計、入力設計、出力設計 )

PDF サンプル 


▼ スクリプトによる詳細設計書作成

Microsoft Excel がインストールされている必要があります

Excel 2007 以降の場合、.xls で保存する形式として 97-2003 として保存するようにしています。VBScript のライブラリはWEB上にあり、それらを参照して実行しています

実行すると、ドキュメントフォルダに作成されます
作成されるのは、非常にシンプルな4種類の設計書フォーマットです。
1) 概要書
 処理を中心とした入出力をオートシェイプの
 フローチャートで示し、概要を記述して正確
 な入出力エントリ列挙します
2) 画面設計書
 最近では画面の画像をはりつける事がほとん
 どです
3) 入力設計書
 入力チェックを中心とした GUI の操作手順を
 ベースとしてアプリケーションの定義をして
 いきます。入力フィールドの属性も通常示さ
 れます
4) 出力設計書
 更新処理はここで記述されます。最近では、
 DBテーブルの更新仕様と考えて良いでしょう。
 但し例外として、印刷処理のフォーマット指示
 である事もあります
作成するのは、詳細設計書書式なのですが、もし、VBScript を書く事ができるのであれば、Excel にアクセスしている部分は WEB 上のライブラリですが、常に Hosting しているので利用していただいて結構です。

ライブラリそのものは、テキストとして Hosting しているので、都合上 UTF-8 で書かれています。以下からダウンロード可能です。

baseFunction.vbs
excelFunction.vbs

※ 以下は仕様を書き込んだ作成イメージです

<JOB>
<COMMENT>
************************************************************
 WSH 実行スケルトン
************************************************************
</COMMENT>

<COMMENT>
************************************************************
 外部スクリプト定義
************************************************************
</COMMENT>
<SCRIPT
	language="VBScript"
	src="http://lightbox.in.coocan.jp/laylaClass.vbs">
</SCRIPT>

<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************
Call laylaFunctionTarget( "http://lightbox.in.coocan.jp/" )
Call laylaLoadFunction( "baseFunction.vbs" )
Call laylaLoadFunction( "excelFunction.vbs" )

Crun

str = InputBox( MyDocDir & " に作成されるExcelブック名を指定します",, _
	"簡易詳細設計書フォーマット" )
if str = "" then
	Wscript.Quit
end if

strTarget = MyDocDir & "\" & str & ".xls"

Set MyBook = CreateBook( strTarget )
' Call ExcelVisible( True )

' ******************************************************
' 画面設計書フォーマット作成
' ******************************************************
strSheetName = "画面設計書"
Wscript.Echo strSheetName & " を作成しています"

Call AddSheetTop(MyBook, strSheetName)
Call ExcelSelectSheet(MyBook, strSheetName)
on error resume next
Call DeleteSheet( MyBook, "Sheet1" )
Call DeleteSheet( MyBook, "Sheet2" )
Call DeleteSheet( MyBook, "Sheet3" )
on error goto 0

Call Format_Page(MyBook)

Call ExcelSize_Disp(MyBook, strSheetName)
Call ExcelLine_Disp(MyBook, strSheetName)
Call ExcelSetText_Disp(MyBook, strSheetName)

' ******************************************************
' 概要書
' ******************************************************
strSheetName = "概要書"
Wscript.Echo strSheetName & " を作成しています"

Call AddSheetTop(MyBook, strSheetName)
Call ExcelSelectSheet(MyBook, strSheetName)
Call Format_Page(MyBook)
Call ExcelSize_Plan(MyBook, strSheetName)
Call ExcelLine_Plan(MyBook, strSheetName)
Call ExcelSetText_Plan(MyBook, strSheetName)

' ******************************************************
' 入力設計書
' ******************************************************
strSheetName = "入力設計書"
Wscript.Echo strSheetName & " を作成しています"

Call AddSheetLast(MyBook, strSheetName)
Call ExcelSelectSheet(MyBook, strSheetName)
Call Format_Page(MyBook)
Call ExcelSize_Plan(MyBook, strSheetName)
Call ExcelLine_Plan(MyBook, strSheetName)
Call ExcelSetText_Plan(MyBook, strSheetName)

' ******************************************************
' 出力設計書
' ******************************************************
strSheetName = "出力設計書"
Wscript.Echo strSheetName & " を作成しています"

Call AddSheetLast(MyBook, strSheetName)
Call ExcelSelectSheet(MyBook, strSheetName)
Call Format_Page(MyBook)
Call ExcelSize_Plan(MyBook, strSheetName)
Call ExcelLine_Plan(MyBook, strSheetName)
Call ExcelSetText_Plan(MyBook, strSheetName)


' ******************************************************
' 終了処理
' ******************************************************
Call ExcelSave( MyBook )
Call ExcelQuit( MyBook )
Call ExcelLoad( Dd(strTarget) )

' ******************************************************
' セルサイズの設定
' ******************************************************
Function ExcelSize_Disp(MyBook, Target)

	'セルの高さ合わせ
	Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
	Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
	Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
	Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)

	For i = 5 To 25
		Call ExcelSetRowHeight(MyBook, Target, i, 24.75)
	Next

	For i = 26 To 38
		Call ExcelSetRowHeight(MyBook, Target, i, 19.00)
	Next

	'セルの幅合わせ
	Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
	Call ExcelSetColumnWidth(MyBook, Target, 2, 22.38)
	Call ExcelSetColumnWidth(MyBook, Target, 3, 7.50)
	Call ExcelSetColumnWidth(MyBook, Target, 4, 6.00)
	Call ExcelSetColumnWidth(MyBook, Target, 5, 6.00)
	Call ExcelSetColumnWidth(MyBook, Target, 6, 11.50)
	Call ExcelSetColumnWidth(MyBook, Target, 7, 25.00)
	Call ExcelSetColumnWidth(MyBook, Target, 8, 12.00)

End Function

' ******************************************************
' 罫線の設定
' ******************************************************
Function ExcelLine_Disp(MyBook, Target)

	' BOX罫線
	Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
	Call ExcelBox(xlContinuous, xlMedium)

	' 上罫線
	Call ExcelRange(MyBook, Target, 1, 2, 8, 2 )
	Call ExcelLine(xlDot, xlThin)

	Call ExcelRange(MyBook, Target, 1, 3, 8, 3 )
	Call ExcelLine(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 1, 4, 8, 4 )
	Call ExcelLine(xlDot, xlThin)

	Call ExcelRange(MyBook, Target, 1, 5, 8, 5 )
	Call ExcelLine(xlContinuous, xlMedium)

	Call ExcelRange(MyBook, Target, 1, 26, 8, 26 )
	Call ExcelLine(xlContinuous, xlMedium)

	for i = 27 to 38
		Call ExcelRange(MyBook, Target, 1, i, 8, i )
		Call ExcelLine(xlDot, xlThin)
	Next

	' 右罫線
	Call ExcelRange(MyBook, Target, 2, 1, 2, 4 )
	Call ExcelLineRight(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 6, 1, 6, 4 )
	Call ExcelLineRight(xlContinuous, xlThin)

	Call ExcelRange(MyBook, Target, 7, 1, 7, 4 )
	Call ExcelLineRight(xlContinuous, xlThin)

End Function

' ******************************************************
' セルのテキストの設定
' ******************************************************
Function ExcelSetText_Disp(MyBook, Target)

	Call ExcelRange(MyBook, Target, 1, 1, 7, 49 )
	Call ExcelVAlign()

	' 1行目
	Call ExcelSetCell(MyBook, Target, 1, 1, " システム名")
	Call ExcelSetCell(MyBook, Target, 3, 1, " サブシステム名")
	Call ExcelSetCell(MyBook, Target, 7, 1, " プログラムID")
	Call ExcelSetCell(MyBook, Target, 8, 1, "ページ")
	Call ExcelRange(MyBook, Target, 8, 1, 8, 1 )
	Call ExcelHAlign()

	' 2行目
	Call ExcelSetCell(MyBook, Target, 8, 2, "/")
	Call ExcelRange(MyBook, Target, 8, 2, 8, 2 )
	Call ExcelHAlign()

	' 3行目
	Call ExcelSetCell(MyBook, Target, 1, 3, " 画面ID")
	Call ExcelSetCell(MyBook, Target, 3, 3, " 画面名")

	Call ExcelSetCell(MyBook, Target, 7, 3, "作成日")
	Call ExcelRange(MyBook, Target, 7, 3, 7, 3 )
	Call ExcelHAlign()

	Call ExcelSetCell(MyBook, Target, 8, 3, "作成者")
	Call ExcelRange(MyBook, Target, 8, 3, 8, 3 )
	Call ExcelHAlign()

	' 4行目
	Call ExcelRange(MyBook, Target, 7, 4, 7, 4 )
	Call ExcelHAlign()

	Call ExcelRange(MyBook, Target, 8, 4, 8, 4 )
	Call ExcelHAlign()

End Function

' ******************************************************
' セルサイズの設定
' ******************************************************
Function ExcelSize_Plan(MyBook, Target)

	if Target = "概要書" then

		'セルの高さ合わせ
		Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 5, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 34, 20.25)

		For i = 6 To 49
			if 6 <= i AND i <= 33then
				Call ExcelSetRowHeight(MyBook, Target, i, 13.50)
			elseif 35 <=  i AND i  <= 44 then
				Call ExcelSetRowHeight(MyBook, Target, i, 24.50)
			elseif 45 <=  i AND i  <= 49 then
				Call ExcelSetRowHeight(MyBook, Target, i, 18.50)
			end if
		Next

		'セルの幅合わせ
		Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
		Call ExcelSetColumnWidth(MyBook, Target, 2, 22.38)
		Call ExcelSetColumnWidth(MyBook, Target, 3, 12.38)
		Call ExcelSetColumnWidth(MyBook, Target, 4, 8.25)
		Call ExcelSetColumnWidth(MyBook, Target, 5, 11.50)
		Call ExcelSetColumnWidth(MyBook, Target, 6, 25.00)
		Call ExcelSetColumnWidth(MyBook, Target, 7, 12.00)

	elseif Target = "入力設計書" then

		'セルの高さ合わせ
		Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 5, 20.25)

		For i = 6 To 38
			if 6 <= i AND i <= 25then
				Call ExcelSetRowHeight(MyBook, Target, i, 24.75)
			elseif 26 <=  i AND i  <= 38 then
				Call ExcelSetRowHeight(MyBook, Target, i, 19.00)
			end if
		Next

		'セルの幅合わせ
		Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
		Call ExcelSetColumnWidth(MyBook, Target, 2, 22.38)
		Call ExcelSetColumnWidth(MyBook, Target, 3, 7.50)
		Call ExcelSetColumnWidth(MyBook, Target, 4, 6.00)
		Call ExcelSetColumnWidth(MyBook, Target, 5, 6.00)
		Call ExcelSetColumnWidth(MyBook, Target, 6, 11.50)
		Call ExcelSetColumnWidth(MyBook, Target, 7, 25.00)
		Call ExcelSetColumnWidth(MyBook, Target, 8, 12.00)

	elseif Target = "出力設計書" then

		'セルの高さ合わせ
		Call ExcelSetRowHeight(MyBook, Target, 1, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 2, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 3, 13.50)
		Call ExcelSetRowHeight(MyBook, Target, 4, 24.50)
		Call ExcelSetRowHeight(MyBook, Target, 5, 20.25)

		For i = 6 To 38
			if 6 <= i AND i <= 25then
				Call ExcelSetRowHeight(MyBook, Target, i, 24.75)
			elseif 26 <=  i AND i  <= 38 then
				Call ExcelSetRowHeight(MyBook, Target, i, 19.00)
			end if
		Next

		'セルの幅合わせ
		Call ExcelSetColumnWidth(MyBook, Target, 1, 3.50)
		Call ExcelSetColumnWidth(MyBook, Target, 2, 22.38)
		Call ExcelSetColumnWidth(MyBook, Target, 3, 7.50)
		Call ExcelSetColumnWidth(MyBook, Target, 4, 6.00)
		Call ExcelSetColumnWidth(MyBook, Target, 5, 6.00)
		Call ExcelSetColumnWidth(MyBook, Target, 6, 11.50)
		Call ExcelSetColumnWidth(MyBook, Target, 7, 25.00)
		Call ExcelSetColumnWidth(MyBook, Target, 8, 12.00)

	end if

End Function

' ******************************************************
' 罫線の設定
' ******************************************************
Function ExcelLine_Plan(MyBook, Target)

	if Target = "概要書" then
		' BOX罫線
		Call ExcelRange(MyBook, Target, 1, 1, 7, 49 )
		Call ExcelBox(xlContinuous, xlMedium)

		' 上罫線
		Call ExcelRange(MyBook, Target, 1, 2, 7, 2 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 3, 7, 3 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 1, 4, 7, 4 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 5, 7, 5 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 5, 6, 7, 6 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 1, 34, 7, 34 )
		Call ExcelLine(xlContinuous, xlMedium)

		Call ExcelRange(MyBook, Target, 1, 35, 7, 35 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 36 to 44
			' 線種→点線, 太さ→標準
			Call ExcelRange(MyBook, Target, 1, i, 7, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		Call ExcelRange(MyBook, Target, 1, 45, 7, 45 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 46 to 49
			' 線種→点線, 太さ→標準
			Call ExcelRange(MyBook, Target, 1, i, 7, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		' 右罫線
		Call ExcelRange(MyBook, Target, 1, 35, 1, 44 )
		Call ExcelLineRight(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 4, 3, 4, 33 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 5, 1, 5, 4 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 6, 1, 6, 4 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 2, 34, 2, 44 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 3, 34, 3, 44 )
		Call ExcelLineRight(xlContinuous, xlThin)

	elseif Target = "入力設計書" then

		' BOX罫線
		Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
		Call ExcelBox(xlContinuous, xlMedium)

		' 上罫線
		Call ExcelRange(MyBook, Target, 1, 2, 8, 2 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 3, 8, 3 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 1, 4, 8, 4 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 5, 8, 5 )
		Call ExcelLine(xlContinuous, xlMedium)

		Call ExcelRange(MyBook, Target, 1, 6, 8, 6 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 7 to 25
			Call ExcelRange(MyBook, Target, 1, i, 8, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		Call ExcelRange(MyBook, Target, 1, 26, 8, 26 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 27 to 38
			Call ExcelRange(MyBook, Target, 1, i, 8, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		' 右罫線
		Call ExcelRange(MyBook, Target, 1, 6, 1, 25 )
		Call ExcelLineRight(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 2, 1, 2, 2 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 2, 5, 2, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 3, 5, 3, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 4, 5, 4, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 5, 3, 5, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 6, 1, 6, 25 )
		Call ExcelLineRight(1, 2)

		Call ExcelRange(MyBook, Target, 7, 1, 7, 4 )
		Call ExcelLineRight(1, 2)

	elseif Target = "出力設計書" then

		' BOX罫線
		Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
		Call ExcelBox(xlContinuous, xlMedium)

		' 上罫線
		Call ExcelRange(MyBook, Target, 1, 2, 8, 2 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 3, 8, 3 )
		Call ExcelLine(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 1, 4, 8, 4 )
		Call ExcelLine(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 1, 5, 8, 5 )
		Call ExcelLine(xlContinuous, xlMedium)

		Call ExcelRange(MyBook, Target, 1, 6, 8, 6 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 7 to 25
			Call ExcelRange(MyBook, Target, 1, i, 8, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		Call ExcelRange(MyBook, Target, 1, 26, 8, 26 )
		Call ExcelLine(xlContinuous, xlMedium)

		for i = 27 to 38
			Call ExcelRange(MyBook, Target, 1, i, 8, i )
			Call ExcelLine(xlDot, xlThin)
		Next

		' 右罫線
		Call ExcelRange(MyBook, Target, 1, 6, 1, 25 )
		Call ExcelLineRight(xlDot, xlThin)

		Call ExcelRange(MyBook, Target, 2, 1, 2, 2 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 2, 5, 2, 25 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 5, 3, 5, 4 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 6, 1, 6, 4 )
		Call ExcelLineRight(xlContinuous, xlThin)

		Call ExcelRange(MyBook, Target, 7, 1, 7, 25 )
		Call ExcelLineRight(xlContinuous, xlThin)
	end if

End Function

' ******************************************************
' セルのテキストの設定
' ******************************************************
Function ExcelSetText_Plan(MyBook, Target)

	if Target = "概要書" then

		Call ExcelRange(MyBook, Target, 1, 1, 7, 49 )
		Call ExcelVAlign()

		Call ExcelSetCell(MyBook, Target, 1, 1, " システム名")
		Call ExcelSetCell(MyBook, Target, 3, 1, " サブシステム名")
		Call ExcelSetCell(MyBook, Target, 6, 1, " プログラムID")
		Call ExcelSetCell(MyBook, Target, 1, 3, " プログラム名")
		Call ExcelSetCell(MyBook, Target, 1, 34, " テーブル名")

		Call ExcelSetCell(MyBook, Target, 7, 1, "ページ")
		Call ExcelRange(MyBook, Target, 7, 1, 7, 1 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 7, 2, "/")
		Call ExcelRange(MyBook, Target, 7, 2, 7, 2 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 5, 3, "種別")
		Call ExcelRange(MyBook, Target, 5, 3, 5, 3 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 6, 3, "作成日")
		Call ExcelRange(MyBook, Target, 6, 3, 6, 3 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 7, 3, "作成者")
		Call ExcelRange(MyBook, Target, 7, 3, 7, 3 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 5, 5, "処理概要")
		Call ExcelRange(MyBook, Target, 5, 5, 7, 5 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 3, 34, "入出力")
		Call ExcelRange(MyBook, Target, 3, 34, 3, 34 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 4, 34, "備考")
		Call ExcelRange(MyBook, Target, 4, 34, 7, 34 )
		Call ExcelHAlign()

		for i = 35 to 44
			Call ExcelSetCell(MyBook, Target, 1, i, i - 34)
			Call ExcelRange(MyBook, Target, 1, i, 1, i )

			' 配置
			Call ExcelHAlign()
			' 書式設定
			Call ExcelSetFont("太字", 12)
		next

	elseif Target = "入力設計書" then

		Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
		Call ExcelVAlign()

		Call ExcelSetCell(MyBook, Target, 1, 1, " システム名")

		Call ExcelSetCell(MyBook, Target, 3, 1, " サブシステム名")

		Call ExcelSetCell(MyBook, Target, 7, 1, " プログラムID")

		Call ExcelSetCell(MyBook, Target, 8, 1, "ページ")
		Call ExcelRange(MyBook, Target, 8, 1, 8, 1 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 8, 2, "/")
		Call ExcelRange(MyBook, Target, 8, 2, 8, 2 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 1, 3, " プログラム名")

		Call ExcelSetCell(MyBook, Target, 6, 3, "種別")
		Call ExcelRange(MyBook, Target, 6, 3, 6, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 7, 3, "作成日")
		Call ExcelRange(MyBook, Target, 7, 3, 7, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 8, 3, "作成者")
		Call ExcelRange(MyBook, Target, 8, 3, 8, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 1, 5, " 項目名")

		Call ExcelSetCell(MyBook, Target, 3, 5, "型式")
		Call ExcelRange(MyBook, Target, 3, 5, 3, 5 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 4, 5, "桁数")
		Call ExcelRange(MyBook, Target, 4, 5, 4, 5 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 5, 5, "I/O")
		Call ExcelRange(MyBook, Target, 5, 5, 5, 5 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 6, 5, "種別")
		Call ExcelRange(MyBook, Target, 6, 5, 6, 5 )
		Call ExcelHAlign()

		For i = 6 to 25
			Call ExcelSetCell(MyBook, Target, 1, i, i - 5 )
			Call ExcelRange(MyBook, Target, 1, i, 1, i )
			Call ExcelHAlign()
		Next

	elseif Target = "出力設計書" then

		Call ExcelRange(MyBook, Target, 1, 1, 8, 38 )
		Call ExcelVAlign()

		Call ExcelSetCell(MyBook, Target, 1, 1, " システム名")

		Call ExcelSetCell(MyBook, Target, 3, 1, " サブシステム名")

		Call ExcelSetCell(MyBook, Target, 7, 1, " プログラムID")

		Call ExcelSetCell(MyBook, Target, 8, 1, "ページ")
		Call ExcelRange(MyBook, Target, 8, 1, 8, 1 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 8, 2, "/")
		Call ExcelRange(MyBook, Target, 8, 2, 8, 2 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 1, 3, " プログラム名")

		Call ExcelSetCell(MyBook, Target, 6, 3, "種別")
		Call ExcelRange(MyBook, Target, 6, 3, 6, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 7, 3, "作成日")
		Call ExcelRange(MyBook, Target, 7, 3, 7, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 8, 3, "作成者")
		Call ExcelRange(MyBook, Target, 8, 3, 8, 4 )
		Call ExcelHAlign()

		Call ExcelSetCell(MyBook, Target, 1, 5, " 列名")

		Call ExcelSetCell(MyBook, Target, 3, 5, " 更新説明")

		Call ExcelSetCell(MyBook, Target, 8, 5, "対象")
		Call ExcelRange(MyBook, Target, 8, 5, 8, 5 )
		Call ExcelHAlign()

		For i = 6 to 25
			Call ExcelSetCell(MyBook, Target, 1, i, i - 5 )
			Call ExcelRange(MyBook, Target, 1, i, 1, i )
			Call ExcelHAlign()
		Next

	end if

End Function

' ******************************************************
' ヘッダー,余白の指定
' ******************************************************
Function Format_Page(MyBook)

	on error resume next
	With MyBook.ActiveSheet.PageSetup
		.CenterHeader = "&18&A"
		.LeftMargin = ExcelApp.InchesToPoints(0.393700787401575)
		.RightMargin = ExcelApp.InchesToPoints(0.196850393700787)
		.TopMargin = ExcelApp.InchesToPoints(0.551181102362205)
		.BottomMargin = ExcelApp.InchesToPoints(0.393700787401575)
		.HeaderMargin = ExcelApp.InchesToPoints(0.196850393700787)
		.FooterMargin = ExcelApp.InchesToPoints(0.196850393700787)
	End With
	on error goto 0

End Function
</SCRIPT>
</JOB>




posted by at 2016-11-27 18:03 | VBScript | このブログの読者になる | 更新情報をチェックする

2015年02月26日

VBScript(WMI) : システム環境変数の変更を監視する event_change_reg.wsf

関連する Microsoft のドキュメント

RegistryValueChangeEvent class

Receiving a WMI Event

RegistryValueChangeEvent は、HKEY_CURRENT_USER をサポートしていません

以下のサンプルは、システム環境変数の PATH を変更した場合にメッセージが表示されます

event_change_reg.wsf
<JOB>
<OBJECT id="WshShell" progid="WScript.Shell" />
<SCRIPT language="VBScript">
Crun

' **************************************
' WMI
' **************************************
Set objWMIServices = GetObject("winmgmts:\\.\root\default")
Set objSink = WScript.CreateObject( "WbemScripting.SWbemSink","SINK_")

' **************************************
' WMI イベント登録
' **************************************
objWMIServices.ExecNotificationQueryAsync objSink, _
    "Select * from RegistryValueChangeEvent Where " & _
    "Hive = 'HKEY_LOCAL_MACHINE' and " & _
    "KeyPath = 'SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment' and " & _
    "ValueName = 'Path'"

WScript.Echo "イベント待機中..."

While True 
     WScript.Sleep 1000
Wend

' **************************************
' 終了確認
' **************************************
Wscript.Echo "処理が終了しました"

' **************************************
' WMI イベント
' **************************************
Sub SINK_OnObjectReady(wmiObject, wmiAsyncContext) 
	WScript.Echo "レジストリが変更されました"
	WScript.Echo wmiObject.KeyPath
	WScript.Echo wmiObject.ValueName
	WScript.Echo WshShell.RegRead("HKLM\" & wmiObject.KeyPath & "\" & wmiObject.ValueName)
End Sub


' **************************************
' Cscript.exe で実行を強制
' Cscript.exe の実行終了後 pause で一時停止
' **************************************
Function Crun( )

	Dim str

	str = WScript.FullName
	str = Right( str, 11 )
	str = Ucase( str )
	if str <> "CSCRIPT.EXE" then
		str = WScript.ScriptFullName

		strParam = " "
		For I = 0 to Wscript.Arguments.Count - 1
			if instr(Wscript.Arguments(I), " ") < 1 then
				strParam = strParam & Wscript.Arguments(I) & " "
			else
				strParam = strParam & Dd(Wscript.Arguments(I)) & " "
			end if
		Next
		Call WshShell.Run( "cmd.exe /c cscript.exe " & Dd(str) & strParam & " & pause", 3 )
		WScript.Quit
	end if

End Function
' **************************************
' 文字列を " で囲む関数
' **************************************
Function Dd( strValue )

	Dd = """" & strValue & """"

End function
</SCRIPT>
</JOB>





タグ:VBScript WMI
posted by at 2015-02-26 00:31 | Comment(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2015年02月23日

VBScript : スクリプトが存在するディレクトリをユーザ環境変数の PATH へ登録



スクリプトが存在するディレクトリを ユーザ環境変数の PATH へ登録します。もし、システム環境変数またはユーザ環境変数に既に同じパスがあれば登録しません。登録位置は、PATH 環境変数文字列の一番最後になります

登録直後、cmd.exe で PATH の内容を見ても反映されないので、最後にエクスプローラを再起動しています。
<JOB>
<OBJECT id="WshShell" progid="WScript.Shell" />
<OBJECT id="WshNetwork" progid="WScript.Network" />
<OBJECT id="Fso" progid="Scripting.FileSystemObject" />
<SCRIPT language="VBScript">

strTitle = "スクリプトが存在するディレクトリをユーザPATH環境変数に登録"

' **************************************
' PC 名と ユーザ名を取得
' **************************************
strUser = WshNetwork.UserName
strMachine = WshNetwork.ComputerName

' **************************************
' スクリプトが存在するディレクトリを取得
' **************************************
strScriptPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strScriptPath )
Set obj = obj.ParentFolder
strScriptPath = obj.Path

' **************************************
' WMI
' **************************************
Set obj = GetObject("winmgmts:\\.\root\cimv2")

' **************************************
' システム環境変数のチェック
' **************************************
strValue = ""

Set objItems = obj.ExecQuery _
   ("select * from Win32_Environment where SystemVariable = True and Name = 'PATH'")

For Each objItem in objItems
	strValue = objItem.VariableValue
Next

if strValue <> "" then
	aData = Split( strValue, ";" )

	For I = 0 to Ubound( aData )
		if UCase(aData(I)) = UCase(strScriptPath) then
			Call Msgbox( "システム環境変数に既に登録されています", 0, strTitle )
			Wscript.Quit
		end if
	Next
end if


' **************************************
' ユーザ環境変数のチェック
' **************************************
strValue = ""

Set objItems = obj.ExecQuery _
   ("select * from Win32_Environment where SystemVariable = False and Name = 'PATH'")

For Each objItem in objItems
	if Ucase( objItem.UserName ) = Ucase(strMachine & "\" & strUser) then
		strValue = objItem.VariableValue
	end if
Next

if strValue <> "" then
	aData = Split( strValue, ";" )

	For I = 0 to Ubound( aData )
		if UCase(aData(I)) = UCase(strScriptPath) then
			Call Msgbox( "ユーザ環境変数に既に登録されています", 0, strTitle )
			Wscript.Quit
		end if
	Next
end if


' **************************************
' ユーザ環境変数を登録
' **************************************
strValue = strValue & ";" & strScriptPath

Set objEnv = obj.Get("Win32_Environment").SpawnInstance_

objEnv.Name = "PATH"
objEnv.UserName = strMachine & "\" & strUser
objEnv.VariableValue = strValue
objEnv.Put_

' **************************************
' エクスプローラを再起動
' ( ※ 登録されたパスを有効にします )
' **************************************
Set colProcessList = obj.ExecQuery _ 
	("Select * from Win32_Process Where Name = 'explorer.exe'") 
For Each objProcess in colProcessList
	on error resume next
	objProcess.Terminate() 
	on error goto 0
Next 

' 少し待ちます
Wscript.Sleep(500)
Call WshShell.Run( "explorer.exe" )


' **************************************
' 終了確認
' **************************************
Wscript.Echo "処理が終了しました"

</SCRIPT>
</JOB>


元となった Hey, Scripting Guy!

スクリプトを使用して環境変数を作成することはできますか


タグ:WMI VBScript
posted by at 2015-02-23 22:27 | VBScript | このブログの読者になる | 更新情報をチェックする

2015年02月05日

VBScript で GUID 生成

このコードは、VBScript のノウハウの詰まった『Hey, Scripting Guy!』に掲載されていたものです。

Scripting Guy さん、よろしくお願いします。スクリプトを使用して GUID を作成することはできますか。
Set TypeLib = CreateObject("Scriptlet.TypeLib")
WScript.Echo TypeLib.Guid
この記事では後半に、InternetExplorer.Application を使って GUID をクリップボードらコピーする方法が続きます。しかし、今の時代ではコマンドプロンプトで、clip.exe が使用できるので、そちらを使うのもいいかもしれません。
sCommand = "cmd /c echo Set TypeLib=CreateObject(""Scriptlet.TypeLib""):Wscript.echo TypeLib.Guid>%temp%\_.vbs&cscript.exe /NOLOGO %temp%\_.vbs | clip"

Set WshShell = WScript.CreateObject("WScript.Shell")
Call WshShell.Run( sCommand, 0, True )
WshShell.Run
0 : ウィンドウを非表示にし、別のウィンドウをアクティブにします
TRUE : プログラムの実行が終了するまでスクリプトの実行は中断



posted by at 2015-02-05 20:42 | VBScript | このブログの読者になる | 更新情報をチェックする

2015年01月22日

XMLファイルの書き換え (VBScript)

このブログの RSS を使ってテストしています

http://ginpro.winofsql.jp/index20.rdf

PC にダウンロードして実行すると、data.xml を作成します

▼ 追加部分


' DOM Object 作成
Set dom = CreateObject("Msxml2.DOMDocument")

' 既存 XML 入力
' http://ginpro.winofsql.jp/index20.rdf
dom.load( "index20.rdf" )

' 既存のノード( channel ) を取得
Set nodeList = dom.getElementsByTagName("channel")

' 新規ノードを作成( createElement でも良い )
Set node = dom.createNode( 1, "item", "" )
' Set node = dom.createElement( "item" )

' *****************************
' title ノードを作成
' *****************************
Set nodeChild = dom.createElement("title")
' テキストノードを作成して title ノードに追加
nodeChild.appendChild( dom.createTextNode("これは") )
' item ノードに titile ノードを追加
node.appendChild( nodeChild )

' *****************************
' content ノードを作成( CDATA セクションを使用します )
' *****************************
Set nodeChild = dom.createElement("content:encoded")
Set CDATASection = dom.createCDATASection( vbCrLf & "本文" & vbCrLf )
nodeChild.appendChild( CDATASection )
node.appendChild( nodeChild )

' *****************************
' link ノードを作成
' *****************************
Set nodeChild = dom.createElement("link")
nodeChild.appendChild( dom.createTextNode("SHIFT_JIS ですが") )
node.appendChild( nodeChild )

' *****************************
' description ノードを作成
' *****************************
Set nodeChild = dom.createElement("description")
nodeChild.appendChild( dom.createTextNode("オブジェクトになると") )
node.appendChild( nodeChild )

' *****************************
' category ノードを作成
' *****************************
Set nodeChild = dom.createElement("category")
nodeChild.appendChild( dom.createTextNode("内部コードに") )
node.appendChild( nodeChild )

' *****************************
' author ノードを作成
' *****************************
Set nodeChild = dom.createElement("author")
nodeChild.appendChild( dom.createTextNode("変換されます") )
node.appendChild( nodeChild )


' channel ノードは、一つしか無いので、nodeList(0) で参照
' channel ノードの下に item ノードを追加
nodeList(0).appendChild( node )

' 保存
dom.save( "data.xml" )


'<channel>
'	<item>
'		<title>aaaaa</title>
'		<content:encoded><![CDATA[bbbbb]]></content:encoded>
' 		<link>ccccc</link> 
' 		<description>ddddd</description> 
'		<category>eeeee</dc:subject> 
'		<author>fffff</dc:date> 
'	</item>
'		<---- ここに追加
' </channel>

Microsoft ドキュメント

IXMLDOMDocument/DOMDocument Members



posted by at 2015-01-22 11:19 | VBScript | このブログの読者になる | 更新情報をチェックする

2014年10月29日

VBScript から実行する PHPコードの PDF処理のサンプル

PDF 処理を行う為に、PHP を利用していますが、実行はエクスプローラから VBScript(WSH) の実行として開始します。

PDF の処理としては少し古いですが、FPDF を使用しています。

php.exe にパスが通っている必要があります

PDF を扱う為のライブラリは、全て WEB 上に置いてますので、インターネットさえ繋がっておれば、どこからでも利用できます。WSH のインラインストリームというか、ソースの中に PHP のソースがあるのがミソです。PHP は、テンポラリファイルとして書き出されて、スクリプトがあるディレクトリに PDF が作成されます。

実行すると、フォルダ選択ダイアログが表示されて、その中のファイルサイズを取得して PDF に出力します。

最後の処理として、PDF を表示する為に、Windows に登録されている .pdf の拡張子に対するアプリケーション(普通は Adobe Reader)で開くようになっていますが、無い場合は対象となるアプリケーションが無いというメッセージが表示されます。



folder_size_phppdf.wsf
<JOB>
<COMMENT>
*********************************
 WEB WSH 実行スケルトン
 ★★★ PDF 作成 ★★★
*********************************
</COMMENT>

<COMMENT>
*********************************
 外部スクリプト定義
*********************************
</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" )

target = SelectDir( "対象フォルダを選択して下さい" )
if target = "" then
	Wscript.Quit
end if

strParam = "$DIR," & Replace( ScriptDir, "", "" )
strParam = strParam & ",$TARGET," & Replace(target, "", "")
Call RunPhpParam( "TargetList", False, strParam )

</SCRIPT>

<COMMENT>
*********************************
 実行する PHP ( php.exe にパスが通っている必要があります )
 php5 でテストしています
 php.ini の allow_url_include を On にして下さい
*********************************
</COMMENT>
<RESOURCE id="TargetList">
<![CDATA[
<?php
error_reporting(E_ALL & ~E_DEPRECATED);
require('http://homepage2.nifty.com/lightbox/phppdf/japanese.php');

$GLOBALS['margin'] = 5;

$pdf = new PDF_Japanese( 'P', 'mm', 'A4' );

$pdf->AddSJISFont("MSPGothic");
$pdf->AddPage();
# 塗りつぶす為の色
$pdf->SetFillColor( 200, 230, 185 );

# タイトル印字
$pdf->SetFont('SJIS','B',20);
$text = 'ディレクトリ容量の表示';
$pdf->Text( $GLOBALS['margin'], 13.5, $text );

# 通常印字フォント
$pdf->SetFont('SJIS','',10);
# ページ内の印字開始高さ
$pdf->Ln(10);

$Fso = new COM("Scripting.FileSystemObject");
$Folder = $Fso->GetFolder("$TARGET");
$SubFolder = $Folder->SubFolders;

$pdf->SetX( $GLOBALS['margin'] );
$pdf->SetTextColor( 0, 0, 255 );
$pdf->Cell( 100, 6, "ディレクトリ名称" , 1, 0, 'C', 1 );
$pdf->SetTextColor( 0, 0, 0 );
$pdf->Cell( 20, 6, "サイズ", 1, 0, 'C', 0 );
$pdf->Ln();

foreach($SubFolder as $obj) {

	$pdf->SetX( $GLOBALS['margin'] );
	$pdf->SetTextColor( 0, 0, 255 );
	$pdf->Cell( 100, 6, $obj->Name, 1, 0, 'L', 1 );
	$pdf->SetTextColor( 0, 0, 0 );

	try {
		$pdf->Cell( 20, 6, trim((floor($obj->Size / 1000) / 1000)), 1, 0, 'R', 0 );
	}
	catch( Exception $e ) {
		$pdf->Cell( 20, 6, "エラー", 1, 0, 'L', 1 );
	}

	$pdf->Ln();

}


$pdf->Output("$DIR\sample.pdf");

# *******************************
# Windows 経由の 外部実行
# *******************************
$WshShell = new COM("WScript.Shell");
$command = "RunDLL32.EXE shell32.dll,ShellExec_RunDLL ";
$command .= ""$DIR\sample.pdf"";
$WshShell->Run( $command, 1, TRUE );

print "処理が終了しました\n";

?>
]]>
</RESOURCE>

</JOB>

※ 初回投稿 : 2007-03-14


posted by at 2014-10-29 01:04 | VBScript | このブログの読者になる | 更新情報をチェックする

2014年10月10日

Cscript.exe の引数と、Windows Script Host を無効にするレジストリ設定

通常、こんな事をする必要は無いのですが、万が一こんな目にあって作業できない時は、これでなんとかなるかもしれません。
>cscript.exe
Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

使い方 : CScript scriptname.extension [オプション...] [引数...]

オプション :
 //B         バッチ モード : スクリプトのエラーおよびプロンプトを非表示にする
 //D         アクティブ デバッグを使用可能にする
 //E:engine  スクリプト実行時にエンジンを使用する
 //H:CScript 既定のスクリプト ホストを CScript.exe に変更する
 //H:WScript 既定のスクリプト ホストを WScript.exe に変更する (既定値)
 //I         対話モード (既定値、//B と逆の動作)
 //Job:xxxx  WSF ジョブを実行する
 //Logo      ロゴを表示する (既定値)
 //Nologo    ロゴを表示しない : 実行時に見出しを表示しない
 //S         このユーザーの現在のコマンド ライン オプションを保存する
 //T:nn      秒単位のタイムアウト時間 :  スクリプトを実行できる時間の最大値
 //X         デバッガでスクリプトを実行する
 //U         コンソールからリダイレクトされた I/O に Unicode を使用する

ちなみに、以下は WSH が起動しなくなる設定です
Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows Script Host\Settings]
"DisplayLogo"="1"
"ActiveDebugging"="1"
"SilentTerminate"="0"
"UseWINSAFER"="1"
"Enabled"="0"
C:\Documents and Settings\lightbox>cscript
CScript エラー: Windows Script Host へのアクセスがこのコンピュータ上で無効にされ
ています。詳細については、管理者に連絡してください。
posted by at 2014-10-10 13:23 | VBScript | このブログの読者になる | 更新情報をチェックする

2014年08月30日

Access.Application ( docmd.TransferText ) でエクスポートとインポート

ドキュメントを読むと、余計わかりにくくなりますが、2番目の引数は省略できます(デフォルトのインポート/エクスポートの仕様を選択する場合は、この引数を空白のままにすることができます)。

一番の問題は、.vbs 内で定義されていない定数を使う事で、.wsf で定数をインポートする場合は別ですが、.vbs では定数をあらかじめ定義しておく必要があります。

AcTextTransferType Enumeration
Const acExportDelim 	= 2	'Export Delimited
Const acExportFixed	= 3	'Export Fixed Width
Const acExportHTML	= 8	'Export HTML
Const acExportMerge	= 4	'Export Microsot Word Merge
Const acImportDelim	= 0	'Import Delimited
Const acImportFixed	= 1	'Import Fixed Width
Const acImportHTML	= 7	'Import HTML
Const acLinkDelim	= 5	'Link Delimited
Const acLinkFixed	= 6	'Link Fixed Width
Const acLinkHTML	= 9	'Link HTML

Set ac = Wscript.CreateObject("Access.Application") 
ac.OpenCurrentDatabase("C:\vbs\mdb\a2010.accdb") 

ac.docmd.TransferText acExportDelim, "", "社員マスタ", "C:\vbs\mdb\doexp.csv", true

ac.docmd.TransferText acImportDelim, "", "社員マスタ", "C:\vbs\mdb\社員マスタ.csv", true

ac.docmd.Closedatabase

最後の true は、一行目がフィールド名である事を示しています

※ このインポート処理では、キーが重複しないもののみインポートされます


posted by at 2014-08-30 12:14 | Comment(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2014年08月26日

VBScript でエクスプローラの再起動

WMI に関しては決まり文句です。GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") 以外を使用する事は少ないです。『.』は、自分が実行しているコンピュータですが、違った書き方では、他の PC にログインしてリモートで WMI を実行できます。

For Each objProcess in colProcessList も決まり文句で、目的が一つしか無い事が通常ですが、For Each 内で対象の処理を行う事がほとんどです。

エクスプーラを、Terminate しても実行中のアプリは現状維持するようです。エクスプローラが本体として動作しているフォルダや管理ウインドウはいったん閉じてまたデフォルトの状態で開くようですが細かく確認はしていません。
' 起動用
Set WshShell = Wscript.CreateObject( "WScript.Shell" )
' WMI用
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

' いったん終了させます
Set colProcessList = objWMIService.ExecQuery _ 
	("Select * from Win32_Process Where Name = 'explorer.exe'") 
For Each objProcess in colProcessList
	on error resume next
	objProcess.Terminate() 
	on error goto 0
Next 

' 少し待ちます
Wscript.Sleep(500)
Call WshShell.Run( "explorer.exe" )




タグ:VBScript WMI
posted by at 2014-08-26 22:07 | Comment(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2014年08月21日

VBScript : CAPICOM を使った通常文字列の Base64エンコードと SHA1 と MD5 と SHA256/384/512

CAPICOM.Utilities は相当昔からあります。昔はわざわざインストールするものでしたが、自分の環境では既に入っています。( 一般的な Windows ではインストールされないのでダウンロードしてインストールします )

ドキュメント

以下の方法と同様で、バイナリファイルの変換に使う事が可能です。(PHPの文字列はバイナリ扱いです)

結果は PHP の関数で同じになる事を確かめています。
( php -r "print hash('sha256','変換する文字列');" )

SHA256/384/512 動きました。( HashedData.Algorithm )。最後に小文字に変換してますが、PHP の結果と合わす為です。

そもそも、こんな事を調べるような気になったのは、VBScript で Twitter のAPI を呼び出すのに、JavaScript ベースのライブラリを使ったのですが、ネイティブなものが使えないか試したわけですが、肝心の HMAC-SHA1 が見つからないので参考程度です( Twitter では結局 JavaScript のライブラリを VBScript 側から呼び出しました )

Base64 の変換では、本来良く使われて来た用途としてバイナリデータのテキスト表現で、メールの添付ファイルに使用する際に改行を含めて76文字になるようになっています。CAPIUtil.Base64Encode の仕様もそうなっているので、PHP と比較する為に、ここではわざわざ改行を取り除いています。

それと、CAPICOM.HashedData で作成したオブジェクトを使いまわすとエラーになる事があったので、毎回作成して処理しました。
Set CAPIUtil = Wscript.CreateObject( "CAPICOM.Utilities" )
Set Stream = Wscript.CreateObject("ADODB.Stream")
Set StreamBin = Wscript.CreateObject("ADODB.Stream")

'***********************************
' Base64
'***********************************
Stream.Open
Stream.Charset = "shift_jis"
' shift_jis で入力文字を書き込む
Stream.WriteText "日本語表示OK日本語表示OK日本語表示OK日本語表示OK日本語表示OK"
Stream.Position = 0

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

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

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

str = CAPIUtil.ByteArrayToBinaryString( StreamBin.Read )
str2 = CAPIUtil.Base64Encode( str )
' ' 長い文字列は仕様として、(\r\n を含めて 76文字で) 改行されます
str2 = Replace(str2,vbCrLf,"")

Wscript.Echo str2

'***********************************
' SHA1,SHA256,SHA384,SHA512 と MD5
'***********************************
' SHA1
Set HashedData = Wscript.CreateObject( "CAPICOM.HashedData" )
HashedData.Algorithm = 0
HashedData.Hash(str)

Wscript.Echo LCase(HashedData.Value)

' SHA256
Set HashedData = Wscript.CreateObject( "CAPICOM.HashedData" )
HashedData.Algorithm = 4
HashedData.Hash(str)

Wscript.Echo LCase(HashedData.Value)

' SHA384
Set HashedData = Wscript.CreateObject( "CAPICOM.HashedData" )
HashedData.Algorithm = 5
HashedData.Hash(str)

Wscript.Echo LCase(HashedData.Value)

' SHA512
Set HashedData = Wscript.CreateObject( "CAPICOM.HashedData" )
HashedData.Algorithm = 6
HashedData.Hash(str)

Wscript.Echo LCase(HashedData.Value)

' MD5
Set HashedData = Wscript.CreateObject( "CAPICOM.HashedData" )
HashedData.Algorithm = 3
HashedData.Hash(str)

Wscript.Echo LCase(HashedData.Value)




posted by at 2014-08-21 23:28 | VBScript | このブログの読者になる | 更新情報をチェックする
Seesaa の各ページの表示について
Seesaa の 記事がたまに全く表示されない場合があります。その場合は、設定> 詳細設定> ブログ設定 で 最新の情報に更新の『実行ボタン』で記事やアーカイブが最新にビルドされます。

Seesaa のページで、アーカイブとタグページは要注意です。タグページはコンテンツが全く無い状態になりますし、アーカイブページも歯抜けページはコンテンツが存在しないのにページが表示されてしまいます。

また、カテゴリページもそういう意味では完全ではありません。『カテゴリID-番号』というフォーマットで表示されるページですが、実際存在するより大きな番号でも表示されてしまいます。

※ インデックスページのみ、実際の記事数を超えたページを指定しても最後のページが表示されるようです

対処としては、このようなヘルプ的な情報を固定でページの最後に表示するようにするといいでしょう。具体的には、メインの記事コンテンツの下に『自由形式』を追加し、アーカイブとカテゴリページでのみ表示するように設定し、コンテンツを用意するといいと思います。


※ エキスパートモードで表示しています

アーカイブとカテゴリページはこのように簡単に設定できますが、タグページは HTML 設定を直接変更して、以下の『タグページでのみ表示される内容』の記述方法で設定する必要があります

<% if:page_name eq 'archive' -%>
アーカイブページでのみ表示される内容
<% /if %>

<% if:page_name eq 'category' -%>
カテゴリページでのみ表示される内容
<% /if %>

<% if:page_name eq 'tag' -%>
タグページでのみ表示される内容
<% /if %>
この記述は、以下の場所で使用します


Android SDK ポケットリファレンス
改訂版 Webデザイナーのための jQuery入門
今すぐ使えるかんたん ホームページ HTML&CSS入門
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX