COM Programming Adventure

[Robert]

Here's the same code I wrote but refactored to use COM()/UNCOM()

Code Select Expand

Dim as Object oWMILocator,oServer,oCollection
Dim tmp$

set oWMILocator = COM("WbemScripting.SWBemLocator")

set oServer = oWMILocator.ConnectServer(".", "root\cimv2")

set oCollection = oServer.InstancesOf("Win32_OperatingSystem")

For Each oItem in oCollection
    tmp$ = oItem.Caption
    print "OS Name: ",tmp$
    tmp$ = oItem.Version
    print "OS Version: ",tmp$
    tmp$ = oItem.InstallDate
    print "Install Date: ", fixDateString(tmp$)
Next

UnCom(oWMILocator)
Pause

Function fixDateString(szDate As string) As string
    Dim As string szYear,szMonth, szDay, szNewDate
    szYear = Mid$(szDate,1,4)
    szMonth = Mid$(szDate,5,2)
    szDay = Mid$(szDate,7,2)
   
    Sprint szNewDate, szYear, "-", szMonth, "-", szDay
    Return szNewDate

End Function
AIR.

There are memory leaks in the above code, originally posted at

https://bcxbasiccoders.com/smf/index.php?topic=1028.msg5272#msg5272

Check SET Nothing statement!
Unreleased objects:2

To correct this problem,

Code Select Expand

UNCOM(oCollection)
UNCOM(oServer)

should be prepended to

Code Select Expand

UnCom(oWMILocator)


[airr]

Thanks for testing, MrB!

I commented out the VRAM because it's having an issue with retrieving the amount of ram for an NVIDIA card I have on my work machine.

AIR.

[MrBcx]

I also added vid_Ram to the PRINT section. 

My PC uses integrated gfx, so no dedicated VRAM -- RAM is dynamically allocated from system RAM, as needed.


System information for \\KEVIN:

Uptime: 2 Day(s), 10 Hours, 14 Minutes, 17 Seconds
OS Name: Microsoft Windows 10 Pro
OS Version: 10.0.19045
OS Build: 19045
OS Installed: 2020-06-30
Registered Org:
Registered Owner: owner
System Architecture: 64-bit
System Root: C:\Windows
Total System Memory:  16GB
CPU Model: Intel(R) Core(TM) i7-10700K CPU @ 3.80GHz
CPU Cores: 8
CPU Threads: 16
CPU Speed:  3.792Ghz
Video Card: Intel(R) UHD Graphics 630
Video Driver Version: 31.0.101.2114
Video RAM:  1024 MB

Press any key to continue . . .

[airr]

Added the Video Card info.

Make these changes:

Add this to the struct

Code Select Expand

    vid_Model as string
    vid_Ram as string
    vid_DriverVersion as string

Add this function call before the UNCOM() call:

Code Select Expand

getGpuInfo(oServer, &comp)

Add this to the Print section:

Code Select Expand

Print "Video Card: ",           comp.vid_Model
Print "Video Driver Version: ", comp.vid_DriverVersion

Finally, add this function:

Code Select Expand

Sub getGpuInfo(server as object, me as LPCOMPUTER)
    Dim as Object oCollection
    Dim as string szModel, szRam, szDriverVersion, szActive
   
    ComSet oCollection = oServer.InstancesOf("Win32_VideoController")
   
    For Each oItem in oCollection
        szActive = oItem.CurrentScanMode
        If NotNull(Trim$(szActive)) Then
            szModel = oItem.Caption
            szRam = oItem.AdapterRAM
            szDriverVersion = oItem.DriverVersion
        End If   
    Next
   
    With me
        Sprint .vid_Model, szModel
        'Sprint .vid_Ram, CInt(Val(szRam)) / 1048576," MB"
        Sprint .vid_DriverVersion, szDriverVersion
    End With

End Sub


Screenshot from my old Thinkpad attached.

AIR.

[MrBcx]

AIR -- thanks for the very nice bit of code. 

(tip)  I changed SET to its alias COMSET, so that I could reformat the code to my liking in BED.

I also noticed that you got yourself a killer machine this year.  FUN!

[airr]

