GINPRO / SQLの窓と銀プログラマ

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

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

Set objBasic = new basic : objBasic
Set objWmireg = new wmireg : objWmireg

Call SetAlias()

Function SetAlias( )

' ***********************************************************
' 処理開始
' ***********************************************************
	' 対象のレジストリを決定
	strTarget = "default"
	strTarget = "SOFTWARE\AnHttpd\" & strTarget & "\Alias"
	' 仮想ディレクトリの一覧を取得する
	Set var = objWmireg.GetLValueArray( strTarget )
	
	' 仮想ディレクトリ名を決定
	strAlias = " /" & objBasic.var("ScriptCurDirName")

' ***********************************************************
' 既にあれば上書き、無ければ追加
' ***********************************************************
	if not var.Exists( strAlias ) then
		nValue = var("Count") + 1
		objWmireg.SetLDword strTarget, "Count", nValue
	end if
	' 物理ディレクトリは、このスクリプトのあるパス
	objWmireg.SetLString strTarget, strAlias, objBasic.var("ScriptCurDir") 


	Wscript.Echo objBasic.var("ScriptCurDir") & vbCrLf & " を AnHttpd の一般パスのエイリアスとして登録しました" & vbCrLf

End Function

Class basic

Public var
Public objWMIService
 
' ************************************************
' コンストラクタ
' ************************************************
Public Default Function InitSetting()

	Dim obj,objOS

	Set var = CreateObject( "Scripting.Dictionary" )

	' スクリプトが存在するディレクトリ(WSH用)
	on error resume next
	ScriptCurDir = WScript.ScriptFullName
	Set obj = Fso.GetFile( ScriptCurDir )
	Set obj = obj.ParentFolder
	var("ScriptCurDir") = obj.Path
	Set obj = Fso.GetFolder( var("ScriptCurDir") )
	var("ScriptCurDirName") = obj.Name
	on error goto 0

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

	Set obj = objWMIService.ExecQuery( _
		"Select * from Win32_OperatingSystem")
	on error resume next
	For Each objOS in obj
		var("OsName") = objOS.Caption
		var("ComputerName") = objOS.CSName
		var("ServicePack") = objOS.ServicePackMajorVersion _
		& "." & objOS.ServicePackMinorVersion
		var("WinDir") = objOS.WindowsDirectory
		var("SysDir") = objOS.SystemDirectory
	Next
	on error goto 0

end function

' ************************************************
' 環境文字列の一覧の取得
' ************************************************
Function GetAllValue()

	Dim str,key

	str = ""

	For Each key in var
		str = str & key & " = " & var(key) & vbCrLf
	Next

	GetAllValue = str

end function
 
' ************************************************
' 非同期実行
' ************************************************
Function RunASync( strPath )

	Call WshShell.Run( strPath )

end function

' ************************************************
' 同期実行
' ************************************************
Function RunSync( strPath )

	Call WshShell.Run( strPath, , True )

end function

' ************************************************
' コマンドプロンプト同期実行( プロンプトを開く )
' cmd.exe /c 以降を指定
' ************************************************
Function CmdSyncWithConsole( strPath, bPause )

	if bPause then
		Call WshShell.Run( _
		"cmd.exe /c " & strPath & " & pause", , True )
	else
		Call WshShell.Run( _
		"cmd.exe /c " & strPath, , True )
	end if

end function

' ************************************************
' コマンドプロンプト同期実行( プロンプトを開かない )
' cmd.exe /c 以降を指定
' ************************************************
Function CmdSyncWithoutConsole( strPath )

	Call WshShell.Run( _
		"cmd.exe /c " & strPath, 0, True )

end function

End Class

const WMI_HKEY_LOCAL_MACHINE = &H80000002
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 
 
' ************************************************
' コンストラクタ
' ************************************************
Public Default Function InitSetting()
 
	Set objReg = _
		GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
		".\root\default:StdRegProv") 
 
end function

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

	Dim aSubKeys,str

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

' ************************************************
' 値の一覧の連想配列を取得
' ************************************************
Function GetLValueArray( strPath )

	Dim aValueNames, aValueTypes, strValue, aValue

	Set var = CreateObject( "Scripting.Dictionary" )

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

	Set GetLValueArray = var

end function

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

	objReg.SetStringValue _
		WMI_HKEY_LOCAL_MACHINE,strPath,strName,strValue 

end function

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

	objReg.SetDWORDValue _
		WMI_HKEY_LOCAL_MACHINE,strPath,strName,dwValue

end function

End Class