COMate - control COM objects via automation - OBSOLETE!

[SFSxOI]

Can you post your code?

Here's some that I've just run. With a core 2 processor it only lists cpu0. Should it list two?

Code: Select all

IncludePath "..\.."
XIncludeFile "COMate.pbi"

Procedure Get_Processors() 
   Protected objWMIService.COMateObject, processor.COMateObject 
   Protected colProcessor.COMateEnumObject 

   strComputer.s = "." 
   objWMIService = COMate_GetObject("winmgmts:\" + strComputer + "\root\cimv2", "") 
   If objWMIService 
      colProcessor = objWMIService\CreateEnumeration("ExecQuery('Select * FROM Win32_Processor')") 
      If colProcessor 
         processor = colProcessor\GetNextObject() 
         While processor
            Debug processor\GetStringProperty("DeviceID")
            processor\Release() 
            processor = colProcessor\GetNextObject() 
         Wend 
         colProcessor\Release() 
      EndIf 
      objWMIService\Release()  
   EndIf 
EndProcedure 

Get_Processors()

You get the number of cores with this:

Code: Select all

Str(CPU\GetIntegerProperty("NumberOfCores"))

Your question "Should it list two?" ; you need to get the number of logical processors. The cpu0 is only the device ID of the actual cpu plugged into the socket, not the number of cores in the processor which are logical processors. I think your asking about the number of logical processors, where each core shows up as a logical processor.

The for the number of logical processors you do this:

Code: Select all

Str(CPU\GetIntegerProperty("NumberOfLogicalProcessors"))

To determine the number of physical CPU's in a computer use the Win32_ComputerSystemProcessor class, but you can also get it from the Win32_ComputerSystem class too if your using Vista.

Here is a version i'm using that feeds a linked list (not shown), works in Vista (and mostly in XP but some of the things don't work in XP, not all of them are commented below - consult the MSDN. The L2CacheSpeed doesn't seem to work at all though. CPU_GUID depends on the processor serial number being on or off in BIOS I think. The hyperthreading part is just demostration only, I don't use it in actual use.):

Code: Select all

; CPU Families
Procedure.s CPU_Family_Type(cpu_famt.l)

  Select cpu_famt
  
    Case 1
      CPU_Fam_Type$ = "Other"
    Case 2
      CPU_Fam_Type$ = "Unknown"
    Case 3
      CPU_Fam_Type$ = "8086"
    Case 4
      CPU_Fam_Type$ = "80286"
    Case 5
      CPU_Fam_Type$ = "Intel386 Processor"
    Case 6
      CPU_Fam_Type$ = "Intel486 Processor"
    Case 7
      CPU_Fam_Type$ = "8087"
    Case 8
      CPU_Fam_Type$ = "80287"
    Case 9
      CPU_Fam_Type$ = "80387"
    Case 10
      CPU_Fam_Type$ = "80487"
    Case 11
      CPU_Fam_Type$ = "Pentium Brand"
    Case 12
      CPU_Fam_Type$ = "Pentium Pro"
    Case 13
      CPU_Fam_Type$ = "Pentium II"
    Case 14
      CPU_Fam_Type$ = "Pentium Processor With MMX Technology"
    Case 15
      CPU_Fam_Type$ = "Celeron"
    Case 16
      CPU_Fam_Type$ = "Pentium II Xeon"
    Case 17
      CPU_Fam_Type$ = "Pentium III"
    Case 18
      CPU_Fam_Type$ = "M1 Family"
    Case 19
      CPU_Fam_Type$ = "M2 Family"
    Case 24
      CPU_Fam_Type$ = "AMD Duron Processor Family"
    Case 25
      CPU_Fam_Type$ = "K5 Family"
    Case 26
      CPU_Fam_Type$ = "K6 Family"
    Case 27
      CPU_Fam_Type$ = "K6-2"
    Case 28
      CPU_Fam_Type$ = "K6-3"
    Case 29
      CPU_Fam_Type$ = "AMD Athlon Processor Family"
    Case 30
      CPU_Fam_Type$ = "AMD2900 Family"
    Case 31
      CPU_Fam_Type$ = "K6-2+"
    Case 32
      CPU_Fam_Type$ = "Power PC Family"
    Case 33
      CPU_Fam_Type$ = "Power PC 601"
    Case 34
      CPU_Fam_Type$ = "Power PC 603"
    Case 35
      CPU_Fam_Type$ = "Power PC 603+"
    Case 36
      CPU_Fam_Type$ = "Power PC 604"
    Case 37
      CPU_Fam_Type$ = "Power PC 620"
    Case 38
      CPU_Fam_Type$ = "Power PC X704"
    Case 39
      CPU_Fam_Type$ = "Power PC 750"
    Case 48
      CPU_Fam_Type$ = "Alpha Family"
    Case 49
      CPU_Fam_Type$ = "Alpha 21064"
    Case 50
      CPU_Fam_Type$ = "Alpha 21066"
    Case 51
      CPU_Fam_Type$ = "Alpha 21164"
    Case 52
      CPU_Fam_Type$ = "Alpha 21164PC"
    Case 53
      CPU_Fam_Type$ = "Alpha 21164a"
    Case 54
      CPU_Fam_Type$ = "Alpha 21264"
    Case 55
      CPU_Fam_Type$ = "Alpha 21364"
    Case 64
      CPU_Fam_Type$ = "MIPS Family"
    Case 65
      CPU_Fam_Type$ = "MIPS R4000"
    Case 66
      CPU_Fam_Type$ = "MIPS R4200"
    Case 67
      CPU_Fam_Type$ = "MIPS R4400"
    Case 68
      CPU_Fam_Type$ = "MIPS R4600"
    Case 69
      CPU_Fam_Type$ = "MIPS R10000"
    Case 80
      CPU_Fam_Type$ = "SPARC Family"
    Case 81
      CPU_Fam_Type$ = "SuperSPARC"
    Case 82
      CPU_Fam_Type$ = "microSPARC II"
    Case 83
      CPU_Fam_Type$ = "microSPARC IIep"
    Case 84
      CPU_Fam_Type$ = "UltraSPARC"
    Case 85
      CPU_Fam_Type$ = "UltraSPARC II"
    Case 86
      CPU_Fam_Type$ = "UltraSPARC IIi"
    Case 87
      CPU_Fam_Type$ = "UltraSPARC III"
    Case 88
      CPU_Fam_Type$ = "UltraSPARC IIIi"
    Case 96
      CPU_Fam_Type$ = "68040"
    Case 97
      CPU_Fam_Type$ = "68xxx Family"
    Case 98
      CPU_Fam_Type$ = "68000"
    Case 99
      CPU_Fam_Type$ = "68010"
    Case 100
      CPU_Fam_Type$ = "68020"
    Case 101
      CPU_Fam_Type$ = "68030"
    Case 112
      CPU_Fam_Type$ = "Hobbit Family"
    Case 120
      CPU_Fam_Type$ = "Crusoe TM5000 Family"
    Case 121
      CPU_Fam_Type$ = "Crusoe TM3000 Family"
    Case 122
      CPU_Fam_Type$ = "Efficeon TM8000 Family"
    Case 128
      CPU_Fam_Type$ = "Weitek"
    Case 130
      CPU_Fam_Type$ = "Itanium Processor"
    Case 131
      CPU_Fam_Type$ = "AMD Athlon 64 Processor Famiily"
    Case 132
      CPU_Fam_Type$ = "AMD Opteron Processor Family"
    Case 144
      CPU_Fam_Type$ = "PA-RISC Family"
    Case 145
      CPU_Fam_Type$ = "PA-RISC 8500"
    Case 146
      CPU_Fam_Type$ = "PA-RISC 8000"
    Case 147
      CPU_Fam_Type$ = "PA-RISC 7300LC"
    Case 148
      CPU_Fam_Type$ = "PA-RISC 7200"
    Case 149
      CPU_Fam_Type$ = "PA-RISC 7100LC"
    Case 150
      CPU_Fam_Type$ = "PA-RISC 7100"
    Case 160
      CPU_Fam_Type$ = "V30 Family"
    Case 176
      CPU_Fam_Type$ = "Pentium III Xeon Processor"
    Case 177
      CPU_Fam_Type$ = "Pentium III Processor With Intel SpeedStep Technology"
    Case 178
      CPU_Fam_Type$ = "Pentium 4"
    Case 179
      CPU_Fam_Type$ = "Intel Xeon"
    Case 180
      CPU_Fam_Type$ = "AS400 Family"
    Case 181
      CPU_Fam_Type$ = "Intel Xeon Processor MP"
    Case 182
      CPU_Fam_Type$ = "AMD Athlon XP Family"
    Case 183
      CPU_Fam_Type$ = "AMD Athlon MP Family"
    Case 184
      CPU_Fam_Type$ = "Intel Itanium 2"
    Case 185
      CPU_Fam_Type$ = "Intel Pentium M Processor"
    Case 190
      CPU_Fam_Type$ = "K7"
    Case 200
      CPU_Fam_Type$ = "IBM390 Family"
    Case 201
      CPU_Fam_Type$ = "G4"
    Case 202
      CPU_Fam_Type$ = "G5"
    Case 203
      CPU_Fam_Type$ = "G6"
    Case 204
      CPU_Fam_Type$ = "z/Architecture Base"
    Case 250
      CPU_Fam_Type$ = "i860"
    Case 251
      CPU_Fam_Type$ = "i960"
    Case 260
      CPU_Fam_Type$ = "SH-3"
    Case 261
      CPU_Fam_Type$ = "SH-4"
    Case 280
      CPU_Fam_Type$ = "ARM"
    Case 281
      CPU_Fam_Type$ = "StrongARM"
    Case 300
      CPU_Fam_Type$ = "6x86"
    Case 301
      CPU_Fam_Type$ = "MediaGX"
    Case 302
      CPU_Fam_Type$ = "MII"
    Case 320
      CPU_Fam_Type$ = "WinChip"
    Case 350
      CPU_Fam_Type$ = "DSP"
    Case 500
      CPU_Fam_Type$ = "Video Processor"
    Default
      CPU_Fam_Type$ = "Unknown"
  
  EndSelect

