VBScript GOD MODEを作ってクイックアクセスに登録する

#万人受けする重要なTIPS Quick Accessの日本語表記は
クィックアクセスではなくクイックアクセスで、イが大きい。
https://www.jtca.org/standardization/katakana_03.pdf
2006年の調査ながら、イを小さく書く人は２割くらいか。


#God Modeの作り方
https://pc-karuma.net/windows-10-godmode/
これはあとで補足があります。
#God Modeの必要性
##最新のバージョン（1903）ではContorlPanelが表示されにくい
現在（2019/07/29)
OS 名:                  Microsoft Windows 10 Home
OS バージョン:          10.0.18362 N/A ビルド 18362
なぜか当方ではWin+Xでもコントロールパネルが表示されません。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/126919/0f827794-cf13-939c-d39f-95653641badb.png)

スタートメニューの表示からデスクトップにもっていきましたが、コントロールパネルはタスクバーに簡単にピン留めできません。

これに対してGodModeはこれでタスクバーには登録できませんが、クィックアクセスツールバーに登録が可能である程度整列してでるため検索も容易です。

##ContorolPanel表示しても容易にタスクバーに登録できない
もちろん
［Windows］＋［R］キーで［ファイル名を指定して実行］ダイアログを開き、名前項目に「control」と入力して、［Enter］キーを押すというのはあります。このとき単数形なのが謎ですが。
コントロールパネルはコントロールパネルを開いてタスクバーのコントロールパネルアイコンを右クリックしてピン留めして止まります。
普通はアイコンを右クリックすればできるのにこれだけ違うのです。

##God Modeも挙動がおかしい点がある
https://pc-karuma.net/windows-10-godmode/
先ほどのサイトの作り方だと神モードというフォルダ名になりますが、フォルダ名が現バージョンでは消えます。
下のコードの上から24行目までを下のように書き換えることができます。24行目から下はCodeの項目の完成式と同じになります。
一度日付を利用した仮の名前のフォルダを作り、これを名前を変更するという方法です。

```vb
Option explicit
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemobject")
Dim WSH : Set WSH = CreateObject("Wscript.Shell")
Dim SHL : Set SHL = CreateObject("Shell.Application")
Dim Reg : Set Reg = CreateObject("VBScript.RegExp")
Dim oDeskTop : Set oDeskTop = FSO.Getfolder(WSH.SpecialFolders("Desktop") )
Dim GodModeFolder
Dim str,buf
Dim NS , TG , c, v, Shcut
Dim Win ,Windows , Cnt
Dim blOneDrive, blSuccess
Dim strTemp : strTemp = "temp" &  Replace(Replace(Replace(Now(), "/", ""), ":", ""), " ", "")
IF FSO.FolderExists(WSH.SpecialFolders("Desktop") & "\GodMode.{ED7BA470-8E54-465E-825C-99712043E01C}" ) = False Then
Cnt = clng(0)
FSO.CreateFolder(WSH.SpecialFolders("Desktop") & "\" & strTemp ) : Wscript.sleep 5000 : FSO.MoveFolder  WSH.SpecialFolders("Desktop") & "\" & strTemp , WSH.SpecialFolders("Desktop") & "\GodMode.{ED7BA470-8E54-465E-825C-99712043E01C}"
'Wscript.Echo "Lines:0016:" & "WSH.SpecialFolders("Desktop")  ' OneDriveのデスクトップかわからないときはここを使用し、フォルダ名にOneDriveが含まれていたらOnDriveです
Do 
IF FSO.FolderExists(WSH.SpecialFolders("Desktop") & "\GodMode.{ED7BA470-8E54-465E-825C-99712043E01C}") = True Then Exit Do
Wscript.sleep 500
Cnt = Cnt + 1
If Cnt = 10 then exit Do
Loop
End IF
```

しかしこの方法でも名前が出ません。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/126919/c717d1d1-9db4-a434-6454-c2a27ff9f3d8.png)
このようにアイコンだけの存在になります。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/126919/33b3aec5-7429-8066-f403-09736386b02d.png)
コントロールパネルは名前がついているため区別できます。

