2019年02月21日


PATH 環境変数をセミコロンで区切って一つづつコマンドプロンプトに表示するバッチファイル path-list.bat

echo で VBScript の実行文を表示して、%temp%\_.vbs に書き出してそのまま実行するという、バッチファイルです。システム用とユーザ用を別々に作成して実行しています。

PATH コマンドの代りに使えます。

@echo off
echo ▼ システム
cmd /c echo Set ws=WScript.CreateObject("WScript.Shell"):Set wv=ws.Environment("SYSTEM"):pt=wv("PATH"):ad=Split(pt,";"):For I=0 To Ubound(ad):Wscript.echo ws.ExpandEnvironmentStrings(ad(I)):Next>%temp%\_.vbs&cscript.exe /NOLOGO %temp%\_.vbs
echo ▼ ユーザ
cmd /c echo Set ws=WScript.CreateObject("WScript.Shell"):Set wv=ws.Environment("USER"):pt=wv("PATH"):ad=Split(pt,";"):For I=0 To Ubound(ad):Wscript.echo ws.ExpandEnvironmentStrings(ad(I)):Next>%temp%\_.vbs&cscript.exe /NOLOGO %temp%\_.vbs
pause







posted by at 13:42 | ツール | このブログの読者になる | 更新情報をチェックする



WSF : 架空氏名作成スクリプト

選択する漢字によっては、さらに架空度が増します。

結果をコマンドプロンプトへ出力する事を前提としているので、Wscript.exe でスクリプトが実行された場合、Crun という関数で コマンドプロンプトを開いて cscript.exe でスクリプトを強制的に再実行させるようにしています。

<JOB>
<OBJECT id="WshShell" progid="WScript.Shell" />
<SCRIPT language="VBScript">
' ***********************************************************
' 処理開始
' ***********************************************************
nMax = 20	' 取得する人数

Crun

' 1、2 は教育漢字の最初
strName1 = "愛悪圧安暗案以位囲委意易異移胃衣遺医域育一印員因引飲院右宇羽"
strName2 = "雨運雲営映栄永泳英衛液益駅円園延沿演遠塩央往応横王黄億屋恩温"
strName3 = "男也一行樹之朗七人"
strName4 = "子代美恵"

For i = 1 to nMax

	' 姓1文字目
	nTarget = Random( 1, Len(strName1) )
	strName = Mid( strName1, nTarget, 1 )

	' 1文字目と2文字目が一致したら除外
	nTarget2 = nTarget
	Do while( nTarget = nTarget2 )
		nTarget2 = Random( 1, Len(strName1) )
	Loop

	' 姓2文字目
	strName = strName & Mid( strName1, nTarget2, 1 ) & " "

	' 名1文字目
	nTarget = Random( 1, Len(strName2) )
	strName = strName & Mid( strName2, nTarget, 1 )

	' 性別
	nTarget = Random( 0, 1 )

	' 性別によって名2文字目を決定
	if nTarget = 0 then
		nTarget = Random( 1, Len(strName3) )
		strName = strName & Mid( strName3, nTarget, 1 )
	else
		nTarget = Random( 1, Len(strName4) )
		strName = strName & Mid( strName4, nTarget, 1 )
	end if
	
	Wscript.Echo strName

Next

' ***********************************************************
' 範囲内ランダム値取得
' ***********************************************************
Function Random( nMin, nMax )

	Randomize
	Random = nMin + Int(Rnd * (nMax - nMin + 1))

End function

' ***********************************************************
' Cscript.exe で強制実行
' ***********************************************************
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>





posted by at 13:13 | Comment(0) | WSHのオブジェクト | このブログの読者になる | 更新情報をチェックする


2019年02月20日


VBScript : プリンタ名の一覧


※ 一覧なので、cscript.exe PrinterList.vbs としたほうがいいでしょう。( スクリプトでは、Wscript.exe で実行した場合 コマンドプロンプトを開いて Cscript.exe で実行しなおすようになっています )



item.Name は FolderItem オブジェクトのプロパティです
FolderItem Properties (Windows)
右端のアイコンよりダウンロードできます
Crun

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(&H4)
Set colItems = objFolder.Items

For each item in colItems

	if item.Name <> "プリンタの追加" then
		Wscript.Echo item.Name
	end if

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
※『プリンタの追加』以外のチェックは、Windows10 では必要ありませんでした