ProcedureReturn CPU_Fam_Type$

EndProcedure

Procedure.s CPU_Info() 
  Define.COMateObject objWMIService, CPU, PROC 
  procCPU.COMateEnumObject
  sysCPU.COMateEnumObject 
  strComputer.s = "." 
  objWMIService = COMate_GetObject("winmgmts:\" + strComputer + "\root\cimv2", "") 
  If objWMIService
    sysCPU = objWMIService\CreateEnumeration("ExecQuery('Select * from Win32_Processor')")  
    procCPU = objWMIService\CreateEnumeration("ExecQuery('Select * from Win32_ComputerSystem')") 
    If sysCPU And procCPU
      CPU = sysCPU\GetNextObject()
      PROC = procCPU\GetNextObject()
      While CPU
        
        My_Adapter_Info_List()\CPU_Proc_Num = Str(PROC\GetIntegerProperty("NumberOfProcessors"))
        My_Adapter_Info_List()\CPU_System_Type = PROC\GetStringProperty("SystemType")
        My_Adapter_Info_List()\CPU_Num_Core = Str(CPU\GetIntegerProperty("NumberOfCores")) ; doesn't work with Windows Server 2003, Windows XP, and Windows 2000
        My_Adapter_Info_List()\CPU_Num_Logical = Str(CPU\GetIntegerProperty("NumberOfLogicalProcessors")) ; doesn't work with Windows Server 2003, Windows XP, and Windows 2000
        My_Adapter_Info_List()\CPU_Manufacturer = CPU\GetStringProperty("Manufacturer")
        My_Adapter_Info_List()\CPU_ExtClock = Str(CPU\GetIntegerProperty("ExtClock"))
        cpu_famt.l = CPU\GetIntegerProperty("Family")
        My_Adapter_Info_List()\CPU_Family = CPU_Family_Type(cpu_famt.l)
        My_Adapter_Info_List()\CPU_AddressWidth = Str(CPU\GetIntegerProperty("AddressWidth"))
        My_Adapter_Info_List()\CPU_DataWidth_Total = Str(CPU\GetIntegerProperty("DataWidth"))
        My_Adapter_Info_List()\CPU_DataWidth_Core = Str(CPU\GetIntegerProperty("DataWidth") / CPU\GetIntegerProperty("NumberOfLogicalProcessors"))
        My_Adapter_Info_List()\CPU_Caption = CPU\GetStringProperty("Caption") 
        My_Adapter_Info_List()\CPU_Name = CPU\GetStringProperty("Name")
        My_Adapter_Info_List()\CPU_ProcessorId = CPU\GetStringProperty("ProcessorId")
        My_Adapter_Info_List()\CPU_GUID = CPU\GetStringProperty("UniqueId")
        My_Adapter_Info_List()\CPU_SocketType = CPU\GetStringProperty("SocketDesignation")
        My_Adapter_Info_List()\CPU_DeviceID = CPU\GetStringProperty("DeviceID") 
        My_Adapter_Info_List()\CPU_MaxClockSpeed = Str(CPU\GetIntegerProperty("MaxClockSpeed"))
        My_Adapter_Info_List()\CPU_L2CacheSize = Str(CPU\GetIntegerProperty("L2CacheSize"))
        My_Adapter_Info_List()\CPU_L2CacheSpeed = Str(CPU\GetIntegerProperty("L2CacheSpeed"))
        
        ;NumberOfCores is less than NumberOfLogicalProcessors = hyperthreading
        If CPU\GetIntegerProperty("NumberOfCores") < CPU\GetIntegerProperty("NumberOfLogicalProcessors")
        My_Adapter_Info_List()\CPU_Hyper_Thread = "Yes"
        Else
        My_Adapter_Info_List()\CPU_Hyper_Thread = "No"
        EndIf 
                        
        CPU\Release()
        PROC\Release() 
        CPU = sysCPU\GetNextObject()
        PROC = procCPU\GetNextObject() 
      Wend 
      sysCPU\Release()
      procCPU\Release() 
    EndIf 
    
    objWMIService\Release()  
  EndIf 
EndProcedure

[nicolaus]

Ok now i have take a look into the PSDK and have found what we need. The prob is that it is not in the COMate lib at this time.

If the request have more than one instance we must use the "SWbemObject.Instances_", it returns the instances.

At this time i have not found a way to use it with COMate.

[nicolaus]

@SFSxOI

With your code you can also read only the values for one of the core´s if the CPU is a multi core CPU.
I have a AMD X2 Dual Core and want read the informations for all core´s in the CPU.

in this link http://vbnet.mvps.org/index.html?code/w ... cessor.htm you can see that we can read the informations for multicore cpu. it use the "InstancesOf" methode.

But how i can do this in PB?

[srod]

Well, the code in the VB snippet looks identical (in function) to that already posted and indeed I just ran a translation of the VB code on my core 2 machine and get exactly the same results - i.e. cpu0 only.

Now is there a distinction to be made here between multi-core and multi-processor? It seems to me that the VB code will only list multiple processors etc.

[SFSxOI]

Well, the code in the VB snippet looks identical (in function) to that already posted and indeed I just ran a translation of the VB code on my core 2 machine and get exactly the same results - i.e. cpu0 only.

Now is there a distinction to be made here between multi-core and multi-processor? It seems to me that the VB code will only list multiple processors etc.

Let me see if I can say this correctly without confusing the issue; The term 'processor' is interchanged frequently with the term 'CPU'. Both refer to a single physical package installed in a compatable socket on a mother board in a computer system. The cores are whats inside that single physical package. The expansion of the term 'processor' to 'multi-processor' refers to more then one single physical package installed in compatable sockets on a mother board in a computer system. Each single package in a 'multi-processor' system can have multiple cores (e.g.. Intel Core 2 Duo means a single physical package with two cores inside the single physical package). There are two types of processors, the actual physical package you plug into the socket on the motherboard called a processor or CPU, and any core inside that plugged in physical package when the core is operating is called a "logical processor" (e.g....Intel Core 2 Duo has one physical package, called a processor or CPU, that plugs into the socket on the motherboard - that package contains two cores each of which is called a "logical processor")

Thus 'Multi-Processor' = physical processor/CPU package plugged into a socket on the mother board ....and...."Multi-Core" means more then one core in a single physical processor/CPU package where each core in a single physical processor/CPU package is called a 'logical processor' (note the use of the word 'logical' in relation to cores and not physical although each core is physically there the core like everything else inside the processor package operates in the logic rhelm, thus a core is called a logical processor and not a physical processor). Processors that use Hyper-Threading also may be detected as multiple cores (logical processors) but there may only be one core in the processor.

It is possible to have a multi-core processor with both cores operating as a single 'logical processor', and its also possible to turn a core off so a multi-core processor only shows one 'logical processor', its also possible to have some sort of error or hardware problem with the physical processor package so that one of the cores (logical processors) does not operate properly or at all.

The cpu0 is for the first processor found, then it progresses from there up to the max number found in the computer, i.e...cpu0, cpu1,cpu2, etc....., the number of cores in each processor/CPU is had by the property "NumberOfLogicalProcessors" which is the total number of ALL the cores in ALL the processors on the motherboard, you have to dive into the WMI classes a little deeper to seperate the cores out from the processors for more detailed answers but you will still end up just wanting to know the number of cores total. The reason the number of cores total is more important then spending the time digging into the classes is because after you code all that stuff from the other classes in the end whats going to still only matter is the number of 'logical processors' (the cores) in actual use. The cpu0 you see means that only one processor socket in the computer is populated with a processor, or the code only read the last value it encountered because it didn't loop back thru to find more values. If the motherboard only has one physical processor package plugged into a socket then the value of 'cpu0' is correct. The logical counting of processors in a computer system begins at 0. If there are more then one processor in a system then you have to resort to more coding to bring those values out. If you had two occupied processor sockets in the computer then with some slight re-arrangement in the code you would see a cpu0 and then a cpu1, the re-arranged code might look like this:

Code: Select all

x = x + 1
If x = 1
My_Adapter_Info_List()\CPU_Proc_Num = Str(PROC\GetIntegerProperty("NumberOfProcessors"))
EndIf

If x = 2
My_Adapter_Info_List()\CPU_Proc_Num = Str(PROC\GetIntegerProperty("NumberOfProcessors"))
EndIf

If x = 3 ; etc.... up to the number socketed processors on the motherboard


Next x

Of course in the above code things are very simple and it is representative only, if only life was that way and we were so lucky. You would also need to test one result from 'Str(PROC\GetIntegerProperty("NumberOfProcessors"))' to ensure that each time the loop went thru and the value of x changed that a different real value representing the factual number of processors was correct. In the below code for another part of something i'm writing using COmate you can see this idea i'm trying to describe where below i'm getting all of the IPv4 and IPv6 addresses and all of the gateway addresses, etc....for a network adapter (this particular piece of code uses a safe array, but the concept of looping and filtering is the same to get the info you need for processors):

Code: Select all

Procedure.s IP_DNS_GW_Addresses(Adapt_Index.l, get_what.s)
Define.COMateObject objWMIService, IPConfig
IPConfigSet.COMateEnumObject
Define *var.VARIANT, *varIP.VARIANT
*sa.SafeArray

strComputer.s = "."
Net_I_Index$ = Str(Adapt_Index)

objWMIService = COMate_GetObject("winmgmts:\" + strComputer + "\root\cimv2", "")
If objWMIService
  ;IPConfigSet = objWMIService\CreateEnumeration("ExecQuery('Select * from Win32_NetworkAdapterConfiguration Where InterfaceIndex= $0027" + Net_I_Index$ +"$0027')") ; win Vista only
  IPConfigSet = objWMIService\CreateEnumeration("ExecQuery('Select * from Win32_NetworkAdapterConfiguration Where Index= $0027" + Net_I_Index$ +"$0027')") ; winXP and win Vista
  If IPConfigSet
    IPConfig = IPConfigSet\GetNextObject()
    While IPConfig
      If IPConfig
        If get_what = "IP"
        *var = IPConfig\GetVariantProperty("IPAddress") ; for win Vista both IPv4 and IPv6 are returned, for winXP only IPv4 is returned.
        EndIf
        If get_what = "DNS"
        *var = IPConfig\GetVariantProperty("DNSServerSearchOrder")
        EndIf
        If get_what = "GW"
        *var = IPConfig\GetVariantProperty("DefaultIPGateway")
        EndIf
        If get_what = "SUFFIX"
        *var = IPConfig\GetVariantProperty("DNSDomainSuffixSearchOrder")
        EndIf
        If get_what = "SUBNET"
        *var = IPConfig\GetVariantProperty("IPSubnet")
        EndIf
                 
        If *var\vt <> #VT_NULL
          *sa = *var\parray
          For i = saLBound(*sa) To saUBound(*sa)
            *varIP = SA_VARIANT(*sa, i)
            If *varIP\vt <> #VT_BSTR
              VariantChangeType_(*varIP, *varIP, 0, #VT_BSTR)
            EndIf
            
            x = x + 1
            IP_Address_DNS_GW$ = PeekS(*varIP\bstrVal, -1, #PB_Unicode)
            ;//////////////adapter IP///////////////////////////////
            If x = 1 And get_what = "IP" ; IP v 4
            My_Adapter_Info_List()\IPAdress_ipv4 = IP_Address_DNS_GW$
              Else
                If x = 1 And get_what = "IP" And IP_Address_DNS_GW$ = ""
                  My_Adapter_Info_List()\IPAdress_ipv4 = "No IPv4 Address assigned"
                EndIf
            EndIf
            
            If x = 2 And get_what = "IP"; IP v 6
            My_Adapter_Info_List()\IPAdress_ipv6 = IP_Address_DNS_GW$
              Else
                If x = 2 And get_what = "IP" And IP_Address_DNS_GW$ = ""
                  My_Adapter_Info_List()\IPAdress_ipv4 = "No IPv4 Address assigned"
                EndIf
            EndIf
            ;////////////////////DNS server/////////////////////////
            If x = 1 And get_what = "DNS"
            My_Adapter_Info_List()\DNS_Server_1 = IP_Address_DNS_GW$
            EndIf
            
            If x = 2 And get_what = "DNS"
            My_Adapter_Info_List()\DNS_Server_2 = IP_Address_DNS_GW$
            EndIf
            
            If x = 3 And get_what = "DNS"
            My_Adapter_Info_List()\DNS_Server_3 = IP_Address_DNS_GW$
            EndIf
            ;//////////////default GateWay server/////////////////
            If x = 1 And get_what = "GW"
            My_Adapter_Info_List()\GW_Server_1 = IP_Address_DNS_GW$
            EndIf
            
            If x = 2 And get_what = "GW"
            My_Adapter_Info_List()\GW_Server_2 = IP_Address_DNS_GW$
            EndIf
            
            If x = 3 And get_what = "GW"
            My_Adapter_Info_List()\GW_Server_3 = IP_Address_DNS_GW$
            EndIf
            ;/////////////domain suffix search order if any////////
            If x = 1 And get_what = "SUFFIX"
              If IP_Address_DNS_GW$ = ""
                My_Adapter_Info_List()\DNSDomainSuffix_1 = "None Detected"
                Else
                My_Adapter_Info_List()\DNSDomainSuffix_1 = IP_Address_DNS_GW$
              EndIf
            EndIf
            
            If x = 2 And get_what = "SUFFIX"
            My_Adapter_Info_List()\DNSDomainSuffix_2 = IP_Address_DNS_GW$
            EndIf
            
            If x = 3 And get_what = "SUFFIX"
            My_Adapter_Info_List()\DNSDomainSuffix_3 = IP_Address_DNS_GW$
            EndIf
            
            If x = 1 And get_what = "SUBNET"
            My_Adapter_Info_List()\IP_Subnet_1 = IP_Address_DNS_GW$
            EndIf 
            
            If x = 2 And get_what = "SUBNET"
              If Len(IP_Address_DNS_GW$) < 7 Or IP_Address_DNS_GW$ = ""
                My_Adapter_Info_List()\IP_Subnet_2 = ""
                Else
                My_Adapter_Info_List()\IP_Subnet_2 = IP_Address_DNS_GW$
              EndIf
            EndIf
            
            If x = 3 And get_what = "SUBNET"
              If Len(IP_Address_DNS_GW$) < 7 Or IP_Address_DNS_GW$ = ""
                My_Adapter_Info_List()\IP_Subnet_3 = ""
                Else
                My_Adapter_Info_List()\IP_Subnet_3 = IP_Address_DNS_GW$
              EndIf
            EndIf 
            
            If My_Adapter_Info_List()\DNSDomainSuffix_1 = "" And My_Adapter_Info_List()\DNSDomainSuffix_2 = "" And My_Adapter_Info_List()\DNSDomainSuffix_3 = ""
            My_Adapter_Info_List()\DNSDomainSuffix_1 = "None Detected"
            My_Adapter_Info_List()\DNSDomainSuffix_2 = ""
            My_Adapter_Info_List()\DNSDomainSuffix_3 = ""
            EndIf
            
            VariantClear_(*varIP)
          Next
          saFreeSafeArray(*sa)
        EndIf
        VariantClear_(*var) : FreeMemory(*var)
        IPConfig\Release()
      EndIf
      IPConfig = IPConfigSet\GetNextObject()
    Wend
  EndIf  
Else
  MessageRequester("Error", "Couldn't create DNS_GW object!")
EndIf

EndProcedure

now back to the subject of the processor.

Please note that the property 'NumberOfProcessors' does not work with winXP and the others as noted in the code I posted. What I posted was intended for machines where only one processor socket is occupied on the motherboard, in this intended case the socket is occupied by dual core processor.

To read individual data sets out for each core you will need to loop thru the cores individually (sort of similar to the above) up to the max number of cores.

[srod]

'Bug' fixed. 26th Nov. 2008.
An inconsistency between Windows 2000 (and presumably earlier versions of Windows) and XP etc. led to problems with the GetIntegerProperty() method on these earlier versions of Windows. This has been fixed. (The problem was with VariantChangeType_()).

See the nxSoftware site for the download.

[fizban]

I am having problems with collections of strings. The call to CreateEnumeration works fine, but the first call to GetNextObject seems to fail, since they are actually strings. I can call GetNextVariant OK, but then I do not know what to do with the resulting variant...

Any help?

[srod]

If the resulting variant contains a BSTR then just use something like PeekS(*var\bstrVal, -1, #PB_Unicode) to get the string. Don't forget to free the variant when done (VariantClear_()).

[fizban]

Thanks, srod. Here's a snippet of what I came out with:

Code: Select all

        colErrors=obj\CreateEnumeration("errorList()")
        If colErrors
          *varError=colErrors\GetnextVariant()
          While *varError
            Debug PeekS(*varError\bstrVal, -1, #PB_Unicode) 
            VariantClear_(*varError) 
            FreeMemory(*varError)
            *varError = colErrors\GetNextVariant() 
          Wend 
          colErrors\Release()
       endif
 

That piece of code seems to work, now. I am just posting it for you to confirm I am not missing anything. Besides, it might help others as well.

[srod]

Yep looks fine.

[srod]

Update and bug fix - 8th Dec. 2008.

COMate version 1.1.8.

First, only the version of COMate for PB 4.3 has had this update and bug fix. COMate for PB 4.2 remains at version 1.1.7

A dirty steaming couple of bugs would see COMate, in certain circumstances, enumerating through a chain of property-gets and even though the COMponents in question would signal success, a null object was nevertheless being returned! I just assumed that a successful return would always result in a valid object - doh! This would of course result in COMate subsequently attempting to execute a method or property against a null object - CRASH BANG WALLOP !!!

This has been fixed.

Have upgraded the error reporting to give detailed information in the case of a chain of property-gets being ruined by a null-object return.

See the nxSoftware site for the download.

[neotoma]

Hi Srod,

i tried to use COMate to write a plugin for DogWaffle (a nice Painting-Program http://www.thebest3d.com). It Offers a Com-Object to access the Application. Also some Examples in VisualBasic or Delphi.

My Problem is to Access the Image-Channels, offered as Variant-Arrays... (buhhh)

i have that - at the Moment :

Code: Select all

XIncludeFile "COMate.pbi"
XIncludeFile "VariantHelper_Include.pb"

EnableExplicit

Define.COMateObject DogWaffleObject

dhToggleExceptions(#True)

Define.l  Result,*ResultR.VARIANT,*ResultG.VARIANT,*ResultB.VARIANT
Define dh,dw,j,i,*startR,*startB,*startG

DogWaffleObject = COMate_CreateObject("Dogwaffle.Dogwaffle_Class")

Result=DogWaffleObject\GetIntegerProperty("Dog_BufferHeight")
Debug(Str(Result))
dh = Result

Result=DogWaffleObject\GetIntegerProperty("Dog_BufferWidth")
Debug(Str(Result))
dw = Result

*ResultR = DogWaffleObject\GetVariantProperty("Dog_GetRBuffer")
*startR = VT_ARRAY(*ResultR)

#IMAGE=0

OpenWindow(0,0,0,dw,dh,"dogwaffle",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible)
CreateGadgetList(WindowID(0))

If CreateImage(#IMAGE,dw,dh)=0
  MessageRequester("ERROR","Cant create image",#MB_ICONERROR)
  End
EndIf

StartDrawing(ImageOutput(#IMAGE))
  
  For i = 0 To dh
    For j = 0 To dw
      Plot(j,i ,RGB(PeekB(*startR),0,0))
      *startR+1 : *startG+1 : *startB+1
    Next
  Next
  
StopDrawing()

ImageGadget(#IMAGE,0,0,0,0,ImageID(#IMAGE))
DisableGadget(#IMAGE,1)    
HideWindow(0,0)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      End
  EndSelect
ForEver

DogWaffleObject\Release()

End

I firstwant only to see the Image in PB. But it is disrupted.


Here is the VB-Code to Acesse and Manipulate :

Code: Select all

Sub Main

'*** NEGATIVE FILTER EXAMPLE ***

'to use this example, create a visual basic project with no forms
'and one empty module and paste this code into it. that's it.
'dogwaffle should be running when this code is executed.

Dim x As Integer, y As Integer
Dim r As Byte, g As Byte, b As Byte

'allocate the main buffers
Dim MainRBuffer() As Byte
Dim MainGBuffer() As Byte
Dim MainBBuffer() As Byte
 
'create a dogwaffle object
Dim Dogwaffle As Object
Set Dogwaffle = CreateObject("Dogwaffle.Dogwaffle_Class")

 'get the width and height of the buffer
th = Dogwaffle.Dog_BufferHeight
tw = Dogwaffle.Dog_BufferWidth

 'get the buffers

MainRBuffer() = Dogwaffle.Dog_GetRBuffer
MainGBuffer() = Dogwaffle.Dog_GetGBuffer
MainBBuffer() = Dogwaffle.Dog_GetBBuffer

 'process the buffers.
'
in this case, a negative effect.
  For y = 0 To th-1
   For x = 0 To tw-1
      r = MainRBuffer(x, y)
      g = MainGBuffer(x, y)
      b = MainBBuffer(x, y)
      MainRBuffer(x, y) = 255-r
      MainGBuffer(x, y) = 255-g
      MainBBuffer(x, y) = 255-b
    Next
  Next

'send the buffers back to dogwaffle.

Dogwaffle.Dog_SetRbuffer MainRBuffer()
Dogwaffle.Dog_SetGbuffer MainGBuffer()
Dogwaffle.Dog_SetBbuffer MainBBuffer()

'and refresh the screen

Dogwaffle.Dog_Refresh

End Sub

How can i do this with PB ?

Mike

[srod]

neotoma, a quick glance at the VB code and it would seem that the safe arrays in question are 2 dimensional. Your code is accessing the array as a one dimensional array. Now, do safe-arrays work that way; is this valid? Of course the variant include file only caters for one dimensional safe arrays.

**EDIT : wait, there is a big problem with your loop...

[srod]

Right, problems with the way you were accessing the safe-array elements. Best bet is to define *startR etc. as pointers to safe-arrays.

The following is of course untested and assumes that a 2-dimensional safe-array's elements are contiguous in memory (not an unreasonable assumption) :

Code: Select all

XIncludeFile "COMate.pbi" 
XIncludeFile "VariantHelper_Include.pb" 

EnableExplicit 

Define.COMateObject DogWaffleObject 

dhToggleExceptions(#True) 

Define.l  Result,*ResultR.VARIANT,*ResultG.VARIANT,*ResultB.VARIANT 
Define dh,dw,j,i
Define.SafeArray *startR,*startB,*startG 

DogWaffleObject = COMate_CreateObject("Dogwaffle.Dogwaffle_Class") 

Result=DogWaffleObject\GetIntegerProperty("Dog_BufferHeight") 
Debug(Str(Result)) 
dh = Result 

Result=DogWaffleObject\GetIntegerProperty("Dog_BufferWidth") 
Debug(Str(Result)) 
dw = Result 

*ResultR = DogWaffleObject\GetVariantProperty("Dog_GetRBuffer") 
*startR = *ResultR\parray 

#IMAGE=0 

OpenWindow(0,0,0,dw,dh,"dogwaffle",#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible) 
CreateGadgetList(WindowID(0)) 

If CreateImage(#IMAGE,dw,dh)=0 
  MessageRequester("ERROR","Cant create image",#MB_ICONERROR) 
  End 
EndIf 

StartDrawing(ImageOutput(#IMAGE)) 
  
  For i = 0 To dh 
    For j = 0 To dw 
      Plot(j,i ,RGB(*startR\pvData\bVal[rIndex],0,0)) 
      rIndex+1
    Next 
  Next 
  
StopDrawing() 

ImageGadget(#IMAGE,0,0,0,0,ImageID(#IMAGE)) 
DisableGadget(#IMAGE,1)    
HideWindow(0,0) 

Repeat 
  Select WaitWindowEvent() 
    Case #PB_Event_CloseWindow 
      End 
  EndSelect 
ForEver 

DogWaffleObject\Release() 

End 

You would of course be better of using the oleaut32 library to create a wrapper for 2-dimensional safe-arrays; if I had time then I'd have a crack at it!

[neotoma]

Thanx srod!

It works - now i can make my own Plugins.

Mike