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

2018年02月16日

VBScript + clipコマンド + レジストリ登録で、エクスプローラのディレクトリの右クリックでファイル名のリストをクリップボードにコピーできるようにする



昔はクリップボードにコピーするコマンドを自作したりしてましたが、今では clip コマンドが Windows のコマンドプロンプトから実行できます。
CLIP

説明:
    コマンド ライン ツールの出力を Windows クリップボードにリダイレクトします。
    その出力されたテキストをほかのプログラムに貼り付けることができます。

パラメーター一覧:
    /?                  このヘルプを表示します。

例:
    DIR | CLIP          現在のディレクトリ一覧のコピーを Windows クリップボード
                        に貼り付けます。

    CLIP < README.TXT   readme.txt ファイルのテキストのコピーを Windows
                        クリップボードに貼り付けます。
これを使用すると、dir コマンドの結果をクリップボードにコピーできます。 dir /A:-D /B /O:N | clip ※ -D はディレクトリを省く、/B はファイル名のみを表示、/O:N は名前順に表示 さらに、このコマンドを VBScript から『コマンドプロンプトを開かない』で実行できるようにします。 filelist.vbs
Set WshShell = CreateObject( "WScript.Shell" )

Target= WScript.Arguments(0)
Command = "cmd /C dir ""$1"" /A:-D /B /O:N | CLIP"
Command = Replace( Command, "$1", Target )

Call WshShell.Run( Command, 0, True )

※ 引数に dir 対象のフォルダのパスが入る必要があります。

これを以下の内容で、.reg を拡張子にしてキャラクタセットを SHIFT_JIS か unicode に変更してエクスプローラからダブルクリックして実行すると、エクスプローラのフォルダの右クリックで実行できるようになります。

filelist.reg
Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\Directory\shell\filelist]
@="ファイル一覧をコピー"

[HKEY_CLASSES_ROOT\Directory\shell\filelist\command]
@="wscript.exe \"C:\\tools\\filelist.vbs\" \"%L\""
※ ここでは、filelist.vbs を c:\toos に保存しています。



posted by at 2018-02-16 07:49 | VBScript | このブログの読者になる | 更新情報をチェックする

2018年02月12日

VBScript(WMI) : OSの情報をコマンドプロンプトに一覧で表示する

WMI( Win32_OperatingSystem ) により、OS の情報を表示しています。全ての値が文字列でそのまま表示可能では無いので on error resume next と on error goto 0 でエラー処理を行っています。



結果をテキストファイルにするには、コマンドプロンプトから cscript スクリプト名 > テキストファイル名 とすると書き込まれます( cscript で実行すると、Crun 関数は何もしません )

Call Crun()

' **********************************************************
' OS の情報一覧( ローカル限定 )
' **********************************************************
Set obj = GetObject("winmgmts:\\.\root\cimv2")
Set colTarget = obj.ExecQuery( "select * from Win32_OperatingSystem" )
' この場合行は1行しかありません
For Each objRow in colTarget
	Set colProps = objRow.Properties_
	For Each objProp in colProps
		on error resume next
		Wscript.Echo RpadB(objProp.Name," ", 25 ) & " : " & objProp.Value
		if Err.Number <> 0 then
			Wscript.Echo RpadB(objProp.Name," ", 25 ) & " : " & "データ型が " & TypeName(objProp.Value) & " なので処理できません"
		end if
		on error goto 0
	Next
Next

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

	Dim str,WshShell

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

		Set WshShell = CreateObject( "WScript.Shell" )

		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", 1 )
		WScript.Quit
	end if

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

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

End function
' **************************************
' 文字列の右側をスペースで埋める
' **************************************
Function RpadB( strValue, str, nLen )

	Dim strWork,nLen2

	strWork = Left( strValue & String(nLen,str), nLen )
	nLen2 = nLen

	Do While ByteLen( strWork ) > nLen
		nLen2 = nLen2 - 1
		if nLen2 <= 0 then
			Exit Do
		end if
		strWork = Left( strValue & String(nLen,str), nLen2 )
	Loop
	RpadB = strWork