Further Adventures:

I wanted to try replicating the PSInfo64 application from SysInternals, which also has the issue where it does not correctly identify the OS version that I mentioned earlier.

Here is my initial attempt, using COM except for the Uptime function:

Code Select Expand


Type Computer
    ComputerName as String
    os_Name as String
    os_version as String
    os_Build as string
    os_Installed as String
    os_RegOrg as string
    os_RegOwner as string
    cpu_ProcessorName as String
    cpu_Cores as String
    cpu_Speed as String
    cpu_Threads as String
    sys_Root as String
    sys_Memory as string
    sys_Arch as string
    sys_Uptime as string
End Type

dim comp as Computer
Dim as Object oWMILocator,oServer

set oWMILocator = COM("WbemScripting.SWBemLocator")
set oServer = oWMILocator.ConnectServer(".", "root\cimv2")

getSysInfo(oServer, &comp)
getProcessorInfo(oServer, &comp)

UNCOM(oWMILocator)

Print "System information for \\", comp.ComputerName,E":\n"
Print "Uptime: ",               comp.sys_Uptime
Print "OS Name: ",              comp.os_Name
Print "OS Version: ",           comp.os_version
Print "OS Build: ",             comp.os_Build
Print "OS Installed: ",         comp.os_Installed
Print "Registered Org: ",       comp.os_RegOrg
Print "Registered Owner: ",     comp.os_RegOwner
Print "System Architecture: ",  comp.sys_Arch
Print "System Root: ",          comp.sys_Root
Print "Total System Memory: ",  comp.sys_Memory
Print "CPU Model: ",            comp.cpu_ProcessorName
Print "CPU Cores: ",            comp.cpu_Cores
Print "CPU Threads: ",          comp.cpu_Threads
Print "CPU Speed: ",            comp.cpu_Speed



pause

sub getProcessorInfo(server as object, me as LPCOMPUTER)
    Dim as Object oCollection
    dim as string szComputerName, szProcessorName, szNumberOfCores, szThreads, szSpeed
    dim as string szVirtualization
   
    set oCollection = oServer.InstancesOf("Win32_Processor")
   
    for each oItem in oCollection
        szComputerName = oItem.SystemName
        szProcessorName = oItem.Name
        szNumberOfCores = oItem.NumberOfCores
        szSpeed = oItem.MaxClockSpeed
        szThreads = oItem.ThreadCount
    next
   
    With me
        sprint .ComputerName, szComputerName
        sprint .cpu_ProcessorName, szProcessorName
        sprint .cpu_Cores, szNumberOfCores
        sprint .cpu_Threads, szThreads
        sprint .cpu_Speed, round(val(szSpeed) / 1000,3),"Ghz"
    End With
End Sub

Sub getSysInfo(server as object, me as LPCOMPUTER)
    Dim as Object oCollection
    Dim as string szName, szVersion, szInstallDate, szBuild
    Dim as String szMemory, szRegOrg, szRegUser, szSystemRoot
    dim as String szLocalTime, szBootTime, szArch
   
    set oCollection = oServer.InstancesOf("Win32_OperatingSystem")
   
    For Each oItem in oCollection
        szName = oItem.Caption
        szVersion = oItem.Version
        szInstallDate = oItem.InstallDate
        szBuild = oItem.BuildNumber
        szArch = oItem.OSArchitecture
        szMemory = oItem.TotalVisibleMemorySize
        szRegOrg = oItem.Organization
        szRegUser = oItem.RegisteredUser
        szSystemRoot = oItem.WindowsDirectory
        szLocalTime = oItem.LocalDateTime
        szBootTime = oItem.LastBootupTime
    Next
   
    With me
        sprint .os_Name, szName
        sprint .os_version, szVersion
        sprint .os_Installed, fixDateString(szInstallDate)
        sprint .os_Build, szBuild
        sprint .os_RegOrg, szRegOrg
        sprint .os_RegOwner, szRegUser
        sprint .sys_Root, szSystemRoot
        sprint .sys_Arch, szArch
        sprint .sys_Memory, (int)Val(szMemory) / 1000000,"GB"
        sprint .sys_Uptime, getUptime$()
    End With


End Sub

Function fixDateString(szDate As string) As string
    Dim As string szYear,szMonth, szDay, szNewDate
    szYear = Mid$(szDate,1,4)
    szMonth = Mid$(szDate,5,2)
    szDay = Mid$(szDate,7,2)
   
    Sprint szNewDate, szYear, "-", szMonth, "-", szDay
    Return szNewDate

End Function

FUNCTION getUptime$()
    DIM STATIC tmp$
    DIM tc AS ULONGLONG
    DIM days%, hours%, minutes%, seconds%

    tc = GetTickCount64()

    seconds% = IMOD((tc / 1000), 60)
    minutes% = IMOD((tc / 1000 / 60), 60)
    hours% =   IMOD((tc / 1000 / 60 / 60), 24 )
    days% =    IMOD((tc / 1000 / 60 / 60 / 24), 7)

    SPRINT tmp, days%, " Day(s),", hours%, " Hours,", minutes%, " Minutes,", seconds%, " Seconds"

    FUNCTION = TRIM$(tmp)

END FUNCTION


Below is a screenshot with both apps running side-by-side.  Mine is on the left.

AIR.

[Robert]

Here's the same code I wrote but refactored to use COM()/UNCOM()

Code Select Expand


Dim as Object oWMILocator,oServer,oCollection
Dim tmp$

set oWMILocator = COM("WbemScripting.SWBemLocator")

set oServer = oWMILocator.ConnectServer(".", "root\cimv2")

set oCollection = oServer.InstancesOf("Win32_OperatingSystem")

For Each oItem in oCollection
    tmp$ = oItem.Caption
    print "OS Name: ",tmp$
    tmp$ = oItem.Version
    print "OS Version: ",tmp$
    tmp$ = oItem.InstallDate
    print "Install Date: ", fixDateString(tmp$)
Next

UnCom(oWMILocator)
Pause

Function fixDateString(szDate As string) As string
    Dim As string szYear,szMonth, szDay, szNewDate
    szYear = Mid$(szDate,1,4)
    szMonth = Mid$(szDate,5,2)
    szDay = Mid$(szDate,7,2)
   
    Sprint szNewDate, szYear, "-", szMonth, "-", szDay
    Return szNewDate

End Function

AIR.

" ... you might want to use SWbemLocator to connect to WMI if you find the WMI connection string used with GetObject confusing or difficult."

quoted from

https://learn.microsoft.com/en-us/windows/win32/wmisdk/swbemlocator

Thanks AIR, for the very informative, good, lesson.

[airr]

Here's the same code I wrote but refactored to use COM()/UNCOM()

Code Select Expand


Dim as Object oWMILocator,oServer,oCollection
Dim tmp$

set oWMILocator = COM("WbemScripting.SWBemLocator")

set oServer = oWMILocator.ConnectServer(".", "root\cimv2")

set oCollection = oServer.InstancesOf("Win32_OperatingSystem")

For Each oItem in oCollection
    tmp$ = oItem.Caption
    print "OS Name: ",tmp$
    tmp$ = oItem.Version
    print "OS Version: ",tmp$
    tmp$ = oItem.InstallDate
    print "Install Date: ", fixDateString(tmp$)
Next

UnCom(oWMILocator)
Pause

Function fixDateString(szDate As string) As string
    Dim As string szYear,szMonth, szDay, szNewDate
    szYear = Mid$(szDate,1,4)
    szMonth = Mid$(szDate,5,2)
    szDay = Mid$(szDate,7,2)
   
    Sprint szNewDate, szYear, "-", szMonth, "-", szDay
    Return szNewDate

End Function

AIR.

[MrBcx]

Here's a small code I wrote 15+ years ago that uses GetObject to open a chart created inside a MS Access file.

Sorry ...  chart.mdb is long gone but you get the idea.

Code Select Expand



CONST MyDB$ = "c:\temp\chart.mdb"

DIM oConn   as OBJECT
DIM MyDoCmd as OBJECT

SET oConn = GetObject(MyDB$)

oConn.Visible = TRUE

Set MyDoCmd = oConn.DoCmd

