'================================================================== ' Windows 10 の「設定」ショートカットを作成しますYO! 'http://www10.plala.or.jp/palm84/wsh.html 'http://d.hatena.ne.jp/palm84/20150809/1439131299 'http://www10.plala.or.jp/palm84/archives/wsh/Win10-1607_CreateMsSettingsShortCut.vbs.txt 'https://eu7w9wsmf6a74xyjdfzl3q-on.drv.tw/archives/wsh/Win10-1607_CreateMsSettingsShortCut.vbs.txt '================================================================== '2017.4.10 Anniversary Update (ReleaseId 1607) 専用にする 'Shell オブジェクトを作成 Set objShell = WScript.CreateObject("WScript.Shell") 'FileSystemObject オブジェクトを作成 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") Const ForReading = 1, ForWriting = 2, ForAppending = 8 Const INIFile = "desktop.ini" 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, ヒゲソ..(ry" 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, ヒゲソ..(ry" WScript.Quit End If Const Scheme = "ms-settings:" '*** path *** appPath = objFSO.GetParentFolderName(WScript.ScriptFullName) myRoot = appPath & "\設定ショートカット" 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(10) arrCategory(0) = "01_システム" arrCategory(1) = "02_デバイス" arrCategory(2) = "03_ネットワークとインターネット" 'arrCategory(3) = "パーソナル設定" arrCategory(3) = "04_個人用設定" arrCategory(4) = "05_アプリ" arrCategory(5) = "06_アカウント" arrCategory(6) = "07_時刻と言語" arrCategory(7) = "08_ゲーム" arrCategory(8) = "09_簡単操作" arrCategory(9) = "10_プライバシー" arrCategory(10) = "11_更新とセキュリティ" For x = 0 To 10 dirCategory = myRoot & "\" & arrCategory(x) If Not objFSO.FolderExists(dirCategory) Then objFSO.CreateFolder(dirCategory) End If Next '*** 設定 *** myFolder = myRoot Title = "設定" strFile = "%windir%\explorer.exe" strArguments = "shell:AppsFolder\Windows.ImmersiveControlPanel_cw5n1h2txyewy!microsoft.windows.immersivecontrolpanel" strWorkingDirectory = "" strIcon = "%SystemRoot%\System32\shell32.dll, 316" MySC strFile = "%windir%\explorer.exe" '*** xxxxx *** Dim strTitle(99), strURI(99) ' strTitle(xx) = "" ' strURI(xx) = "" '*** システム *** myFolder = myRoot & "\01_システム" strTitle(0) = "ディスプレイ" strURI(0) = "AAA_SettingsPagePCSystemDisplay" strTitle(1) = "通知とアクション" strURI(1) = "AAA_SettingsPageAppsNotifications" strTitle(2) = "電源とスリープ" strURI(2) = "AAA_SettingsPageScreenPowerAndSleep" strTitle(3) = "バッテリー" strURI(3) = "AAA_SystemSettings_BatterySaver_LandingPage_UsageDetailsLink" strTitle(4) = "ストレージ" strURI(4) = "AAA_SettingsPageStorageSenseStorageOverview" strTitle(5) = "タブレット モード" strURI(5) = "AAA_SettingsPagePCSystemShellMode" strTitle(6) = "マルチタスク" strURI(6) = "AAA_SettingsGroupVirtualDesktops" strTitle(7) = "この PC へのプロジェクション" strURI(7) = "AAA_SettingsPageContinuum" strTitle(8) = "共有エクスペリエンス" strURI(8) = "" strTitle(9) = "バージョン情報" strURI(9) = "AAA_SettingsPagePCSystemInfo" For y = 0 to 9 If strTitle(y) <> "" Then Title = strTitle(y) strArguments = Content & strURI(y) & ".settingcontent-ms" MySC End If Next '*** デバイス *** myFolder = myRoot & "\02_デバイス" 'strTitle(10) = "Bluetooth とその他のデバイス" 'strURI(10) = "" strTitle(11) = "プリンタとスキャナー" strURI(11) = "AAA_SettingsPageDevicesPrinters" strTitle(12) = "マウス" strURI(12) = "AAA_SettingsGroupInputMouse" strTitle(13) = "タッチパッド" strURI(13) = "" strTitle(14) = "ペンと Windows Ink" strURI(14) = "AAA_SettingsPageDevicesPen" strTitle(15) = "自動再生" strURI(15) = "AAA_SettingsPagePCSystemAutoPlay" strTitle(16) = "USB" strURI(16) = "AAA_SettingsPageUsb" For y = 11 to 16 If strTitle(y) <> "" Then Title = strTitle(y) strArguments = Content & strURI(y) & ".settingcontent-ms" MySC End If Next '*** ネットワークとインターネット *** myFolder = myRoot & "\03_ネットワークとインターネット" strTitle(17) = "状態" strURI(17) = "AAA_Settings_Group_NetworkStatus" strTitle(18) = "Wi-Fi" strURI(18) = "AAA_SettingsPageNetworkWiFi" strTitle(19) = "イーサネット" strURI(19) = "AAA_SettingsPageNetworkEthernet" strTitle(20) = "ダイヤルアップ" strURI(20) = "AAA_SettingsPageNetworkDialup" strTitle(21) = "VPN" strURI(21) = "AAA_SettingsPageNetworkVPN" strTitle(22) = "機内モード" strURI(22) = "AAA_SettingsPageNetworkAirplaneMode" strTitle(23) = "モバイル ホットスポット" strURI(23) = "AAA_SettingsPageNetworkMobileHotspot" strTitle(24) = "データ使用状況" strURI(24) = "AAA_SettingsGroupDataSenseMainPageOverview" strTitle(25) = "プロキシ" strURI(25) = "AAA_SettingsPageNetworkProxy" For y = 17 to 25 If strTitle(y) <> "" Then Title = strTitle(y) strArguments = Content & strURI(y) & ".settingcontent-ms" MySC End If Next '*** 個人用設定 *** myFolder = myRoot & "\04_個人用設定" strTitle(26) = "背景" strURI(26) = "AAA_SystemSettings_Personalize_Background_ChooseBackground" strTitle(27) = "色" strURI(27) = "AAA_SettingsPageColors" strTitle(28) = "ロック画面" strURI(28) = "AAA_SettingsPageLockScreen" strTitle(29) = "テーマ" strURI(29) = "AAA_SettingsPageThemes" strTitle(30) = "スタート" strURI(30) = "AAA_SettingsPageStart" strTitle(31) = "タスクバー" strURI(31) = "AAA_SettingsPageTaskbar" For y = 26 to 31 If strTitle(y) <> "" Then Title = strTitle(y) strArguments = Content & strURI(y) & ".settingcontent-ms" MySC End If Next '*** アプリ *** myFolder = myRoot & "\05_アプリ" strTitle(32) = "アプリと機能" strURI(32) = "AAA_SettingsGroupAppSizesList" strTitle(33) = "既定のアプリ" strURI(33) = "AAA_SettingsPageAppsDefaults" strTitle(34) = "オフライン マップ" strURI(34) = "AAA_SettingsPageMapsicon" strTitle(35) = "Web サイト用のアプリ" strURI(35) = "" For y = 32 to 35 If strTitle(y) <> "" Then Title = strTitle(y) strArguments = Content & strURI(y) & ".settingcontent-ms" MySC End If Next '*** アカウント *** myFolder = myRoot & "\06_アカウント" strTitle(36) = "ユーザーの情報" strURI(36) = "AAA_SettingsGroupYourAccount" strTitle(37) = "メール & アプリのアカウント" strURI(37) = "AAA_SettingsPageAccountsEmailApp" strTitle(38) = "サインイン オプション" strURI(38) = "AAA_SettingsPageAccountsManage" strTitle(39) = "職場または学校にアクセスする" strURI(39) = "AAA_SettingsPageNetworkWorkplace" strTitle(40) = "家族とその他のユーザー" strURI(40) = "AAA_SettingsPageAccountsUsers" strTitle(41) = "設定の同期" strURI(41) = "AAA_SettingsPageAccountsSync" For y = 36 to 41 If strTitle(y) <> "" Then Title = strTitle(y) strArguments = Content & strURI(y) & ".settingcontent-ms" MySC End If Next '*** 時刻と言語 *** myFolder = myRoot & "\07_時刻と言語" 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 & "\08_ゲーム" strTitle(45) = "ゲーム バー" strURI(45) = "" strTitle(46) = "ゲーム DVR" strURI(46) = "" strTitle(47) = "ブロードキャスト" strURI(47) = "" strTitle(48) = "ゲーム" strURI(48) = "" For y = 45 to 48 If strTitle(y) <> "" Then Title = strTitle(y) strArguments = Content & strURI(y) & ".settingcontent-ms" MySC End If Next '*** 簡単操作 *** myFolder = myRoot & "\09_簡単操作" strTitle(49) = "ナレーター" strURI(49) = "AAA_SettingsPageEaseOfAccessNarrator" strTitle(50) = "拡大鏡" strURI(50) = "AAA_SettingsPageEaseOfAccessMagnifier" strTitle(51) = "ハイ コントラスト" strURI(51) = "AAA_SettingsPageEaseOfAccessHighContrast" strTitle(52) = "字幕" strURI(52) = "AAA_SettingsPageEaseOfAccessClosedCaptioning" strTitle(53) = "キーボード" strURI(53) = "AAA_SettingsPageEaseOfAccessKeyboard" strTitle(54) = "マウス" strURI(54) = "AAA_SettingsPageEaseOfAccessMouse" strTitle(55) = "その他のオプション" strURI(55) = "AAA_SettingsPageEaseOfAccessMoreOptions" For y = 49 to 55 If strTitle(y) <> "" Then Title = strTitle(y) strArguments = Content & strURI(y) & ".settingcontent-ms" MySC End If Next '*** プライバシー *** myFolder = myRoot & "\10_プライバシー" strTitle(56) = "全般" strURI(56) = "AAA_SettingsPagePrivacyGeneral" strTitle(57) = "位置情報" strURI(57) = "AAA_SettingsPagePrivacyLocation" strTitle(58) = "カメラ" strURI(58) = "AAA_SettingsPagePrivacyWebcam" strTitle(59) = "マイク" strURI(59) = "AAA_SettingsPagePrivacyMicrophone" strTitle(60) = "通知" strURI(60) = "" strTitle(61) = "音声認識、手書き入力、入力の設定" strURI(61) = "AAA_SettingsPagePrivacyPersonalization" strTitle(62) = "アカウント情報" strURI(62) = "AAA_SettingsPagePrivacyAccountInfo" strTitle(63) = "連絡先" strURI(63) = "AAA_SettingsPagePrivacyContacts" strTitle(64) = "カレンダー" strURI(64) = "AAA_SettingsPagePrivacyCalendar" strTitle(65) = "通話履歴" strURI(65) = "AAA_SettingsPagePrivacyCallHistory" strTitle(66) = "メール" strURI(66) = "AAA_SettingsPagePrivacyEmail" strTitle(67) = "タスク" strURI(67) = "" strTitle(68) = "メッセージング" strURI(68) = "AAA_SettingsPagePrivacyMessaging" strTitle(69) = "無線" strURI(69) = "AAA_SettingsPagePrivacyRadios" strTitle(70) = "他のデバイス" strURI(70) = "AAA_SettingsPagePrivacyCustomPeripherals" strTitle(71) = "フィードバックと診断" strURI(71) = "AAA_SettingsPagePrivacySIUFSettings" strTitle(72) = "バック グラウンド アプリ" strURI(72) = "AAA_SystemSettings_Privacy_BackgroundApps_SubText" strTitle(73) = "アプリの診断" strURI(73) = "" For y = 56 to 73 If strTitle(y) <> "" Then Title = strTitle(y) strArguments = Content & strURI(y) & ".settingcontent-ms" MySC End If Next '*** 更新とセキュリティ *** myFolder = myRoot & "\11_更新とセキュリティ" strTitle(74) = "Windows Update" strURI(74) = "AAA_SettingsPageRestoreMusUpdate" strTitle(75) = "Windows Defender" strURI(75) = "AAA_SettingsPageWindowsDefender" strTitle(76) = "バックアップ" strURI(76) = "AAA_SettingsPageRestoreOneBackup" strTitle(77) = "回復" strURI(77) = "AAA_SettingsPageRestoreRestore" strTitle(78) = "ライセンス認証" strURI(78) = "AAA_SettingsPageActivate" strTitle(79) = "開発者向け" strURI(79) = "AAA_SettingsPageRestoreDeveloperOptions" strTitle(80) = "デバイスの検索" strURI(80) = "AAA_SettingsPageFindMyDevice" strTitle(81) = "Windows Insider Program" strURI(81) = "AAA_SettingsPageFlights" For y = 74 to 81 If strTitle(y) <> "" Then Title = strTitle(y) strArguments = Content & strURI(y) & ".settingcontent-ms" MySC End If Next '*** Windows Update *** myFolder = myRoot Title = "Windows Update" strArguments = Content & "AAA_SettingsPageRestoreMusUpdate" & ".settingcontent-ms" strIcon = "%SystemRoot%\System32\shell32.dll, 46" MySC '*** ネットワーク接続 *** myFolder = myRoot Title = "ネットワーク接続" strArguments = Content & "Classic_{9EF86966-2F35-49BE-A9F6-398E0B844411}" & ".settingcontent-ms" strIcon = "%SystemRoot%\System32\netshell.dll, 0" MySC '*** コントロール パネル *** myFolder = myRoot Title = "コントロール パネル" strArguments = Content & "ControlPanel" & ".settingcontent-ms" strIcon = "%SystemRoot%\System32\shell32.dll, 21" MySC '*** コントロール パネル *** 'myFolder = myRoot 'Title = "コントロール パネル2" 'strFile = "%windir%\System32\control.exe" 'strArguments = "" 'strIcon = "%SystemRoot%\System32\shell32.dll, 21" 'MySC '*** GodMode *** strFolder = myRoot Title = "GodMode" strFolder = myRoot & "\" & Title strCLSID = "{ED7BA470-8E54-465E-825C-99712043E01C}" strIcon = "%SystemRoot%\system32\shell32.dll, 207" If Not objFSO.FolderExists(strFolder) Then MyCreateFolder End If '*** GodMode (リンク) *** Title = "GodMode (リンク)" strArguments = myRoot & "\" & "GodMode" strIcon = "%SystemRoot%\system32\shell32.dll, 207" MySC '*** Bluetooth とその他のデバイス *** 'strTitle(10) = "Bluetooth とその他のデバイス" myFolder = myRoot & "\02_デバイス" Title = "Bluetooth とその他のデバイス" strFile = "ms-settings:bluetooth" strArguments = "" strIcon = "%SystemRoot%\System32\shell32.dll, 315" MySC Kakunin = MsgBox ("終了です YO!", 64 ,"クマー! (´・ω・`) ") Set objTxt = Nothing Set objFSO = Nothing Set objShortcut = Nothing Set objShell = Nothing '********************************************************* 'Sub MyKakunin '********************************************************* Sub MyKakunin Kakunin = MsgBox (" 設定ショートカットを作りますのん? (´・ω・`)", 65 ,"設定ショートカットを作るYO! (´・ω・`) ") 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 '********************************************************* '* Sub MyCreateFolder '********************************************************* Sub MyCreateFolder 'フォルダが存在するなら何もしない、なければ作成 If Not objFSO.FolderExists(strFolder) Then objFSO.CreateFolder strFolder End If ' desktop.ini 作成 strINI = strFolder & "\" & INIFile Set objTxt = objFSO.OpenTextFile(strINI, ForWriting, true, -2) objTxt.WriteLine "[.ShellClassInfo]" objTxt.WriteLine "CLSID=" & strCLSID objTxt.Close 'ファイルにシステム・隠し属性 Set objFile = objFSO.GetFile(strINI) objFile.Attributes = objFile.Attributes + 6 'フォルダ属性 Set objFolder = objFSO.GetFolder(strFolder) 'フォルダにシステム属性 objFolder.Attributes = objFolder.Attributes + 4 'フォルダにシステム&隠し属性 'objFolder.Attributes = objFolder.Attributes + 6 End Sub