End function
' **************************************
' 漢字と半角での横幅の計算
' **************************************
Function ByteLen( strTarget )

	Dim i,nLen,nRet,strMoji,nAsc

	nRet = 0

	nLen = Len( strTarget )

	For i = 1 to nLen
		nRet = nRet + 2
		strMoji = Mid( strTarget, i, 1 )
		nAsc = Asc( strMoji )
		if &H0 <= nAsc and nAsc <= &H80 then
			nRet = nRet - 1
		end if
		if &HA0 <= nAsc and nAsc <= &HDF then
			nRet = nRet - 1
		end if
		if &HFD <= nAsc and nAsc <= &HFF then
			nRet = nRet - 1
		end if
	Next

	ByteLen = nRet

End Function


全く同じ処理を以下の短いコードでも実行できます(関数を WEB 上に置いています)
<JOB>
<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 Crun()

' **********************************************************
' OS の情報一覧( ローカル限定 )
' **********************************************************
Set obj = GetObject("winmgmts:\\.\root\cimv2")
Set colTarget = obj.ExecQuery( "select * from Win32_OperatingSystem" )
' この場合行は1行しかありません
For Each objRow in colTarget
	Set colProps = objRow.Properties_
	For Each objProp in colProps
		on error resume next
		Wscript.Echo RpadB(objProp.Name," ", 25 ) & " : " & objProp.Value
		if Err.Number <> 0 then
			Wscript.Echo RpadB(objProp.Name," ", 25 ) & " : " & "データ型が " & TypeName(objProp.Value) & " なので処理できません"
		end if
		on error goto 0
	Next
Next

</SCRIPT>
</JOB>


TypeName 関数



タグ:VBScript WMI
posted by at 2018-02-12 14:29 | VBScript | このブログの読者になる | 更新情報をチェックする

VBScript(WMI) : 共有一覧

共有の取得部分は、Select * from Win32_Share で取得できます。それらをコマンドプロンプトで見やすく表示させる為の関数を定義しています。



1) Crun : cscript.exe での実行の強制( コマンドプロンプトへの切り替え )
2) Dd : 文字列の処理
3) RpadB : 文字列整形用
4) ByteLen : RpadB 用

Call Crun()

' **************************************
' 共有一覧(WMI)
' **************************************
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colShares = objWMIService.ExecQuery("Select * from Win32_Share")
Wscript.Echo "【共有一覧】"
Wscript.Echo "----------------------------------------------------"
For Each Share In colShares
	Wscript.Echo RpadB(Share.Name, " ", 20) & " : " & Share.Path
Next


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

	Dim str,WshShell

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

		Set WshShell = CreateObject( "WScript.Shell" )

		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", 1 )
		WScript.Quit
	end if

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

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

End function
' **************************************
' 文字列の右側をスペースで埋める
' **************************************
Function RpadB( strValue, str, nLen )

	Dim strWork,nLen2

	strWork = Left( strValue & String(nLen,str), nLen )
	nLen2 = nLen

	Do While ByteLen( strWork ) > nLen
		nLen2 = nLen2 - 1
		if nLen2 <= 0 then
			Exit Do
		end if
		strWork = Left( strValue & String(nLen,str), nLen2 )
	Loop
	RpadB = strWork

End function
' **************************************
' 漢字と半角での横幅の計算
' **************************************
Function ByteLen( strTarget )

	Dim i,nLen,nRet,strMoji,nAsc

	nRet = 0

	nLen = Len( strTarget )

	For i = 1 to nLen
		nRet = nRet + 2
		strMoji = Mid( strTarget, i, 1 )
		nAsc = Asc( strMoji )
		if &H0 <= nAsc and nAsc <= &H80 then
			nRet = nRet - 1
		end if
		if &HA0 <= nAsc and nAsc <= &HDF then
			nRet = nRet - 1
		end if
		if &HFD <= nAsc and nAsc <= &HFF then
			nRet = nRet - 1
		end if
	Next

	ByteLen = nRet

