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キー以下に情報があるアプリケーションのみになります。

関連記事

  1. Windows関連

    Windows 8 Consumer PreviewにMicrosoft Security Esse…

    ※ 下記はWindows 8 Consumer Preview(日本語…

  2. Windows関連

    [Windows 10]画面スケッチを起動するショートカット

    前回の記事の関連です。前回はスケッチパッドを起動するショートカ…

  3. Windows関連

    Windows Insider Meetup in Japan 3 東京に参加しました。

    前回のイベント(下記記事参照)から8か月、Windows Inside…

  4. Windows関連

    VivoTab RT TF600TにWindows RT 8.1をインストールしました。

    Windows ストアからWindows RT 8.1がダウンロードで…

  5. Windows関連

    [Windows 8]圧縮ファイルを解凍する。

    ※ 下記はWindows Developer Preview(英語版・…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP