VBScript : logical　error

Google

TOP / VBScript

- 1 2 >>

2023年03月02日

指定した位置でレジストリエディタを開く為の VBScript をダウンロードします

理屈としては、regedit は、終了する時に表示していたパスをレジストリに保存しており、その場所に書き込む事によって regedit を起動した時に好きな場所が表示されるようにしています。


保存場所
HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Applets\Regedit\LastKey

コンボボックスにいくつかサンプルを用意しています。入力フィールドに直接セットしてもいいですし、いったんダウンロードしたソースの先頭のパスを変更しても OK です。

IE11 ソースエディタは、インターネットオプションのプログラムでメモ帳を選択してからアクセスします

一度ダウンロードしたソースコードの先頭の strParam にレジストリのパスを設定するだけで使えます

strParam = "HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\ODBC\ODBCINST.INI"

' レジストリ書き込み用
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 )

REM **********************************************************
REM OS バージョンの取得
REM **********************************************************
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

posted by lightbox at 2023-03-02 08:43 | VBScript |

2020年02月02日

VBScript(WSH) と PHP(7.3) で氏名をランダムに作成





names.wsf

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

<OBJECT id="WshShell" progid="WScript.Shell" />

<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************

nMax = 500

' ***********************************************************
' Cscript.exe で強制実行
' ***********************************************************
Crun

strName1 = "山川森鈴木高田本多村吉岡松丸杉浦中尾安原野内"
strName2 = "和元雅正由克友浩春冬洋輝"
strName3 = "男也一行樹之"
strName4 = "子代美恵"

str = ""

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

	str = str & strName & " / "
	if (i-1) Mod 6 = 5 then
		Wscript.Echo str
		str = ""
	end if

Next

if str <> "" then
	Wscript.Echo str
end if


REM ************************************************
REM 指定範囲の整数の乱数を取得
REM ************************************************
Function Random( nMin, nMax )

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

End function

Function SameRandom( nMin, nMax )

	SameRandom = nMin + Int(Rnd * (nMax - nMin + 1))

End function

REM **********************************************************
REM Wscript で実行された場合は Cscript で実行しなおす
REM **********************************************************
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

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

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

End function

</SCRIPT>
</JOB>


names.php

<?php
// ソースコードは UTF8N
// PHP.INI の default_charset = "UTF-8"

$NAME_1 = 0;
$NAME_2 = 1;
$NAME_3 = 2;
$NAME_4 = 3;

# シード
$name_seed = array();
$name_seed[] = "山川森鈴木高田本多村吉岡松丸杉浦中尾安原野内";
$name_seed[] = "和元雅正由克友浩春冬洋輝";
$name_seed[] = "男也一行樹之";
$name_seed[] = "子代美恵";
$names = array();

# 人数
$num = 100;

for ( $i = 0; $i < $num; $i++ ) {

	// 姓1文字目
	$n1 = mb_substr( $name_seed[$NAME_1], rand( 0, mb_strlen($name_seed[$NAME_1])-1 ), 1 );

	// 1文字目と2文字目が一致したら除外
	$n2 = $n1;
	while( $n2 == $n1 ) {
		$n2 = mb_substr( $name_seed[$NAME_1], rand( 0, mb_strlen($name_seed[$NAME_1])-1 ), 1 ) ;
	} 

	
	$name_result = $n1 . $n2 . " ";

	// 名1文字目
	$n3 = mb_substr( $name_seed[$NAME_2], rand( 0, mb_strlen($name_seed[$NAME_2])-1 ), 1 );
	$name_result .= $n3;

	$sex = rand( 0,1 );

	// 性別によって名2文字目を決定
	if ( $sex == 0 ) {
		$name_result .= mb_substr( $name_seed[$NAME_3], rand( 0, mb_strlen($name_seed[$NAME_3])-1 ), 1 );
	}
	else {
		$name_result .= mb_substr( $name_seed[$NAME_4], rand( 0, mb_strlen($name_seed[$NAME_4])-1 ), 1 );
	}

	// php PHP 7.3.13 で化けません
	if ( array_search( $name_result, $names ) === FALSE ) {
		print $name_result;
	}
	else {
		// 同姓同名
		print "*" . $name_result;
	}

	print " / ";

	if ( $i % 6 == 5 ) {
		print "\n";
	}

	$names[] = $name_result;

}

file_put_contents("names.log", print_r($names, true) );

print "\n";
print file_get_contents("names.log");

?>


▼ names.bat( php.exe に対して PATH は通してから実行 )
php.exe "%~p0names.php"
pause


このページのPDF

posted by lightbox at 2020-02-02 20:53 | VBScript |

2019年01月12日

VBScript : XCOPYで新しいファイルのみバックアップする為のスクリプトを作成するスクリプト





1) ディレクトリ選択でバックアップするフォルダを決定
2) カレント(このスクリプトを実行したフォルダ)にスクリプトが作成されます
3) 新しいスクリプトを実行
4) カレントにバックアップ用のフォルダが作成されます
5) バックアップするフォルダ内をそのフォルダ内に全てコピーします

▼ 実行時に表示されるフォルダ選択


XCOPY なので、2回目以降は新しいファイルのみコピーします

▼ 作成されたスクリプトのサンプルです

strName = "BK_C_temp_lightbox"
strTarget = "C:\temp\lightbox"
strBackupFolder = "C:\tmp\vbs"
if MsgBox( strTarget & vbCrLf & "のバックアップを開始します。よろしいですか? (保存先:" & strBackupFolder & "\" & strName & ")", 1 ) = 2 then
	Wscript.Quit
end if
Set WshShell = Wscript.CreateObject( "WScript.Shell" )
ExecCommand = "cmd.exe /C ""xcopy.exe """ & strTarget & """ """ & strBackupFolder & "\" & strName & "\"" /D /E /C /S /Y & PAUSE"""
Call WshShell.Run( ExecCommand )


▼ 使用するオプション
/D : コピー元の日付がコピー先の日付より新しいファイルだけをコピーします
/E : ディレクトリまたはサブディレクトリが空であってもコピーします
/C : エラーが発生してもコピーを続けます
/S : 空の場合を除いて、ディレクトリとサブディレクトリをコピーします
/Y : 既存のファイルを上書きする前に確認のメッセージを表示しません

一番重要なのは、/D です。/S /E で、存在するディリクトリはすべてコピーされます。/E /Y によって、最後まで停止する事なく実行されます。

追加で使う事が想定されるオプション

コピーしたくないディレクトリやファイルがある場合、以下のように指定します。

/EXCLUDE:ファイルのパス

ファイルのパスが示すテキストファイル内に、除外するディレクトリやファイルにある文字列の一部を1 行に 1 つずつ記述します。

その文字列が、コピー対象ファイルの絶対パスの一部と一致した場合、そのファイルはコピーから除外されます。

▼ 例
⭕ "\obj\" という文字列を指定するとディレクトリ obj の下の全ファイルが除外 されます。
⭕ ".obj" という文字列を指定すると .obj という拡張子のファイルがすべて除外されます

ソースコード

' ***********************************************************
' 処理開始
' ***********************************************************
Set Fso = Wscript.CreateObject( "Scripting.FileSystemObject" )
Set Shell = Wscript.CreateObject( "Shell.Application" )

' ***********************************************************
' 実行中ディレクトリの取得
' ***********************************************************
strPath = Wscript.ScriptFullName 
Set objFile = Fso.GetFile( strPath )
strBackupFolder = Fso.GetParentFolderName( objFile )

' ***********************************************************
' バックアップ対象ディレクトリの取得
' ***********************************************************
' ① 省略すると、ルートはデスクトップ
Set objFolder = Shell.BrowseForFolder( 0, "バックアップするフォルダを選択してください", &H4B )

' ② 文字列による直接指定
' strRoot = "c:\"
' Set objFolder = Shell.BrowseForFolder( 0, "バックアップするフォルダを選択してください", &H4B, strRoot )

' ③ ルートを番号で指定( この場合は C:\Users\username\AppData\Local )
' ※ あまり現実的ではない特殊ディレクトリの選択
' nRoot = &h1c
' Set objFolder = Shell.BrowseForFolder( 0, "バックアップするフォルダを選択してください", &H4B, nRoot )

if objFolder is nothing then
	WScript.Quit
end if
if not objFolder.Self.IsFileSystem then
	WScript.Echo "ファイルシステムではありません"
	WScript.Quit
end if

strTargetFolder = objFolder.Self.Path
strName = Replace( strTargetFolder, ":", "" )
strName = Replace( strName, "\", "_" )
strName = Replace( strName, " ", "" )
strName = "BK_" & strName

' ***********************************************************
' スクリプト作成
' ***********************************************************
Set OutFile = Fso.OpenTextFile( strBackupFolder & "\" & strName & ".vbs", 2, True )

OutFile.WriteLine "strName = """ & strName & """"
OutFile.WriteLine "strTarget = """ & strTargetFolder & """"
OutFile.WriteLine "strBackupFolder = """ & strBackupFolder & """"
OutFile.Write "if MsgBox( strTarget & vbCrLf & ""のバックアップを開始します。よろしいですか? (保存先:"" & strBackupFolder & ""\"" & strName & "")"""
OutFile.WriteLine ", 1 ) = 2 then"
OutFile.WriteLine "	Wscript.Quit"
OutFile.WriteLine "end if"