End Function


全く同じ処理を以下の短いコードでも実行できます(関数を WEB 上に置いています)
<JOB>
<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 Crun()

' **************************************
' 共有一覧(WMI)
' **************************************
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colShares = objWMIService.ExecQuery("Select * from Win32_Share")
Wscript.Echo "【共有一覧】"
Wscript.Echo "----------------------------------------------------"
For Each Share In colShares
	Wscript.Echo RpadB(Share.Name, " ", 20) & " : " & Share.Path
Next

</SCRIPT>
</JOB>



タグ:VBScript WMI
posted by at 2018-02-12 03:08 | VBScript | このブログの読者になる | 更新情報をチェックする

2018年02月03日

IE のお気に入りディレクトリにあるファイルの表示・非表示を設定する / HTA(HTML アプリケーション)

VBScript の処理方法を整理する意味で、Windows10 でテストして9年ぶりに更新しました。

※ 昨今、IE は使われ無いようになって行っていますが、まだ当分は必要な環境もあると思います。
このプログラムは、IE のお気に入りディレクトリのファイルの表示・非表示を設定するツールです。 ( C:\Users\ユーザ名\Favorites ) チェックボックスがチェックされていると表示されます。チェックされていないと非表示となります。 更新後、IE は再起動するか、タブを複製すると反映されます(新しいタブでも反映されてました) ▼ エントリをクリックするとプロパティを開きます favdir.hta の内容 ※ 実行するには、拡張子が hta である必要があります
<meta http-equiv="content-type" content="text/html; charset=SHIFT_JIS">
<SCRIPT language="VBScript">

	Dim WshShell,TargetDir,objShell,nId

	Set WshShell = CreateObject( "WScript.Shell" )
	TargetDir = WshShell.SpecialFolders("Favorites")
	Set objShell = CreateObject("Shell.Application")

	Set Fso = CreateObject( "Scripting.FileSystemObject" )