MyDoCmd.OpenForm "Chart", 2    '1=design, 0=normal, 2=preview

MyDoCmd.Visible = TRUE

MyDoCmd.close
oConn.close

SET MyDoCmd = Nothing
SET oConn   = Nothing



[MrBcx]

Here's one by the master himself (Ljubisa Knezevic). 
It compiles with Pelles using BED and runs perfectly.
And it uses GetObject.

BCX translates GetObject to this prototype:

void  BCX_GetObject   (TCHAR *objname, OBJECT *obj);

which is emitted along with its associated runtime function and support.

Hope that helps ...

Code Select Expand


' Requirements Windows ME and up.
' More details at: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wmisdk/wmi/system_requirements.asp
' Demo by Ljubisa Knezevic
BCX_SHOW_COM_ERRORS(TRUE)
CLS

Dim strComputer$
Dim temp_str$
Dim objWMIService as Object
Dim colItems as Object

strComputer$ = "."
'strComputer$ = "aop55"
temp_str$ = "winmgmts:\\" & strComputer & "\root\cimv2"
Set objWMIService = GetObject(temp_str$)
Call PrintProcessorInfo()
Call PrintSysInfo()
Call PrintBiosInfo()
Call PrintVideoInfo()
Call PrintOpSysInfo()
Call PrintDiskInfo()
Call PrintNetworkInfo()
Print "*****************************************************"



Set objWMIService = Nothing

print " "
print "demo finished! Press any key to exit ..."
KEYPRESS

' -------------------------------------------------------------------------------------------------

Sub PrintProcessorInfo()
  Print " "
  Print "*****************************************************"
  PrintItem("System Info: ", "Processors", 14, 0)
  Print "*****************************************************"
  Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
  For Each objItem in colItems 
    temp_str$ = objItem.Name
    PrintItem("Processor Name : ", trim$(temp_str$), 14,0)
    temp_str$ = objItem.DeviceID
    PrintItem("Processor ID: ", trim$(temp_str$), 14,0)
    temp_str$ = objItem.CurrentClockSpeed
    PrintItem("Current Clock Speed: ", trim$(temp_str$) + " MHz", 14,0)
    temp_str$ = objItem.MaxClockSpeed
    PrintItem("Maximum Clock Speed: ", trim$(temp_str$) + " MHz", 14,0)
    temp_str$ = objItem.L2CacheSize
    PrintItem("L2 Cache Size: ", trim$(temp_str$), 14,0)
    temp_str$ = objItem.Family
    PrintItem("Processor Family: ", trim$(temp_str$), 14,0)
  Next
  Set colItems = Nothing
End Sub

' -------------------------------------------------------------------------------------------------

Sub PrintSysInfo()
  Print " "
  Print "*****************************************************"
  PrintItem("System Info: ", "General", 11, 0)
  Print "*****************************************************"
  Dim temp_lng as LONG
  Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
  For Each objItem in colItems 
    temp_str$ = objItem.Name
    PrintItem("Name: ", trim$(temp_str$), 11,0)
    temp_str$ = objItem.manufacturer
    PrintItem("Manufacturer: ", trim$(temp_str$), 11,0)
    temp_str$ = objItem.model
    PrintItem("Model: ", trim$(temp_str$), 11,0)
    temp_lng = (VT_R4)objItem.TotalPhysicalMemory 
    temp_lng = temp_lng / 1024 ' GET SIZE IN MB
        temp_str$ = str$(temp_lng) + " KB"
    PrintItem("Total Physical Memory: ", trim$(temp_str$), 11,0)
    temp_str$ = objItem.NumberOfProcessors
    PrintItem("Number Of Processors: ", trim$(temp_str$), 11,0)
  Next
  Set colItems = Nothing
End Sub

' -------------------------------------------------------------------------------------------------

