PCインストール済みのアプリケーション情報の取得方法

質問

初めての書き込みです。

掲示板はいつも参考資料として、拝見させて頂いてますが
今回は、どうしても参考のソースや情報がみつからなくて質問を
書き込ませて頂きました。宜しくお願い致しますm(_ _)m

会社でＶＢ６を使って、パソコンのシステム調査のために、現在エクセルに出力させるプログラムを組んでいます。

メモリ・ＨＤＤ・ＯＳバージョン・ＣＰＵまでは、ＡＰＩ関数を使い
情報を取得するように出来ましたが、一番重要な
「インストール済みのアプリケーション情報」の取得方法が
いくら調べても、分らないのです(T_T)

ＡＰＩでレジストリのHKEY_CURRENT_USERのアンインストールの値を
読み込めばいいところまでは調べたのですが
ＡＰＩ自体、それほど把握していないので
かなり悩みつづけている状態です。。。

参考ソースや他の方法があれば教えて頂きたいです。
宜しくお願い致します。

回答No.1

TAGOSAKU7 · ベストアンサー

>ＡＰＩでレジストリのHKEY_CURRENT_USERのアンインストールの値を読み込めばいいところまでは調べたのですが
アプリのインストールはユーザ別ではないので、HKEY_LOCAL_MACHINEですよー
正確には
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall
です^^

>ＡＰＩ自体、それほど把握していないのでかなり悩みつづけている状態です。。。
以前にインストーラのデバッグ用として、作ったものがあります。
レジストリ操作の関数は
advapi32.dll
Shlwapi.dll
の2種類ありますが、advapi32.dllだけの使用です。
私はあまりShlwapi.dll系は利用しません。バグがあるとかそういうんじゃないけど、DLLに32という数字がついている方が、サンプルを拾い易いからです^^
16bit版の移植DLLという信頼性もありますしねー

それと(当然ですが)「アプリケーションの追加と削除」に出てくるのは、アンインストーラが用意されているものに限りますので、インストーラを介さず、単に解凍して利用しているアプリケーションは対応不可能ですのであしからずデス。

サンプルは下に張っておきますねー

処理としては
　1.HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall
　をキーとして、その中のサブキーを列挙

　2.同時に、サブキーと"DisplayName"という項目で、「プログラムの追加と削除」で出てくる表示名を取得

　3-1.取得OK:インストール情報を記憶
　3-2.取得NG:無処理《3-1と同様、処理は継続する》

　4.列挙し終えるまで、1に帰る

です

以上

--------------------------------------------------------------------------
Option Explicit

Private Type FILETIME
　dwLowDateTime As Long
　dwHighDateTime As Long
End Type

Private Const DEFSTR_UNINSTALL_REG_SUBKEY_PARENT　　As String = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
Private Const DEFSTR_UNINSTALL_REG_NAME_DISPLAYNAME As String = "DisplayName"

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_DYN_DATA = &H80000006

Private Const MAX_LEN = 2048
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_READ = &H20000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
　　　　　　　　　　　　　 KEY_QUERY_VALUE Or _
　　　　　　　　　　　　　 KEY_ENUMERATE_SUB_KEYS Or _
　　　　　　　　　　　　　 KEY_NOTIFY) And (Not SYNCHRONIZE))

Private Const ERROR_SUCCESS　　　　　　 As Long = 0&

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Sub Test()
　　Dim colWk　 As Collection
　　Dim i　　　 As Long

　　If Not GetAppUnInstDisplay(colWk) Then
　　　　Exit Sub
　　End If

　　For i = 1 To colWk.Count
　　　　Debug.Print colWk(i)
　　Next i
End Sub

'アンインストール情報表示名の取得
Public Function GetAppUnInstDisplay(Optional otCol As Collection) As Boolean
　　Dim lngRet　　　　　As Long
　　Dim lnghReg　　　　 As Long
　　Dim lngIndex　　　　As Long
　　Dim lngLen　　　　　As Long
　　Dim strBuffSubKey　 As String * MAX_LEN
　　Dim FT　　　　　　　As FILETIME
　　Dim strSubKey　　　 As String
　　Dim strDspName　　　As String

　　'返りコレクション初期化
　　Set otCol = New Collection

　　'キーオープン
　　If Not (ERROR_SUCCESS = RegOpenKeyEx(HKEY_LOCAL_MACHINE, DEFSTR_UNINSTALL_REG_SUBKEY_PARENT, 0, KEY_READ, lnghReg)) Then
　　　　'キーオープン失敗なので、強制抜け
　　　　Exit Function
　　End If

　　'インデックス初期化
　　lngIndex = 0
　　Do
　　　　'lngIndex個目のサブキーを取得
　　　　lngLen = Len(strBuffSubKey)
　　　　lngRet = RegEnumKeyEx(lnghReg, lngIndex, strBuffSubKey, lngLen, 0, vbNullString, 0, FT)
　　　　If lngRet = ERROR_SUCCESS Then
　　　　　　'値を取得するサブキーの整理
　　　　　　strSubKey = DEFSTR_UNINSTALL_REG_SUBKEY_PARENT & "\" & BuffArrangement(strBuffSubKey)

　　　　　　'アンインストール表示名称の取得
　　　　　　If GetRegValue(HKEY_LOCAL_MACHINE, strSubKey, DEFSTR_UNINSTALL_REG_NAME_DISPLAYNAME, strDspName) Then
　　　　　　　　'取得できたなら、コレクションに追加
　　　　　　　　otCol.Add strDspName
　　　　　　End If

　　　　　　'インデックスを進める
　　　　　　lngIndex = lngIndex + 1
　　　　End If
　　Loop While lngRet = 0

　　GetAppUnInstDisplay = True
PGMEND:
　　'キークローズ
　　Call RegCloseKey(lnghReg)
End Function

'レジストリ値取得(文字列)
Private Function GetRegValue(ByVal inKey As Long, ByVal inSubKey As String, ByVal inName As String, Optional otValue As String) As Boolean
　　Dim lnghReg　　　　 As Long
　　Dim strBuffValue　　As String * MAX_LEN
　　Dim lngLen　　　　　As Long
　　Dim lngType　　　　 As Long

　　'キーオープン
　　If Not (ERROR_SUCCESS = RegOpenKeyEx(inKey, inSubKey, 0, KEY_QUERY_VALUE, lnghReg)) Then
　　　　Exit Function
　　End If

　　'レジストリ値取得メイン
　　lngLen = Len(strBuffValue)
　　If (ERROR_SUCCESS = RegQueryValueEx(lnghReg, inName, 0, lngType, ByVal strBuffValue, lngLen)) Then
　　　　otValue = BuffArrangement(strBuffValue)
　　　　GetRegValue = (otValue <> "")
　　End If

　　'キークローズ
　　Call RegCloseKey(lnghReg)
End Function

'API独特のバッファNULL文字の消去
Function BuffArrangement(ByVal inBuff As String) As String
　　On Error Resume Next
　　BuffArrangement = Left$(inBuff, InStr(1, inBuff, vbNullChar) - 1)
End Function

お礼

TAGOSAKU7さん、参考ソースはとっても勉強になります(＾＾。
色々教えていただいて有難う御座いますm(_ _)m

まだまだ勉強不足の身ですが、また何かありましたら
宜しくお願いします。