Scriptガイド

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 "%~p0names.php"
pause

30と言う秒数は、サンプルです。最もテストしやすい間隔なので使用しています。

' このセクションは、cscript.exe で処理を強制させるものです
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str <> "CSCRIPT.EXE" then
	str = WScript.ScriptFullName
	Set WshShell = CreateObject( "WScript.Shell" )
	Call WshShell.Run( "cmd.exe /c cscript.exe """ & str & """ & pause", 3 )
	WScript.Quit
end if

' 現在の日付・時刻を取得
dtBase = Now()
dtTarget = dtBase
' 30秒後の日付・時刻を取得
dtTarget = DateAdd( "s", 30, dtTarget )

' Win32_LocalTime に対して比較する為の値を作成
TargetH = Hour( dtTarget )
TargetM = Minute( dtTarget )
TargetS = Second( dtTarget )

' WMI の処理の為のオブジェクトを取得
Set obj = GetObject("winmgmts:\\.\root\cimv2")
' 該当する時間になればイベント発生
Set objMonitor = obj.ExecNotificationQuery( _
	"select * from __InstanceModificationEvent " & _
	"where TargetInstance isa 'Win32_LocalTime' " & _
	"and TargetInstance.Hour = " & TargetH & " " & _
	"and TargetInstance.Minute = " & TargetM & " " & _
	"and TargetInstance.Second = " & TargetS & " " _
)

Wscript.Echo "イベントを待機しています..."
' 以下の行で処理が停止します
Set objLatestEvent = objMonitor.NextEvent 

' イベントが発生したら、ここ以下が実行される
Wscript.Echo "イベントが発生しました"
Wscript.Echo dtTarget
Wscript.Echo Now()

以下では、イベントに関する解説と、ログオフさせる方法について書かれています

スクリプトセンターのドキュメント

あるプロセスを開始し、そのプロセスが終了した時点でユーザーをログオフさせる

' ****************************************
' 新しい Excel の Book を作成する
' ****************************************
Function NewBook( BookPath )

	Dim ExcelApp	' アプリケーション
	Dim ExcelBook	' ブック

	Set ExcelApp = CreateObject("Excel.Application")

	' 警告を出さないようにする
	ExcelApp.DisplayAlerts = False

	' ブック追加
	ExcelApp.Workbooks.Add

	' 追加したブックを取得
	Set ExcelBook = ExcelApp.Workbooks( ExcelApp.Workbooks.Count )

	on error resume next
	' 保存
	' 56 は、Excel 2007 で拡張子 .xls で保存する場合に必要
	if CLng(Left(ExcelApp.Version & "",2 )) > 11 then
		Call ExcelBook.SaveAs( BookPath, 56 )
	else
		Call ExcelBook.SaveAs( BookPath )
	end if
	if Err.Number <> 0 then
		MsgBox( "ERROR:" & Err.Description )
	end if
	on error goto 0

	' Excel をアプリケーションとして終了
	ExcelApp.Quit
	' Excel を VBScript から開放
	Set ExcelApp = Nothing
	' オブジェクト変数を通常変数として初期化
	' ( ExcelApp がローカル変数なので実際は必要ありません )
	ExcelApp = Empty

End Function

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

XlFileFormat Enumeration [Excel 2007 Developer Reference]

▼ オンラインライブラリでのテストコード

<JOB>
<SCRIPT language="VBScript" src="http://lightbox.on.coocan.jp/webwsh/GetScriptDir.txt"></SCRIPT>
<SCRIPT language="VBScript" src="http://lightbox.on.coocan.jp/webwsh/NewBook.txt"></SCRIPT>

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

	NewBook( GetScriptDir() & "\新しいBOOK.xls" )

</SCRIPT>
</JOB>

http://lightbox.on.coocan.jp/webwsh/GetScriptDir.txt
http://lightbox.on.coocan.jp/webwsh/NewBook.txt

関連する記事

VBScript : Excel のバージョン表示

' Shell.Application を使用する
Set obj = Wscript.CreateObject("Shell.Application")
if Wscript.Arguments.Count = 0 then
	' 引数無しの単純な実行の場合のみ、runas で自分自身を呼び出す
	obj.ShellExecute "wscript.exe", WScript.ScriptFullName & " runas", "", "runas", 1
	Wscript.Quit
end if

' ここが実行された時、管理者権限で実行している事になります

VBScript から利用可能な Shell の機能( Shell.Application )を使って、右クリックメニューにある『管理者として実行』を実行する方法です。

引数なしで実行された場合に、引数をダミーで一つセットして( この場合一つめの runas がそうです )自分自身を呼び出すと言う単純な手法を使用しています。ですから、管理者権限で引数を渡すのは少し面倒になるので、外部ファイルから入力するのがいいと思います。

4番目の引数は省略できますが、その場合は以下のようになります

var Shell = new ActiveXObject("Shell.Application");
var objFolder = Shell.BrowseForFolder( 0, "フォルダ選択", 0x4B, 0x5 );
if ( objFolder == null ) {
	WScript.Quit();
}
if ( !objFolder.Self.IsFileSystem ) {
	WScript.Echo("ファイルシステムではありません" );
	WScript.Quit();
}

WScript.Echo( objFolder.Self.Path );

関連する記事

VBScript : ディレクトリ選択

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;

set-executionpolicy remotesigned を実行する為には、コマンドプロンプトは、『管理者として実行』で開きましょう

set-executionpolicy remotesigned の実行は、PowerShell のコマンドの実行なので、コマンドプロンプトから、powershell.exe が実行された状態で行って下さい。


最初、スクリプトを実行しようとすると、エラーとなってget-help about_signing を参照するように求められます。

以下の部分が必要なところで、remotesigned 実行ポリシーに変更します

署名されているスクリプトの実行の許可
-------------------------------
コンピューター上で初めて Windows PowerShell を起動すると、通常は Restricted 実行ポリシー (既定値) が有効になります。

Restricted 実行ポリシーでは、すべてのスクリプトの実行が禁止されます。

コンピューター上の有効な実行ポリシーを調べるには、次のように入力します。

  get-executionpolicy

自分がローカル コンピューター上で作成した署名のないスクリプトおよび他のユーザーの署名が付けられたスクリプトを実行するには、次のコマンドを使用して、コンピューター上の実行ポリシーをRemoteSigned に変更します。

  set-executionpolicy remotesigned

詳細については、「Set-ExecutionPolicy」を参照してください。

関連する記事

PowerShell2.0 : 全ての日本語ヘルプファイル(テキスト)を作成するスクリプト
管理者権限でコマンドプロンプトを開く VBScript

コマンドプロンプトで実行しておいて、終了はコマンドプロンプトを閉じます。実行される処理は、非同期では無いので外部のスクリプトをプロセスとして実行するといいでしょう。どうしても、同一スクリプト内で実行したい場合は、Cron の代替え : VBScript でタイマー処理 を参照して下さい

' このセクションは、cscript.exe で処理を強制させるものです
str = WScript.FullName
str = Right( str, 11 )
str = Ucase( str )
if str <> "CSCRIPT.EXE" then
	str = WScript.ScriptFullName
	Set WshShell = CreateObject( "WScript.Shell" )
	Call WshShell.Run( "cmd.exe /c cscript.exe """ & str & """ & pause", 3 )
	WScript.Quit
end if

Set obj = GetObject("winmgmts:\\.\root\cimv2")
Set objMonitor = obj.ExecNotificationQuery( _
	"select * from __InstanceModificationEvent " & _
	"where TargetInstance isa 'Win32_LocalTime' " & _
	" and (TargetInstance.Second = 0" & _
	" or TargetInstance.Second = 10" & _
	" or TargetInstance.Second = 20" & _
	" or TargetInstance.Second = 30" & _
	" or TargetInstance.Second = 40" & _
	" or TargetInstance.Second = 50)" _
)

Do


	Set objLatestEvent = objMonitor.NextEvent 

	' ここに処理を記述
	Wscript.Echo Now()

Loop

以下のプロパティが使用できます

class Win32_LocalTime : Win32_CurrentTime
{
  uint32 Day;
  uint32 DayOfWeek;
  uint32 Hour;
  uint32 Milliseconds;
  uint32 Minute;
  uint32 Month;
  uint32 Quarter;
  uint32 Second;
  uint32 WeekInMonth;
  uint32 Year;
};

先にログインを済ませておいてから実行します。

# **********************************************************
# Seesaa アクセス解析処理
# $agent はグローバル変数
# **********************************************************
def seesaaAction(blog_id,blog_nm,opt) 

	# ブログ選択
	page = $agent.get($seesaa_select_blog + blog_id)
	# アクセス解析デフォルトページ( ページ別 )
	page = $agent.get($seesaa_access_default)

	# アクセス数と訪問者数を取得
	/top_total right">(.+?)<\/td>.+top_total right">(.+?)</m =~ page.body
	$ucnt = $2
	$vcnt = $1

	print blog_nm + "   " +  $ucnt + "/" + $vcnt + "<br>\n"

end

関連する記事

Seesaa のブログ設定の『最新の情報に更新』を実行する Ruby のコード

この後、必要なページへ移動してユーザー操作を実行させます。

#!/usr/local/bin/ruby
print "Content-type: text/html; Charset=utf-8\n\n"

# 標準エラー出力の出力先を標準出力に変更
$stderr = $stdout

require "cgi"
cgi = CGI.new

require 'uri'

ENV['GEM_HOME']="/home/lightbox/gems"
$LOAD_PATH.push('/home/lightbox/lib')

require 'rubygems'
require 'mechanize'

agent = WWW::Mechanize.new

agent.open_timeout = 600
agent.read_timeout = 600

#seesaa にログイン
page = agent.get("https://ssl.seesaa.jp/www/pages/welcome/login/input")
form = page.forms.first
form["member__email"] = "メールアドレス"
form["member__password"] = "パスワード"
form.submit

関連する記事

Seesaa のブログ設定の『最新の情報に更新』を実行する Ruby のコード

WScript.FullName には、その時使用された Wscript.exe か Cscript.exe の
フルパスが入っていますので、その内容が Wscript.exe であれば、Cscript.exe
で自分自身を実行して、現在の処理は終了してやります。

引数はそのまま全てを文字列に作りなおして呼び出してやるといいです。

Set WshShell = CreateObject( "WScript.Shell" )

' フルパス
strPath = WScript.FullName
strTarget = Right( strPath, 11 )
strTarget = Ucase( strTarget )

' CSCRIPT.EXE で無い場合
if strTarget <> "CSCRIPT.EXE" then
	' 自分自身ののフルパス
	strMyPath = 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 & """" & Wscript.Arguments(I) & """ "
		end if
	Next
	Call WshShell.Run( "cscript.exe """ & strMyPath & """" & strParam, 3 )
	WScript.Quit

end if

' テストの為 強制的に GUI で結果表示
MsgBox( WScript.FullName )
For I = 0 to Wscript.Arguments.Count - 1
	MsgBox( Wscript.Arguments(I) )
Next

関連する記事

VBScript : WEBWSH : Wscript で実行された場合は Cscript で実行しなおす

比較的小さいファイルをダウンロードするのに問題無く使えます。
( 3メガバイトを超えるようなファイルは別の方法を検討します。)

Function HTTPDownload( strUrl, strPath )

	Dim objSrvHTTP,Stream

	Set objSrvHTTP = CreateObject("Msxml2.ServerXMLHTTP.3.0")
	Set Stream = CreateObject("ADODB.Stream")

	HTTPDownload = True

	on error resume next
	Call objSrvHTTP.Open("GET", strUrl, False )
	if Err.Number <> 0 then
		ErrorMessage = Err.Description
		HTTPDownload = False
		Exit Function
	end if
	on error goto 0

	objSrvHTTP.Send

	Stream.Open
	Stream.Type = 1	' バイナリ
	Stream.Write objSrvHTTP.responseBody
	Stream.SaveToFile strPath, 2
	Stream.Close

End Function

関連する記事

WEBのファイルをコマンドラインからダウンロードするスクリプト
 : httpget.vbs ( 2〜3メガまでが目安 )

API 使うよりもお手軽ですが、入力画面の HTML が変更されると
修正が必要です。

#!/usr/local/bin/ruby
print "Content-type: text/html\n\n"

require "cgi"
cgi = CGI.new

ENV['GEM_HOME']="/home/lightbox/gems"

$LOAD_PATH.push('/home/lightbox/lib')

require 'rubygems'
require 'mechanize'

agent = WWW::Mechanize.new
#twitterにログイン
page = agent.get("http://twitter.com/login")
form = page.forms[1]
form["session[username_or_email]"] = cgi['user'][0]
form["session[password]"] = cgi['pass'][0]
page = form.submit

#twitterのページより投稿
form = page.forms[1]
form["status"] = cgi['text'][0]
result = form.submit

print result.body

---------------------------------------------
PS C:\ps\test> .\fc
パラメータ不足
PS C:\ps\test> .\fc a
パラメータ不足
PS C:\ps\test> .\fc a b
ファイルを開けません
PS C:\ps\test> .\fc test_001.ps1 test_001.ps1
一致
PS C:\ps\test> .\fc test_001.ps1 test_002.ps1
不一致
PS C:\ps\test>
---------------------------------------------

$LastExitCode の説明はタイトルのままでそれ以上の説明は
ありません。以下のテストは、fc.exe を使った簡単なサンプル
で、fc.exe が出力するメッセージは表示されません

fc.exe $args[0] $args[1] 2>&1 | out-null
switch ($LastExitCode){
	-1 {
		"パラメータ不足"
	}
	2 {
		"ファイルを開けません"
	}
	1 {
		"不一致"
	}
	0 {
		"一致"
	}
}

普通に探すと見つかりにくいかもしれません

Windows 管理フレームワーク (Windows PowerShell 2. 0、WinRM 2. 0、および BITS 4. 0)

XP では、何故か「アクセサリ」に登録されたので、PowerShell 統合スクリプト環境 (ISE)
はそこから起動できます



また、この環境のプロファイルは、コンソールとは別になっているので
新たに作成する必要があります。

関連する記事

PowerShell2.0 : プロファイルの作成

初期状態では、プロファイルは作成されていないようで、作成するファイルの
パスは $profile に格納されているので、以下のコードで作成します。コンソ
ールに貼り付けた後、エンターキーを二回押して実行して下さい。

if (!(test-path $profile))
	{new-item -type file -path $profile -force}

作成後、そのファイル( Microsoft.PowerShell_profile.ps1 )をテキストエディタ
で開いて、コマンドを書いておくと、起動時に有効となります。例えば以下は、
Variable ブロバイダに移動する var: という関数を作成します。

new-item -path function: -value {set-location variable:} -name var: | Out-Null

関連する記事

PowerShell2.0 : Variable プロバイダ

全ての変数を持つ名前空間で、ファイルシステムのような階層はありません。
変数名の頭に $ を付加させる記法は変数の内容を参照する為のショートカッ
トです。

set-variable -name a -value 10
set-variable -name b -value (get-variable -name a).value
get-variable -name b

Name                           Value
----                           -----
b                              10

set-location variable: で移動して、dir(get-childitem) を実行する事で表示可能です。
自分自身を含む他のドライブから以下の構文でも同じ結果を得る事ができま
す。

get-childitem -path variable:

-----------------------------------------------------------
Name                           Value
----                           -----
$
?                              True
^
_
args                           {}
ConfirmPreference              High
ConsoleFileName
DebugPreference                SilentlyContinue
Error                          {}
ErrorActionPreference          Continue
ErrorView                      NormalView
ExecutionContext               System.Management.Automation.EngineIntrinsics
false                          False
FormatEnumerationLimit         4
HOME                           C:\Documents and Settings\lightbox
Host                           System.Management.Automation.Internal.Host.InternalHost
input                          System.Collections.ArrayList+ArrayListEnumeratorSimple
MaximumAliasCount              4096
MaximumDriveCount              4096
MaximumErrorCount              256
MaximumFunctionCount           4096
MaximumHistoryCount            64
MaximumVariableCount           4096
MyInvocation                   System.Management.Automation.InvocationInfo
NestedPromptLevel              0
null
OutputEncoding                 System.Text.ASCIIEncoding
PID                            804
PROFILE                        C:\Documents and Settings\lightbox\My Documents\WindowsPowe...
ProgressPreference             Continue
PSBoundParameters              {}
PSCulture                      ja-JP
PSEmailServer
PSHOME                         C:\WINDOWS\system32\WindowsPowerShell\v1.0
PSSessionApplicationName       wsman
PSSessionConfigurationName     http://schemas.microsoft.com/powershell/Microsoft.PowerShell
PSSessionOption                System.Management.Automation.Remoting.PSSessionOption
PSUICulture                    ja-JP
PSVersionTable                 {CLRVersion, BuildVersion, PSVersion, WSManStackVersion...}
PWD                            C:\ps\test
ReportErrorShowExceptionClass  0
ReportErrorShowInnerException  0
ReportErrorShowSource          1
ReportErrorShowStackTrace      0
ShellId                        Microsoft.PowerShell
StackTrace
true                           True
VerbosePreference              SilentlyContinue
WarningPreference              Continue
WhatIfPreference               False

Microsoft のサンプルと全く同じでは動きませんでしたので、マクロを記録して
コードを補完しました。
Cells で、行・カラムにしているのはそのほうがプログラミングで都合がいいからです

関連する記事

PowerShell2.0 : COM 経由で Excel のグラフを作成した後、PDFとしてエクスポートする

<JOB>
<SCRIPT
	language="VBScript"
	src="http://lightbox.on.coocan.jp/webwsh/GetScriptDir.vbs"
></SCRIPT>

<SCRIPT language=VBScript>
' ***********************************************************
' 新しいグラフを作成する
' ***********************************************************

Dim ExcelApp	' アプリケーション
Dim ExcelBook	' ブック
Dim MySheet
Dim dataRange
Dim chartObjects
Dim newChartObject
Dim MyChart
Dim BookPath

Set ExcelApp = CreateObject("Excel.Application")

' 警告を出さないようにする
ExcelApp.DisplayAlerts = False
' Excel を表示状態にする
'ExcelApp.Visible = True

' ブック追加
ExcelApp.Workbooks.Add

' 追加したブックを取得
Set ExcelBook = ExcelApp.Workbooks( ExcelApp.Workbooks.Count )

' Worksheet を選択 ( 最初のシート )
Set MySheet = ExcelBook.Sheets(1)

' シートへグラフ用データをセット
MySheet.Cells(1, 1) = ""
MySheet.Cells(1, 2) = "Q1"
MySheet.Cells(1, 3) = "Q2"
MySheet.Cells(1, 4) = "Q3"
MySheet.Cells(1, 5) = "Q4"

MySheet.Cells(2, 1) = "N. America"
MySheet.Cells(2, 2) = "1.5"
MySheet.Cells(2, 3) = "2"
MySheet.Cells(2, 4) = "1.5"
MySheet.Cells(2, 5) = "2.5"

MySheet.Cells(3, 1) = "S. America"
MySheet.Cells(3, 2) = "2"
MySheet.Cells(3, 3) = "1.75"
MySheet.Cells(3, 4) = "2"
MySheet.Cells(3, 5) = "2"
 
MySheet.Cells(4, 1) = "Europe"
MySheet.Cells(4, 2) = "2.25"
MySheet.Cells(4, 3) = "2"
MySheet.Cells(4, 4) = "2.5"
MySheet.Cells(4, 5) = "2"

 
MySheet.Cells(5, 1) = "Asia"
MySheet.Cells(5, 2) = "2.5"
MySheet.Cells(5, 3) = "2.5"
MySheet.Cells(5, 4) = "2"
MySheet.Cells(5, 5) = "2.75"

' データの範囲
Set dataRange = MySheet.Range(MySheet.Cells(1, 1), MySheet.Cells(5, 5))

Set chartObjects = MySheet.ChartObjects()
' 座標は、グラフのエリア
Set newChartObject = chartObjects.Add(0, 100, 300, 300)

Dim paramChartFormat : paramChartFormat = 1
Dim paramCategoryLabels : paramCategoryLabels = 0
Dim paramSeriesLabels : paramSeriesLabels = 0
Dim paramHasLegend  : paramHasLegend = True
Dim paramTitle : paramTitle = "Sales by Quarter"
Dim paramCategoryTitle : paramCategoryTitle = "Fiscal Quarter"
Dim paramValueTitle : paramValueTitle = "Billions"

Set MyChart = newChartObject.Chart

MyChart.ChartType = 54
Call MyChart.SetSourceData( dataRange )

BookPath = GetScriptDir & "\chart.xls"
on error resume next
' 保存
' 56 は、Excel 2007 で拡張子 .xls で保存する場合に必要
if CLng(Left(ExcelApp.Version & "",2 )) > 11 then
	Call ExcelBook.SaveAs( BookPath, 56 )
else
	Call ExcelBook.SaveAs( BookPath )
end if
if Err.Number <> 0 then
	MsgBox( "ERROR:" & Err.Description )
end if
on error goto 0

' Excel をアプリケーションとして終了
ExcelApp.Quit
' Excel を VBScript から開放
Set ExcelApp = Nothing
' オブジェクト変数を通常変数として初期化
ExcelApp = Empty


</SCRIPT>
</JOB>

関連する記事

VBScript : 実行中のスクリプトが存在するディレクトリ
VBScript : Excel の新しいBookを作成する


関連する Microsoft ドキュメント

Creating Basic Column Charts in Excel 2007
XlChartType Enumeration [Excel 2007 Developer Reference]

何故か、Version プロパティは文字列で返されて来るのに、
.0 という部分が付加されています。2007のExcel のバージ
ョン表示を見ると、その .0 の部分も表示されています。
(以前のバージョンでは表示されていなかったと思います)

全てを表示するのであれば、ExcelApp.Version と ExcelApp.Build
をそのまま表示すれば良いですが、バージョン毎の動作の違いの為
に使う場合は、CLng(Left(ExcelApp.Version & "",2 )) として
使うと良いと思います。

Set ExcelApp = CreateObject("Excel.Application")

MsgBox( CLng(Left(ExcelApp.Version & "",2 ))&"."&ExcelApp.Build  )


' Excel をアプリケーションとして終了
ExcelApp.Quit
' Excel を VBScript から開放
Set ExcelApp = Nothing
' オブジェクト変数を通常変数として初期化
ExcelApp = Empty

<JOB>
<SCRIPT
	language="VBScript"
	src="http://lightbox.on.coocan.jp/webwsh/GetScriptDir.vbs"
></SCRIPT>

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

	MsgBox( GetScriptDir() )

</SCRIPT>
</JOB>

上記コードで、オンラインの関数をテストできます

VISTA からレジストリ内での名前が変更されています。そのために
GetOSVersion 関数が必要になります。元々、regedit は、一つの
プロセスしか起動できないので、終了させるのは容易です。

※ 一旦終了させないと、この選択は起動時にしか行われません

OpenReg( "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run" )

Function OpenReg( strReg )

	Dim str1
	Dim str2
	Dim Wmi 
	Dim colTarget 
	Dim objRow
	Dim WshShell

	Set WshShell = CreateObject( "WScript.Shell" )

	str1 = "Software\Microsoft\Windows\CurrentVersion\Applets\Regedit\LastKey"

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

	WshShell.RegWrite "HKCU\" & str1, str2, "REG_SZ"

	strComputer = "."
	Set Wmi = GetObject("winmgmts:" _
	    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

	Set colTarget = Wmi.ExecQuery _ 
		("Select * from Win32_Process Where Name = 'regedit.exe'")

	For Each objRow in colTarget 
		objRow.Terminate() 
	Next 

	Call WshShell.Run( "regedit" )

End Function

関連する記事

VBScript : 数値として比較できる OS のバージョンの取得

Windows 2000 : 5.0、XP : 5.1
Vista : 6.0、Windows7 : 6.1

なので、if GetOSVersion() > 5 then というふうに使えます。

関連する情報

Windows NT系 - Wikipedia

<JOB>
<SCRIPT
	language="VBScript"
	src="http://lightbox.on.coocan.jp/webwsh/GetOSVersion.vbs"
></SCRIPT>

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

	MsgBox( GetOSVersion() )

</SCRIPT>
</JOB>

上記コードで、オンラインの関数をテストできます

JavaScript では、引数を() で囲って呼び出して下さい

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

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

</SCRIPT>

拡張子 .hta の HTMLアプリケーションを実行中のスクリプトが存在する
ディレクトリを取得します。

str = Replace(window.location&"","file:///","")
str = Replace(str,"/","\")
str = Replace(str,"%20"," ")

関連する記事
VBScript : IIS7 の 仮想ディレクトリ登録

<JOB>
<OBJECT id="WshShell"	progid="WScript.Shell" />
<OBJECT id="Fso"		progid="Scripting.FileSystemObject" />

<SCRIPT language="VBScript" src="crun.vbs"></SCRIPT>

<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
'
' 既存の仮想ディレクトリでも、物理パスを変更可能
' ***********************************************************

' Cscript.exe で実行する
crun

' スクリプトが存在するディレクトリと名前
strCurPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurPath )
Set obj = obj.ParentFolder
strCurPath = obj.Path & ""
strName = obj.Name
strPhp = "C:\php-5.2.8-Win32\php-cgi.exe"

' 仮想ディレクトリのパスを「既定の Web サイト」として設定
strVDir = "IIS://localhost/W3SVC/1/Root/" & strName

' 仮想ディレクトリが既に存在するフラグ
bExist = True

on error resume next
' 仮想ディレクトリのオブジェクトを取得
Set IIsWebVDirObj = GetObject(strVDir)
if Err.Number <> 0 then
	' 新規
	Set IIsWebVDirRootObj = GetObject("IIS://localhost/W3SVC/1/Root") 
	Set IIsWebVDirObj = _
		IIsWebVDirRootObj.Create("IIsWebVirtualDir", strName ) 
	' 物理パスを設定
	IIsWebVDirObj.Put "Path", strCurPath
	' 新規仮想ディレクトリ
	bExist = False
else
	Set IIsWebVDirRootObj = GetObject("IIS://localhost/W3SVC/1/Root") 
	' 変更( 物理パスが変わっていても、ここでセットされる )
	IIsWebVDirObj.Put "Path", strCurPath
end if
on error goto 0

' ルートの仮想ディレクトリのマッピングに追加して PHP を使用できるように構成
strMap = ""
bTarget = False
For each value in IIsWebVDirRootObj.ScriptMaps
	strCheck = Ucase((Split( value, "," ))(0))
	if strCheck = ".PHP" then
		strMap = strMap & vbTab & ".php," & strPhp & ",5,GET,POST"
		bTarget = True
	else
		if strMap <> "" then
			strMap = strMap & vbTab
		end if
		strMap = strMap & value
	end if
Next
if Not bTarget then
	strMap = strMap & vbTab & ".php," & strPhp & ",5,GET,POST"
end if
IIsWebVDirObj.Put "ScriptMaps", Split(strMap,vbTab)

' .asp ファイルの実行を許可
IIsWebVDirObj.Put "AccessScript", True

' 実行可能ファイルの実行を許可
IIsWebVDirObj.Put "AccessExecute", True		

' クライアントが要求したリソースに対するアクセス
IIsWebVDirObj.Put "AccessSource", True

IIsWebVDirObj.Put "AccessRead", True			' 読み取り
IIsWebVDirObj.Put "AccessWrite", True			' 書き込み
IIsWebVDirObj.Put "EnableDirBrowsing", True		' ディレクトリの参照

' ログファイルに書き込むかどうか( False で書き込む )
IIsWebVDirObj.Put "DontLog", False

' このリソースに索引を付ける
IIsWebVDirObj.Put "ContentIndexed", False

' インプロセス (0)、アウトプロセス (1)、またはプロセスプール内 (2)
' 2 が 中なので注意
IIsWebVDirObj.AppCreate2 2

' アプリケーションの名前
IIsWebVDirObj.Put "AppFriendlyName", "php実行可能ディレクトリ"

IIsWebVDirObj.Put "AspAllowSessionState", True	' セッション有効
IIsWebVDirObj.Put "AspSessionTimeout", 20		' セッションタイムアウト(分)
IIsWebVDirObj.Put "AspBufferingOn", True		' バッファ処理
IIsWebVDirObj.Put "AspEnableParentPaths", True	' ..\ 表記を使用可能
IIsWebVDirObj.Put "AspScriptTimeout", 90		' スクリプトタイムアウト(秒)

' 既定のドキュメントを読み込むようにする
IIsWebVDirObj.Put "EnableDefaultDoc", True
' 既定のドキュメント
IIsWebVDirObj.Put "DefaultDoc", "index.htm,index.html,index.php"

' ASP ファイルをキャッシュしない
IIsWebVDirObj.Put "AspScriptFileCacheSize", True

' 書き込み
IIsWebVDirObj.SetInfo


if bExist then
	Wscript.Echo "仮想ディレクトリ " & strName & " を変更しました"
else
	Wscript.Echo "仮想ディレクトリ " & strName & " を作成しました"
end if


</SCRIPT>
</JOB>

*************************************************************
■このスクリプトが置かれたディレクトリを
  仮想ディレクトリとして登録
*************************************************************

1) list_iis.wsf で、既定の Web サイトの情報を取得
2) create_vdir.wsf で作成または変更

仮想ディレクトリ名は実際のディレクトリ名が使われますが、
任意の名前にしたい場合は、22 行目の
strName = obj.Name
を
strName = "任意の名前"
に変更して下さい。

※ php の情報は strPhp = "C:\php-5.2.8-Win32\php-cgi.exe" を変更
※ 別のディレクトリで実行すると、その場所で更新になります
※ crun.vbs は外部ライブラリファイル
※ phpinfo.php は、php 実行確認用
※ check.asp は、asp 実行確認用
※ view.htm は、check.asp より #include しています

【チェック】
ディレクトリの権限で、少なくとも Users グループが登録されている必要があります
ファイルの書き込みを行う場合は、Users グループをフルコントロールにすると
問題を回避できると思います

■著作権その他

このプログラムはフリーです。どうぞ自由に御使用ください。
著作権は作者である私が保有しています。
また、本ソフトを運用した結果については、作者は一切責任を
負えせんのでご了承ください。

lightbox

関連する記事
VBScript : IIS7 の 仮想ディレクトリ登録

対象ディレクトリの中に置いて実行するだけです。
このスクリプトは、スクリプトのあるディレクトリを登録するので、
インストールしたいアプリケーションと共に保存しておけば
呼び出すだけで目的が達成されます

' **********************************************************
' ■ スクリプトが存在するディレクトリを
'    ユーザ環境変数の PATH へ登録します
'
' ■ もし、システム環境変数に既に同じパスがあれば
'    登録しません
'
' ■ 登録位置は、一番最後です
' **********************************************************
strTitle = "スクリプトが存在するディレクトリをユーザPATH環境変数に登録"

' **********************************************************
' PC 名と ユーザ名を取得
' **********************************************************
Set WshNetwork = CreateObject( "WScript.Network" )
strUser = WshNetwork.UserName
strMachine = WshNetwork.ComputerName

' **********************************************************
' スクリプトが存在するディレクトリを取得
' **********************************************************
Set Fso = CreateObject( "Scripting.FileSystemObject" )

strScriptPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strScriptPath )
Set obj = obj.ParentFolder
strScriptPath = obj.Path

' strScriptPath に 使用するディレクトリがセットされています


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

strComputer = "."
Set obj = GetObject("winmgmts:\\.\root\cimv2")

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 = ""

strComputer = "."
Set obj = GetObject("winmgmts:\\.\root\cimv2")

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_

以下は、削除用です
システムとログインしているユーザをチェックして、両方にあれば
両方とも削除します。

■ 関連するページ
環境変数作成
Hey, Scripting Guy! : Path 環境変数に場所を追加する方法はありますか
Hey, Scripting Guy! : Path 環境変数から値を削除する方法はありますか
wmiquery
PATH 環境変数メンテナンス : Redmond Path

<%
Function require( Url )

	Dim obj,strFunction

	Set obj = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
	on error resume next
	Call obj.Open("GET", Url, False )
	if Err.Number <> 0 then
		require = False
		Exit Function
	end if
	on error goto 0
	obj.Send
	strFunction = obj.responseText
	ExecuteGlobal strFunction

	require = True

End Function

require( "http://winofsql.jp/VBScript/functions.vbs" )

CreateMdb( Server.MapPath("売上.mdb") )
if ErrorMessage <> "" then
	Response.Write ErrorMessage & "<br>"
end if
%>
処理が終了しました

この関数の方法論は、WSH や IE でも有効です。
WSH や IE では、スクリプトタグがあるので必要無いように思われる
かもしれませんが、この関数によって取得されるのは文字列なので、
動的に関数の内容を変更してから「関数として実装」が可能になります

■関連する記事
VBScript : MDB作成 / http 経由で関数ライブラリを読み込む

ローカルでも構いませんが、WEB上に functions.vbs というファイル
を作成して利用しています。

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

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

CreateMdb( "売上.mdb" )
if ErrorMessage <> "" then
	Wscript.Echo ErrorMessage
end if

</SCRIPT>
</JOB>

以下が functions.vbs ですが、
クォート付加
スクリプト種別の判定
文字列名称からオブシェクト作成

を使用しています

REM **********************************************************
REM ■ 動的にローディングする為の注意
REM 1) UTF-8N で保存する
REM 2) コメントは REM を使用する
REM 3) 条件式として = を使わない
REM ■ 問題回避の対策
REM .htaccess 
REM AddType "text/plain" .vbs
REM **********************************************************

REM **********************************************************
REM シングルクォートで囲む
REM **********************************************************
Function Ss( strValue )

	Ss = "'" & strValue & "'"

End Function

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

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

End function

REM **********************************************************
REM 実行中のスクリプトのタイプ
REM 1:WSH, 2:HTA, 3:ASP, 0:不明
REM **********************************************************
Function ScriptType( )

	Dim nType

	nType = 0

	if IsObject( Wscript ) then
		nType = 1
	else
		if IsObject( window ) then
			nType = 2
		else
			if IsObject( Server ) then
				nType = 3
			end if
		end if
	end if

	ScriptType = nType

End Function

REM **********************************************************
REM オブジェクト作成を WSH、IE、ASP で共通に使えるようにする
REM **********************************************************
Function GetObj( strTarget, strObjectName )

	Dim ExecuteString

	ExecuteString = "Dim " & strTarget & " : "
	ExecuteString = ExecuteString & "Set " & strTarget & " = "

	Select Case ScriptType
		Case 1
			ExecuteString = ExecuteString & _
			"WScript.CreateObject("
		Case 2
			ExecuteString = ExecuteString & _
			"CreateObject("
		Case 3
			ExecuteString = ExecuteString & _
			"Server.CreateObject("
		Case Else
			ExecuteString = ExecuteString & _
			"CreateObject("
	End Select

	ExecuteString = ExecuteString & Dd( strObjectName ) & ")"

	ExecuteGlobal ExecuteString

End Function

REM **********************************************************
REM ADOX.Catalog の取得
REM **********************************************************
Function GetAdox( )

	if not IsObject( Adox ) then
		Call GetObj( "Adox", "ADOX.Catalog" )
	end if

End Function

REM ******************************************************
REM 文字列よりグローバルスコープの変数を定義
REM ******************************************************
Function GlobalDim(str)

	Dim ExecuteString

	ExecuteString = "Dim " & str
	ExecuteGlobal ExecuteString

End Function

REM ******************************************************
REM MDB 作成
REM ******************************************************
Function CreateMdb( strPath )

	CreateMdb = True

	GetAdox

	on error resume next
	Adox.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
		"Data Source=" & strPath & ";"
	if Err.Number <> 0 then
		CreateMdb = False
		GlobalDim("ErrorMessage")
		ErrorMessage = Err.Description
	end if
	on error goto 0

End Function

関数の相互間や、グローバルスコープ等、どこからでも共通に
変数を参照可能になるように、その必要のある変数は
ExecuteGlobal ステートメントを使用して作成しています

Adox(オブジェクト) も、ErrorMessage(変数) も、グローバル
スコープで参照可能な変数となります。たとえ既にグローバルで Dim によって定義されていても、
エラーとはならず無い場合に正しく作成されます

もう何年も運用していますが特に問題は出ていません
( ネットワーク障害や DNS の問題は、http 経由という部分において支障が発生します )

■ 関連する記事
ASP : 別ドメインにある関数ライブラリを使用して Mdb を作成する

Set Shell = CreateObject( "Shell.Application" )
Set objFolder = Shell.BrowseForFolder( 0, "フォルダ選択", &H4B, "C:\" )
if objFolder is nothing then
	WScript.Quit
end if
if not objFolder.Self.IsFileSystem then
	WScript.Echo "ファイルシステムではありません"
	WScript.Quit
end if

WScript.Echo objFolder.Self.Path

4番目の引数は、ディレクトリ選択ダイアログのトップを指定します。省略できますが、省略しない場合は以下の一覧から選択します。システムで定義された数値か "C:\TMP" というような文字列でもかまいません

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;

関連する記事

JScript : ディレクトリ選択

' リモートコンピュータの WMI オブジェクトを取得

Const Impersonate = 3

strServer = "ped0-007"
strUser = "lightbox"
strPassword = "password"

' ロケータ
Set objLocator = CreateObject("WbemScripting.SWbemLocator")

on error goto 0
' サービス
Set objWMIService = objLocator.ConnectServer( _
	strServer, _
	"root\cimv2", _
	strUser, _
	strPassword _
)
if Err.Number <> 0 then
	Wscript.Echo Err.Description
	Wscript.Quit
end if

' セキュリティ
objWMIService.Security_.ImpersonationLevel = Impersonate
if Err.Number <> 0 then
	Wscript.Echo Err.Description
	Wscript.Quit
end if
on error goto 0

' 対象サービスを取得
Query = "Select * from Win32_Service where Name='Spooler'"
Set colServiceList = objWMIService.ExecQuery(Query) 

' サービス開始
For each objService in colServiceList 
	errReturn = objService.StartService()
Next

Wscript.Echo errReturn

■ 関連する記事
WMIでローカルPCのサービス開始
コマンドプロンプトからサービス開始

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

' ローカルコンピュータの WMI オブジェクトを取得
str = "winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2"
Set objWMIService = GetObject( str )

' 対象サービスを取得
Query = "Select * from Win32_Service where Name='Spooler'"
Set colServiceList = objWMIService.ExecQuery(Query) 

' サービス開始
For each objService in colServiceList 
	errReturn = objService.StartService()
Next

Wscript.Echo errReturn

errReturn は以下の内容が戻されます

関連する記事

コマンドプロンプトからサービス開始


関連する Microsoft ドキュメント

サービスおよびその依存サービスの開始
StartService Method of the Win32_Service Class

IE からアプリケーションを実行するには、セキュリティゾーン別に
運用をよく考えて設定する必要があります。

通常、インターネットは「インターネットゾーン」なので、
WEB ページからアプリケーションを実行するには、「信頼するサイト」
に登録し、多少危険ですが、AvtiveX が無効になっているのを最低限、
ダイアログで確認するように設定する必要があります。

その結果、実行時に、AvtiveX を実行してもかまわないか、
ユーザーに確認するダイアログが、オブジェクト作成時に表示されます。

ですが、IE には、隠された「マイ コンピュータ」ゾーンがあり、
その対象は、ローカルファイルシステムであり、そのデフォルトの設定
で、結果的には実行可能になると思います。
( 厳密には、IE6 やら IE7 やら XP SP2 やらで変遷があると思いますが )



いずれにしても、設定次第で即実行可能にもできますし、
実行不能にする事もできます。ただ、最近はこのへんが複雑になってきているのも事実です。

Now, with IE7, it's broken.
About URL Security Zones 
ネットワーク プロトコルのロックダウン 

ですから、以上の二つの運用の自信が無い場合は、
HTML を HTA で作成したフレームに埋め込む事によって、
全くセキュリティを考えずに実行可能です。

<meta http-equiv="content-type" content="text/html; charset=SHIFT_JIS">
<SCRIPT type="text/vbscript" language="vbscript">

Set WshShell =  CreateObject( "WScript.Shell" )

Function webrun(no)

	Select Case no
	Case 0
		WshShell.Run("notepad.exe")
	Case 1
		WshShell.Run("regedit.exe")
	End Select

End Function

</SCRIPT>
<HTML>
<HEAD>
<META http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
<LINK rel="stylesheet" href="style.css">
</HEAD>
<BODY>

<pre>
<A href="vbscript:" onClick='webrun(0)'>メモ帳の実行</A>
<A href="vbscript:" onClick='webrun(1)'>レジストリの実行</A>
</pre>

</BODY>
</HTML>

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

	' 親フレーム(一つ)が存在する場合に、画面一杯に広げる
	if parent.document.getElementsByTagName("FRAME").length = 1 then
		top.moveTo 0, 0
		top.resizeTo screen.width, screen.height - 32
	end if


</SCRIPT>

※ IE に表示させるHTMLの先頭に VBScript を書くと、
※ そのページのデフォルト言語がVBScript になります
( 最近は、その前に META でキャラクタセットを指定しないと動かない可能性があります )

以下は、HTA として実行する為の上記 HTML を埋め込む枠です。
( application="yes" によって実現されています )

※ ICON で指定する画像は、WEB上にするといいと思います。

<HTML>
<HEAD>
<TITLE>HTA Frame</TITLE>
<META http-equiv="Content-Type" content="text/html; charset=shift_jis">

<HTA:APPLICATION ID="Sqlwin"
	BORDERSTYLE="sunken"
	INNERBORDER="yes"
	ICON="db.ico"
>

</HEAD>
<FRAMESET id="TopFrame" rows="*">
	<FRAME name="HTAFrame" src="run.htm" application="yes">
</FRAMESET>

' **********************************************************
' テキストファイルの1行単位での入出力
' **********************************************************

Set Fso = CreateObject( "Scripting.FileSystemObject" )

strPath1 = "enum_desktop.vbs"
strPath2 = "enum_desktop.txt"

Set objHandle1 = Fso.OpenTextFile( strPath1, 1 )
Set objHandle2 = Fso.OpenTextFile( strPath2, 2, True )

Do While not objHandle1.AtEndOfStream
	Buffer = objHandle1.ReadLine
	objHandle2.WriteLine Buffer
Loop

Call objHandle2.Close()
Call objHandle1.Close()

' **********************************************************
' メモリを使用したテキストファイルの一括入出力
' **********************************************************

Set Fso = CreateObject( "Scripting.FileSystemObject" )

strPath1 = "enum_desktop.vbs"
strPath2 = "enum_desktop.txt"

Set objHandle1 = Fso.OpenTextFile( strPath1, 1 )
Set objHandle2 = Fso.OpenTextFile( strPath2, 2, True )

strText = objHandle1.ReadAll
objHandle2.Write( strText )

Call objHandle2.Close()
Call objHandle1.Close()

■ OpenTextFile

REM **********************************************************
REM 実行中のスクリプトのタイプ
REM 1:WSH, 2:HTA, 3:ASP, 0:不明
REM **********************************************************
Function ScriptType( )

	Dim nType

	nType = 0

	if IsObject( Wscript ) then
		nType = 1
	else
		if IsObject( window ) then
			nType = 2
		else
			if IsObject( Server ) then
				nType = 3
			end if
		end if
	end if

	ScriptType = nType

End Function

REM **********************************************************
REM 文字列を指定して、変数にオブシェクトを作成させる
REM **********************************************************
Function GetObj( strTarget, strObjectName )

	Dim ExecuteString

	ExecuteString = "Dim " & strTarget & " : "
	ExecuteString = ExecuteString & "Set " & strTarget & " = "

	Select Case ScriptType
		Case 1
			ExecuteString = ExecuteString & _
			"WScript.CreateObject("
		Case 2
			ExecuteString = ExecuteString & _
			"CreateObject("
		Case 3
			ExecuteString = ExecuteString & _
			"Server.CreateObject("
		Case Else
			ExecuteString = ExecuteString & _
			"CreateObject("
	End Select

	ExecuteString = ExecuteString & Dd( strObjectName ) & ")"

	ExecuteGlobal ExecuteString

End Function

REM **********************************************************
REM シングルクォートで囲む
REM **********************************************************
Function Ss( strValue )

	Ss = "'" & strValue & "'"

End Function

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

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

End function