COMate - control COM objects via automation - OBSOLETE!

Developed or developing a new product in PureBasic? Tell the world about it.
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Post by ts-soft »

Sparkie wrote::oops: Thanks. Thought that was a link to a download page for PureBasic 4.2.
there is no free download of PureBasic 4.2 :lol:
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

Not even for registered users :?: :wink:
What goes around comes around.

PB 5.21 LTS (x86) - Windows 8.1
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

Demo_MonitorInfo.pb shows results for both of my monitors. ts-soft, what are the specs of your monitors?
What goes around comes around.

PB 5.21 LTS (x86) - Windows 8.1
SFSxOI
Addict
Addict
Posts: 2970
Joined: Sat Dec 31, 2005 5:24 pm
Location: Where ya would never look.....

Post by SFSxOI »

srod wrote:SFSxOI - could you please take a look at the monitors WMI example which I took from an example you posted. ts-soft reports that it does not list his secondary monitor!
@ts-soft

I read something about that yesterday while i was searching for something else, i'll see if I can find it again. I happen to have dumped my browser history yesterday so i dont have the direct link right now but i'll see if i can find it. If I remember it has something to do with the way the drivers report.
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

@ts-soft: Does this return results for both monitors :?:

Code: Select all

; Author : DataMiner 
; Tweaked by Droopy to create a Libary 
; PureBasic 3.93 
; 14/06/05 

;{- WMI Constants 
#COINIT_MULTITHREAD=0 
#RPC_C_AUTHN_LEVEL_CONNECT=2 
#RPC_C_IMP_LEVEL_IDENTIFY=2 
#EOAC_NONE=0 
#RPC_C_AUTHN_WINNT=10 
#RPC_C_AUTHZ_NONE=0 
#RPC_C_AUTHN_LEVEL_CALL=3 
#RPC_C_IMP_LEVEL_IMPERSONATE=3 
#CLSCTX_INPROC_SERVER=1 
#wbemFlagReturnImmediately=16 
#wbemFlagForwardOnly=32 
#IFlags = #wbemFlagReturnImmediately + #wbemFlagForwardOnly 
#WBEM_INFINITE=$FFFFFFFF 
#WMISeparator="," 
;} 

