[Perl/PDK/PerlCtrl] Returning an array of arrays for VB6/VBScript

For the last few weeks I've been trying to get used to working with the Perl Development Kit (PDK 7.1) from ActiveState, particularly PerlCtrl.

One of the challenges I've been facing lately is how to return an array of arrays. That is, returning something that in VB6 or VBScript might be represented as Array( Item, Array( Item, Item ), Item ).

Kudos to Perl Monks, who have provided a function which converts a Perl array to a VB array. Interestingly, it also copes with said converted array being embedded in another array and with that array being converted as well. (Bodes well for other projects.)

So what we have below is some Perl code, a PerlCtrl wrapper around a WMI call to list System Services. The wrapper returns a two element array, the first element being an array of all the services which are running, and the second an array of all the services which have been stopped.

Note that without 'use Win32::OLE qw(in);' you can't access the elements of the $colItems collection, as it enables the use of 'in' in the foreach. Similarly, you need Win32::OLE::Variant for all the Variant() calls.

Please don't ask me to explain what's going on in the convertArrayToVBArray sub, because I have no idea. Anyone know?

package ServicesList; use strict; use warnings; use Win32::OLE qw(in); use Win32::OLE::Variant; sub convertArrayToVBArray { my $array_ref = $_[0]; my $ary = Variant( VT_ARRAY|VT_VARIANT, $#{$array_ref}+1); $ary->Put(\@{$array_ref}); return $ary; } sub GetServices { my @stoppedServices; my @runningServices; my $strComputer = '.'; my $objWMIService = Win32::OLE->GetObject('winmgmts:\\\\' . $strComputer . '\\root\\cimv2'); my $colItems = $objWMIService->ExecQuery('Select * from Win32_Service'); foreach my $objItem (in $colItems) { if ( $objItem->State eq "Stopped" ) { push @stoppedServices, $objItem->DisplayName; } else { push @runningServices, $objItem->DisplayName; } } @stoppedServices = sort @stoppedServices; @runningServices = sort @runningServices; my $running = convertArrayToVBArray( \@runningServices ); my $stopped = convertArrayToVBArray( \@stoppedServices ); my @serviceList = ( $running, $stopped ); my $services = convertArrayToVBArray( \@serviceList ); return $services; } 1; =pod =begin PerlCtrl %TypeLib = ( PackageName => 'ServicesList', TypeLibGUID => '{B20BBC2D-30C6-4DED-ADF2-BADFD66FA221}', # do NOT edit this line ControlGUID => '{B6398FF7-F2BC-42D7-A094-04F53A65941E}', # do NOT edit this line either DispInterfaceIID=> '{9322D169-82A6-46BC-B927-BBAE6E0AC7E9}', # or this one ControlName => 'ServicesList', ControlVer => 1, # increment if new object with same ProgID # create new GUIDs as well ProgID => 'ServicesList.sl', DefaultMethod => '', Methods => { GetServices => { DocString => "Returns array containing two arrays, running services and stopped services respectively.", HelpContext => 101, RetType => VT_ARRAY|VT_VARIANT, TotalParams => 0, NumOptionalParams => 0, ParamList => [], }, }, # end of 'Methods' Properties => { }, # end of 'Properties' ); # end of %TypeLib =end PerlCtrl =cut

The second bit of code is a VBScript testing the COM DLL. It's a assumed that you've run the above code through PerlCtrl, generated a DLL and registered it with RegSvr32.

set o = WScript.CreateObject("ServicesList.sl") a = o.GetServices For Each sServiceName in a(0) wscript.echo "'" & sServiceName & "' running" Next wscript.echo For Each sServiceName in a(1) wscript.echo "'" & sServiceName & "' stopped" Next

I'm having a lot of fun with Perl. I've been able to take a lot of Perl functionality (Tree::Nary, Data::Trie, Lingua::EN::Inflect, Algorithm::LCSS, Algorithm::Knapsack, Algorithm::BinPack, Algorithm::Bucketizer, Algorithm::Permute, Algorithm::SetCovering, String::LCSS and Statistics::Benford) and turn it into something that VB6 and VBScript can use. I'm impressed. Would that every scripting language had this kind of power.

© Copyright Bruce M. Axtens, 2008