'==================================================================
' Windows 10 の Quick Lanuch に「設定」ショートカットを作成しますYO！
'http://www10.plala.or.jp/palm84/wsh.html
'http://d.hatena.ne.jp/palm84/20150823/1440328044
'http://www10.plala.or.jp/palm84/archives/wsh/Win10_CreateMsSettingsShortCut_QL.vbs.txt
'==================================================================
'2017.4.10 Anniversary Update (ReleaseId 1607) 専用にする
'Shell オブジェクトを作成
Set objShell = WScript.CreateObject("WScript.Shell")
'FileSystemObject オブジェクトを作成
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

Const Reg_ProductName = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName"
myOS = objShell.RegRead(Reg_ProductName)
If Not InStr(myOS, "Windows 10") > 0 Then 
		MsgBox "Windows 10 専用クマー (´；ω；`) ",48 ,"I am Sorry, ヒゲソ..（ｒｙ"
		WScript.Quit
End If
Const Reg_ReleaseId = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ReleaseId"
If Not objShell.RegRead(Reg_ReleaseId) = "1607" Then 
		MsgBox "Aniversary Update (ReleaseID 1607) 専用クマー (´；ω；`) ",48 ,"I am Sorry, ヒゲソ..（ｒｙ"
		WScript.Quit
End If
QuickLaunch = objShell.ExpandEnvironmentStrings("%APPDATA%\Microsoft\Internet Explorer\Quick Launch")

'*** path ***
'appPath = objFSO.GetParentFolderName(WScript.ScriptFullName)
myRoot = QuickLaunch & "\設定 (menu)"
Content = objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%\Packages\windows.immersivecontrolpanel_cw5n1h2txyewy\LocalState\Indexed\Settings\ja-JP\")

MyKakunin

If Not objFSO.FolderExists(myRoot) Then
	objFSO.CreateFolder(myRoot)
End IF

ReDim arrCategory(8)
arrCategory(0) = "システム"
arrCategory(1) = "デバイス"
arrCategory(2) = "ネットワークとインターネット"
'arrCategory(3) = "パーソナル設定"
arrCategory(3) = "個人用設定"
arrCategory(4) = "アカウント"
arrCategory(5) = "時刻と言語"
arrCategory(6) = "簡単操作"
arrCategory(7) = "プライバシー"
arrCategory(8) = "更新とセキュリティ"

For x = 0 To 8
	dirCategory = myRoot & "\" & arrCategory(x)
	If Not objFSO.FolderExists(dirCategory) Then
		objFSO.CreateFolder(dirCategory)
	End If
Next

'*** 設定 ***
'myFolder = QuickLaunch
'Title = "設定"
'strArguments = "shell:AppsFolder\Windows.ImmersiveControlPanel_cw5n1h2txyewy!microsoft.windows.immersivecontrolpanel"
'strWorkingDirectory = ""
'MySC

strFile = "%windir%\explorer.exe"
strIcon = "%SystemRoot%\System32\shell32.dll, 315"

'*** xxxxx ***
Dim strTitle(99), strURI(99)
'*** システム ***
myFolder = myRoot & "\システム"
strTitle(0) = "ディスプレイ"
strURI(0) = "AAA_SettingsPagePCSystemDisplay"
strTitle(1) = "通知とアクション"
strURI(1) = "AAA_SettingsPageAppsNotifications"
strTitle(2) = "アプリと機能"
strURI(2) = "AAA_SettingsGroupAppSizesList"
strTitle(3) = "オプション機能の管理"
strURI(3) = "AAA_SystemSettings_StorageSense_AppSizesOptionalComponentsLink"
strTitle(4) = "マルチタスク"
strURI(4) = "AAA_SettingsGroupVirtualDesktops"
strTitle(5) = "タブレット モード"
strURI(5) = "AAA_SettingsPagePCSystemShellMode"
'strTitle(6) = "バッテリー節約機能"
'strURI(6) = "AAA_SettingsPageBatterySaver"
strTitle(7) = "バッテリー"
strURI(7) = "AAA_SystemSettings_BatterySaver_LandingPage_UsageDetailsLink"
'strTitle(8) = "バッテリー節約機能の設定"
strURI(8) = "AAA_SystemSettings_BatterySaver_LandingPage_SettingsLink"
strTitle(9) = "電源とスリープ"
strURI(9) = "AAA_SettingsPageScreenPowerAndSleep"
strTitle(10) = "ストレージ"
strURI(10) = "AAA_SettingsPageStorageSenseStorageOverview"
strTitle(11) = "オフライン マップ"
strURI(11) = "AAA_SettingsPageMaps"
strTitle(12) = "既定のアプリ"
strURI(12) = "AAA_SettingsPageAppsDefaults"
strTitle(13) = "バージョン情報"
strURI(13) = "AAA_SettingsPagePCSystemInfo"
strTitle(14) = "この PC へのプロジェクション"
strURI(14) = "AAA_SettingsPageContinuum"
For y = 0 to 14
	If strTitle(y) <> "" Then
		Title = strTitle(y)
		strArguments = Content & strURI(y) & ".settingcontent-ms"
		MySC
	End If