posted by at 21:08 | Shell.Application | このブログの読者になる | 更新情報をチェックする


2019年02月19日


VBScript : エクスプローラ ( explorer.exe ) の再起動

目的としては、システムへの変更を作業環境に反映させる為に行います。

例えば、ショートカットのファイルは拡張子 .lnk が付いているのですが、一般的に表示される事はありません。これを表示させるには簡単で、手動でレジストリの コンピューター\HKEY_CLASSES_ROOT\lnkfile の中のエントリである NeverShowExt をAllwaysShowExt に名称変更すると .lnk が表示されるようになります。但し、すぐには反映されないのでエクスプローラを再起動します。するとすぐに反映されようになっています。
右端のアイコンよりダウンロードできます
' **********************************************************
' エクスプローラ(explorer.exe) の再起動
' **********************************************************
strTarget = "explorer.exe"

' 起動用
Set WshShell = CreateObject( "WScript.Shell" )
' WMI用
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

' いったん終了させます
Set colProcessList = objWMIService.ExecQuery _ 
	("Select * from Win32_Process Where Name = '"&strTarget&"'") 
For Each objProcess in colProcessList
	on error resume next
	' 通常はこれで終了されるはず
	objProcess.Terminate() 
	if Err.Number <> 0 then
		' もし終了できなかった場合の強制終了
		Call WshShell.Run("taskkill /F /PID " & objProcess.ProcessId, 0 ) 
	end if
	on error goto 0
Next 

' 少し待ちます
Wscript.Sleep(500)
' エクスプローラを起動
WshShell.Run( strTarget )






タグ:プロセス WMI
posted by at 20:26 | ツール | このブログの読者になる | 更新情報をチェックする


2019年01月02日


IE11で右クリックからソースの表示で外部エディタを起動する





ieSrcEditor.wsf をエクスプローラから実行すると、ファイルを参照するダイアログが開きます。内部のコードはソースコードのようになっています。(必要な関数等はインターネット上に保存して使用しています)

ここでは、ローカルのファイルを開いてパスを取得する為に、InternetExplorer.Application を使用しています。

アンインストールは、zip 内の uninstall.reg か 以下のテキストを uninstall.reg として shift_jis か Unicode で保存してエクスプローラから実行します。内部は、Microsoft の仕様によるレジストリエントリの削除記述となっています。ですから、実際削除を行うのは、regedit.exe です。
Windows Registry Editor Version 5.00

[-HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\View Source Editor]


ieSrcEditor.wsf
<JOB>
<COMMENT>
************************************************************
 WEB WSH 実行スケルトン
************************************************************
</COMMENT>

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

<SCRIPT language=VBScript>
' 管理者として実行を強制する
Set obj = Wscript.CreateObject("Shell.Application")
if Wscript.Arguments.Count = 0 then
	obj.ShellExecute "wscript.exe", WScript.ScriptFullName & " runas", "", "runas", 1
	Wscript.Quit
end if

' ***********************************************************
' 処理開始
' ***********************************************************
Call laylaFunctionTarget( "http://lightbox.in.coocan.jp/" )
Call laylaLoadFunction( "baseFunction.vbs" )
Call laylaLoadFunction( "wmiReg.vbs" )
Call laylaLoadFunction( "toolFunction.vbs" )

' **********************************************************
' エディタ選択
' **********************************************************
strValue = OpenLocalFileName
if strValue = "" then
	Wscript.Quit
end if

' **********************************************************
' レジストリ
' **********************************************************
strPath = "SOFTWARE\Microsoft\Internet Explorer\View Source Editor\Editor Name"
Call WMIRegCreateKey( HKEY_CURRENT_USER, strPath )
strValue = Dd( strValue )
Call WMIRegSetStringValue( HKEY_CURRENT_USER, strPath, Empty, strValue )

MsgOk( strValue & " を IE のソースエディタとして登録しました" )

Function OpenLocalFileName( )

	Call GetObj( "IEDocument", "InternetExplorer.Application" )
	IEDocument.Navigate( ScriptDir( ) & "\local.htm" )
	IEDocument.document.getElementsByTagName("BODY")(0).innerHTML = "<input id=FilePath type=file>"
	IEDocument.document.getElementById("FilePath").click
	if IEDocument.document.getElementById("FilePath").value = "" then
		OpenLocalFileName = ""
		IEDocument.Quit
		Set IEDocument = Nothing
		Exit Function
	end if

	OpenLocalFileName = IEDocument.document.getElementById("FilePath").value

	IEDocument.Quit
	Set IEDocument = Nothing

