'================================================================== ' 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-1709_CreateMsSettingsShortCut.vbs.txt 'https://eu7w9wsmf6a74xyjdfzl3q-on.drv.tw/archives/wsh/Win10-1709_CreateMsSettingsShortCut.vbs.txt '================================================================== '2017.10.20 02:25 Fall Creators Update ReleaseID 1709 対応 'Shell オブジェクトを作成 Set objShell = WScript.CreateObject("WScript.Shell") 'FileSystemObject オブジェクトを作成 Set objFSO = WScript.CreateObject("Scripting.FileSystemObject") Const Reg_ProductName = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName" Const Reg_ReleaseId = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ReleaseId" Const Scheme = "ms-settings:" Const ForReading = 1, ForWriting = 2, ForAppending = 8 Const INIFile = "desktop.ini" 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 If Not objShell.RegRead(Reg_ReleaseId) = "1709" Then MsgBox "Fall Creators Update (ReleaseID 1709) 専用クマー (´;ω;`) ",48 ,"I am Sorry, ヒゲソ..(ry" WScript.Quit End If strArguments = "" strWorkingDirectory = "" '*** path *** appPath = objFSO.GetParentFolderName(WScript.ScriptFullName) myRoot = appPath & "\設定ショートカット" Content1 = objShell.ExpandEnvironmentStrings("%LOCALAPPDATA%\Packages\windows.immersivecontrolpanel_cw5n1h2txyewy\LocalState\Indexed\Settings\ja-JP\") Content2 = objShell.ExpandEnvironmentStrings("%Windir%\ImmersiveControlPanel\Settings\") If objFSO.FolderExists(Content1) Then Content = Content1 ElseIf objFSO.FolderExists(Content2) Then Content = Content2 End IF MyKakunin If Not objFSO.FolderExists(myRoot) Then objFSO.CreateFolder(myRoot) End IF ReDim arrCategory(12) arrCategory(0) = "01_システム" arrCategory(1) = "02_デバイス" arrCategory(2) = "03_電話" arrCategory(3) = "04_ネットワークとインターネット" 'arrCategory(3) = "パーソナル設定" arrCategory(4) = "05_個人用設定" arrCategory(5) = "06_アプリ" arrCategory(6) = "07_アカウント" arrCategory(7) = "08_時刻と言語" arrCategory(8) = "09_ゲーム" arrCategory(9) = "10_簡単操作" arrCategory(10) = "11_Cortana" arrCategory(11) = "12_プライバシー" arrCategory(12) = "13_更新とセキュリティ" For x = 0 To 12 dirCategory = myRoot & "\" & arrCategory(x) If Not objFSO.FolderExists(dirCategory) Then objFSO.CreateFolder(dirCategory) End If Next '*** 設定 *** myFolder = myRoot Title = "設定" strFile = Scheme strWorkingDirectory = "" strIcon = "%SystemRoot%\System32\shell32.dll, 316" MySC '*** xxxxx *** Dim strTitle(99), strURI(99) ' strTitle(xx) = "" ' strURI(xx) = "" '*** システム *** myFolder = myRoot & "\01_システム" strTitle(0) = "ディスプレイ" strURI(0) = "display" strTitle(1) = "通知とアクション" strURI(1) = "notifications" strTitle(2) = "電源とスリープ" strURI(2) = "powersleep" strTitle(3) = "バッテリー" strURI(3) = "batterysaver" strTitle(4) = "ストレージ" strURI(4) = "storagesense" strTitle(5) = "タブレット モード" strURI(5) = "tabletmode" strTitle(6) = "マルチタスク" strURI(6) = "multitasking" strTitle(7) = "この PC へのプロジェクション" strURI(7) = "project" strTitle(8) = "共有エクスペリエンス" strURI(8) = "crossdevice" strTitle(9) = "リモート デスクトップ" strURI(9) = "remotedesktop" strTitle(10) = "バージョン情報" strURI(10) = "about" For y = 0 to 10 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** デバイス *** myFolder = myRoot & "\02_デバイス" strTitle(11) = "Bluetooth とその他のデバイス" strURI(11) = "bluetooth" strTitle(12) = "プリンタとスキャナー" strURI(12) = "printers" strTitle(13) = "マウス" strURI(13) = "mousetouchpad" strTitle(14) = "タッチパッド" strURI(14) = "devices-touchpad" strTitle(15) = "ペンと Windows Ink" strURI(15) = "pen" strTitle(16) = "自動再生" strURI(16) = "autoplay" strTitle(17) = "USB" strURI(17) = "usb" For y = 11 to 17 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** デバイス *** myFolder = myRoot & "\03_電話" strTitle(18) = "電話" strURI(18) = "mobile-devices" Title = strTitle(18) strFile = Scheme & strURI(18) MySC 'For y = 18 to 18 ' If strTitle(y) <> "" Then ' Title = strTitle(y) ' strFile = Scheme & strURI(y) ' MySC ' End If 'Next '*** ネットワークとインターネット *** myFolder = myRoot & "\04_ネットワークとインターネット" strTitle(19) = "状態" strURI(19) = "network-status" strTitle(20) = "Wi-Fi" strURI(20) = "network-wifi" strTitle(21) = "イーサネット" strURI(21) = "network-ethernet" strTitle(22) = "ダイヤルアップ" strURI(22) = "network-dialup" strTitle(23) = "VPN" strURI(23) = "network-vpn" strTitle(24) = "機内モード" strURI(24) = "network-airplanemode" strTitle(25) = "モバイル ホットスポット" strURI(25) = "network-mobilehotspot" strTitle(26) = "データ使用状況" strURI(26) = "datausage" strTitle(27) = "プロキシ" strURI(27) = "network-proxy" For y = 19 to 27 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** 個人用設定 *** myFolder = myRoot & "\05_個人用設定" strTitle(28) = "背景" strURI(28) = "personalization-background" strTitle(29) = "色" strURI(29) = "colors" strTitle(30) = "ロック画面" strURI(30) = "lockscreen" strTitle(31) = "テーマ" strURI(31) = "themes" strTitle(32) = "スタート" strURI(32) = "personalization-start" strTitle(33) = "タスクバー" strURI(33) = "taskbar" For y = 28 to 33 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** アプリ *** myFolder = myRoot & "\06_アプリ" strTitle(34) = "アプリと機能" strURI(34) = "appsfeatures" strTitle(35) = "既定のアプリ" strURI(35) = "defaultapps" strTitle(36) = "オフライン マップ" strURI(36) = "maps" strTitle(37) = "Web サイト用のアプリ" strURI(37) = "appsforwebsites" strTitle(38) = "ビデオの再生" strURI(38) = "videoplayback" For y = 34 to 38 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** アカウント *** myFolder = myRoot & "\07_アカウント" strTitle(39) = "ユーザーの情報" strURI(39) = "yourinfo" strTitle(40) = "メール & アプリのアカウント" strURI(40) = "emailandaccounts" strTitle(41) = "サインイン オプション" strURI(41) = "signinoptions" strTitle(42) = "職場または学校にアクセスする" strURI(42) = "workplace" strTitle(43) = "家族とその他のユーザー" strURI(43) = "otherusers" strTitle(44) = "設定の同期" strURI(44) = "sync" For y = 39 to 44 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** 時刻と言語 *** myFolder = myRoot & "\08_時刻と言語" strTitle(45) = "日付と時刻" strURI(45) = "dateandtime" strTitle(46) = "地域と言語" strURI(46) = "regionlanguage" strTitle(47) = "音声認識" strURI(47) = "speech" For y = 45 to 47 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** ゲーム *** myFolder = myRoot & "\09_ゲーム" strTitle(48) = "ゲーム バー" strURI(48) = "gaming-gamebar" strTitle(49) = "ゲーム DVR" strURI(49) = "gaming-gamedvr" strTitle(50) = "ブロードキャスト" strURI(50) = "gaming-broadcasting" strTitle(51) = "ゲーム モード" strURI(51) = "gaming-gamemode" strTitle(52) = "TruePlay" strURI(52) = "gaming-trueplay" strTitle(53) = "Xbox ネットワーク" strURI(53) = "gaming-xboxnetworking" For y = 48 to 53 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** 簡単操作 *** myFolder = myRoot & "\10_簡単操作" strTitle(54) = "ナレーター" strURI(54) = "easeofaccess-narrator" strTitle(55) = "拡大鏡" strURI(55) = "easeofaccess-magnifier" strTitle(56) = "ハイ コントラスト" strURI(56) = "easeofaccess-highcontrast" strTitle(57) = "字幕" strURI(57) = "easeofaccess-closedcaptioning" strTitle(58) = "キーボード" strURI(58) = "easeofaccess-keyboard" strTitle(59) = "マウス" strURI(59) = "easeofaccess-mouse" strTitle(60) = "その他のオプション" strURI(60) = "easeofaccess-otheroptions" For y = 54 to 60 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** Cortana *** myFolder = myRoot & "\11_Cortana" strTitle(61) = "Cortana" strURI(61) = "cortana" strTitle(62) = "アクセス許可と履歴" strURI(62) = "cortana-permissions" strTitle(63) = "通知" strURI(63) = "cortana-notifications" strTitle(64) = "詳細情報" strURI(64) = "cortana-moredetails" For y = 61 to 64 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** プライバシー *** myFolder = myRoot & "\12_プライバシー" strTitle(65) = "全般" strURI(65) = "privacy" strTitle(66) = "位置情報" strURI(66) = "privacy-location" strTitle(67) = "カメラ" strURI(67) = "privacy-webcam" strTitle(68) = "マイク" strURI(68) = "privacy-microphone" strTitle(69) = "通知" strURI(69) = "privacy-notifications" strTitle(70) = "音声認識、手書き入力、入力の設定" strURI(70) = "privacy-speechtyping" strTitle(71) = "アカウント情報" strURI(71) = "privacy-accountinfo" strTitle(72) = "連絡先" strURI(72) = "privacy-contacts" strTitle(73) = "カレンダー" strURI(73) = "privacy-calendar" strTitle(74) = "通話履歴" strURI(74) = "privacy-callhistory" strTitle(75) = "メール" strURI(75) = "privacy-email" strTitle(76) = "タスク" strURI(76) = "privacy-tasks" strTitle(77) = "メッセージング" strURI(77) = "messaging" strTitle(78) = "無線" strURI(78) = "privacy-radios" strTitle(79) = "他のデバイス" strURI(79) = "privacy-customdevices" strTitle(80) = "フィードバックと診断" strURI(80) = "privacy-feedback" strTitle(81) = "バック グラウンド アプリ" strURI(81) = "privacy-backgroundapps" strTitle(82) = "アプリの診断" strURI(82) = "privacy-appdiagnostics" strTitle(83) = "ファイルの自動ダウンロード" strURI(83) = "privacy-automaticfiledownloads" For y = 65 to 83 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** 更新とセキュリティ *** myFolder = myRoot & "\13_更新とセキュリティ" strTitle(84) = "Windows Update" strURI(84) = "windowsupdate" strTitle(85) = "Windows Defender" strURI(85) = "windowsdefender" strTitle(86) = "バックアップ" strURI(86) = "backup" strTitle(87) = "トラブルシューティング" strURI(87) = "troubleshoot" strTitle(88) = "回復" strURI(88) = "recovery" strTitle(89) = "ライセンス認証" strURI(89) = "activation" strTitle(90) = "デバイスの検索" strURI(90) = "findmydevice" strTitle(91) = "開発者向け" strURI(91) = "developers" strTitle(92) = "Windows Insider Program" strURI(92) = "windowsinsider" For y = 84 to 92 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next strFile = "%windir%\explorer.exe" '*** Windows Update *** myFolder = myRoot Title = "Windows Update" 'strArguments = Content & "AAA_SettingsPageRestoreMusUpdate" & ".settingcontent-ms" strFile = Scheme & "windowsupdate" 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" If objFSO.FileExists(strArguments) Then MySC Else strFile = "%windir%\system32\control.exe" strArguments = "ncpa.cpl" MySC End If '*** ネットワークと共有センター *** myFolder = myRoot Title = "ネットワークと共有センター" strArguments = Content & "Classic_{BD256B65-94BE-4194-84BF-41D50D0EF26E}" & ".settingcontent-ms" strIcon = "%SystemRoot%\System32\netcenter.dll, 0" If objFSO.FileExists(strArguments) Then MySC Else strFile = "%windir%\system32\control.exe" strArguments = "/name Microsoft.NetworkAndSharingCenter" MySC End If '*** コントロール パネル *** 'myFolder = myRoot 'Title = "コントロール パネル" 'strArguments = Content & "ControlPanel" & ".settingcontent-ms" 'strIcon = "%SystemRoot%\System32\shell32.dll, 21" 'MySC '*** コントロール パネル *** myFolder = myRoot Title = "コントロール パネル" strFile = "%windir%\System32\control.exe" strArguments = "" strIcon = "%SystemRoot%\System32\shell32.dll, 21" MySC '*** Windows Defender セキュリティ センター *** Title = "Windows Defender セキュリティ センター" strFile = "%windir%\explorer.exe" strArguments = "shell:AppsFolder\Microsoft.Windows.SecHealthUI_cw5n1h2txyewy!SecHealthUI" strIcon = "%ProgramFiles%\Windows Defender\MSASCui.exe, 0" 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 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