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
VBScript : SQLExpress( SQLServer ) に 販売管理B を作成する
※ エキスパートモードで表示しています
アーカイブとカテゴリページはこのように簡単に設定できますが、タグページは HTML 設定を直接変更して、以下の『タグページでのみ表示される内容』の記述方法で設定する必要があります
