WindowsPropertySystemの値のVBAでの取得につきまして への返答

投稿で使用できる特殊コードの説明。(別タブで開きます。)
本名は入力しないようにしましょう。
投稿した後で削除するときに使うパスワードです。返答があった後は削除できません。
返答する人が目安にします。相手が小学生か社会人かで返答の仕方も変わります。
最初の投稿が質問の場合、質問者が解決時にチェックしてください。(以降も追加書き込み・返信は可能です。)
※「過去ログ」について書くときはその過去ログのURLも書いてください。

以下の返答は逆順(新しい順)に並んでいます。

投稿者 snowmansnow  (社会人) 投稿日時 2021/6/24 19:18:30
こんばんは、魔界の仮面弁士様
最新のSDKも入れてみました。

'https://espresso3389.hatenablog.com/entry/20081119/1227104742
さんとか
'https://potisan-programming-memo.hatenablog.jp/entry/2021/03/09/010950
さんを見て、
自分でも全取得が出来たらいいなと思いましたが、
C++はよく分かりません。
魔界の仮面弁士様に教えて頂いたpropkey.hを使えるようにした方が私らしいと思い、
加工するコードを作ってみました。
ExcelVBAです。
Sub main()

'https://kinuasa.wordpress.com/2011/04/07/%E3%83%89%E3%83%A9%E3%83%83%E3%82%B0%E3%81%95%E3%82%8C%E3%81%9F%E3%83%9E%E3%83%8D%E3%83%BC%E3%82%B8%E3%83%89dll%E3%82%92regasm%E3%81%A7%E7%99%BB%E9%8C%B2%E3%81%99%E3%82%8B%E3%82%B9%E3%82%AF%E3%83%AA/ 

Dim FSOM As Object

Dim PropKeyFilePath As String

Dim myFolder As Folder

Dim TFile As String

Dim VersionN As String

Dim i As Long



Const TFolder = "C:\〇×\"

Const FN = "Propkey"



TFile = TFolder & FN



Const SDKFolderPath = "C:\Program Files (x86)\Windows Kits\10\Include\"

Const Prop = "\um\propkey.h"



Set FSOM = CreateObject("Scripting.FileSystemObject")



 i = 0

  

 If (FSOM.FolderExists(SDKFolderPath) <> True) Then

  MsgBox "Win10SDKフォルダが見つかりませんでした。" & vbCrLf & _

         "処理を中止します。", 16, MsgTitle

  Exit Sub

 Else

  If (FSOM.FolderExists(TFolder) <> True) Then

   MsgBox FN & "ファイルを保存するフォルダが見つかりませんでした。" & vbCrLf & _

         "処理を中止します。", 16, MsgTitle

   Exit Sub

  Else

  

  For Each f In FSOM.GetFolder(SDKFolderPath).SubFolders



    'https://excelwork.info/excel/fsoparentfolder/ 

    VersionN = "(" & Replace(FSOM.GetFolder(f.Path & "\um").ParentFolder.Name, ".", "_") & ")"



    PropKeyFilePath = f.Path & Prop

    

  Call READWRITE_TextFile4(PropKeyFilePath, TFile & VersionN & ".TXT")



 i = i + 1

 

 Next



 End If

End If



End Sub



Sub READWRITE_TextFile4(FILENAME As String, FILENAMEW As String)

'http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110.html 

'http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_040.html 



    Dim FSO As New FileSystemObject

    Dim TS As TextStream

    Dim strREC As String



    Dim FSOW As New FileSystemObject

    Dim TSW As TextStream



    Set TSW = FSOW.CreateTextFile( _

        FILENAME:=FILENAMEW, _

        Overwrite:=True)

    

    Set TS = FSO.OpenTextFile(FILENAME, ForReading)

    

    Do Until TS.AtEndOfStream

        

        strREC = TS.ReadLine

        

        If Left(strREC, 9) = "//  Name:" Then

           c = c + 1

           topCName0 = Mid(strREC, 15, 300)

           topCName = Left(topCName0, InStr(topCName0, " ") - 1)

        Else

        End If

        

        If Left(strREC, 13) = "//  FormatID:" Then

          If InStr(strREC, "}") > InStr(strREC, "{") Then

    '       topFormatID = Mid(strREC, InStr(strREC, "{"), InStr(strREC, "}") - InStr(strREC, "{") + 1) 

           topFormatID = Mid(strREC, InStr(strREC, "{"), 300)

          Else

           topFormatID = "error"

          End If

          TSW.WriteLine c & "," & topFormatID & "," & topCName

        Else

        End If

         

    Loop

    

    TS.Close

    Set TS = Nothing

    Set FSO = Nothing

    TSW.Close

    Set TSW = Nothing

    Set FSOW = Nothing

End Sub