##ContorolPanel あるいは God Modeの必要性
今回のバージョンはかなりひどいです。当方は買い替えたばかりのPCをアップデートし、それからオフィスを入れたのですが、大変なエラーの数が連発します。さらにひどいのはオフィスのアイコンが消えてたまに起動できなくなり、再度インストールする必要があったときもあります。
なにかあくどいことをしているのでは、と思われるかもしれませんが、当方はセットアップのエラーに忙殺され、あくどいことどころかまともに使うこともままならない状況です。しかも型落ちとはいえ新品なんです。
このためイベントマネージャーでエラーや警告をチェックし、エラーメッセージをみたらパッチをあてたり、レジストリを設定したりするのですが、次から次へと頻発して大変困っています。
レジストリエディター、コンポーネントサービス、イベントビューアー、これらはタスクバーに登録できます。
あと設定の歯車もできます。
しかし、コントロールパネルだけは登録できません。
こうしたツールの扱いの不統一も困ったものです。なぜこんなことが起きるのか。
とにかくこうした事象に対応に追われている状況のため、必要に迫られているというわけです。

##Code 
###今のところかなり不本意です
####正規表現が効かない
正規表現が文字列にはうまくいくのですが、どうしても命令等にマッチしない状況です。
まず画面をリフレッシュしたほうがよいと思われますが、たぶんこれが原因でうまくいかない。
なによりピン留めもうまくいかない
なので「クィックアクセスにピン留めする」が0からカウントして1番目である現状を利用してCnt＝1で強制起動しています。
当然違う場合にはカウントを変える必要があります。
ただなぜか「ク」にすらマッチしない。Leftで1字だけとりだしてもダメ。
####GodModeフォルダーの名前が設定できず、表示されない。
全く名前が表示されません。下手に日本語の名前をつけると文字化けしてGodModeのフォルダとは認識されませんでした。
####OneDriveが入るとややこしい
今までのWindows10のデスクトップは
C:\users\name\デスクトップ
のような感じですが、Onedriveを設定すると
c:\users\name\OneDrive\デスクトップ
になります。
これは

```vb
CreateObject("Shell.Application").NameSpace(CreateObject("Wscript.Shell").SpecialFolders("Desktop"))
```

で拾うデスクトップも変わります。

