' 起動用
Set WshShell = 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" )
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
Wscript.Echo
' **********************************************************' サブキーの配列を取得' **********************************************************
Call obj.GetLSubKeyArray(WMI_HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBCINST.INI")
' **********************************************************' 一覧表示' **********************************************************
For Each data in obj.objArray
Wscript.Echo 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
Public objArray
' ************************************************
' 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, objArray
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
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.SendKeys "^+({ESC})"
if GetOSVersion() < 6 then
WScript.Sleep 500
WshShell.AppActivate "Windows タスク マネージャ"
end if
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
Set WshShell = WScript.CreateObject("WScript.Shell")
Crun
' ***********************************************************' 処理開始' ***********************************************************
Const HKEY_LOCAL_MACHINE = &H80000002
Const adVarChar = 200
Const adInteger = 3
Dim ErrorMessage
Set objRegistry = GetObject("Winmgmts:root\default:StdRegProv")
strPath = "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers"
bRet = WMIRegEnumValues( HKEY_LOCAL_MACHINE, strPath, aNames, aTypes )
if not bRet then
Wscript.Echo ErrorMessage
Wscript.Quit
end if
' ソートする前
For Each data in aNames
Wscript.Echo data
Next
Wscript.Echo "-------------------------------------"
Set Rs = CreateObject("ADODB.Recordset")
Rs.Fields.Append "ソートキー", adVarChar,255
Rs.Fields.Append "最初の順番", adInteger
Rs.Open
nCount = 0
For Each data In aNames
nCount = nCount + 1
Rs.AddNew
Rs.Fields("ソートキー").value = data
Rs.Fields("最初の順番").value = nCount
Next
Rs.Sort = "ソートキー"
Rs.MoveFirst
' ソート後
Do while not Rs.EOF
Wscript.Echo Rs.Fields("最初の順番").value & ":" & Rs.Fields("ソートキー").value & ""
Rs.MoveNext
Loop
Rs.Close
' **********************************************************' 列挙' **********************************************************
Function WMIRegEnumValues ( nType, strPath, aNames, aTypes )
WMIRegEnumValues = False
on error resume next
WMIRet = objRegistry.EnumValues( nType, strPath, aNames, aTypes )
if Err.Number <> 0 then
ErrorMessage = Err.Description
Exit Function
end if
if WMIRet <> 0 then
ErrorMessage = Hex( WMIRet )
Exit Function
end if
on error goto 0
WMIRegEnumValues = True
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