魔界の仮面弁士様の説明もわかりやすくなりました。
でも
'https://espresso3389.hatenablog.com/entry/20081119/1227104742
さんの仰ってる、「Canonical Nameが無いもの」の存在が確認できず、
何でなのかな？と思いました。
Display Nameは、先のクラスライブラリで取得しますので、
SDKをインストールし続ければ、最新のプロパティを取得できるのでは？
と思いますので、大変ありがとうございました。
また宜しくお願いします。

0
投稿者 snowmansnow  (社会人) 投稿日時 2021/6/21 21:43:25
こんばんは、魔界の仮面弁士様。
忙しい中、お返事ありがとうございます。
詳しい説明ありがとうございます。
私のバージョンは、10.0.19041.0だったようで、
書いて下さった通り１０３５個でした。
でも、当初の１０１７個と比べて、
System.Devices.AepService.Bluetooth.GattService.CacheMode
System.Devices.AepService.Bluetooth.GattService.Device
System.Devices.AepService.Bluetooth.RfcommService.CacheMode
System.Devices.AepService.Bluetooth.RfcommService.Device
の４個がpropkey.hに無くて、
魔界の仮面弁士様の追加１９個と比べて
System.StorageProviderFileFlags
System.LastSyncWarning
System.Devices.Aep.Bluetooth.LastSeenTime
System.Devices.SchematicName
の４個が多く、
魔界の仮面弁士様の追加の中にある、
System.StorageProviderFileHasConflict
１個が見当たりませんでした。（これは最新SDKでないからかも）

SDKも自分で入れたりしてるのですが、
魔界の仮面弁士様の、最新の、
windows 10 SDK v2104 … 1036 個 (10.0.20348.0)などは、
自分で毎回インストールしないと、更新しないものでしょうか？
propkey.hが見当たらない環境での確認方法は無いでしょうか？

昨日のクラスライブラリのDisplayNameをCanonicalNameにしたクラスライブラリでは
System.Search.ExtendedProperties
System.EdgeGesture.DisableTouchWhenFullscreen
System.Devices.AepService.Bluetooth.GattService.CacheMode
System.Devices.AepService.Bluetooth.GattService.Device
System.Devices.AepService.Bluetooth.RfcommService.CacheMode
System.Devices.AepService.Bluetooth.RfcommService.Device
System.StorageProviderFileHasConflict
がキャノニカルネームで認識されませんでした。

ディスプレイネームは、
System.AppUserModel.VisualElementsManifestHintPath
が増えて５１６個になりました。

for each in～　などで、全部取り出すやり方は、無いのでしょうか？

windows searchの方は
Sub DS2()

On Error Resume Next

Dim objConnection As Connection

Dim objRecordSet As Recordset

Dim ws As Worksheet



Set objConnection = CreateObject("ADODB.Connection")



Dim s(30)



s(0) = "System.FileName"

s(1) = "System.Address.Country"

s(2) = "System.Address.CountryCode"

s(3) = "System.Address.Region"

s(4) = "System.Address.RegionCode"

s(5) = "System.Address.Town"

s(6) = "System.ContentId"

s(7) = "System.ContentUri"

s(8) = "System.Devices.AudioDevice.Microphone.SensitivityInDbfs2"

s(9) = "System.Devices.Panel.PanelGroup"

s(10) = "System.Devices.Panel.PanelId"

s(11) = "System.Supplemental.Album"

s(12) = "System.Supplemental.Location"

s(13) = "System.Supplemental.Person"

s(14) = "System.Supplemental.Tag"

s(15) = "System.AppUserModel.VisualElementsManifestHintPath"

s(16) = "System.Devices.AudioDevice.Microphone.IsFarField"

s(17) = "System.Devices.PhoneLineTransportDevice.Connected"

s(18) = "System.Devices.ChallengeAep"

s(19) = "System.StorageProviderFileFlags"

s(20) = "System.LastSyncWarning"

s(21) = "System.Devices.Aep.Bluetooth.LastSeenTime"

s(22) = "System.Devices.SchematicName"

s(23) = "System.StorageProviderFileHasConflict"



Set objRecordSet = CreateObject("ADODB.Recordset")



objConnection.Open "Provider=Search.CollatorDSO;Extended Properties='Application=Windows';"



For i = 1 To 23



sql1 = "SELECT "

sql1 = sql1 & s(0) & "," & s(i)

 

sql1 = sql1 & " FROM SystemIndex "



objRecordSet.Open sql1, objConnection



Worksheets(1).Select

Worksheets.Add

Set ws = Worksheets(1)



With ws

.Cells(1, 1).Value = s(0)

.Cells(1, 2).Value = s(i)

.Range("A2").CopyFromRecordset objRecordSet

.Name = i

End With



objRecordSet.Close

