|
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.
|
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}"). _
InstancesOf("Win32_LogicalProgramGroup")
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
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 |
