ソース掲示板




すべてから検索

キーワード   条件 表示 現行ログ 過去ログ トピックス 名前 本文

  メンテナンス 前画面に戻る

対象スレッド 件名: 複数項目のソート( 一時的なDBテーブル )
名前: lightbox
処理選択
パスワード

件名 複数項目のソート( 一時的なDBテーブル )
名前 lightbox
コメント
@DIV
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
@END