Enumerate Win32 Fonts

slloyd has asked for the wisdom of the Perl Monks concerning the following question:

I am trying to enumerate through all the fonts installed on my computer. For some reason, I cannot get Win32::TieRegistry to return the ValueNames from the Fonts registry key. The following script returns the error: "Can't use an undefined value as an ARRAY reference at C:/Perl/site/lib/Win32/TieRegistry.pm line 678." What am I doing wrong? The perl script at http://www.microsoft.com/technet/scriptcenter/funzone/games/tips08/gtip0118.mspx also returns the same error.

#!perl
use strict;
use Win32::TieRegistry;
$Registry->Delimiter("/"); # Set delimiter to "/".
$|=1;
my $fontskey = $Registry->{"LMachine/SOFTWARE/Microsoft/Windows NT/Cur
+rentVersion/Fonts"} || die $^E;
for my $val ($fontskey->ValueNames)
{
    print "$val\n";
}
exit;
[download]

This vbscript works fine

Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."

Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & 
+_
    strComputer & "\root\default:StdRegProv")
 
strKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Fonts"
objReg.EnumValues HKEY_LOCAL_MACHINE, _
    strKeyPath,arrEntryNames
For Each strValue in arrEntryNames
    Wscript.Echo strValue
Next
[download]

-------------------------------
Need a good Perl friendly Host Provider?
http://www.dreamhost.com

Comment on Enumerate Win32 Fonts Select or Download Code

Replies are listed 'Best First'.
Re: Enumerate Win32 Fonts by ww (Archbishop) on Jan 21, 2008 at 23:13 UTC
Can't reproduce the error on a windows box here `perl -v This is perl, v5.8.8 built for MSWin32-x86-multi-thread;` [download] `perl -c (yourcode).pl (yourcode).pl syntax OK` [download] And output from `perl (yourcode).pl` is: Roman (All res) Script (All res) Modern (All res) Small Fonts (VGA res) Arial (TrueType) Arial Bold (TrueType) Arial Bold Italic (TrueType) Arial Italic (TrueType) Courier New (TrueType) Courier New Bold (TrueType) Courier New Bold Italic (TrueType) Courier New Italic (TrueType) Lucida Console (TrueType) Lucida Sans Unicode (TrueType) Times New Roman (TrueType) Times New Roman Bold (TrueType) Times New Roman Bold Italic (TrueType) Times New Roman Italic (TrueType) WingDings (TrueType) Symbol (TrueType) Symbol 8,10,12,14,18,24 (VGA res) .... [download]	[reply] [d/l] [select]
Re^2: Enumerate Win32 Fonts by Anonymous Monk on Jan 21, 2008 at 23:48 UTC
I am having similar problems. I am using the cygwin distribution: perl -v This is perl, v5.8.8 built for cygwin-thread-multi-64int	[reply]
Re^3: Enumerate Win32 Fonts by slloyd (Hermit) on Jan 22, 2008 at 00:04 UTC
What version of TieRegistry? I am using 0.25. Steve ------------------------------- Need a good Perl friendly Host Provider? http://www.dreamhost.com	[reply]
Re^4: Enumerate Win32 Fonts by ww (Archbishop) on Jan 22, 2008 at 00:36 UTC
Re: Enumerate Win32 Fonts by nikosv (Deacon) on Jan 22, 2008 at 11:20 UTC
WMI is good for this kind of work use strict; use Win32::OLE('in'); my $computer = "my_pc"; #your computer name as it appears in the cont +rol panel's system menu my $objWMIService = Win32::OLE->GetObject("winmgmts:\\\\$computer\\roo +t\\CIMV2") or die "WMI connection failed.\n"; my $colItems = $objWMIService->ExecQuery("SELECT * FROM Win32_FontInfo +Action", "WQL"); foreach my $objItem (in $colItems) { print "Caption: $objItem->{Caption}\n"; print "FontTitle: $objItem->{FontTitle}\n"; print "File: $objItem->{File}\n"; print "\n"; } } [download] also,there are other properties of Win32_FontInfoAction class that can be queried eg description,file,version. You can use constants wbemFlagReturnImmediately and wbemFlagForwardOnly opting for faster execution. Creating Faster Queries by Using a Forward-only Eumerator	[reply] [d/l]
Re^2: Enumerate Win32 Fonts by slloyd (Hermit) on Jan 22, 2008 at 15:57 UTC
When I run your code it hangs on the foreach. I am not sure why. ------------------------------- Need a good Perl friendly Host Provider? http://www.dreamhost.com	[reply]
Re^3: Enumerate Win32 Fonts by nikosv (Deacon) on Jan 22, 2008 at 20:55 UTC
give it some time,it may appear like it's hanging.if it reaches beyond 'die "WMI connection failed";' should be fine. It runs a 'select *' query so it will take some time.Subsequent calls will be faster.	[reply]
Re: Enumerate Win32 Fonts by Marza (Vicar) on Jan 22, 2008 at 07:04 UTC
Are you running activestate? I found an old note about a bug. It's old so they either never solved it or it was re-introduced. Bug Reported. I ran your code and the code mentioned in the link with strawberry perl. When I ran it with Activestate, both blew up with the mentioned error.	[reply]
Re^2: Enumerate Win32 Fonts by slloyd (Hermit) on Jan 22, 2008 at 15:47 UTC
I am running ActiveState `This is perl, v5.8.8 built for MSWin32-x86-multi-thread (with 50 registered patches, see perl -V for more detail) Copyright 1987-2006, Larry Wall Binary build 820 [274739] provided by ActiveState http://www.ActiveSta +te.com Built Jan 23 2007 15:57:46` [download] ------------------------------- Need a good Perl friendly Host Provider? http://www.dreamhost.com	[reply] [d/l]
Re^2: Enumerate Win32 Fonts by slloyd (Hermit) on Jan 24, 2008 at 00:00 UTC
I finally ended up having to go to Win32API::Registry to make this work. `use strict; $\|=1; use Win32API::Registry qw( :ALL ); my ($key, $uIndex, $name, $nameLength, $type, $data, $dataLength ); my $ok=RegOpenKeyEx( HKEY_LOCAL_MACHINE , "SOFTWARE\\Microsoft\\Window +s NT\\CurrentVersion\\Fonts", 0, KEY_READ, $key ); if($key){ my $uIndex=0; do{ RegEnumValue ( $key, $uIndex, $name, $nameLength, [], $type, +$data, $dataLength ); print "$name=$data\r\n"; $uIndex++; } while(!regLastError()); } RegCloseKey( $key );` [download] ------------------------------- Need a good Perl friendly Host Provider? http://www.dreamhost.com	[reply] [d/l]
Re: Enumerate Win32 Fonts by BitDreamer (Sexton) on Feb 17, 2015 at 21:55 UTC
There have been multiple bug reports that seem to actually be for the same bug. See https://rt.cpan.org/Public/Bug/Display.html?id=99892 for specific details, and possible fixes.	[reply]