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

Call Crun()

' **********************************************************
' OS の情報一覧( ローカル限定 )
' **********************************************************
Set obj = GetObject("winmgmts:\\.\root\cimv2")
Set colTarget = obj.ExecQuery( "select * from Win32_OperatingSystem" )
' この場合行は1行しかありません
For Each objRow in colTarget
	Set colProps = objRow.Properties_
	For Each objProp in colProps
		on error resume next
		Wscript.Echo RpadB(objProp.Name," ", 25 ) & " : " & objProp.Value
		if Err.Number <> 0 then
			Wscript.Echo RpadB(objProp.Name," ", 25 ) & " : " & "データ型が " & TypeName(objProp.Value) & " なので処理できません"
		end if
		on error goto 0
	Next
Next

' **********************************************************
' Cscript.exe で実行を強制
' Cscript.exe の実行終了後 pause で一時停止
' **********************************************************
Function Crun( )

	Dim str,WshShell

	str = WScript.FullName
	str = Right( str, 11 )
	str = Ucase( str )
	if str <> "CSCRIPT.EXE" then
		str = WScript.ScriptFullName

		Set WshShell = CreateObject( "WScript.Shell" )

		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", 1 )
		WScript.Quit
	end if

End Function
' **********************************************************
' 文字列を " で囲む関数
' **********************************************************
Function Dd( strValue )

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

End function
' **************************************
' 文字列の右側をスペースで埋める
' **************************************
Function RpadB( strValue, str, nLen )

	Dim strWork,nLen2

	strWork = Left( strValue & String(nLen,str), nLen )
	nLen2 = nLen

	Do While ByteLen( strWork ) > nLen
		nLen2 = nLen2 - 1
		if nLen2 <= 0 then
			Exit Do
		end if
		strWork = Left( strValue & String(nLen,str), nLen2 )
	Loop
	RpadB = strWork

End function
' **************************************
' 漢字と半角での横幅の計算
' **************************************
Function ByteLen( strTarget )

	Dim i,nLen,nRet,strMoji,nAsc

	nRet = 0

	nLen = Len( strTarget )

	For i = 1 to nLen
		nRet = nRet + 2
		strMoji = Mid( strTarget, i, 1 )
		nAsc = Asc( strMoji )
		if &H0 <= nAsc and nAsc <= &H80 then
			nRet = nRet - 1
		end if
		if &HA0 <= nAsc and nAsc <= &HDF then
			nRet = nRet - 1
		end if
		if &HFD <= nAsc and nAsc <= &HFF then
			nRet = nRet - 1
		end if
	Next

	ByteLen = nRet

End Function

<JOB>
<SCRIPT language="VBScript" src="http://lightbox.in.coocan.jp/laylaClass.vbs"></SCRIPT>
<SCRIPT language="VBScript">
' ***********************************************************
' 処理開始
' ***********************************************************
Call laylaFunctionTarget( "http://lightbox.in.coocan.jp/" )
Call laylaLoadFunction( "baseFunction.vbs" )

Call Crun()

' **********************************************************
' OS の情報一覧( ローカル限定 )
' **********************************************************
Set obj = GetObject("winmgmts:\\.\root\cimv2")
Set colTarget = obj.ExecQuery( "select * from Win32_OperatingSystem" )
' この場合行は1行しかありません
For Each objRow in colTarget
	Set colProps = objRow.Properties_
	For Each objProp in colProps
		on error resume next
		Wscript.Echo RpadB(objProp.Name," ", 25 ) & " : " & objProp.Value
		if Err.Number <> 0 then
			Wscript.Echo RpadB(objProp.Name," ", 25 ) & " : " & "データ型が " & TypeName(objProp.Value) & " なので処理できません"
		end if
		on error goto 0
	Next
Next

</SCRIPT>
</JOB>