--- 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