Next

Set objRecordSet = Nothing



objConnection.Close

Set objConnection = Nothing

End Sub

で、SystemIndex内の存在を追加で確認できました。
できれば、動的に確認したいです。



0
投稿者 魔界の仮面弁士  (社会人) 投稿日時 2021/6/21 01:12:51
> ダウンロードできて確認できるｐｄｆの日付は２０１８年になっています。
> 今２０２１年現在、システムプロパティが、１０１７個なのか確認したり、

1036 個が最新だと思います。これはおそらく Windows Server 2022 [21H2] 世代。
1017 個は、Win10 Fall Creators Update (v1709) 世代のものだと思います。

Windows 10 SDK v1501 …  971 個 (10.0.10240.0)
Windows 10 SDK v1511 …  995 個 (10.0.10586.0～10.0.10586.212)
Windows 10 SDK v1607 … 1008 個 (10.0.14393.0～10.0.14393.795)
Windows 10 SDK v1703 … 1013 個 (10.0.15063.0～10.0.15063.468)
Windows 10 SDK v1709 … 1017 個 (10.0.16299.0～10.0.16299.91)
Windows 10 SDK v1803 … 1025 個 (10.0.17134.0～10.0.17134.12)
Windows 10 SDK v1809 … 1032 個 (10.0.17763.0)
Windows 10 SDK v1903 … 1034 個 (10.0.18362.0～10.0.18362.1)
Windows 10 SDK v2004 … 1035 個 (10.0.19041.0～10.0.19041.1)
Windows 10 SDK v2104 … 1036 個 (10.0.20348.0)


1709 → 1803 で追加された 8 個
System.Address.Country

System.Address.CountryCode

System.Address.Region

System.Address.RegionCode

System.Address.Town

System.ContentId

System.ContentUri

System.Devices.AudioDevice.Microphone.SensitivityInDbfs2


1803 → 1809 で追加された 7 個
System.Devices.Panel.PanelGroup

System.Devices.Panel.PanelId

System.Supplemental.Album

System.Supplemental.Location

System.Supplemental.Person

System.Supplemental.Tag

System.AppUserModel.VisualElementsManifestHintPath


1809 → 1903 で追加された 2 個
System.Devices.AudioDevice.Microphone.IsFarField

System.Devices.PhoneLineTransportDevice.Connected


1903 → 2004 で追加された 1 個
System.Devices.ChallengeAep


2004 → 2104 で追加された 1 個
System.StorageProviderFileHasConflict


Visual Studio をお持ちなら、下記を読んでみると良いかと思います。
C:\Program Files (x86)\Windows Kits\10\Include\バージョン\um\propkey.h

見当たらない場合は、Visual Studio Installer から追加セットアップするか、
下記の Windows SDK をインストールします。
https://developer.microsoft.com/en-us/windows/downloads/sdk-archive/
0
投稿者 snowmansnow  (社会人) 投稿日時 2021/6/19 17:53:22
こんにちは、るきお様、魔界の仮面弁士様、皆様

windows searchで、システムプロパティやディスプレイネームを使って検索できるので、
システムプロパティやディスプレイネームを勉強しています


https://docs.microsoft.com/en-us/windows/win32/properties/windows-properties-system（※１）
では、システムプロパティは、１０１７ある事になっていますが、
ダウンロードできて確認できるｐｄｆの日付は２０１８年になっています。
今２０２１年現在、システムプロパティが、１０１７個なのか確認したり、
その全部のシステムプロパティのキャノニカルネームをVBAで動的に確認する方法はありますか？

https://www.codeproject.com/Articles/1156123/The-Windows-Property-System（※２）を参考に、
１０１７のシステムプロパティのディスプレイネームを取得するクラスライブラリを作りましたが、
取得エラーがあり、可能なディスプレイネームを取得できているのかも疑問です。（５１５個）


下記が、C#で作った、ウィンドウズフォーム、クラスライブラリです。
Windows10pro 64bit Excel2016 32bit

※２のWebからDLできるC#のソースをビルドしてできるDLLを参照しています。
VS2019で作りました

using System;

using System.Runtime.InteropServices;

using WinProps;



namespace WindowsFormsAppWPSCS

{

    [Guid(WPSCL.ClassId)]

    public class WPSCL

    {

        //  COM用のGUID値

        public const string ClassId = "3096DBAE-74E9-4636-B1DE-3E2EF9A0BF1C";



        string rvalue;



        public string GetDisplayNameFromCName(string cName)

        {

            PropertyDescription test1 = new PropertyDescription(cName);

            rvalue = cName + "," + test1.DisplayName;

            return rvalue;

        }

    }

}


できれば、ディスプレイネームもをVBAで動的に確認する方法があると嬉しいです。

よろしくお願いします。


0