| 
        
         
         
         		
         		         		Win32_LogicalProgramGroupItem class represents 
                an element contained by a Win32_ProgramGroup instance, that is 
                not itself another Win32_ProgramGroup instance. In other words, 
                this lists the files under the groups, not the groups (folders) 
                themselves. 
          
         
         		
                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. 
          
       | 
   
   
      
         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 wmiWin32LogicalProgramGroupItem
   
End Sub
Private Sub Form_Load()
   
   Command1.Caption = "Win32_LogicalProgramGroupItem"
End Sub
Private Sub wmiWin32LogicalProgramGroupItem()
      
   Dim objset  As SWbemObjectSet
   Dim obj     As SWbemObject
   Set objset = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
                                     InstancesOf("Win32_LogicalProgramGroupItem")
   
   On Local Error Resume Next
   For Each obj In objset
      With List1
         .AddItem "Name: " & obj.Name
         .AddItem "InstallDate: " & ConvertDate(obj.InstallDate)
         .AddItem ""
      End With
        
   Next
      
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")
   
   Else
   
      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
   Else
   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
      Else
      
      End If
      
   Else
   
      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
   '
   'Syntax:
   '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.
   '
   'Examples:
   'Inserting:
   ' x = InsertInString("Hello World", "Hello ", 7, "")
   '  (x="Hello Hello World")
   '
   'Replacing:
   ' 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
        
   Loop
    
   
   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) & _
                          sReplace
   End Select
    
End Function |