'================================================================== ' Windows 10 の「設定」ショートカットを作成しますYO! 'http://www10.plala.or.jp/palm84/wsh.html 'http://d.hatena.ne.jp/palm84/ 'http://www10.plala.or.jp/palm84/archives/wsh/Win10-1809_CreateMsSettingsShortCut.vbs.txt 'https://eu7w9wsmf6a74xyjdfzl3q-on.drv.tw/archives/wsh/Win10-1809_CreateMsSettingsShortCut.vbs.txt '================================================================== '2018.12.07 October 2018 Update (ReleaseID 1809) 対応 '2019.07.04 重複ミス修正 orz '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) = "1809" Then MsgBox "October 2018 Update (ReleaseID 1809) 専用クマー (´;ω;`) ",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(111), strURI(111) ' strTitle(xx) = "" ' strURI(xx) = "" '*** システム *** myFolder = myRoot & "\01_システム" strTitle(0) = "ディスプレイ" strURI(0) = "display" strTitle(1) = "サウンド" strURI(1) = "sound" strTitle(2) = "通知とアクション" strURI(2) = "notifications" strTitle(3) = "集中モード" strURI(3) = "quiethours" strTitle(4) = "電源とスリープ" strURI(4) = "powersleep" strTitle(5) = "バッテリー" strURI(5) = "batterysaver" strTitle(6) = "ストレージ" strURI(6) = "storagesense" strTitle(7) = "タブレット モード" strURI(7) = "tabletmode" strTitle(8) = "マルチタスク" strURI(8) = "multitasking" strTitle(9) = "この PC へのプロジェクション" strURI(9) = "project" strTitle(10) = "共有エクスペリエンス" strURI(10) = "crossdevice" strTitle(11) = "クリップボード" strURI(11) = "clipboard" strTitle(12) = "リモート デスクトップ" strURI(12) = "remotedesktop" strTitle(13) = "バージョン情報" strURI(13) = "about" For y = 0 to 13 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** デバイス *** myFolder = myRoot & "\02_デバイス" strTitle(14) = "Bluetooth とその他のデバイス" strURI(14) = "bluetooth" strTitle(15) = "プリンタとスキャナー" strURI(15) = "printers" strTitle(16) = "マウス" strURI(16) = "mousetouchpad" strTitle(17) = "タッチパッド" strURI(17) = "devices-touchpad" strTitle(18) = "入力" strURI(18) = "typing" strTitle(19) = "ペンと Windows Ink" strURI(19) = "pen" strTitle(20) = "自動再生" strURI(20) = "autoplay" strTitle(21) = "USB" strURI(21) = "usb" For y = 14 to 21 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** 電話 *** myFolder = myRoot & "\03_電話" strTitle(22) = "電話" strURI(22) = "mobile-devices" Title = strTitle(22) strFile = Scheme & strURI(22) 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(23) = "状態" strURI(23) = "network-status" strTitle(24) = "Wi-Fi" strURI(24) = "network-wifi" strTitle(25) = "イーサネット" strURI(25) = "network-ethernet" strTitle(26) = "ダイヤルアップ" strURI(26) = "network-dialup" strTitle(27) = "VPN" strURI(27) = "network-vpn" strTitle(28) = "機内モード" strURI(28) = "network-airplanemode" strTitle(29) = "モバイル ホットスポット" strURI(29) = "network-mobilehotspot" strTitle(30) = "データ使用状況" strURI(30) = "datausage" strTitle(31) = "プロキシ" strURI(31) = "network-proxy" For y = 23 to 31 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** 個人用設定 *** myFolder = myRoot & "\05_個人用設定" strTitle(32) = "背景" strURI(32) = "personalization-background" strTitle(33) = "色" strURI(33) = "colors" strTitle(34) = "ロック画面" strURI(34) = "lockscreen" strTitle(35) = "テーマ" strURI(35) = "themes" strTitle(36) = "フォント" strURI(36) = "fonts" strTitle(37) = "スタート" strURI(37) = "personalization-start" strTitle(38) = "タスクバー" strURI(38) = "taskbar" For y = 32 to 38 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** アプリ *** myFolder = myRoot & "\06_アプリ" strTitle(39) = "アプリと機能" strURI(39) = "appsfeatures" strTitle(40) = "既定のアプリ" strURI(40) = "defaultapps" strTitle(41) = "オフライン マップ" strURI(41) = "maps" strTitle(42) = "Web サイト用のアプリ" strURI(42) = "appsforwebsites" strTitle(43) = "ビデオの再生" strURI(43) = "videoplayback" strTitle(44) = "スタートアップ" strURI(44) = "startupapps" For y = 39 to 44 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** アカウント *** myFolder = myRoot & "\07_アカウント" strTitle(45) = "ユーザーの情報" strURI(45) = "yourinfo" strTitle(46) = "メールとアカウント" strURI(46) = "emailandaccounts" strTitle(47) = "サインイン オプション" strURI(47) = "signinoptions" strTitle(48) = "職場または学校にアクセスする" strURI(48) = "workplace" strTitle(49) = "家族とその他のユーザー" strURI(49) = "otherusers" strTitle(50) = "設定の同期" strURI(50) = "sync" For y = 45 to 50 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** 時刻と言語 *** myFolder = myRoot & "\08_時刻と言語" strTitle(51) = "日付と時刻" strURI(51) = "dateandtime" strTitle(52) = "地域" strURI(52) = "regionformatting" strTitle(53) = "言語" strURI(53) = "regionlanguage" strTitle(54) = "音声認識" strURI(54) = "speech" For y = 51 to 54 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** ゲーム *** myFolder = myRoot & "\09_ゲーム" strTitle(55) = "ゲーム バー" strURI(55) = "gaming-gamebar" strTitle(56) = "キャプチャ" strURI(56) = "gaming-gamedvr" strTitle(57) = "ブロードキャスト" strURI(57) = "gaming-broadcasting" strTitle(58) = "ゲーム モード" strURI(58) = "gaming-gamemode" strTitle(59) = "TruePlay" strURI(59) = "gaming-trueplay" strTitle(60) = "Xbox ネットワーク" strURI(60) = "gaming-xboxnetworking" For y = 55 to 60 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** 簡単操作 *** myFolder = myRoot & "\10_簡単操作" strTitle(61) = "ディスプレイ" strURI(61) = "easeofaccess-display" strTitle(62) = "カーソルとポインターのサイズ" strURI(62) = "easeofaccess-cursorandpointersize" strTitle(63) = "拡大鏡" strURI(63) = "easeofaccess-magnifier" strTitle(64) = "カラーフィルター" strURI(64) = "easeofaccess-colorfilter" strTitle(65) = "ハイ コントラスト" strURI(65) = "easeofaccess-highcontrast" strTitle(66) = "ナレーター" strURI(66) = "easeofaccess-narrator" strTitle(67) = "オーディオ" strURI(67) = "easeofaccess-audio" strTitle(68) = "字幕" strURI(68) = "easeofaccess-closedcaptioning" strTitle(69) = "音声認識" strURI(69) = "easeofaccess-speechrecognition" strTitle(70) = "キーボード" strURI(70) = "easeofaccess-keyboard" strTitle(71) = "マウス" strURI(71) = "easeofaccess-mouse" strTitle(72) = "視線制御 (ベータ)" strURI(72) = "easeofaccess-eyecontrol" For y = 61 to 72 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** Cortana *** myFolder = myRoot & "\11_Cortana" strTitle(73) = "Cortana に話しかける" 'strURI(73) = "cortana" strURI(73) = "cortana-talktocortana" strTitle(74) = "アクセス許可と履歴" strURI(74) = "cortana-permissions" strTitle(75) = "デバイス間での Cortana" strURI(75) = "cortana-notifications" strTitle(76) = "詳細情報" strURI(76) = "cortana-moredetails" For y = 73 to 76 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** プライバシー *** myFolder = myRoot & "\12_プライバシー" strTitle(77) = "全般" strURI(77) = "privacy" strTitle(78) = "音声認識" strURI(78) = "privacy-speech" strTitle(79) = "手書き入力と入力の個人用設定" strURI(79) = "privacy-speechtyping" strTitle(80) = "診断 & フィードバック" strURI(80) = "privacy-feedback" strTitle(81) = "アクティビティの履歴" strURI(81) = "privacy-activityhistory" strTitle(82) = "位置情報" strURI(82) = "privacy-location" strTitle(83) = "カメラ" strURI(83) = "privacy-webcam" strTitle(84) = "マイク" strURI(84) = "privacy-microphone" strTitle(85) = "通知" strURI(85) = "privacy-notifications" strTitle(86) = "アカウント情報" strURI(86) = "privacy-accountinfo" strTitle(87) = "連絡先" strURI(87) = "privacy-contacts" strTitle(88) = "カレンダー" strURI(88) = "privacy-calendar" strTitle(89) = "通話履歴" strURI(89) = "privacy-callhistory" strTitle(90) = "メール" strURI(90) = "privacy-email" strTitle(91) = "タスク" strURI(91) = "privacy-tasks" strTitle(92) = "メッセージング" strURI(92) = "privacy-messaging" strTitle(93) = "無線" strURI(93) = "privacy-radios" strTitle(94) = "他のデバイス" strURI(94) = "privacy-customdevices" strTitle(95) = "バックグラウンド アプリ" strURI(95) = "privacy-backgroundapps" strTitle(96) = "アプリの診断" strURI(96) = "privacy-appdiagnostics" strTitle(97) = "ファイルの自動ダウンロード" strURI(97) = "privacy-automaticfiledownloads" strTitle(98) = "ドキュメント" strURI(98) = "privacy-documents" strTitle(99) = "ピクチャ" strURI(99) = "privacy-pictures" strTitle(100) = "ビデオ" strURI(100) = "privacy-videos" strTitle(101) = "ファイルシステム" strURI(101) = "privacy-broadfilesystemaccess" For y = 77 to 101 If strTitle(y) <> "" Then Title = strTitle(y) strFile = Scheme & strURI(y) MySC End If Next '*** 更新とセキュリティ *** myFolder = myRoot & "\13_更新とセキュリティ" strTitle(102) = "Windows Update" strURI(102) = "windowsupdate" strTitle(103) = "配信の最適化" strURI(103) = "delivery-optimization" strTitle(104) = "Windows セキュリティ" strURI(104) = "windowsdefender" strTitle(105) = "バックアップ" strURI(105) = "backup" strTitle(106) = "トラブルシューティング" strURI(106) = "troubleshoot" strTitle(107) = "回復" strURI(107) = "recovery" strTitle(108) = "ライセンス認証" strURI(108) = "activation" strTitle(109) = "デバイスの検索" strURI(109) = "findmydevice" strTitle(110) = "開発者向け" strURI(110) = "developers" strTitle(111) = "Windows Insider Program" strURI(111) = "windowsinsider" For y = 102 to 111 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 セキュリティ *** 'Title = "Windows Defender セキュリティ センター" Title = "Windows セキュリティ" strFile = "%windir%\explorer.exe" strArguments = "shell:AppsFolder\Microsoft.Windows.SecHealthUI_cw5n1h2txyewy!SecHealthUI" strIcon = "%ProgramFiles%\Windows Defender\Offline\OfflineScannerShell.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