End Function
</SCRIPT>
</JOB>






posted by at 19:45 | ツール | このブログの読者になる | 更新情報をチェックする


2018年01月26日


指定したキーでレジストリエディタを開く



レジストリエディタは終了する時に直前に表示していた場所をレジストリに登録するので、事前にその値を変更しておいてから開くとその場所を意図的に開く事ができます。

Windows Vista より保存場所の名前が変わっているので、OS バージョンのチェックが必要となっています。

また、同時に二つのレジストリエディタは実行できないので、既に実行中の場合は終わらせる必要があります。その際表示位置やサイズも記録するには、一度アクティブにする必要があるようなので対応しています。
右端のアイコンよりダウンロードできます
if Wscript.Arguments.Count <> 0 then
	strParam = Wscript.Arguments(0)
else
	strParam = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft"
end if

' レジストリ書き込み用
Set WshShell = CreateObject( "WScript.Shell" )
' WMI用
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

' レジストリエディタが最後に開いていたキーの登録を行います
strPath = "Software\Microsoft\Windows\CurrentVersion\Applets\Regedit\LastKey"
if GetOSVersion() >= 6 then
	strRegPath = "コンピューター\" & strParam
else
	strRegPath = "マイ コンピュータ\" & strParam
end if

' 既に regedit が実行中の場合はいったん終了させます
Set colProcessList = objWMIService.ExecQuery _ 
	("Select * from Win32_Process Where Name = 'regedit.exe'") 
For Each objProcess in colProcessList
	' 最後のウインドウの位置とサイズを保存する為の終わらせ方
	WshShell.AppActivate("レジストリ エディタ")
	Wscript.Sleep(500)
	WshShell.SendKeys ("%{F4}")
	Wscript.Sleep(500)
	' 上記終わらせ方が失敗した時の強制終了
	on error resume next
	objProcess.Terminate() 
	on error goto 0
Next 

WshShell.RegWrite "HKCU\" & strPath, strRegPath, "REG_SZ"

' レジストリエディタを起動します
Call WshShell.Run( "regedit.exe" )
' レジストリエディタが終わるまで待つ場合は以下のようにします
' Call WshShell.Run( "regedit.exe", , True )

' **********************************************************
' OS バージョンの取得
' **********************************************************
Function GetOSVersion()

	Dim colTarget,str,aData,I,nTarget

	Set colTarget = objWMIService.ExecQuery( _
		 "select Version from Win32_OperatingSystem" _
	)
	For Each objRow in colTarget
		str = objRow.Version
	Next

	aData = Split( str, "." )
	For I = 0 to Ubound( aData )
		if I > 1 then
			Exit For
		end if
		if I > 0 then
			nTarget = nTarget & "."
		end if
		nTarget = nTarget & aData(I)
	Next

	GetOSVersion = CDbl( nTarget )

End Function


ファイル名を指定して実行から実行するのであれば、以下のように指定します( 最後は開きたいレジストリのパス )
wscript.exe c:\temp\open_reg.vbs HKEY_CURRENT_USER\Software\ODBC\ODBC.INI
※ 二つ目はスクリプトのフルパスです


posted by at 16:36 | ツール | このブログの読者になる | 更新情報をチェックする


2016年03月01日


テキストファイルの一括読み込み

Fso は事前に定義していてもいいですし、引数として渡して使用してもいいですが、このコードでは ErrorMessage と Fso がグローバル変数として関数内で定義されています。
Function GetTextFile( strPath )

	Dim ExecuteString
	Dim objHandle

	ExecuteGlobal "Dim ErrorMessage"

	ExecuteString = "Dim Fso : Set Fso = CreateObject( ""Scripting.FileSystemObject"" )"
	ExecuteGlobal ExecuteString

	ErrorMessage = ""
	on error resume next
	Set objHandle = Fso.OpenTextFile( strPath, 1 )
	if Err.Number <> 0 then
		ErrorMessage = Err.Description
		GetTextFile = ""
	else
		GetTextFile = objHandle.ReadAll
		objHandle.Close
	end if
	on error goto 0

End Function





posted by at 20:58 | 関数 | このブログの読者になる | 更新情報をチェックする


2015年02月16日