OutFile.WriteLine "Set WshShell = Wscript.CreateObject( ""WScript.Shell"" )"
OutFile.Write "ExecCommand = ""cmd.exe /C """"xcopy.exe """""" & strTarget & """""" """""" & strBackupFolder & ""\"" & strName & ""\"""""
OutFile.WriteLine " /D /E /C /S /Y & PAUSE"""""""
OutFile.WriteLine "Call WshShell.Run( ExecCommand )"

OutFile.Close

WScript.Echo "バックアップスクリプト : " &  strName & ".vbs" & " を作成しました"


' ***********************************************************
' ディレクトリ指定用番号
' https://docs.microsoft.com/ja-jp/windows/desktop/api/shldisp/ne-shldisp-shellspecialfolderconstants
' typedef enum {
' 	ssfALTSTARTUP = 0x1d,
' 	ssfAPPDATA = 0x1a,
' 	ssfBITBUCKET = 0x0a,
' 	ssfCOMMONALTSTARTUP = 0x1e,
' 	ssfCOMMONAPPDATA = 0x23,
' 	ssfCOMMONDESKTOPDIR = 0x19,
' 	ssfCOMMONFAVORITES = 0x1f,
' 	ssfCOMMONPROGRAMS = 0x17,
' 	ssfCOMMONSTARTMENU = 0x16,
' 	ssfCOMMONSTARTUP = 0x18,
' 	ssfCONTROLS = 0x03,
' 	ssfCOOKIES = 0x21,
' 	ssfDESKTOP = 0x00,
' 	ssfDESKTOPDIRECTORY = 0x10,
' 	ssfDRIVES = 0x11,
' 	ssfFAVORITES = 0x06,
' 	ssfFONTS = 0x14,
' 	ssfHISTORY = 0x22,
' 	ssfINTERNETCACHE = 0x20,
' 	ssfLOCALAPPDATA = 0x1c,
' 	ssfMYPICTURES = 0x27,
' 	ssfNETHOOD = 0x13,
' 	ssfNETWORK = 0x12,
' 	ssfPERSONAL = 0x05,
' 	ssfPRINTERS = 0x04,
' 	ssfPRINTHOOD = 0x1b,
' 	ssfPROFILE = 0x28,
' 	ssfPROGRAMFILES = 0x26,
' 	ssfPROGRAMFILESx86 = 0x30,
' 	ssfPROGRAMS = 0x02,
' 	ssfRECENT = 0x08,
' 	ssfSENDTO = 0x09,
' 	ssfSTARTMENU = 0x0b,
' 	ssfSTARTUP = 0x07,
' 	ssfSYSTEM = 0x25,
' 	ssfSYSTEMx86 = 0x29,
' 	ssfTEMPLATES = 0x15,
' 	ssfWINDOWS = 0x24
' } ShellSpecialFolderConstants;
' ***********************************************************

更新履歴
2009-06-28 : 記事作成
2013-04-02 : ダウンロード追加
2015-08-07 : ダウンロードを zip 化( Google Chrome 対応 )
2018-04-21 : 作成したスクリプト内の保存するフォルダ名を固定化( 変更を容易にするため )


関連する Microsoft ドキュメント

Shell Reference
Shell Objects for Scripting and Microsoft Visual Basic
Shell object
Shell.BrowseForFolder method

タグ：xcopy バックアップ VBScript WSH

posted by lightbox at 2019-01-12 14:42 | VBScript |

2018年02月20日

VBScript + PowerShell : PowerShell がファイルを開くダイアログで取得したパスをテキストファイル経由で VBScript に戻して使用する