```vb
Option explicit
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemobject")
Dim WSH : Set WSH = CreateObject("Wscript.Shell")
Dim SHL : Set SHL = CreateObject("Shell.Application")
Dim Reg : Set Reg = CreateObject("VBScript.RegExp")
Dim oDeskTop : Set oDeskTop = FSO.Getfolder(WSH.SpecialFolders("Desktop") )
Dim GodModeFolder
Dim str,buf
Dim NS , TG , c, v, Shcut
Dim Win ,Windows , Cnt
Dim blOneDrive, blSuccess

IF FSO.FolderExists(WSH.SpecialFolders("Desktop") & "\GodMode.{ED7BA470-8E54-465E-825C-99712043E01C}" ) = False Then
Cnt = clng(0)
FSO.CreateFolder(WSH.SpecialFolders("Desktop") & "\GodMode.{ED7BA470-8E54-465E-825C-99712043E01C}" ) : Wscript.sleep 5000
'Wscript.Echo "Lines:0016:" & WSH.SpecialFolders("Desktop")  ' OneDriveのデスクトップかわからないときはここを使用し、フォルダ名にOneDriveが含まれていたらOnDriveです
Do 
IF FSO.FolderExists(WSH.SpecialFolders("Desktop") & "\GodMode.{ED7BA470-8E54-465E-825C-99712043E01C}") = True Then Exit Do
Wscript.sleep 500
Cnt = Cnt + 1
If Cnt = 10 then exit Do
Loop
End IF
Cnt = clng(0)
Set windows = CreateObject("Shell.Application").windows()
buf = ""
Reg.Global = True : Reg.MultiLine = True : Reg.IgnoreCase = False : Reg.Pattern = "^.*デスクトップ.*$"
For Each win In windows
    'MsgBox win.LocationURL, vbInformation, TypeName(win.Document)
    buf =   win.LocationURL & vbTab & TypeName(win.Document) & vbCrlf
    IF reg.test(win.LocationURL & vbTab & TypeName(win.Document)) = true then 	win.refresh : Wscript.Echo "Refresh Window"
    Cnt = Cnt +1
    If Cnt = 10 then exit For
Next
'Msgbox buf
Set Reg = Nothing
Set Reg = CreateObject("VBScript.RegExp")
Reg.Global = True : Reg.MultiLine = False : Reg.IgnoreCase = False :  Reg.Pattern = "ク" ' But not match it.
'Wscript.Echo Reg.Test("アクセスにピン留めする") & "Lines:0039:" ' This is Success
Set NS = SHL.NameSpace(WSH.SpecialFolders("Desktop") & "\GodMode.{ED7BA470-8E54-465E-825C-99712043E01C}")
Set TG = NS.Self
Set c = Tg.verbs
If C Is Nothing then
  Wscript.Echo "Error"
  Set Reg = Nothing
  Set SHL = Nothing
  Set FSO = Nothing
  Set WSH = Nothing
  Wscript.Quit
End if
blSuccess = CBool(vbFalse) : Cnt = clng(0) 
For each v in C
Str = str & v.name & vbcrlf
'Wscript.Echo "Line0054 " & v.name & Left(v.name,1) & Reg.Test(Left(cstr(v.name),1))  'test code line. Not Match Quick Access
IF Reg.test(Left(Cstr(v.name),1) ) =True or Cstr(v.name) = "クイック アクセスにピン留めする" then 'スタートかクィックアクセスにしかできない。タスクバーは出てこないため効かない。' = "タスク バーにピン留め(&K)" Then
v.DoIt : Wscript.sleep 1000 : Wscript.Echo "line 57 Success"
blSuccess = vbTrue
End If
If blSuccess =vbFalse And Cnt = 1 then v.Doit : Wscript.sleep 1000 : blSuccess = vbTrue :Wscript.Echo "Lines:0059:" & v.name & " Forced Boost" : Exit for
Cnt = Cnt + 1 
Next
'msgbox str 'どうしても起動しないときは右クリックの何番目に来るかで強制起動する。その何番目かがわからないときはリスティングさせる。空白はカウントする。
Str =""
' --- 以下ショートカットを作成する例
'Set Shcut = WSH.CreateShortcut(WSH.SpecialFolders("Desktop") & "\GodShct.lnk") 
'Shcut.TargetPath = WSH.SpecialFolders("Desktop") & "\GodMode.{ED7BA470-8E54-465E-825C-99712043E01C}" 
'Shcut.Save
'Wscript.sleep 1000
'Set NS = SHL.NameSpace(WSH.SpecialFolders("Desktop") & "\GodShct.lnk")
'Set TG = NS.Self
'Set c = Tg.verbs
'For each v in C
'Str = str & v.name & vbcrlf
'IF Reg.test(v.name) =True then ' = "タスク バーにピン留め(&K)" Then
'v.DoIt
'End If
'next
'msgbox str
Set Reg = Nothing
Set SHL = Nothing
Set FSO = Nothing
Set WSH = Nothing
Wscript.Echo "End"
```
#参考サイト
###PowerShellで行う例
https://www.vwnet.jp/Windows/w10/2017020201/Pin2QuickAccess.htm
###類似命令はVBSで使える
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q11171792736
###日付文字列取得
https://bayashita.com/p/entry/show/39
###VBScriptのワイルドカード
VBScript（VBスクリプト）でLikeするには？
http://chaichan.lolipop.jp/vbtips/VBMemo2007010118.htm
http://logicalerror.seesaa.net/article/127274437.html
###ショートカットの作成
http://www.wannko.net/vbs/file/shortcut.html
###画面のRefresh
https://www.papy.in/bbs/vb1/200803/08030054.html
For Each で逃げたがITEM番号は0から始まっているようだ
https://www.vbsedit.com/scripts/storage/folders/scr_1590.asp
###Quick起動(Quick Launch)を使用するか今後検討
https://www.tipsfound.com/windows10/06007