URLEncode ( UTF-8 の文字列として全ての文字をパーセントエンコーディングします )

VBScript の内部コードから意図的に UTF-8 のキャラクタセットでテキストを書き込んで、バイナリストリームにコピーして、UTF-8 としてのバイトデータを1バイトづつ読み込んで『パーセントエンコーディング』で表現した文字列に変換しています。

※ UTF-8 として処理した場合、先頭3バイトは BOM なので取り除いています。
REM ***********************************************
REM UTF-8 のバイナリデータを作成して URLエンコード
REM ※ 全ての文字をパーセントエンコーディングします
REM ***********************************************
Function URLEncode(s1,s2, str)

	s1.Open
	s1.Charset = "utf-8"
	REM shift_jis で入力文字を書き込む
	s1.WriteText str
	REM コピーの為にデータポインタを先頭にセット
	s1.Position = 0

	REM バイナリで開く
	s2.Open
 	s2.Type = 1

	REM テキストをバイナリに変換
	s1.CopyTo s2
	s1.Close

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

	Dim Buffer : Buffer = ""
	REM BOMを取り去る
	s2.Read(3)
	Do while not s2.EOS
		LineBuffer = s2.Read(16)
 
		For i = 1 to LenB( LineBuffer )
			CWork = MidB(LineBuffer,i,1)
			Cwork = AscB(Cwork)
			Cwork = Hex(Cwork)
			Cwork = Ucase(Cwork)
			if Len(Cwork) <> 1 then
				Buffer = Buffer & "%" & Cwork
			else
				Buffer = Buffer & "%0" & Cwork
			end if
		Next
 
	Loop

	s2.Close

	URLEncode = Buffer

End Function

▼ 呼び出しサンプル
<JOB>
<OBJECT id="s1" progid="ADODB.Stream" />
<OBJECT id="s2" progid="ADODB.Stream" />

<SCRIPT language="VBScript" src="http://winofsql.jp/VBScript/urlencode.vbs"></SCRIPT>

<SCRIPT language="VBScript">

str = "あいうえお"

Wscript.Echo URLEncode(s1,s2, str)

</SCRIPT>
</JOB>

REM を使ったり、条件式の = を使わずに、<> を使っているのは、ExecuteGlobal を使って動的に関数登録する為です。
VBScript では、x = y の解釈が 2 とおりあります。1 つ目は代入ステートメントとして解釈され、y の値が x に代入されます。2 つ目は x と y の値が等しいかどうかをテストする式として解釈されます。等しい場合、result は True です。それ以外の場合、result は False です。ExecuteGlobal ステートメントは常に 1 つ目の解釈を適用し、Eval メソッドは常に 2 つ目の解釈を適用します。
posted by at 17:47 | 関数 | このブログの読者になる | 更新情報をチェックする


2014年07月11日


VBScript で『管理者として実行を強制する』処理

freefont_logo_hkreikk.png
昨今の Windows では、管理者権限が無いと失敗する処理が増えました。これは、バッチで自動化する時には使用できませんが、PC の前に操作員が居るという前提で実行可能です。

この処理は、右クリックで表示されるメニューの中の『管理者として実行』という項目に該当し、本来の英語表示は『runas』であると思われ、スクリプトの Operation"runas" を引き渡すと実現できます。

Shell.ShellExecute method

注意するのは、以下のコードでは VBScript に対して引数がある場合は利用できないと言う事です。引数がある場合はその引数の数に合わせてカスタマイズする必要があります。

ここでは、引数が無いという前提なので、次に実行する場合はダミーで "runas" という引数を渡しています。WScript.ScriptFullName & " runas"wscript.exe に対する引数で、runas が スクリプトに対する引数です。

こうする事によって、2回目の実行は、管理者権限で実行されている状態で、if Wscript.Arguments.Count = 0 then を通り抜ける事になります。

ShellExecute の3番目の引数が省略されていますが、これは作業ディレクトリの指定で、このパラメータを指定しない場合、現在の作業ディレクトリが使用されます。

ShellExecute の5番目引数は、ウインドウの表示方法で、1 は、ノーマル表示を意味します。
' 管理者として実行を強制する
Set obj = Wscript.CreateObject("Shell.Application")
if Wscript.Arguments.Count = 0 then
	obj.ShellExecute "wscript.exe", WScript.ScriptFullName & " runas", "", "runas", 1
	Wscript.Quit
end if