PowerShell : ファイルを開くダイアログを使うのに System.Windows.Forms を参照する二つの方法 で、C# のコードを使って PowerShell 内で『ファイルを開くダイアログ』を使用しました。

ここでは、その結果のパスを VBScript に渡す方法として、TEMP フォルダに適当なファイルを作成して引き渡します。呼び出しはもちろん VBScript から行います。この呼び出しは同期処理なので、特に問題なく順番に実行されます。

方法として、PowerShell の標準出力を VBScript で取り込む方法もあるのですが、その場合は VBScrip からの呼び出しが非同期となってしまうので、ユーザ側の操作が少し煩雑になるのでテキストファイル渡しとしました。

さらにもう一つ、InternetExplorer.Application オブジェクトを使用してクリップボード経由で取り込む方法もありますが、IE11 はさすがにいつどうなるか解らないので避けたいところです。( htmlfile オブジェクトでもできるはずですが、やはりテキストファイル経由が確実と思われます )

Windows7 の PowerShell で -Sta 引数を使う

PowerShell スクリプトの呼び出しは、セキュリティ上の問題で設定が必要なので、PowerShell の引数で一時的に実行可能にするのですが、Windows7 で -Sta を指定しないと動作しないので注意です。(Windows10 は動いています。Windows7 : バージョン2 / Windows10 : バージョン5 )

get_ps_tempfile.vbs

Set WshShell = WScript.CreateObject("WScript.Shell")
Set Fso = CreateObject( "Scripting.FileSystemObject" )

' 同期処理で実行( コマンドプロンプトは開かない )
Call WshShell.Run( "powershell -NoProfile -ExecutionPolicy Unrestricted .\open_file_dialog_cs.ps1", 0, True )
' Windows7 では、powershell -Sta -NoProfile -ExecutionPolicy Unrestricted .\open_file_dialog_cs.ps1

strPath = WshShell.ExpandEnvironmentStrings("%temp%")

' PowerShell 内の C# が出力したパスを取得
Set objHandle = Fso.OpenTextFile( strPath & "\_param.txt", 1 )
strParam = objHandle.ReadAll
objHandle.Close

if strParam = "キャンセルされました" then
	MsgBox "ここで処理を中断"
else
	' 取得したパス
	MsgBox strParam
end if


PowerShell 独特の世界をいまさら覚える時間もったいないので、C# で書いたほうがいろいろ手っ取り早いと思います。(取り回しは、VBScript だけでなんとかなりそうな気もしてます)

open_file_dialog_tempfile_cs.ps1

$code = @"
using System;
using System.IO;
using System.Text;
using System.Windows.Forms;
public class MyClass {
	public static string Open() {

		OpenFileDialog obj = new OpenFileDialog();
		obj.Filter = "Excel|*.xlsx|旧 Excel|*.xls|全て|*.*";
		obj.InitialDirectory = @"C:\";

		if (obj.ShowDialog() == DialogResult.OK) {
			return obj.FileName;
		}
		else {
			return "キャンセルされました";
		}

	}
	public static void Put(string param) {
		string path = Environment.GetEnvironmentVariable("temp");
		if (path == null) {
			path = Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location);
		}
		path = string.Format(@"{0}\_param.txt", path);

		// SHIFT_JIS で書き込み
		Encoding Enc = Encoding.GetEncoding(932);
		using (StreamWriter WriteFile = new StreamWriter( path, false, Enc )) {
			WriteFile.Write(param);
			WriteFile.Close();
		}
	}
}
"@

Add-Type -Language CSharp -TypeDefinition $code -ReferencedAssemblies ("System.Windows.Forms")

$param = [MyClass]::Open()
[MyClass]::Put($param)

タグ：VBScript PowerShell

posted by lightbox at 2018-02-20 18:20 | VBScript |

2018年02月19日

VBScript : XMLファイルのテキストノードの値の更新

概要

ターゲットは、WEB 上にあるサンプルXML です。その中にある　param-value の中の一つを書き換えます( 中の値によって対象かどうかを判断しています )

objXML.async = False を指定しないと、処理中のどの時点で XML ドキュメントが有効になるかを判断できません。VBScript はイベント処理がオブジェクトに依存するので、このようにしています。

※ VBScript は SHIFT_JIS で記述されていますが、XML を UTF-8 で記述しているので、オブジェクト的に問題ありません。書き出した sample.xml も utf8n で保存されています。

