Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"

Win32::Desktop -- need help

by jacques (Priest)
on Jan 17, 2004 at 03:30 UTC ( #321990=perlquestion: print w/ replies, xml ) Need Help??
jacques has asked for the wisdom of the Perl Monks concerning the following question:

So we have Win32::Wallpaper. But what would be really nice would be a module that supports the ActiveDesktop interface. This has been brought up before here. I couldn't figure the code out, but with some help from others, here's where I am, but this code is not working at all. Please help in any way. Any tips are appreciated. I am trying to do what the MSDN docs suggest:
To access the Active Desktop, a client application would need to create an instance of the ActiveDesktop object (CLSID_ActiveDesktop) with the CoCreateInstance function and retrieve a pointer to the object's IActiveDesktop interface.
I can't get the pointer to work! Once I have the pointer I should be able to use the highly coveted ActiveDesktop methods. See the MSDN docs above for the code examples that I am trying to emulate. I have even more code that I've been hacking on, but this seems to be the best so far. Thanks.

use strict; use Win32::API; use constant S_OK => 0x00000000; use constant CLSCTX_INPROC_SERVER => 1; use constant CLSCTX_INPROC_HANDLER => 2; use constant CLSCTX_LOCAL_SERVER => 4; my $CoInitialize = new Win32::API("ole32.dll", "CoInitialize", 'P', 'N') or die "new CoInitialize: $!"; my $ret = $CoInitialize->Call(0); if ($ret != S_OK) { printf "CoInitialize->Call error: ret=%d (%08x)\n", $ret, $ret; exit; } print "CoInitialize->Call good\n"; my $CoCreateInstance = new Win32::API("ole32.dll", "CoCreateInstance", + 'PPNPP', 'N') or die "new CoCreateInstance: $!"; # CLSID bits: 32, 16, 16, 8 x 8 - replace CLSID with correct one: my $class_id = '{ef636391-f343-11d0-9477-00c04fd36226}'; # fixed. 'g' $class_id =~ s/^{|}$//g; my @c = split /-/, $class_id; my $REFCLSID = pack 'LSSC8', hex $c[0], hex $c[1], hex $c[2], hex (substr $c[3], 0, 2), hex (substr $c[3], 2, 2), hex (substr $c[4], 0, 2), hex (substr $c[4], 2, 2), hex (substr $c[4], 4, 2), hex (substr $c[4], 6, 2), hex (substr $c[4], 8, 2), hex (substr $c[4], 10, 2); # empty pointer for returned ptr my $PPV = pack 'P', 0; my $dwClsContext = CLSCTX_INPROC_SERVER; # class context # null interface ID my $refiid = pack 'P', 0; # this interface would normally be a pointer to IUnknown or IClassFactory in UUID.LIB # pointer to accept return ptr my $ppv = pack 'P', $PPV; print "::: ($REFCLSID, 0, $dwClsContext, $refiid, $ppv)\n"; $ret = $CoCreateInstance->Call($REFCLSID, 0, $dwClsContext, $refiid, $ppv); if ($ret != S_OK) { printf "CoCreateInstance->Call error: ret=%d (%08x)\n", $ret, $ret; exit; } print "CoCreateInstance->Call good\n"; __END__ CO_E_FIRST 0x800401F0 CO_E_NOTINITIALIZED 0x800401F0 REGDB_E_CLASSNOTREG 0x80040154 E_OUTOFMEMORY 0x8004000E E_UNEXPECTED 0x8000FFFF CLASS_E_NOAGGREGATION 0x80040110 #define E_INVALIDARG 0x80070057L #define E_NOINTERFACE 0x80004002L #define CO_E_INIT_TLS 0x80004006L #define CO_E_INIT_SHARED_ALLOCATOR 0x80004007L #define CO_E_INIT_MEMORY_ALLOCATOR 0x80004008L #define CO_E_INIT_CLASS_CACHE 0x80004009L #define CO_E_INIT_RPC_CHANNEL 0x8000400AL #define CO_E_INIT_TLS_SET_CHANNEL_CONTROL 0x8000400BL #define CO_E_INIT_TLS_CHANNEL_CONTROL 0x8000400CL #define CO_E_INIT_UNACCEPTED_USER_ALLOCATOR 0x8000400DL #define CO_E_INIT_SCM_MUTEX_EXISTS 0x8000400EL #define CO_E_INIT_SCM_FILE_MAPPING_EXISTS 0x8000400FL #define CO_E_INIT_SCM_MAP_VIEW_OF_FILE 0x80004010L #define CO_E_INIT_SCM_EXEC_FAILURE 0x80004011L #define CO_E_INIT_ONLY_SINGLE_THREADED 0x80004012L #define CO_E_FIRST 0x800401F0L #define CO_E_LAST 0x800401FFL #define CO_E_NOTINITIALIZED 0x800401F0L #define CO_E_ALREADYINITIALIZED 0x800401F1L #define CO_E_CANTDETERMINECLASS 0x800401F2L #define CO_E_CLASSSTRING 0x800401F3L #define CO_E_IIDSTRING 0x800401F4L #define CO_E_APPNOTFOUND 0x800401F5L #define CO_E_ERRORINAPP 0x800401F7L #define CO_E_DLLNOTFOUND 0x800401F8L #define CO_E_ERRORINDLL 0x800401F9L #define CO_E_WRONGOSFORAPP 0x800401FAL #define CO_E_OBJNOTREG 0x800401FBL #define CO_E_OBJISREG 0x800401FCL #define CO_E_OBJNOTCONNECTED 0x800401FDL #define CO_E_APPDIDNTREG 0x800401FEL #define CO_E_RELEASED 0x800401FFL #define CO_E_CLASS_CREATE_FAILED 0x80080001L #define CO_E_SCM_ERROR 0x80080002L #define CO_E_SCM_RPC_FAILURE 0x80080003L #define CO_E_BAD_PATH 0x80080004L #define CO_E_SERVER_EXEC_FAILURE 0x80080005L #define CO_E_OBJSRV_RPC_FAILURE 0x80080006L #define CO_E_SERVER_STOPPING 0x80080008L

Edited by Chady -- added readmore tag.

Comment on Win32::Desktop -- need help
Download Code
Re: Win32::Desktop -- need help
by BrowserUk (Pope) on Jan 17, 2004 at 04:15 UTC

    You may find some of the stuff on this page from my bookmarks, particularly Tip 3.

    I gave up on trying to do this kind of stuff from perl, the extra levels of indirection between you and the api's make life very hard except for very simple things.

    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "Think for yourself!" - Abigail
    Timing (and a little luck) are everything!

      Yeah, I've been told the same: this is too tough for Perl, do it in some other language. I have more code I could show you, but I am taking stabs in the dark here. I think I will put this project away on a shelve somewhere. Hopefully, it won't gather too much dust. :)

        I have no knowledge whatsoever of OLE, but it is my understanding it would be easier to access from C or C++. Couldn't you create an extention in C, bypassing Win32::OLE altogether?

        Flame notes that he has no experience with XS either.

        My code doesn't have bugs, it just develops random features.


        I've been told the same: this is too tough for Perl
        NOTHING is too tough for Perl, just because whomever was talking doesn't know how to do it (or do it easily) does not mean its too tough. To access C libraries you have to know C. Look at any of the already available Win32 extensions to see how to write one.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://321990]
Approved by Mr. Muskrat
Front-paged by bart
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (9)
As of 2014-11-28 10:01 GMT
Find Nodes?
    Voting Booth?

    My preferred Perl binaries come from:

    Results (195 votes), past polls