Procedure.l ansi2bstr(ansi.s) 
  Size.l=MultiByteToWideChar_(#CP_ACP,0,ansi,-1,0,0) 
  Dim unicode.w(Size) 
  MultiByteToWideChar_(#CP_ACP, 0, ansi, Len(ansi), unicode(), Size) 
  ProcedureReturn SysAllocString_(@unicode()) 
EndProcedure 

Procedure bstr2string (bstr) 
  Shared result.s 
  result.s = "" 
  pos=bstr 
  While PeekW (pos) 
    result=result+Chr(PeekW(pos)) 
    pos=pos+2 
  Wend 
  ProcedureReturn @result 
EndProcedure 

ProcedureDLL.s WMI(WMICommand.s) 
  ;- WMI Initialize 
  CoInitializeEx_(0,#COINIT_MULTITHREAD) 
  hres=CoInitializeSecurity_(0, -1,0,0,#RPC_C_AUTHN_LEVEL_CONNECT,#RPC_C_IMP_LEVEL_IDENTIFY,0,#EOAC_NONE,0) 
  If hres <> 0: MessageRequester("ERROR", "unable to call CoInitializeSecurity", #MB_OK): Goto cleanup: EndIf 
  hres=CoCreateInstance_(?CLSID_WbemLocator,0,#CLSCTX_INPROC_SERVER,?IID_IWbemLocator,@loc.IWbemLocator) 
  If hres <> 0: MessageRequester("ERROR", "unable to call CoCreateInstance", #MB_OK): Goto cleanup: EndIf 
  hres=loc\ConnectServer(ansi2bstr("root\cimv2"),0,0,0,0,0,0,@svc.IWbemServices) 
  If hres <> 0: MessageRequester("ERROR", "unable to call IWbemLocator::ConnectServer", #MB_OK): Goto cleanup: EndIf 
  hres=svc\QueryInterface(?IID_IUnknown,@pUnk.IUnknown) 
  hres=CoSetProxyBlanket_(svc,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE) 
  If hres <> 0: MessageRequester("ERROR", "unable to call CoSetProxyBlanket", #MB_OK): Goto cleanup: EndIf 
  hres=CoSetProxyBlanket_(pUnk,#RPC_C_AUTHN_WINNT,#RPC_C_AUTHZ_NONE,0,#RPC_C_AUTHN_LEVEL_CALL,#RPC_C_IMP_LEVEL_IMPERSONATE,0,#EOAC_NONE) 
  If hres <> 0: MessageRequester("ERROR", "unable to call CoSetProxyBlanket", #MB_OK): Goto cleanup: EndIf 
  pUnk\Release() 
  
  
  ;- CallData 
  k=CountString(WMICommand,#WMISeparator) 
  Dim wmitxt$(k) 
  For i=0 To k 
    wmitxt$(i) = StringField(WMICommand,i+1,#WMISeparator) 
  Next 
  
  For z=0 To k 
    Debug Str(z)+" "+wmitxt$(z) 
  Next 
  
  
  hres=svc\ExecQuery(ansi2bstr("WQL"),ansi2bstr(wmitxt$(0)), #IFlags,0,@pEnumerator.IEnumWbemClassObject) 
  If hres <> 0: MessageRequester("ERROR", "unable to call IWbemServices::ExecQuery", #MB_OK): Goto cleanup: EndIf 
  hres=pEnumerator\Reset() 
  Repeat 
    hres=pEnumerator\Next(#WBEM_INFINITE, 1, @pclsObj.IWbemClassObject, @uReturn) 
    For i=1 To k 
      mem=AllocateMemory(1000) 
      hres=pclsObj\get(ansi2bstr(wmitxt$(i)), 0, mem, 0, 0) 
      type=PeekW(mem) 
      Select type 
        Case 8 
          val.s=PeekS(bstr2string(PeekL(mem+8))) 
        Case 3 
          val.s=Str(PeekL(mem+8)) 
        Default 
          val.s="" 
      EndSelect 
      If uReturn <> 0: wmi$=wmi$+wmitxt$(i)+" = "+val+Chr(10)+Chr(13): EndIf 
      FreeMemory(mem) 
    Next 
  Until uReturn = 0 
  
  ;- Cleanup 
  cleanup: 
  svc\Release() 
  loc\Release() 
  pEnumerator\Release() 
  pclsObj\Release() 
  CoUninitialize_() 
  
  ProcedureReturn wmi$ 
EndProcedure 

;{- WMI DATASECTION 
DataSection 
CLSID_IEnumWbemClassObject: 
  ;1B1CAD8C-2DAB-11D2-B604-00104B703EFD 
Data.l $1B1CAD8C 
Data.w $2DAB, $11D2 
Data.b $B6, $04, $00, $10, $4B, $70, $3E, $FD 
IID_IEnumWbemClassObject: 
  ;7C857801-7381-11CF-884D-00AA004B2E24 
Data.l $7C857801 
Data.w $7381, $11CF 
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24 
CLSID_WbemLocator: 
    ;4590f811-1d3a-11d0-891f-00aa004b2e24 
Data.l $4590F811 
Data.w $1D3A, $11D0 
Data.b $89, $1F, $00, $AA, $00, $4B, $2E, $24 
IID_IWbemLocator: 
    ;dc12a687-737f-11cf-884d-00aa004b2e24 
Data.l $DC12A687 
Data.w $737F, $11CF 
Data.b $88, $4D, $00, $AA, $00, $4B, $2E, $24 
IID_IUnknown: 
    ;00000000-0000-0000-C000-000000000046 
Data.l $00000000 
Data.w $0000, $0000 
Data.b $C0, $00, $00, $00, $00, $00, $00, $46 

EndDataSection 

MessageRequester("Win32_Process",WMI("SELECT * FROM Win32_DesktopMonitor,ScreenWidth,ScreenHeight,Description")) 

What goes around comes around.

PB 5.21 LTS (x86) - Windows 8.1
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Post by ts-soft »

Sparkie wrote:Demo_MonitorInfo.pb shows results for both of my monitors. ts-soft, what are the specs of your monitors?
TFT 24" with 1920x1200 as primary
CRT 17" with 1184x864 as secundary.

But i think the problem is UltraMon
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
SFSxOI
Addict
Addict
Posts: 2970
Joined: Sat Dec 31, 2005 5:24 pm
Location: Where ya would never look.....

Post by SFSxOI »

set both monitors to the same resolution and see if they report properly then.

I plugged in a second monitor and used the demo, both were reported, but both of them were at the same resolution at the time also.
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Post by ts-soft »

SFSxOI wrote:set both monitors to the same resolution and see if they report properly then.

I plugged in a second monitor and used the demo, both were reported, but both of them were at the same resolution at the time also.
The same resolution shuffles only my desctop-icons :wink:
Doesn't work on my pc, don't know

I use a GeForce 8600 GT with 512 MB for both monitors
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

@ts-soft: This code http://www.purebasic.fr/english/viewtop ... 072#258072 didn't find both monitors as well :?:
What goes around comes around.

PB 5.21 LTS (x86) - Windows 8.1
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Post by ts-soft »

Sparkie wrote:@ts-soft: This code http://www.purebasic.fr/english/viewtop ... 072#258072 didn't find both monitors as well :?:
is the same, only my primary display :cry:

can this a problem with 64-bit OS?
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
Sparkie
PureBatMan Forever
PureBatMan Forever
Posts: 2307
Joined: Tue Feb 10, 2004 3:07 am
Location: Ohio, USA

Post by Sparkie »

ts-soft, one last thought before I go...add this line to srod's Demo_MonitorInfo.pb.

Code: Select all

Debug "Availabilty   =   " + Str(Monitor\GetIntegerProperty("Availability")) 
What goes around comes around.

PB 5.21 LTS (x86) - Windows 8.1
SFSxOI
Addict
Addict
Posts: 2970
Joined: Sat Dec 31, 2005 5:24 pm
Location: Where ya would never look.....

Post by SFSxOI »

ts-soft wrote:
Sparkie wrote:@ts-soft: This code http://www.purebasic.fr/english/viewtop ... 072#258072 didn't find both monitors as well :?:
is the same, only my primary display :cry:

can this a problem with 64-bit OS?
hmmm, no i don't think its a 64 bit OS thing. I'm using an ATI 2600XT with 512 MB. The demo reports both monitors here. Maybe its a GeForce thing?
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Post by ts-soft »

Sparkie wrote:ts-soft, one last thought before I go...add this line to srod's Demo_MonitorInfo.pb.

Code: Select all

Debug "Availabilty   =   " + Str(Monitor\GetIntegerProperty("Availability")) 

Code: Select all

Procedure.s Monitor_Info() 
  Define.COMateObject objWMIService, Monitor 
  colMonitor.COMateEnumObject 
  strComputer.s = "." 
  Net_I_Index$ = Str(Interface_Index) 
  objWMIService = COMate_GetObject("winmgmts:\" + strComputer + "\root\cimv2", "") 
  If objWMIService 
    colMonitor = objWMIService\CreateEnumeration("ExecQuery('Select * from Win32_DesktopMonitor')") 
    If colMonitor 
      Monitor= colMonitor\GetNextObject() 
      While Monitor 
        Debug "Availabilty   =   " + Str(Monitor\GetIntegerProperty("Availability")) 
        Debug "Screen Height   =   " + Str(Monitor\GetIntegerProperty("ScreenHeight")) 
        Debug "Screen Width   =   " + Str(Monitor\GetIntegerProperty("ScreenWidth")) 
        Monitor\Release() 
        Monitor = colMonitor\GetNextObject() 
      Wend 
      colMonitor\Release() 
    EndIf 
    objWMIService\Release()  
  EndIf 
EndProcedure 

Monitor_Info() 
Debugger wrote:Availabilty = 3
Screen Height = 1200
Screen Width = 1920
:?:
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
SFSxOI
Addict
Addict
Posts: 2970
Joined: Sat Dec 31, 2005 5:24 pm
Location: Where ya would never look.....

Post by SFSxOI »

"TFT 24" with 1920x1200 as primary
CRT 17" with 1184x864 as secundary. "


ahhhhh...

Availabilty = 3
Screen Height = 1200
Screen Width = 1920

would be correct because its still only seeing your TFT 24". All thats telling you is that the one monitor it can detect is available and functioning as far as the OS is concerned, the OS sees the monitor as "Running or Full Power" (http://msdn.microsoft.com/en-us/library ... S.85).aspx)
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Post by ts-soft »

This is not a problem, the Desktop Lib in PB works as expected .

The CRT goes over a switcher (Monitor, Keyboard, Mouse, Sound for second
PC), and uses 100 Hertz, not 60 as the TFT, i think, one of this is the problem.
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
Post Reply