' オブジェクト作成
Set Fso = CreateObject("Scripting.FileSystemObject")
Set objXML = CreateObject("Msxml2.DOMDocument.6.0")

' WEB からのデータ取得をその場で完了させる
objXML.async = False

' スクリプトのあるディレクトリ
strCurDir = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurDir )
Set obj = obj.ParentFolder
strCurDir = obj.Path

' XML を読み込み
objXML.load( "https://lightbox.sakura.ne.jp/demo/sample.xml" )

' 全体の表示
MsgBox( objXML.xml )

Set ParamValue = objXML.getElementsByTagName("param-value")

For I = 0 to ParamValue.length - 1

	if ParamValue.item(I).firstChild.nodeValue = "UTF8N で保存してます" then
		' 置き換え
		ParamValue.item(I).firstChild.nodeValue = "本文を変更しました"
		Exit For
	end if
Next

' XML を保存
objXML.save( strCurDir & "\sample.xml" )


MsgBox の結果

<?xml version="1.0" encoding="UTF-8"?>
<note>
  <param-value>あなた</param-value>
  <param-value>私</param-value>
  <param-value>XMLサンプル</param-value>
  <param-value>UTF8N で保存してます</param-value>
</note>

タグ：VBScript xml DOM

posted by lightbox at 2018-02-19 14:16 | VBScript |

2018年02月16日

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



WSH : 指定したキーでレジストリエディタを開く は、WSH での処理なので、どちらかと言えばバッチ処理です。連続してレジストリエディタの作業をするのでは無く、その場限りの処理で使ったりします( とにかくある場所のレジストリキーを開きたい等 )

このサンプルは、ある目的の作業中にレジストリエディタの特定のキーを、何度も連続して開く事を想定していますので、GUI を持つ HTA を使っています。

右端のアイコンよりダウンロードできます

<SCRIPT language="VBScript">

	Dim WshShell

	Set WshShell = CreateObject( "WScript.Shell" )

	Dim objWMIService

	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

</SCRIPT>
<html>
<head>
<title>指定したキーでレジストリエディタを開く</title>
<meta http-equiv="content-type" content="text/html; charset=SHIFT_JIS">
<HTA:APPLICATION ID="Sqlwin"
	BORDERSTYLE="sunken"
	INNERBORDER="yes"
	SCROLL="no"
	ICON="http://winofsql.jp/WinOfSql.ico"
>

<style type="text/css">
* {
	font-family: "メイリオ"
	font-size: 16px;
}
body {
	margin:0;
	background-color: white;
}

.action {
	margin-top: 20px;
	margin-left: 20px;
}

</style>

<SCRIPT language="VBScript">

Function ActionOpenReg( str )

	Dim colProcessList

	Set colProcessList = objWMIService.ExecQuery _ 
		("Select * from Win32_Process Where Name = 'regedit.exe'") 
	For Each objProcess in colProcessList 
		WshShell.AppActivate("レジストリ エディタ")
		WshShell.SendKeys ("%{F4}")
	Next 

	Call window.setTimeout("Call OpenReg(""" & str & """)", 500 )

End Function

Function OpenReg( str )

	Dim colProcessList

	Set colProcessList = objWMIService.ExecQuery _ 
		("Select * from Win32_Process Where Name = 'regedit.exe'") 
	For Each objProcess in colProcessList 
		on error resume next
		objProcess.Terminate() 
		on error goto 0
	Next 

	Dim strRegSavePoint

	if GetOSVersion() >= 6 then
		str = "コンピュータ\" & str
	else
		str = "マイ コンピュータ\" & str
	end if

	strRegSavePoint = "Software\Microsoft\Windows\CurrentVersion\Applets\Regedit\LastKey"
	WshShell.RegWrite "HKCU\" & strRegSavePoint, str, "REG_SZ"

	Call WshShell.Run( "regedit" )

End Function

' **********************************************************
' 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
</SCRIPT>


</head>
<body>

<input class="action" type="text" id="key" style='width:600px;' value="HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run">
<input class="action" type="button" value=" 開く " onClick='Call ActionOpenReg(document.getElementById("key").value)'>

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

	window.focus()
	top.moveTo 0, 0
	top.resizeTo 800, 120

</SCRIPT>

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


</SCRIPT>

タグ：レジストリ HTA サンプルソース VBScript

posted by lightbox at 2018-02-16 08:27 | VBScript |