Visual Basic WMI System Services
Win32_LogicalProgramGroup: WMI Start Menu Program Groups
Posted:   Wednesday October 30, 2002
Updated:   Monday November 28, 2011
Applies to:   VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   Windows NT, 2000, XP. See Prerequisites below.
Author:   VBnet - Randy Birch




Windows Script Host is built into Microsoft Windows 98, 2000, ME and XP. If you are running Windows 95 or NT4, you can download Windows Script Host from the Microsoft Windows Script Technologies Web site at Some information is not returned on non-NT-based systems.

A reference set in Projects / References to the Microsoft WMI Scripting Library.

The Win32_LogicalProgramGroup WMI class represents a program group in a Windows system, for example, Accessories or Startup. The values returned are for all installed user profiles on the system, including All Users. Information includes the date the start menu program group folder was created .

This demo and illustration shows only some of the available information from the class. For a complete listing see the Comments section below. Note that some information may not be returned on all systems.

 BAS Module Code

 Form Code
To a form add a command button (Command1) and a listbox (List1). Set a reference in Projects / References to the Microsoft WMI Scripting Library, and add the following to the form:

Option Explicit
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
Private Sub Command1_Click()

   Call wmiWin32LogicalProgramGroup
End Sub

Private Sub Form_Load()
   Command1.Caption = "Win32_LogicalProgramGroup"

End Sub

Private Sub wmiWin32LogicalProgramGroup()
   Dim objset  As SWbemObjectSet
   Dim obj     As SWbemObject

   Set objset = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
   On Local Error Resume Next

   For Each obj In objset

      With List1
         .AddItem "UserName: " & obj.UserName
         .AddItem "GroupName: " & obj.GroupName
         .AddItem "InstallDate: " & ConvertDate(obj.InstallDate)
         .AddItem ""
      End With
End Sub

Private Function ConvertDate(dtb) As String

   Dim d As String
   Dim t As String
   Dim bias As Long
   If Not IsNull(dtb) Then
      bias = SplitDateTimeBias(CStr(dtb), d, t)
      ConvertDate = Format$(d, "dddd mmm d, yyyy") & " at " & _
                    Format$(t, "hh:mm:ss")
      ConvertDate = "(date returned null)"
   End If
End Function

Private Function SplitDateTimeBias(leasedate As String, _
                                   leasedatepart As String, _
                                   leasetimepart As String) As Long

  'takes a datetime returned
  'and splits out the date and time
  'components, returns them in the
  'leasedatepart and leasetimepart
  'passed variables, and returns the
  'bias to be applied to the resultant date.
   Dim pos     As Long
   Dim bias    As Long
   pos = InStr(leasedate, ".")

   If pos > 0 Then

      bias = StripTimeZoneBias(leasedate)
      leasedatepart = Left$(leasedate, 8)
      leasetimepart = Mid$(leasedate, 9, pos - Len(leasedatepart) - 1)
      leasedatepart = InsertInString(leasedatepart, "-", 5, "")
      leasedatepart = InsertInString(leasedatepart, "-", 8, "")
      leasetimepart = InsertInString(leasetimepart, ":", 3, "")
      leasetimepart = InsertInString(leasetimepart, ":", 6, "")
      SplitDateTimeBias = bias


   End If

End Function

Private Function StripTimeZoneBias(leasedate As String) As Long

   Dim pos As Long
   Dim tmp As String
   pos = InStr(leasedate, "-")
   If pos = 0 Then
      pos = InStr(leasedate, "+")
      If pos = 0 Then
         StripTimeZoneBias = 0
      End If
      tmp = Mid$(leasedate, pos, Len(leasedate))
      leasedate = Mid$(leasedate, 1, pos - 1)
      StripTimeZoneBias = CLng(tmp)
   End If
End Function

Private Function InsertInString(ByVal sOriginal As String, _
                                sReplace As String, _
                                nField As Long, _
                                sDelimeter As String) As String
   'c 1998 Mario Lavignasse
   'Abbott Scientific
   'Replaces or inserts a string into a (any char) delimeted string
   'sOriginal:  string of interest, returned unchanged
   'sReplace:   replacement or insert chr(s)
   'nField:     1-based position for the insert/replace to begin
   'sDelimeter: string to insert/replace. If empty, sReplace is
   '            inserted, if present sDelimeter is replaced by sReplace.
   ' x = InsertInString("Hello World", "Hello ", 7, "")
   '  (x="Hello Hello World")
   ' x = InsertInString("Hello World", "Hello ", 7, "World")
   '   (x="Hello Hello")
   Dim lnCount As Long
   Dim lnStart As Long
   Dim lnLast As Long
   Do While InStr(lnStart + 1, sOriginal, sDelimeter) > 0
      lnStart = InStr(lnStart + 1, sOriginal, sDelimeter)
      lnCount = lnCount + 1
      If lnCount >= nField Then
         Exit Do
      End If
      lnLast = lnStart
   Select Case lnCount
      Case 1
         InsertInString = sReplace & Mid$(sOriginal, lnStart)
      Case Is >= nField
         InsertInString = Mid$(sOriginal, 1, lnLast) & _
                               sReplace & Mid$(sOriginal, lnStart)
      Case Else
         InsertInString = sOriginal & _
                          String$((nField - 1) - lnCount, sDelimeter) & _
   End Select
End Function
All information returned in the Win32_LogicalProgramGroup class (note that some systems may not return information in all class properties):
string Caption;
string Description;
string GroupName;
datetime InstallDate;
string Name;
string Status;
string UserName;


PayPal Link
Make payments with PayPal - it's fast, free and secure!


Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy


Hit Counter