Function SetTable()

	Set objFolder = Fso.GetFolder( TargetDir )
	Set objFiles = objFolder.SubFolders 

	str=""
	str=str&"<TABLE id=ieex border=0 cellspacing=1 cellpadding=6> "&vbCrLf
	str=str&"<TH style='width:35px;'></TH> "&vbCrLf
	str=str&"<TH>エントリをクリックするとプロパティを開きます<br>エントリが二段で下がリンクの場合クリックすると IE で開く事ができます</TH> "&vbCrLf
	str=str&"<TH></TH> "&vbCrLf

	nId = 1
	For each objFile in objFiles

		str=str&"<tr>" & vbCrLf
		str=str&"<td>" & vbCrLf
		' チェックボックス ( check+n )
		str=str&"<input type='checkbox' id=check" & nId

		' hidden の場合
		if objFile.Attributes and 2 then
			' なにもしない
		else
			' 通常表示されている状態
			str=str&" checked "
		end if

		str=str&">"
		str=str&"</td>" & vbCrLf
		str=str&"<td style='background-color:silver;font-weight:bold;'>" & vbCrLf
		str=str&"<input type='button' value='フォルダに移動' onClick='Call ChangeDir("""& TargetDir & "\" & objFile.Name &""")'>&nbsp;"
		str=str&"<span id=target" & nId & " style='cursor:pointer;color:navy;vertical-align:4px' onClick='Call OpenProp(""" & nId & """)'>["

		Set objShellFolder = objShell.NameSpace(TargetDir & "\" & objFile.Name)

		str=str&objShellFolder.Title
		str=str&"]</span>"
		str=str&"</td>" & vbCrLf
		str=str&"<td style='background-color:silver;font-weight:bold;' id=fullpath" & nId & ">"
		str=str&TargetDir & "\" & objFile.Name
		str=str&"</td>" & vbCrLf
		str=str&"</tr>" & vbCrLf

		nId = nId + 1

	Next

	Set objFiles = objFolder.Files

	For each objFile in objFiles

		if Ucase(Right(objFile.Name,4)) = ".URL" then

			str=str&"<tr>" & vbCrLf
			str=str&"<td>" & vbCrLf
			' チェックボックス ( check+n )
			str=str&"<input type='checkbox' id=check" & nId
		
			' hidden の場合
			if objFile.Attributes and 2 then
				' なにもしない
			else
				' 通常表示されている状態
				str=str&" checked "
			end if
		
			str=str&">"
			str=str&"</td>" & vbCrLf
			str=str&"<td>" & vbCrLf
			str=str&"<span id=target" & nId & " style='cursor:pointer;color:navy' onClick='Call OpenProp(""" & nId & """)'>"
			str=str&objFile.Name
			str=str&"</span>"
		
			str=str&"<br>"
			Set oUrlLink = WshShell.CreateShortcut(TargetDir & "\" & objFile.Name)
			if Ucase(Left(Trim(oUrlLink.TargetPath),11)) <> "JAVASCRIPT:" then
				str=str&"<a style='color:blue;' href='"
				str=str&oUrlLink.TargetPath
				str=str&"' target=_blank>"&oUrlLink.TargetPath&"</a>"
			end if
		
			str=str&"</td>" & vbCrLf
			str=str&"<td id=fullpath" & nId & ">"
			str=str&TargetDir & "\" & objFile.Name
			str=str&"</td>" & vbCrLf
			str=str&"</tr>" & vbCrLf
		
			nId = nId + 1

		end if

	Next

	nId = nId - 1

	str=str&"</TABLE>"&vbCrLf

	document.getElementById("table").innerHTML = str

End Function

Function OpenProp( nRow )

	Dim str,str1,str2

	str = document.getElementById("fullpath"&nRow).innerText

	Dim objWork,bFlg

	if Ucase(document.getElementById("fullpath"&nRow).style.backgroundColor) = "SILVER" then
		Set objWork = Fso.GetFolder(str)
	else
		Set objWork = Fso.GetFile( str )
	end if
	bFlg = False
	if (objWork.Attributes and 2) = 2 then
		objWork.Attributes = objWork.Attributes and (255-2)
		bFlg = True
	end if

	Set objFolder = objShell.NameSpace(TargetDir)

	For each objFile in objFolder.items
		if str = objFile.Path then
			Set obj = objFile.Verbs
			For i = 0 To obj.Count - 1
				if InStr( obj.item(i).Name, "プロパティ" ) > 0 then
					objFile.InvokeVerb("Properties")
				end if
			Next
		end if
	Next

	if bFlg then
		objWork.Attributes = objWork.Attributes or 2
	end if

End Function

Function AttUpdate()

	Dim idx,str,work,objFile

	For idx = 1 to nId
		' 対象となるパス
		str = document.getElementById("fullpath"&idx).innerText

		if Ucase(document.getElementById("fullpath"&idx).style.backgroundColor) = "SILVER" then
			' ファイルオブジェクト
			Set objFile = Fso.GetFolder(str)
		else
			' ファイルオブジェクト
			Set objFile = Fso.GetFile(str)
		end if

		if document.getElementById("check"&idx).checked then
			' チェックされているので hidden を除く
			objFile.Attributes = objFile.Attributes and (255-2)
		else
			' チェックが外されているので hidden を設定する
			objFile.Attributes = objFile.Attributes or 2
		end if
	Next

	alert("更新しました   ")

End Function

Function ChangeDir( path )

	TargetDir = path

	Call SetTable()

	document.title = path

End Function

</SCRIPT>
<html>
<head>
<title>お気に入り ディレクトリ/メンテナンス</title>
<HTA:APPLICATION ID="Sqlwin"
	BORDERSTYLE="sunken"
	INNERBORDER="yes"
	SCROLL="yes"
	ICON="http://winofsql.jp/WinOfSql.ico"
>
<style type="text/css">
* {
	font-size:12px;
	font-family: "メイリオ";
}
body {
	margin:0;
}

#ieex {
	table-layout:fixed;
	margin-top:4px;
	margin-left:20px;
	width:1000px;
	background-color:black;
}

#ieex td,#ieex th {
	background-color:white;
}

#update {
	margin-top:0px;
	margin-left:20px;
}

</stylE>
</head>
<body>
<div style='padding:5px 20px;font-size:16px;font-weight:bold'>IE のお気に入りディレクトリにあるファイルの表示・非表示を設定する</div>
<div style='width:1000px;'>
	<input style='float:right' type="button" value="HOME" onclick='TargetDir = WshShell.SpecialFolders("Favorites"):Call SetTable():document.title = "お気に入り ディレクトリ/メンテナンス"'>
	<input id=update type=button value="更新" onClick='Call AttUpdate()'> <span style='vertical-align:4px'>チェックを外して更新すると、IE 側で表示だけしなくなります(<b>IE は再起動するか、タブを複製して下さい</b>)。</span>
</div>
<div id=table>

</BODY>
</html>
<SCRIPT for=window event=onload language="VBScript">

	window.focus()
	top.moveTo 0, 0
	top.resizeTo screen.width, screen.height - 32

	Call SetTable()

</SCRIPT>

<SCRIPT for=window event=onunload language="VBScript">

</SCRIPT>




posted by at 2018-02-03 14:32 | VBScript | このブログの読者になる | 更新情報をチェックする

2018年01月30日

VBScript : デスクトップの列挙

オンライン上にある、VBScript のライブラリを使用しています。
<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" )

GetShell

Crun2 130

Wscript.Echo "【デスクトップ/一般】"
Wscript.Echo "----------------------------------------------------"
Set objFolder = Shell.NameSpace( 0 )

Set objFolderItems = objFolder.Items()
nCount = objFolderItems.Count

' 列挙1
strData = ""
For i = 0 to nCount - 1

	strData = strData & RpadB(objFolderItems.Item(i).Name," ",30 )
'	strData = strData & RpadB(objFolderItems.Item(i).ModifyDate," ",30 )
	strData = strData & RpadB(objFolderItems.Item(i).Path," ",89 )
'	strData = strData & RpadB(objFolderItems.Item(i).Size," ",20 )
'	strData = strData & RpadB(objFolderItems.Item(i).Type," ",20 )
	WScript.Echo strData
	strData = ""

Next


' 列挙2
Wscript.Echo
Wscript.Echo "【デスクトップ/詳細情報】"
Wscript.Echo "----------------------------------------------------"
strData = ""
For Each obj In objFolderItems

	strData = strData & RpadB(objFolder.GetDetailsOf(obj, 0)," ",20 )
	strData = strData & RpadB(objFolder.GetDetailsOf(obj, 1)," ",20 )
	strData = strData & RpadB(objFolder.GetDetailsOf(obj, 2)," ",20 )
	strData = strData & RpadB(objFolder.GetDetailsOf(obj, 3)," ",20 )
	strData = strData & RpadB(objFolder.GetDetailsOf(obj, 4)," ",20 )
	strData = strData & RpadB(objFolder.GetDetailsOf(obj, -1)," ",20 )
	WScript.Echo strData
	strData = ""

Next

Wscript.Echo

</SCRIPT>
</JOB>



▼ Windows10 での実行結果サンプル


結果をテキストファイルに残すには、以下のようにして表示をファイルにリダイレクトします
cscript ginpro_1517239356526.wsf > log.txt
一部特殊フォルダが表示されていますが、それらを使用してエクスプローラを起動する事ができます。Winows10 で、PC を選択してエクスプローラを開く記述は以下のようになります。
Explorer /e,/root,::{20D04FE0-3AEA-1069-A2D8-08002B30309D}



posted by at 2018-01-30 17:25 | VBScript | このブログの読者になる | 更新情報をチェックする

2018年01月28日

バッチ処理の為の .wsf スケルトン / cscript.exe での実行を強制する / 自分自身の呼び出し

Wscript.Echo は、Wscript.exe から実行すると、一回の処理毎にメッセージボックスを表示するので、連続処理する場合は避けなければなりません(wscript.exe をタスクマネージャから強制終了する事になります)

Wscript.exe は、通常エクスプローラからダブルクリックでスクリプトを実行した際に使用されるので、誤って実行してしまう事を避ける方法です。以下のサンプルでは、スクリプトにデータを含めて、そのデータをループ処理で表示する処理ですが、コマンドプロンプトからの実行を強制しています( コマンドプロンプトから、cscript.exe を使用しないと Quit されます )


右端のアイコンよりダウンロードできます
<JOB>
<SCRIPT language="VBScript">

' コマンドプロンプトより起動される為の処理
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str <> "CSCRIPT.EXE" then
	strMessage = "コマンドプロンプトより cscript " & WScript.ScriptFullName
	strMessage = strMessage & " と指定して実行して下さい   " & vbCrLf & vbCrLf
	strMessage = strMessage & "( この文字列をクリップボードにコピーした場合は"
	strMessage = strMessage & "ctrl+c です )"
	WScript.Echo strMessage
	WScript.Quit
end if

aData = Split( getResource("myText"), vbCrLf )
For I = 0 to Ubound( aData )
	if Trim( aData(I) ) <> "" then
		Wscript.Echo aData(I)
	end if
Next

</SCRIPT>

<RESOURCE id="myText">
コード名称マスタ
商品マスタ
得意先マスタ
社員マスタ
取引データ
</RESOURCE>
</JOB>

以下はオンラインのライブラリの Crun と言う関数を使って、Wscript.exe で起動された場合は、cscript.exe で自分自身を呼び出して再度実行しています( 最後にコマンドプロンプトの pause で停止 )
右端のアイコンよりダウンロードできます
<JOB>
<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" )

Crun()

aData = Split( getResource("myText"), vbCrLf )
For I = 0 to Ubound( aData )
	if Trim( aData(I) ) <> "" then
		Wscript.Echo aData(I)
	end if
Next

</SCRIPT>

<RESOURCE id="myText">
コード名称マスタ
商品マスタ
得意先マスタ
社員マスタ
取引データ
</RESOURCE>
</JOB>


上記内容をオンラインなしで実行するには、以下のようになります
右端のアイコンよりダウンロードできます
<JOB>
<SCRIPT language="VBScript">

' コマンドプロンプトより起動される為の処理
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str <> "CSCRIPT.EXE" then
	str = WScript.ScriptFullName
	Set WshShell = Wscript.CreateObject("WScript.Shell")
	strParam = " "
	For I = 0 to Wscript.Arguments.Count - 1
		if instr(Wscript.Arguments(I), " ") < 1 then
			strParam = strParam & Wscript.Arguments(I) & " "
		else
			strParam = strParam & """" & Wscript.Arguments(I) & """ "
		end if
	Next
	Call WshShell.Run( "cmd.exe /c cscript.exe """ & str & """" & strParam & " & pause", 3 )
	WScript.Quit
end if

aData = Split( getResource("myText"), vbCrLf )
For I = 0 to Ubound( aData )
	if Trim( aData(I) ) <> "" then
		Wscript.Echo aData(I)
	end if
Next

</SCRIPT>

<RESOURCE id="myText">
コード名称マスタ
商品マスタ
得意先マスタ
社員マスタ
取引データ
</RESOURCE>
</JOB>




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

2018年01月27日

【VBS汎用】SHIFT_JISデータを各種キャラクタセットのテキストファイルへ変換

Microsoft のデータはメモ帳でも解るように、SHIFT_JIS と Unicode と (UTF8) しか通常では対応していないので、このような処理が実は結構必要になります。

しかし、このような方法はたぶんあまり知られて無いので、他のアプリケーションを利用している場合が多いのでは無いでしょうか。(というか、そもそもファイルシステムオブジェクトで UTF8、UTF8N、EUC-JP を対応しろって思いますけど。)

変換は全てメモリ上で処理します。

外部ライブラリを WEB 上に置いて読み込んで処理しているので、その部分は『コマンド』だと思って下さい。
例) Crun は、コマンドプロンプトでの実行を強制します


VBScript の中に埋め込んだデータはファイルとしては Shift_JIS です。VBScript のインタープリタの内部的には Unicode ですが、何も考えなければ出力されたデータは Shift_JIS になってしまいます。

これを 5 種類のキャラクタセットとして意図的に出力します
1) SHIFT_JIS
2) UNICODE
3) EUC-JP
4) UTF8
5) UTF8N
※ UTF8 が少し特殊です(BOMを付加しています)
右端のアイコンよりダウンロードできます
<JOB>
<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" )

' Csript.exe で実行を強制
Crun

' 元となる shift_jis の文字列
strShiftJis = GetInline("shift_jis")

' このディレクトリ
strDir = ScriptDir()

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

' 出力パス
strPath1 = strDir & "\sjis.txt"
strPath2 = strDir & "\unicode.txt"
strPath3 = strDir & "\ujis.txt"
strPath4 = strDir & "\utf8.txt"
strPath5 = strDir & "\utf8n.txt"

' ファイルシステムオブジェクトで、sjis と unicode
Call PutTextFile( strPath1, strShiftJis )
Call PutTextFileUnicode( strPath2, strShiftJis )

' キャラクタセット変換用の Stream オブジェクト
Set Stream = Wscript.CreateObject("ADODB.Stream")
Set Stream2 = Wscript.CreateObject("ADODB.Stream")

' 開く
Stream.Open
Stream2.Open
' 二つ目はバイナリ専用
Stream2.Type = 1

Stream.Charset = "euc-jp"
Stream.WriteText strShiftJis
Stream.SaveToFile strPath3, 2

' 先頭に移動
Stream.Position = 0
Stream.Charset = "utf-8"
Stream.WriteText strShiftJis
Stream.SaveToFile strPath4, 2

' バイナリにコピー
Stream.CopyTo Stream2

' 一つ目もバイナリにする為、いったん閉じる
Stream.Close
' 再度開いてバイナリにする
Stream.Open
Stream.Type = 1

' バイナリを読んでバイナリに書く
Stream2.Position = 0
Stream2.Read(3)
Do while not Stream2.EOS
	Stream.Write Stream2.Read(16)
Loop

' utn-8n
Stream.SaveToFile strPath5, 2


' 閉じる
Stream2.Close
Stream.Close


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

Wscript.Quit

</SCRIPT>

<RESOURCE id="shift_jis">
<![CDATA[
ここは、VBScript なので shift_jis になります。
必要に応じてキャラクタセットを変更します
]]>
</RESOURCE>

</JOB>




posted by at 2018-01-27 21:48 | VBScript | このブログの読者になる | 更新情報をチェックする

2018年01月14日

VBScript : ディレクトリ内のディレクトリで使用している容量一覧

▼ このように実行されます(Windows10 での例です)
Microsoft (R) Windows Script Host Version 5.812
Copyright (C) Microsoft Corporation. All rights reserved.

D:\GIMPPortable

          6.766 M : 509620891
        179.393 M : App
        711.864 M : Data
          0.441 M : footprint
          0.039 M : gimp_effects_scripts
         11.003 M : IM00015850-01_RonsApocalypse
          0.040 M : Other
          8.061 M : photoshop

        917.609 M : 表示合計
        922.714 M : D:\GIMPPortable のサイズ
          5.104 M : D:\GIMPPortable 下のファイル

続行するには何かキーを押してください . . .
' ************************************************
' 除外フォルダ名を スペースで区切って並べる
' (簡易的な除外)
' ************************************************
Dim Exclude
Exclude = ".gem"
Exclude = Lcase(Exclude)

' ************************************************
' 管理者権限で実行用
' ************************************************
Set Shell = CreateObject( "Shell.Application" )

' ************************************************
' 管理者権限で再実行
' ************************************************
if Wscript.Arguments.Count = 0 then
	Shell.ShellExecute "cmd.exe", "/c cscript.exe " & Dd(WScript.ScriptFullName) & " next" & " & pause", "", "runas", 1
	Wscript.Quit
end if

' ************************************************
' 処理用
' ************************************************
Set WshShell = CreateObject( "WScript.Shell" )
Set Fso = CreateObject( "Scripting.FileSystemObject" )

Dim target

' ************************************************
' 対象ディレクトリ
' ************************************************
target = SelectDir( "対象フォルダを選択して下さい" )
if target = "" then
	Wscript.Quit
end if

Wscript.Echo target
Wscript.Echo

' ************************************************
' フォルダオブジェクト取得
' ************************************************
Set objFolder =  Fso.GetFolder(target)

' ************************************************
' サブフォルダコレクション取得
' ************************************************
Set colSubFolder =  objFolder.SubFolders

' ************************************************
' 一覧
' ************************************************
Dim TargetSize : TargetSize = 0
For Each obj in colSubFolder

	Do While true

		if InStr(Exclude,Lcase(obj.Name)) > 0 then
			Exit Do
		end if

		on error resume next
		Wscript.Echo Lpad(FormatNumber((Fix(obj.Size / 1024) / 1024),3)," ", 15) & " M : " & obj.Name
		if Err.Number <> 0 then
			Wscript.Echo "                  ( " & obj.Name & " : 処理できません )"
		else
			TargetSize = TargetSize + obj.Size
		end if
		on error goto 0


		Exit Do
	Loop


Next

Wscript.Echo

Dim AllSize
Dim er : er = 0
on error resume next
AllSize = objFolder.Size
if Err.Number <> 0 then
	er = 1
	AllSize	= TargetSize
end if
on error goto 0


Wscript.Echo Lpad(FormatNumber((Fix(TargetSize / 1024) / 1024),3)," ", 15) & " M : " & "表示合計"

if er = 1 then
	Wscript.Echo "                  ( " & target & " のサイズは取得できませんでした )"
else
	Wscript.Echo Lpad(FormatNumber((Fix(AllSize / 1024) / 1024),3)," ", 15) & " M : " & target & " のサイズ"
end if

Dim fsize : fsize = 0
For Each file in objFolder.files
	fsize = fsize + file.size
Next
Wscript.Echo Lpad(FormatNumber((Fix((fsize) / 1024) / 1024),3)," ", 15) & " M : " & target & " 下のファイル"

Wscript.Echo

' ************************************************
' ディレクトリ選択
' ************************************************
Function SelectDir( strTitle )

	Dim obj

	Set obj = Shell.BrowseForFolder( 0, strTitle, &H4B, 0 )
	if obj is nothing then
		SelectDir = ""
		Exit Function
	end if
	if not obj.Self.IsFileSystem then
		ErrorMessage = "ファイルシステムではありません"
		SelectDir = ""
		Exit Function
	end if

	SelectDir = obj.Self.Path

End Function

' ************************************************
' ダブルクォートで囲む
' ************************************************
Function Dd( strValue )

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

End function

' ************************************************
' 指定数、指定文字列左側を埋める
' ************************************************
Function Lpad( strValue, str, nLen )

	Lpad = Right( String(nLen,str) & strValue, nLen )

End Function

Windows の都合で読み込めないフォルダむはメッセージを表示して読み飛ばしています。その場合、合計に反映されないので注意して下さい。また、その場合は対象としたフォルダに対するサイズも取得に失敗すねので、表示合計のみの表示となります


posted by at 2018-01-14 03:23 | VBScript | このブログの読者になる | 更新情報をチェックする

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 | このブログの読者になる | 更新情報をチェックする
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