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

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

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

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

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

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

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


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

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

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

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

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