Sub PrintBiosInfo()
  Print " "
  Print "*****************************************************"
  PrintItem("System Info: ", "BIOS", 12, 0)
  Print "*****************************************************"
  Set colItems = objWMIService.ExecQuery("Select * from Win32_bios")
  For Each objItem in colItems 
    temp_str$ = objItem.SerialNumber
    PrintItem("BIOS Serial Number: ", trim$(temp_str$), 12,0)
    temp_str$ = objItem.SMBIOSBIOSVersion
    PrintItem("SMBIOS Version: ", trim$(temp_str$), 12,0)
    temp_str$ = objItem.Version   
    PrintItem("BIOS Version: ", trim$(temp_str$), 12,0)
  Next
  Set colItems = Nothing
End Sub

' -------------------------------------------------------------------------------------------------

Sub PrintVideoInfo()
  Print " "
  Print "*****************************************************"
  PrintItem("System Info: ", "Video Controller", 13, 0)
  Print "*****************************************************"
  Set colItems = objWMIService.ExecQuery("Select * from Win32_VideoController")
  For Each objItem in colItems 
    temp_str$ = objItem.Description
    PrintItem("Video Controller Name: ", trim$(temp_str$), 13,0)
    temp_str$ = objItem.VideoModeDescription
    PrintItem("Video Controller Mode: ", trim$(temp_str$), 13,0)
  Next
  Set colItems = Nothing
End Sub

' -------------------------------------------------------------------------------------------------

Sub PrintOpSysInfo()
  Print " "
  Print "*****************************************************"
  PrintItem("System Info: ", "Operating System", 10, 0)
  Print "*****************************************************"
  Dim temp_lng as LONG
  Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
  For Each objItem in colItems 
    temp_str$ = objItem.Caption
    PrintItem("Operating System: ", trim$(temp_str$), 10,0)
    temp_str$ = objItem.Version
    PrintItem("Version: ", trim$(temp_str$), 10,0)
  Next
  Set colItems = Nothing
End Sub

' -------------------------------------------------------------------------------------------------

Sub PrintDiskInfo()
  Print " "
  Print "*****************************************************"
  PrintItem("System Info: ", "Disk Drives", 15, 0)
  Print "*****************************************************"
  Dim temp_dw as DWORD
  Set colItems = objWMIService.ExecQuery("Select * From Win32_DiskDrive")
  For Each objItem in colItems 
    Print "+++++++++++++++++++++++++++++++++++++++++++++++++++++"
    temp_str$ = objItem.DeviceID
    PrintItem("Device ID: ", trim$(temp_str$), 15,0)
    temp_dw = (VT_R8)objItem.size
    'temp_dw = temp_dw
    temp_str$ = STR$(temp_dw)
    PrintItem("Size: ", trim$(temp_str$), 15,0)
    temp_str$ = objItem.Manufacturer
    PrintItem("Manufacturer: ", trim$(temp_str$), 15,0)
    temp_str$ = objItem.model
    PrintItem("Model: ", trim$(temp_str$), 15,0)
    Print "+++++++++++++++++++++++++++++++++++++++++++++++++++++"
  Next
  Set colItems = Nothing
End Sub

' -------------------------------------------------------------------------------------------------

Sub PrintNetworkInfo()
  Print " "
  Print "*****************************************************"
  PrintItem("System Info: ", "Network Adapter", 9, 0)
  Print "*****************************************************"
  Dim temp_dw as DWORD
  Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapter")
  For Each objItem in colItems 
    temp_str$ = objItem.ProductName
    PrintItem("Network Adapter: ", trim$(temp_str$), 9,0)
  Next
  Set colItems = Nothing
End Sub

' -------------------------------------------------------------------------------------------------

Sub PrintItem(Desc$, value$, color1%, color2%)
  Color  7,0
  Print Desc$;
  Color color1, color2
  Print value$
  Color  7,0 
End Sub




[Robert]

C Front end ... is Crazy ?   

If you don't like it, don't look. 

Yeah, I know, mind boggling isn't it ?

GetObject ? Whazzat ? I'm on the case.

Thanks for the Windows 11 detective. Really great !

[airr]

There aren't really any COM Programming posts, so I thought I'd share my first foray into COM Programming (after all these years).

My goal was to retrieve the Operating System Name, the OS Build, and the Installation Date.

My first non-COM attempt was via registry queries, but that didn't produce the correct results.  It seems that with Win11, Microsoft retained the Win10 entries for backwards compatibility with software that checks the registry during installation and fails if Windows 10 is not reported reported.