Wscript.Echo WScript.Arguments(0)





タグ:SHELL
posted by at 13:04 | Shell.Application | このブログの読者になる | 更新情報をチェックする


2014年05月29日


WMIのレジストリアクセスで、レジストリエントリの一覧を取得する VBScript クラス

freefont_logo_hkreikk.png
WMI : StdRegProv class
VBScript のクラス : Initialize イベント

Private Sub Class_Initialize は、コンストラクタのような働きをしますが、イベントなので引数を使うコンストラクタを実装する事ができません。また、そもそも同名のメソッドを作成できないので、注意が必要です。

ここでは、デフォルトのメソッドを定義して、メソッド名を指定せずに処理を実行しています。

Set Shell = CreateObject("Shell.Application")
if WScript.Arguments.Count = 0 then
	Shell.ShellExecute "cmd.exe", "/c Cscript.exe """ & Wscript.ScriptFullName & """ dummy & pause", "", "runas", 1
	Wscript.Quit
end if

Dim obj

' ************************************************
' インスタンス作成
' ************************************************
Set obj = new Wmireg

' ************************************************
' デフォルトメソッド実行
' ************************************************
Set list = obj(WMI_HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run")

' ************************************************
' 一覧表示
' ************************************************
For Each data in list.Keys

	Wscript.Echo data & " : " & list(data)

Next

const WMI_HKEY_CLASSES_ROOT = &H80000000
const WMI_HKEY_CURRENT_USER = &H80000001
const WMI_HKEY_LOCAL_MACHINE = &H80000002
const WMI_HKEY_USERS = &H80000003
const WMI_HKEY_CURRENT_CONFIG = &H80000005

const WMI_REG_SZ = 1 
const WMI_REG_EXPAND_SZ = 2 
const WMI_REG_BINARY = 3 
const WMI_REG_DWORD = 4 
const WMI_REG_MULTI_SZ = 7 

Class Wmireg

	Public objReg 

	' ************************************************
	' Initialize イベント
	' ************************************************
	Private Sub Class_Initialize

		Set objReg = _
			GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
			".\root\default:StdRegProv") 

	End Sub

	' ************************************************
	' サブキーの配列を取得
	' ************************************************
	Public Function GetLSubKeyArray( defKey, strPath )

		Dim aSubKeys,str

		objReg.EnumKey defKey, strPath, aSubKeys
		GetLSubKeyArray = aSubKeys
	 
	end function

	' ************************************************
	' 値の一覧の連想配列を取得( 規定のメソッド )
	' ************************************************
	Public Default Function GetLValueArray( defKey, strPath )

		Dim aValueNames, aValueTypes, strValue, aValue

		Set var = CreateObject( "Scripting.Dictionary" )

		objReg.EnumValues defKey, strPath,_ 
			aValueNames, aValueTypes 
		For i=0 To UBound(aValueNames)
			Select Case aValueTypes(i) 
				Case WMI_REG_SZ
					objReg.GetStringValue _
					defKey,strPath,aValueNames(i),strValue
					var(aValueNames(i)) = strValue
				Case WMI_REG_EXPAND_SZ
					objReg.GetExpandedStringValue _
					defKey,strPath,aValueNames(i),strValue
					var(aValueNames(i)) = strValue
				Case WMI_REG_DWORD
					objReg.GetDWORDValue _
					defKey,strPath,aValueNames(i),strValue
					var(aValueNames(i)) = strValue
				Case WMI_REG_MULTI_SZ
					objReg.GetMultiStringValue _
					defKey,strPath,aValueNames(i),aValue
					var(aValueNames(i)) = aValue
				Case WMI_REG_BINARY 
					objReg.GetBinaryValue _
					defKey,strPath,aValueNames(i),aValue
					var(aValueNames(i)) = aValue
			End Select 
		Next 

		Set GetLValueArray = var

	end function

	' ************************************************
	' 文字列セット
	' ************************************************
	Public Function SetLString( defKey, strPath, strName, strValue )

		objReg.SetStringValue _
			defKey,strPath,strName,strValue 

	end function

	' ************************************************
	' 整数セット
	' ************************************************
	Public Function SetLDword( defKey, strPath, strName, dwValue )

		objReg.SetDWORDValue _
			defKey,strPath,strName,dwValue

	end function

End Class



タグ:WMI クラス
posted by at 01:41 | WMI | このブログの読者になる | 更新情報をチェックする