Next

'*** デバイス ***
myFolder = myRoot & "\デバイス"
strTitle(15) = "プリンタとスキャナー"
strURI(15) = "AAA_SettingsPageDevicesPrinters"
strTitle(16) = "接続中のデバイス"
strURI(16) = "AAA_SettingsPagePCSystemDevices"
strTitle(17) = "Bluetooth"
strURI(17) = "AAA_SettingsPagePCSystemBluetooth"
strTitle(18) = "マウスとタッチパッド"
strURI(18) = "AAA_SettingsPagePCSystemDeviceSettings"
strTitle(19) = "自動再生"
strURI(19) = "AAA_SettingsPagePCSystemAutoPlay"
strTitle(20) = "USB"
strURI(20) = "AAA_SettingsPageUsb"
For y = 15 to 20
	If strTitle(y) <> "" Then
		Title = strTitle(y)
		strArguments = Content & strURI(y) & ".settingcontent-ms"
		MySC
	End If
Next

'*** ネットワークとインターネット ***
myFolder = myRoot & "\ネットワークとインターネット"
strTitle(21) = "Wi-Fi"
strURI(21) = "AAA_SettingsPageNetworkWiFi"
'strTitle(20) = "Wi-Fi設定を管理する"
'strURI(20) = "network-wifisettings"
strTitle(22) = "機内モード"
strURI(22) = "AAA_SettingsPageNetworkAirplaneMode"
strTitle(23) = "データ使用状況"
strURI(23) = "AAA_SettingsGroupDataSenseMainPageOverview"
strTitle(24) = "VPN"
strURI(24) = "AAA_SettingsPageNetworkVPN"
strTitle(25) = "ダイヤルアップ"
strURI(25) = "AAA_SettingsPageNetworkDialup"
strTitle(26) = "イーサネット"
strURI(26) = "AAA_SettingsPageNetworkEthernet"
strTitle(27) = "プロキシ"
strURI(27) = "AAA_SettingsPageNetworkProxy"
strTitle(28) = "状態"
strURI(28) = "AAA_Settings_Group_NetworkStatus"
strTitle(29) = "モバイル ホットスポット"
strURI(29) = "AAA_SettingsPageNetworkMobileHotspot"
For y = 21 to 29
	If strTitle(y) <> "" Then
		Title = strTitle(y)
		strArguments = Content & strURI(y) & ".settingcontent-ms"
		MySC
	End If
Next

'*** 個人用設定 ***
myFolder = myRoot & "\個人用設定"
strTitle(30) = "背景"
strURI(30) = "AAA_SystemSettings_Personalize_Background_ChooseBackground"
strTitle(31) = "色"
strURI(13) = "AAA_SettingsPageColors"
strTitle(32) = "ロック画面"
strURI(32) = "AAA_SettingsPageLockScreen"
strTitle(33) = "テーマ"
strURI(33) = "AAA_SettingsPageThemes"
strTitle(34) = "スタート"
strURI(34) = "AAA_SettingsPageStart"
strTitle(35) = "タスクバー"
strURI(35) = "AAA_SettingsPageTaskbar"
For y = 30 to 35
	If strTitle(y) <> "" Then
		Title = strTitle(y)
		strArguments = Content & strURI(y) & ".settingcontent-ms"
		MySC
	End If
Next

'*** アカウント ***
myFolder = myRoot & "\アカウント"
strTitle(36) = "ユーザーの情報"
strURI(36) = "AAA_SettingsGroupYourAccount"
strTitle(37) = "サインイン オプション"
strURI(37) = "AAA_SettingsPageAccountsManage"
strTitle(38) = "職場または学校にアクセスする"
strURI(38) = "AAA_SettingsPageNetworkWorkplace"
strTitle(39) = "家族とその他のユーザー"
strURI(39) = "AAA_SettingsPageAccountsUsers"
strTitle(40) = "設定の同期"
strURI(40) = "AAA_SettingsPageAccountsSync"
strTitle(41) = "メール ＆ アプリのアカウント"
strURI(41) = "AAA_SettingsPageAccountsEmailApp"
For y = 36 to 41
	If strTitle(y) <> "" Then
		Title = strTitle(y)
		strArguments = Content & strURI(y) & ".settingcontent-ms"
		MySC
	End If
Next

'*** 時刻と言語 ***
myFolder = myRoot & "\時刻と言語"
strTitle(42) = "日付と時刻"
strURI(42) = "AAA_SettingsPageTimeRegionDateTime"
strTitle(43) = "地域と言語"
strURI(43) = "AAA_SettingsPageTimeRegionLanguage"
strTitle(44) = "音声認識"
strURI(44) = "AAA_SettingsPageSpeech"
For y = 42 to 44
	If strTitle(y) <> "" Then
		Title = strTitle(y)
		strArguments = Content & strURI(y) & ".settingcontent-ms"
		MySC
	End If
Next