Try this on a Windows 11 machine:

Code Select Expand

print REGSTRING$(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "ProductName")

pause

Anyway, I know from using WMI calls in Powershell that the correct info can be retrieved, so I went ahead and coded this (not a lot of error checking, though):

Code Select Expand

#include <Wbemidl.h>


$Pragma comment(lib, "wbemuuid.lib")

Dim hres As HRESULT
Dim As BSTR res, language, query
Dim pSvc As IWbemServices Ptr
Dim pLoc As IWbemLocator Ptr
Dim pEnumerator As IEnumWbemClassObject Ptr
Dim pResult As IWbemClassObject Ptr
Dim var As Variant, uReturn As Ulong

hres = CoInitializeEx(NULL, COINIT_MULTITHREADED)
hres = CoInitializeSecurity(NULL, -1, NULL, NULL, RPC_C_AUTHN_LEVEL_DEFAULT, RPC_C_IMP_LEVEL_IMPERSONATE, NULL, EOAC_NONE, NULL)



res = UCODE$(E"ROOT\\CIMV2")
language = UCODE$("WQL")
query = UCODE$("SELECT * FROM Win32_OperatingSystem")


hres = CoCreateInstance(&CLSID_WbemLocator, 0, CLSCTX_INPROC_SERVER, &IID_IWbemLocator, (LPVOID *)&pLoc)
hres = pLoc->lpVtbl->ConnectServer(pLoc, res, NULL, NULL, NULL, 0,  NULL, Null, &pSvc)


hres = pSvc->lpVtbl->ExecQuery(pSvc, language, query, WBEM_FLAG_BIDIRECTIONAL, NULL, &pEnumerator)

If pEnumerator != NULL Then
    hres = pEnumerator->lpVtbl->Next(pEnumerator, WBEM_INFINITE, 1, &pResult, &uReturn)
    hres = pResult->lpVtbl->Get(pResult, UCODE$("Caption"), 0, &var, 0, 0)
    Print "OS Name: ", WideToAnsi$(var.bstrVal)
    hres = pResult->lpVtbl->Get(pResult, UCODE$("Version"), 0, &var, 0, 0)
    Print "OS Version: ", WideToAnsi$(var.bstrVal) 
    hres = pResult->lpVtbl->Get(pResult, UCODE$("InstallDate"), 0, &var, 0, 0)
    Print "Install Date: ", fixDateString(WideToAnsi$(var.bstrVal))

End If

CoUninitialize()

Pause
End

Function fixDateString(szDate As string) As string
    Dim As string szYear, szMonth, szDay, szNewDate
    szYear = Mid$(szDate, 1, 4)
    szMonth = Mid$(szDate, 5, 2)
    szDay = Mid$(szDate, 7, 2)

    Sprint szNewDate, szYear, "-", szMonth, "-", szDay
    Return szNewDate

End Function


Which works.

Of course, BCX being what it is, there's a far less verbose (on the front end, the generated C file is crazy!) way of coding this:

Code Select Expand

Dim tmp$
Dim objWMIService as Object
Dim oCollection as Object
Const service = "winmgmts:\\.\root\cimv2"


Set objWMIService = GetObject(service)

Set oCollection = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

For Each oItem in oCollection
    tmp$ = oItem.Caption
    Print "OS Name: ", tmp$
    tmp$ = oItem.Version
    Print "OS Version: ", tmp$
    tmp$ = oItem.InstallDate
    Print "Install Date: ", fixDateString(tmp$)
Next

Set objWMIService = Nothing

Pause

Function fixDateString(szDate As string) As string
    Dim As string szYear,szMonth, szDay, szNewDate
    szYear = Mid$(szDate,1,4)
    szMonth = Mid$(szDate,5,2)
    szDay = Mid$(szDate,7,2)
   
    Sprint szNewDate, szYear, "-", szMonth, "-", szDay
    Return szNewDate

End Function

Which produces the same output as my more verbose version.

I do have a couple of comments, though:

• How would one go about using the COM() option to code this?  I tried and wasn't successful.
• I wasn't able to find GetObject in the help file.

AIR.