#(蛇足)さらにいうとマイクロソフトは独禁法違反かその系統でウィンドウズ10が問題になるのは不可避という認識を抱からざるを得ない
###理由1:対策が変わる
たとえばマイクロソフトエッジです。
現在のバージョンではエッジは削除不可能です。
さらにMicrosoft Edge そして Windows Defenderはくっついています。
これは当初WindowsDefenderのエラー対策を行ううちに発見されました。
削除して対策することができなくなったのです。
またOneDriveも上記のようにユーザー名以下を丸ごとのっとっています。
https://ascii.jp/elem/000/000/994/994821/
https://hardware.srad.jp/story/17/07/07/0448253/
https://eizone.info/onedrive-trajectory/

###理由2:変更の目的がマイクロソフトが個人情報を吸い上げる以外の目的がない
Microsoft Edgeはユーザーの情報を吸い上げるために必要だからです。
しかもユーザーからみてわからない位置どころか、ネットに上がっています。（自分のアカウントのページなので外部からは見られませんが）
https://support.microsoft.com/ja-jp/help/10607/microsoft-edge-view-delete-browser-history
履歴やブックマークだけでなくPCの位置、使ったファイルさえ内部どころかネットに上がります。
クラウドに保存された閲覧の履歴をクリアする (Cortana を使っている場合)
ところがこの説明には問題があります。Cortanaを使っていなくてもCortanaは裏で動いているからです。
あと、モバイルならまだしもPCって今家からそんな動かさないから意味がないわ。。。
MSはEdgeをGoogleエンジンに変えても、絶対にこれは辞めないでしょう。
というかそれだけ集めてエラーが止まらないのはなぜか。どこに力を入れているのかあきれてしまう。
また、MSの歴史は優れた商品やサービスをパクってつぶす以外の手法で成長したことがありません。
MSが個人情報を集めまくって利用しようとしているのは、GAFAに対抗するするためであり、裏を返すとGAFAはMS以上の卑怯な手を使っているといえます。MicrosoftTeamsの利用を強制するのと同じ理由ですね。
https://pc.watch.impress.co.jp/docs/news/1197670.html
###理由3:バージョンを上げると動かない機種が出ます。
https://www.sbbit.jp/article/cont1/35047
###理由4:バージョンを上げるとIrDAのように動かない機能がある
以前のバージョンなら動いていたのに、現在のバージョンの前のバージョンで動かなくなっている。
これは海外のMSのQAにありますが、MS自体は公式にアナウンスしたか把握しがたいです。
いずれにしろPC本体より周辺機器の方が高いうえに生活が懸かっているので、MSはこんなバカなことをやったりそれを持ち上げるPCライターや技術者は金や生活が懸かった人間の怖さを知らないようだが、高い学習費用を払った方がよいように思う。公取の方が命までは取らないから優しいです。

###これらの理由からうたがわれるもの
####羊頭狗肉
結論から言うと購入者がWindows10をインストールないし使用開始した時点の機能をMSは保証しないとそもそもそれはWindows10とはユーザーは認めないです。看板を変えずに中身を変えるって羊頭狗肉もいいところだ。Windows10の表記を変えないのは消費者に誤解を与える。さらに3年ごとに書き換えてきたOfficeとの整合性がとれない。
####独占的な地位を利用
それ詐欺だし、そんなバカげた商法はWindows以外にないからこうなる。独占的な地位を利用している。
####会計処理は資産計上が必要なのではないか
さらにWindows10は会計処理はどうなっているのか。名前が同じでも古いPCで使えないのは新たなソフトウェアを開発したレベルといっていいという状態なのにWindows10はバージョンアップにとどまっている。これは資産として開発費用を計上しないという会計操作をしている疑い。
https://www.clairlaw.jp/qa/it/accounting/version.html

https://japanese.engadget.com/2019/07/25/gafa-it/

現在はGAFAがやり玉に挙がっているが、GAFAの次はMSだろう。MSのことを持ち上げれば商売になった時代は終わると思う。少なくとも今のMSがやっていることはきな臭い。