'*** 簡単操作 ***
myFolder = myRoot & "\簡単操作"
strTitle(45) = "ナレーター"
strURI(45) = "AAA_SettingsPageEaseOfAccessNarrator"
strTitle(46) = "拡大鏡"
strURI(46) = "AAA_SettingsPageEaseOfAccessMagnifier"
strTitle(47) = "ハイ コントラスト"
strURI(47) = "AAA_SettingsPageEaseOfAccessHighContrast"
strTitle(48) = "字幕"
strURI(48) = "AAA_SettingsPageEaseOfAccessClosedCaptioning"
strTitle(49) = "キーボード"
strURI(49) = "AAA_SettingsPageEaseOfAccessKeyboard"
strTitle(50) = "マウス"
strURI(50) = "AAA_SettingsPageEaseOfAccessMouse"
strTitle(51) = "その他のオプション"
strURI(51) = "AAA_SettingsPageEaseOfAccessMoreOptions"
For y = 45 to 51
	If strTitle(y) <> "" Then
		Title = strTitle(y)
		strArguments = Content & strURI(y) & ".settingcontent-ms"
		MySC
	End If
Next

'*** プライバシー ***
myFolder = myRoot & "\プライバシー"
strTitle(52) = "全般"
strURI(52) = "AAA_SettingsPagePrivacyGeneral"
strTitle(53) = "位置情報"
strURI(53) = "AAA_SettingsPagePrivacyLocation"
strTitle(54) = "カメラ"
strURI(54) = "AAA_SettingsPagePrivacyWebcam"
strTitle(55) = "マイク"
strURI(55) = "AAA_SettingsPagePrivacyMicrophone"
strTitle(56) = "音声認識、手書き入力、入力の設定"
strURI(56) = "AAA_SettingsPagePrivacyPersonalization"
strTitle(57) = "アカウント情報"
strURI(57) = "AAA_SettingsPagePrivacyAccountInfo"
strTitle(58) = "連絡先"
strURI(58) = "AAA_SettingsPagePrivacyContacts"
strTitle(59) = "カレンダー"
strURI(59) = "AAA_SettingsPagePrivacyCalendar"
strTitle(60) = "メッセージング"
strURI(60) = "AAA_SettingsPagePrivacyMessaging"
strTitle(61) = "無線"
strURI(61) = "AAA_SettingsPagePrivacyRadios"
strTitle(62) = "他のデバイス"
strURI(62) = "AAA_SettingsPagePrivacyCustomPeripherals"
strTitle(63) = "フィードバックと診断"
strURI(63) = "AAA_SettingsPagePrivacySIUFSettings"
strTitle(64) = "バック グラウンド アプリ"
strURI(64) = "AAA_SystemSettings_Privacy_BackgroundApps_SubText"
strTitle(65) = "通話履歴"
strURI(65) = "AAA_SettingsPagePrivacyCallHistory"
strTitle(66) = "メール"
strURI(66) = "AAA_SettingsPagePrivacyEmail"
For y = 52 to 66
	If strTitle(y) <> "" Then
		Title = strTitle(y)
		strArguments = Content & strURI(y) & ".settingcontent-ms"
		MySC
	End If
Next

'*** 更新とセキュリティ ***
myFolder = myRoot & "\更新とセキュリティ"
strTitle(67) = "Windows Update"
strURI(67) = "AAA_SettingsPageRestoreMusUpdate"
strTitle(68) = "Windows Defender"
strURI(68) = "AAA_SettingsPageWindowsDefender"
strTitle(69) = "バックアップ"
strURI(69) = "AAA_SettingsPageRestoreOneBackup"
strTitle(70) = "回復"
strURI(70) = "AAA_SettingsPageRestoreRestore"
strTitle(71) = "ライセンス認証"
strURI(71) = "AAA_SettingsPageActivate"
strTitle(72) = "開発者向け"
strURI(72) = "AAA_SettingsPageRestoreDeveloperOptions"
strTitle(73) = "デバイスの検索"
strURI(73) = "AAA_SettingsPageFindMyDevice"
strTitle(74) = "Windows Insider Program"
strURI(74) = "AAA_SettingsPageFlights"
For y = 67 to 74
	If strTitle(y) <> "" Then
		Title = strTitle(y)
		strArguments = Content & strURI(y) & ".settingcontent-ms"
		MySC
	End If
Next


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

Set objShortcut = Nothing
Set objFSO = Nothing
Set objShell = Nothing

'*********************************************************
'Sub MyKakunin
'*********************************************************
Sub MyKakunin
Kakunin = MsgBox ("Quick Launch に設定ショートカットを作りますのん？ (´･ω･`)", 65 ,"設定ショートカットを作るＹＯ！  (´･ω･`) ") 
If Kakunin = 2 Then
	WScript.Quit
End If
End Sub

'*********************************************************
'Sub MySC
'*********************************************************
Sub MySC
strShortCut = myFolder & "\" & Title & ".lnk"
'*** ショートカットオブジェクトを作成 ***
Set objShortCut = objShell.CreateShortcut(strShortCut)
With objShortCut
' リンク先
	.TargetPath = strFile
' 作業フォルダ
	.WorkingDirectory = strWorkingDirectory
' 引数
	.Arguments = strArguments
' コメント
	.Description = ""
' アイコン
	.IconLocation = strIcon
End With
objShortCut.Save

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

End Sub