VBSでメーカー向けクエリーサービスを実装

Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}! \\\. \root\cimv2")
Set Services = objWMIService.ExecQuery("Select * from Win32_Service")
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(0)
i = 0
Do
  If objFolder.GetDetailsOf("", i) = "Company" Then 'Non-Chinese system modify itself
    Exit Do
  Else
    i = i+1
  End If
Loop

For Each objService in Services
  path = GetPath(objService.PathName)
  IF fso.GetExtensionName(path) = "" Then path = path & ".exe"
  Set objFolder = objShell.NameSpace(fso.GetParentFolderName(path))
  Set objItem = objFolder.ParseName(fso.GetFileName(path))
  Comp = objFolder.GetDetailsOf(objItem, i)
  If comp = "" Then comp = "unknown"
  info = info & "Service:"& objService.DisplayName &" Manufacturer:"& comp & vbCrLF
Next
fso.CreateTextFile("info.txt", true).WriteLine info
MsgBox "Done"

Function GetPath(strng)
  Dim re
  Set re = New RegExp
  re.Pattern = "^""? (. +\\[^\\\s""]+). *"
  GetPath = re.Replace(strng,"$1")
  Set regEx = Nothing
End Function