Sexy! Thanks Mark and Jan. mark pryor wrote: > --- Jan Dubois <[EMAIL PROTECTED]> wrote: > > >> On Wed, 10 Jan 2007 09:36:23 +0800, Foo JH >> <[EMAIL PROTECTED]> >> wrote: >> >> >>> I was wondering if there is any API that lets me >>> >> inspect a COM object in >> >>> Perl. By this I mean list out the functions, >>> >> classes, stuff like that. >> >>> I see this happening with the OLE browser that >>> >> comes with the ActivePerl >> >>> HTML manual. Is that written in Perl? >>> >> Yes, it is written in Perl, but the >> Win32::OLE::TypeLib and >> Win32::OLE::TypeInfo classes it uses are not >> documented. I wrote the >> OLE browser to explore both using PerlScript for >> DHTML and support for >> OLE typelibs in Win32::OLE. Therefore the APIs were >> only experimental. >> Since there was not a lot of interest in this >> functionality from other >> people, I never spend the time to finalize the API >> and document it. But >> you can probably figure a lot of this out by looking >> at the OLE browser >> source. >> >> Cheers, >> -Jan >> _______________________________________________ >> Perl-Win32-Users mailing list >> Perl-Win32-Users@listserv.ActiveState.com >> To unsubscribe: >> http://listserv.ActiveState.com/mailman/mysubs >> >> > Hello, > > Starting in Perl 5.8.8 build 819 (Aug 29 2006), > ActiveState has added a patch which gets working the > TLBInf32.dll object. > > This is an activex wrapper around interfaces in > OLEAUT32.dll, like ITypeLib. > > Here is a sample script that uses a combination of > registry scraping and TLBinf32 methods to analyze a > COM object like Scripting.FileSystemObject > > ------------- tlbtest.pl ------------ > #!/usr/bin/perl; > use strict; > use warnings; > > use Win32::OLE qw(in with); > use Win32::TieRegistry( Delimiter=>"/", ArrayValues=>0 > ); > > # TLI main progid > my $Obj = Win32::OLE->new('TLI.TLIApplication', > \&OleQuit) || die("could not create Obj\n"); > > print "ref=", ref($Obj), "\n"; > > my $oRef = > $Obj->TypeLibInfoFromFile("C:\\WINDOWS\\system32\\scrrun.dll"); > > print "ref=", ref($oRef), "\n"; > > # all tlbinf32 collections are 1 based > my $cc = $oRef->{Coclasses}; > > my $iCount = $cc->{Count}; > > my $libname = $oRef->{Name}; > print "LibName=", $libname, " cnt=", $iCount, "\n"; > my $i = 1; > > my $pkey = $Registry->Open("HKEY_CLASSES_ROOT/"); > while ($i <= $iCount) { > my $oItem = $cc->Item($i); > my $sName = $oItem->{Name}; > my $progidkey = $pkey->Open("$libname\.$sName"); > if ($progidkey) { > > # if the TypeFlag masks with 2 then its createable > (11 works too) > my $tkind = $oItem->{AttributeMask}; > if ( $tkind and 2 ) { > print $progidkey->GetValue(''), "\n"; > print "$sName \n"; > } > } > > $i ++; > } > > print "type=", ref($Registry), "\n"; > > my $libs = > $Registry->Open("HKEY_CLASSES_ROOT/TypeLib"); > #keys(%$diskKey) > foreach my $guid ( $libs->SubKeyNames ) { > > # step down and open the next subkey > my $verkeys = $libs->Open("$guid"); > > # > foreach my $sver ( $verkeys->SubKeyNames ) { > my $mkey = $libs->Open("$guid/$sver/"); > my $helpstr = $mkey->GetValue(''); > ; > > my @sk = $mkey->SubKeyNames; > # the langcode is not known apriori (usually 0), so > take it as the 0'th subkeyname > my $lc = $sk[0]; > > # version must be a decimal with a decimal point > (lame messenger tlb has a bug $MS!) > next, unless (index($sver, '.') > 0); > > #get the inproc server path > my $pathkey = $libs->Open("$guid/$sver/$lc/win32/") > ; > > my $pathval = "null"; > if ($pathkey) { > $pathval = $pathkey->GetValue(''); > } > # $pathkey->GetValue('') > > print $pathval, " ",$helpstr," $sver $guid\n"; > } > # pass > } > > # subroutines below > > sub OleQuit { > my $obj = shift; > undefine $obj; > } > ----------- end script ---------- > > > > ____________________________________________________________________________________ > We won't tell. Get more on shows you hate to love > (and love to hate): Yahoo! TV's Guilty Pleasures list. > http://tv.yahoo.com/collections/265 >
_______________________________________________ Perl-Win32-Users mailing list Perl-Win32-Users@listserv.ActiveState.com To unsubscribe: http://listserv.ActiveState.com/mailman/mysubs
