Windows関連

「プログラムと機能」からインストールされているアプリケーションの一覧を取得するVBScript

今回もVBScriptネタです。
今回は「プログラムと機能」から、インストールされているアプリケーションの一覧を取得するスクリプトを書いてみました。

Option Explicit

Dim itm

With CreateObject("Shell.Application").Namespace("shell:::{7b81be6a-ce2b-4676-a29e-eb907a5126c5}")
  For Each itm In .Items
    WScript.Echo itm.Name
  Next
End With

仕組みは「AppUserModelId(AUMID)を列挙するVBScript」と同じで、「プログラムと機能」をフォルダとして扱い、中にあるアイテム(FolderItem2)の名前を列挙しているだけです。

このスクリプトを利用すると、指定したアプリケーションがインストールされているかどうかを判別するスクリプトも簡単に書くことができます。
(名前だけで判断しているので、正確性に欠ける場合があるかもしれませんが)

Option Explicit

MsgBox IsInstalledApplication("ABCDEFG") 'インストールされていない場合は空の文字列が返る
MsgBox IsInstalledApplication("7-Zip") 'インストールされている場合はプログラム名が返る

Private Function IsInstalledApplication(ByVal AppName)
'指定したアプリケーションがインストールされているか判別
  Dim ret
  Dim itm
  
  ret = "" '初期化
  With CreateObject("Shell.Application").Namespace("shell:::{7b81be6a-ce2b-4676-a29e-eb907a5126c5}")
    For Each itm In .Items
      If InStr(LCase(itm.Name), LCase(AppName)) Then
        ret = itm.Name
        Exit For
      End If
    Next
  End With
  IsInstalledApplication = ret
End Function

レジストリにあるアンインストール情報から取得することもできます。

Option Explicit

MsgBox IsInstalledApplication("ABCDEFG") 'インストールされていない場合は空の文字列が返る
MsgBox IsInstalledApplication("7-Zip") 'インストールされている場合はプログラム名が返る

Private Function IsInstalledApplication(ByVal AppName)
'指定したアプリケーションがインストールされているか判別
  Dim reg
  Dim keys
  Dim key
  Dim ret
  Dim res
  Dim display_name
  Const HKEY_CURRENT_USER = &H80000001
  Const HKEY_LOCAL_MACHINE = &H80000002
  Const SubKeyName = "Software\Microsoft\Windows\CurrentVersion\Uninstall\"
  Const SubKeyNameX86 = "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall\"
  
  res = "" '初期化
  Set reg = CreateObject("WbemScripting.SWbemLocator") _
            .ConnectServer(, "root\default").Get("StdRegProv")
  
  On Error Resume Next
  reg.EnumKey HKEY_LOCAL_MACHINE, SubKeyName, keys
  For Each key In keys
    display_name = ""
    ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "DisplayName", display_name)
    If ret <> 0 Then ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyName & key, "QuietDisplayName", display_name)
    If (ret = 0) And (Len(Trim(display_name)) > 0) Then
      If InStr(LCase(display_name), LCase(AppName)) Then
        res = display_name
        Exit For
      End If
    End If
  Next
  On Error GoTo 0
  
  '64ビットアプリケーションに無い場合は32ビットアプリケーションを検索
  If (Isx64() = True) And (Len(Trim(res)) < 1) Then
    On Error Resume Next
    reg.EnumKey HKEY_LOCAL_MACHINE, SubKeyNameX86, keys
    For Each key In keys
      display_name = ""
      ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyNameX86 & key, "DisplayName", display_name)
      If ret <> 0 Then ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, SubKeyNameX86 & key, "QuietDisplayName", display_name)
      If (ret = 0) And (Len(Trim(display_name)) > 0) Then
        If InStr(LCase(display_name), LCase(AppName)) Then
          res = display_name
          Exit For
        End If
      End If
    Next
    On Error GoTo 0
  End If
  
  'HKLMに無い場合はHKCUを検索
  If Len(Trim(res)) < 1 Then
    On Error Resume Next
    reg.EnumKey HKEY_CURRENT_USER, SubKeyName, keys
    For Each key In keys
      display_name = ""
      ret = reg.GetStringValue(HKEY_CURRENT_USER, SubKeyName & key, "DisplayName", display_name)
      If ret <> 0 Then ret = reg.GetStringValue(HKEY_CURRENT_USER, SubKeyName & key, "QuietDisplayName", display_name)
      If (ret = 0) And (Len(Trim(display_name)) > 0) Then
        If InStr(LCase(display_name), LCase(AppName)) Then
          res = display_name
          Exit For
        End If
      End If
    Next
    On Error GoTo 0
  End If
  
  IsInstalledApplication = res
End Function

Private Function Isx64()
'64ビット環境かどうかを判別
  Dim colItems
  Dim itm
  Dim ret
   
  ret = False '初期化
  Set colItems = CreateObject("WbemScripting.SWbemLocator").ConnectServer.ExecQuery("Select * From Win32_OperatingSystem")
  For Each itm In colItems
    If InStr(itm.OSArchitecture, "64") Then
      ret = True
      Exit For
    End If
  Next
  Isx64 = ret
End Function

ただし、こちらの方法で取得できるのはUninstallキー以下に情報があるアプリケーションのみになります。

Lhaplusのバージョンを取得するVBScript前のページ

特殊フォルダやプログラムのCLSID一覧とShellコマンド一覧次のページ

関連記事

  1. Windows 10

    【2017年4月版】Microsoft Edgeで開いているページを名前を付けて保存する方法

    2015年8月に、Microsoft Edgeで開いているページを名前…

  2. Windows 10

    [Windows 10]Microsoft Edgeでブックマークレットを使う。

    2017/3/29 追記:新しく記事を書き直しました。…

  3. Windows 10

    Microsoft Edgeの場所

    「Edge 本体 場所」「Microsoft Edge EXE どこ」…

  4. Windows関連

    ダウンロードフォルダーのパスを取得するVBScript

    ダウンロードフォルダーのパスを取得する必要があったので、過去に書いた記…

  5. Windows 10

    Microsoft Edgeで開いているページを名前を付けて保存する

    2017/4/15 追記:現在この記事に書いてある方法は使えなくな…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP