'==================================================================
' Windows 10, 8 の settingcontent-ms ファイルのショートカットを作成しますYO！
'http://d.hatena.ne.jp/palm84/20150813/1439476358
'http://d.hatena.ne.jp/palm84/20150822/1440252201
'http://www10.plala.or.jp/palm84/wsh.html
'http://www10.plala.or.jp/palm84/archives/wsh/Win10_8_CreateSettingContentShortCut.vbs.txt
'==================================================================
'Shell オブジェクトを作成
Set objShell = WScript.CreateObject("WScript.Shell")
'FileSystemObject オブジェクトを作成
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
'Shell .Application オブジェクトを作成
Set objShellApp = CreateObject("Shell.Application")
Const Reg_ProductName = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName"
myOS = objShell.RegRead(Reg_ProductName)
If Not InStr(myOS, "Windows 8") > 0 And Not InStr(myOS, "Windows 10") > 0 Then 
	MsgBox "Windows 8 と 10 用クマー (´；ω；`) ",48 ,"I am Sorry, ヒゲソ..（ｒｙ"
	WScript.Quit
End If

MyKakunin

'*** path ***
appPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
Content = objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%\Packages\windows.immersivecontrolpanel_cw5n1h2txyewy\LocalState\Indexed\Settings\ja-JP\")
myRoot = appPath & "\settingcontent-ms-ショートカット"
If Not objFSO.FolderExists(myRoot) Then
	objFSO.CreateFolder(myRoot)
End IF
myFolder = myRoot

'* ショートカット設定
strFile = "%windir%\explorer.exe"
' Windows 10
If InStr(myOS, "Windows 10") > 0 Then
	strIcon = "%SystemRoot%\System32\shell32.dll, 315"
End If
' Windows 8
If InStr(myOS, "Windows 8") > 0 Then
	strIcon = "%SystemRoot%\ImmersiveControlPanel\SystemSettings.exe, 0"
End If
strIconClassic = "%SystemRoot%\System32\shell32.dll, 21"

Set objFolder = objShellApp.Namespace(Content)
Set objFolderItems = objFolder.Items()
Dim Title, strURI
MyTest

'* 夏時間のオン/オフ
Title = "夏時間のオン オフ"
strURI = "AAA_SystemSettings_DateTime_IsAutomaticDSTAdjustEnabled"
MySC

'* Windows 10 コントロール パネルと名前重複 追加
If InStr(myOS, "Windows 10") > 0 Then
	Title = "マイクのセットアップ (設定)"
	strURI = "AAA_SettingsGroupSpeechMicrophone"
	MySC
End If

'* Windows 10 「タッチパッドを使う時に"タップしてクリック"を無効にします」
If InStr(myOS, "Windows 10") > 0 Then
	Title = "タッチパッドを使う時に[タップしてクリック]を無効にします"
	strURI = "AAA_SystemSettings_Input_Touch_TapsEnabled"
	MySC
End If

'* Windows 8 置換
If InStr(myOS, "Windows 8") > 0 Then
	Title = "デスクトップの背景の変更"
	strURI = "aaa_Classic_{B3206921-D53A-40D9-BA1A-BEA526A644A5}"
	MySC
End If
'* Windows 8 なぜか作成されないので
If InStr(myOS, "Windows 8") > 0 Then
	Title = "マウス"
	strURI = "Classic_{6c8eec18-8d75-41b2-a177-8831d59d2d50}"
	MySC
End If
'* Windows 8 コントロール パネルと名前重複 追加
If InStr(myOS, "Windows 8") > 0 Then
	Title = "日付と時刻の設定 (PC設定)"
	strURI = "AAA_SettingsPageTimeRegionDateTime"
	MySC
End If


Kakunin = MsgBox ("終了です YO！", 64 ,"クマー！ (´･ω･`) ") 

Set objItem = Nothing
Set objFolderItems = Nothing
Set objFolder = Nothing
Set objShellApp = Nothing
Set objFSO = Nothing
Set objShell = Nothing

'*********************************************************
'Sub MyKakunin
'*********************************************************
Sub MyKakunin
Kakunin = MsgBox ("settingcontent-ms ファイルのショートカットを作りますのん？ (´･ω･`)", 65 ,"settingcontent-ms ファイルのショートカットを作るＹＯ！  (´･ω･`) ") 
If Kakunin = 2 Then
	WScript.Quit
End If
End Sub

'*********************************************************
'Sub MyTest
'*********************************************************
Sub MyTest
For i=0 To objFolderItems.Count-1
    Set objItem = objFolderItems.Item(i)
	On Error Resume Next
	For n=0 to 50
		strName = objFolder.GetDetailsOf(Nothing, n)
		If strName = "コメント" Then
			If objFolder.GetDetailsOf(objItem, n) <> "" Then
				Title = objFolder.GetDetailsOf(objItem, n)
				'WScript.Echo Title
				strURI = objItem
				'WScript.Echo strURI
				MySc
			End If
		End If
	Next
	On Error GoTo 0
Next
End Sub

'*********************************************************
'Sub MySC
'*********************************************************
Sub MySC
strShortCut = myFolder & "\" & Title & ".lnk"
'*** ショートカットオブジェクトを作成 ***
Set objShortCut = objShell.CreateShortcut(strShortCut)
With objShortCut
' リンク先
	.TargetPath = strFile
' 作業フォルダ
	.WorkingDirectory = ""
' 引数
	.Arguments = Content & strURI & ".settingcontent-ms"
' コメント
	.Description = ""
' アイコン
	If InStr(strURI, "Classic") > 0 Or InStr(strURI, "ControlPanel") > 0 Then 
		.IconLocation = strIconClassic
	Else
		.IconLocation = strIcon
End If

End With
objShortCut.Save

''WScript.Echo strFileName & "にショートカットを作成しました。" 
'MsgBox "ショートカットを作成しました YO！"  & vbcrlf & vbcrlf & Title,64 ,"(´･ω･`) クマー！ "

End Sub