Generated: Sun Apr 15 11:46:32 2012 from mruvc8-02.pl 2011/11/02 14.8 KB.
#!/perl -w # NAME: mruvc8-02.pl # AIM: To enumerate the Microsoft Visual Studio 8 Express (MSVC8) from registry # geoff mclane - http://geoffmclane.com/mperl/samples/index.htm - 20070402 # 02/11/2011 - Avoid duplicate outputs... # 01/02/2011 - Drop the FILE list - only the project list, and check the sln file still exists # 2009/09/15 - Also include VC9 # 25/09/2007 - see mruvc8.pl, for simple sample - this add a LINK to the .SLN # file, if it EXISTS now ... # use strict; use warnings; use File::Basename; use File::Copy; use File::stat; use Win32::Registry; use Win32::TieRegistry( Delimiter => "#", ArrayValues => 0 ); my $perl_dir = "C:\\GTools\\perl"; unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl ...\n"; ####require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); ### prt( "$0 ... Hello, World ...\n" ); my $regcnt = 0; my %PathMap = (); my %KeysVal = (); my $htmout = $perl_dir.'\mruvc8-02.htm'; my $donetcopy = 0; # no copy to the NET my $netcpy = "\\\\PRO-2\\PSAVES\\."; my $netcpy2 = "\\\\Dell02\\Public\\SAVES\\."; my @inform = (); my $g_add_files = 0; my @found_projs = (); my @found_names = (); my $g_max_fn = 0; my ($FH); # debug my $do_reg = 1; # to turn OFF registry reading my $write_file = 1; # to turn OFF file writing my $load_htm = 1; # to trun OFF the final HTML loading my $dbg1 = 0; # show entry DURING enumeration my $dbg2 = 0; # show entry already in list DURING enumeration my $dbg3 = 0; # show output during FILE WRITE # 20070402 - MSVC8 MRU Files and Projects - these entries are in UNICODE ##my $MSVC8MRUP = 'HKEY_CURRENT_USER\Software\Microsoft\VCExpress\8.0\ProjectMRUList'; #my $MSVC8MRUP = 'CUser\Software\Microsoft\VCExpress\8.0\ProjectMRUList'; my $MSBASE = 'CUser/Software/Microsoft/'; my $PROJMRU = "ProjectMRUList"; my $MSVC8MRUP = $MSBASE.'VCExpress/8.0/'.$PROJMRU; my $MSVC8MRUF = $MSBASE.'VCExpress/8.0/FileMRUList'; my $MSVC9MRUP = $MSBASE.'VCExpress/9.0/'.$PROJMRU; my $MSVC9MRUF = $MSBASE.'VCExpress/9.0/FileMRUList'; my $pound = $Registry->Delimiter("/"); my $ymd = YYYYMMDD2( time(), '' ); # my $cnt = 0; my $reg_found = 0; sub mycmp_decend_n0 { return 1 if (${$a}[0] < ${$b}[0]); return -1 if (${$a}[0] > ${$b}[0]); return 0; } sub show_REG_list($) { my ($tx) = shift; my ($tkey, $ind, $ecnt, $added); my $lcnt = 0; prt2( "Probe of [$tx] ..." ); my $tx2 = $tx; $tx2 =~ s/ /_/g; $tx2 =~ s/\//\./g; $regcnt++; $tx2 = "Reg" . $regcnt; $added = 0; if ( $tkey = $Registry->{$tx} ) { $PathMap{$tx2} = $tx; $ecnt = 0; foreach my $ent ( keys(%$tkey) ) { $ecnt++; my $dat1 = $tkey->{$ent}; $ent =~ s/^\///; # drop any leading separator my $tx3 = $ymd . '#' . exclmsbase($tx) . '#' . $ent; # establish DATED entry my @aent = split(/\x00/, $dat1); my $ct = scalar @aent; my $vl = join(' ',@aent); if ($ct == 1) { $vl = $dat1; $ind = rindex($vl, '|{'); if (($ind != -1) && ($vl =~ /.*\|{.*}/)) { $vl = substr($vl,0,$ind); } prt( "ent = [$ent], dat1 = [$vl] (1)\n" ) if ($dbg1); } else { ###prt( "ent = $ent - $ct items\n" ); $lcnt = 0; $vl = join('#', @aent); ###prt( "[$vl]\n" ); my $sval = ''; foreach my $d (@aent) { $d =~ s/^\///; $lcnt++; ###prt( "dat".$lcnt." = [$d]\n" ); if (length($d) == 0) { if ( length($sval) && (substr($sval,-1) eq ' ') ) { $d = ''; } else { $d = ' '; } } $sval .= $d; } prt( "ent = [$ent] $lcnt [$sval] (2)\n" ); $vl = $sval; } if ( Is_In_List($tx3, $vl) ) { prt( "NOTE: Already in LIST - $tx3 = $vl ...\n" ) if ($dbg2); } else { if (defined $KeysVal{$tx3}) { prt( "Adding [$vl] to " . $KeysVal{$tx3} . "...\n" ); $KeysVal{$tx3} .= ' ' . $vl; } else { $KeysVal{$tx3} = $vl; } $added++; } } prt2( "Extracted $ecnt entries from this key ... adding $added to hash." ); } else { prt( "\nERROR: Can't open [$tx] value: $^E\n" ); } return $added; } prt2( "Using DATE [$ymd] ..." ); if ($do_reg) { $reg_found = 0; $reg_found += show_REG_list( $MSVC8MRUP ); if ($g_add_files) { $reg_found += show_REG_list( $MSVC8MRUF ); } if (! $reg_found) { prt("Failed on MSVC8, trying MSVC9...\n"); $reg_found += show_REG_list( $MSVC9MRUP ); if ($g_add_files) { $reg_found += show_REG_list( $MSVC9MRUF ); } if (! $reg_found) { prt("ERROR: No entries found!\n"); prt("ERROR: Can NOT locate \n[$MSVC8MRUP], nor \n[$MSVC9MRUP]! \nAborting...\n\n"); exit(1); } } #$cnt = 0; } Read_Previous( $htmout ); if ($write_file) { rename_2_old_bak( $htmout ); if (open $FH, ">$htmout") { Out_2_File($FH); close $FH; if ($donetcopy) { prt( "Attempting COPY of $htmout to $netcpy ... moment ...\n" ); if ( copy( $htmout, $netcpy ) ) { prt( "$htmout COPIED to $netcpy ...\n" ); } else { prt( "WARNING: $htmout COPY to $netcpy FAILED!\n" ); } prt( "Attempting COPY of $htmout to $netcpy2 ... moment ...\n" ); if ( copy( $htmout, $netcpy2 ) ) { prt( "$htmout COPIED to $netcpy2 ...\n" ); } else { prt( "WARNING: $htmout COPY to $netcpy2 FAILED!\n" ); } } } else { prt( "Creation of $htmout FAILED! ... $! ...\n" ); if ( !$dbg1 ) { prt( "Simple listing of components read from registry ...\n" ); my $cnt = 0; foreach my $key (sort keys %KeysVal) { $cnt++; my $val = $KeysVal{$key}; prt( "$cnt $key $val\n" ); } } } } if ($load_htm) { close_log($outfile,0); system( $htmout ); } else { close_log($outfile,1); } exit(0); ######################################## sub Is_In_List { my ($k, $v) = @_; my ($key, $val, @ks, $k1, $k2, $k3, @iks, $ik1, $ik2, $ik3, $cnt); @iks = split('#', $k); $ik1 = $iks[0]; # date of entry $ik2 = $iks[1]; # path (shortened - $MSBASE) $ik3 = $iks[2]; # key, like 'File1', 2, ... $cnt = 0; foreach $key (sort keys %KeysVal) { $cnt++; $val = $KeysVal{$key}; @ks = split('#', $key); $k1 = $ks[0]; $k2 = $ks[1]; $k3 = $ks[2]; if (uc($v) eq uc($val)) { return $cnt; } } return 0; } sub get_tag { my ($l) = shift; my $tg = ''; my $c = ''; my $ln = length($l); for (my $j = 0; $j < $ln; $j++) { $c = substr($l,$j,1); if ($c eq '>') { return $tg; } $tg .= $c; } return ''; } sub remove_href { my ($ln) = shift; if ($ln =~ /href/i) { my $nln = ''; my $len = length($ln); my $ch = ''; for (my $i = 0; $i < $len; $i++) { $ch = substr($ln, $i, 1); if ($ch eq '<') { my $tg = get_tag( substr($ln, ($i+1)) ); if (($tg =~ /^a\s+/i)|| ($tg =~ /^\/a$/i)) { $i += length($tg)+1; next; } } $nln .= $ch; } return $nln; } return $ln; } sub Read_Previous { my ($fil) = shift; my ($IF, $ch, $tag, $len, $i, $pt1, $pt2, $pt3, $key, @arr); if ( open $IF, "<$fil" ) { prt( "Reading previous $fil ... " ); my @lines = <$IF>; close $IF; prt( scalar @lines . " lines ...\n" ); # <DD>20070403#VCExpress/8.0/FileMRUList # <LI>File1 = c:\GTools\ConApps\DateFile\DateFile.cpp foreach my $line (@lines) { chomp $line; # remove CR (\n) $line =~ s/\r$//; # remove LF (\r), if any $line = remove_href($line); $len = length($line); for ($i = 0; $i < $len; $i++) { $ch = substr($line, $i, 1); if ($ch eq '<') { $tag = ''; } elsif( $ch eq '>' ) { if ($tag =~ /^<DD/i ) { $pt1 = substr($line, ($i + 1)); } elsif ($tag =~ /^<LI/i ) { $pt2 = substr($line, ($i + 1)); @arr = split(/=/, $pt2); if (scalar @arr == 2) { $pt2 = RTrim( $arr[0] ); $pt3 = LTrim( $arr[1] ); $pt3 =~ s/\s+\*.*$//; # trim off any tail info stuff $key = $pt1 . '#' . $pt2; if ($g_add_files) { #add em all $KeysVal{$key} = $pt3; } elsif ($pt1 =~ /$PROJMRU/) { # = ProjectMRUList $KeysVal{$key} = $pt3; } } else { prt( "WARNING: [$pt2] did NOT split on = sign!\n" ); } } } $tag .= $ch; } } $len = scalar keys %KeysVal; if ($len) { prt2( "Collected $len old components ..." ); } else { prt( "Failed to get any componets from this file ...\n" ); } } else { prt( "NO PREVIOUS $fil FILE ...\n" ); } } sub Out_2_File { my ($fh) = shift; my ($key, $val, @ks, $k1, $k2, $k3, $cnt); my ($nm,$dir,$ext); ### = fileparse( $fil, qr/\.[^.]*/ ); my ($sb,$msg,$len,$lcdval); prt( "Writing $htmout file ...\n" ); print $fh <<"EOF"; <html> <head> <title>VC8 MRU List</title> </head> <body> <h1 align="center">VC8 MRU List</h1> EOF print $fh "<p>Update:"; print $fh " ".scalar localtime(time()); print $fh "</p>\n"; # fill in entries $cnt = 0; $k1 = ''; $k2 = ''; print $fh "<DL>\n"; my %dupes = (); my %names = (); # do just one, to get the FIRST heading foreach $key (sort keys %KeysVal) { $cnt++; $val = $KeysVal{$key}; ($nm,$dir,$ext) = fileparse( $val, qr/\.[^.]*/ ); @ks = split('#', $key); $k1 = $ks[0]; $k2 = $ks[1]; $k3 = $ks[2]; print $fh "<DD>$k1#$k2\n"; print $fh "<UL>\n"; $msg = ''; if ($sb = stat($val)) { $msg = '*ok '.YYYYMMDD2($sb->mtime,"/"); $lcdval = lc(path_u2d($val)); if (!defined $dupes{$lcdval}) { $dupes{$lcdval} = 1; push(@found_projs, [ $sb->mtime, $val ]); if (!defined $names{$nm}) { $names{$nm} = 1; push(@found_names, $nm); } $len = length($val); $g_max_fn = $len if ($len > $g_max_fn); } } else { $msg = "*Not Found"; } if ((lc($ext) eq '.sln')&&( -f $val )) { print $fh "<LI>$k3 = <a href=\"".dos_2_unix($val)."\">$val</a> $msg\n"; } else { print $fh "<LI>$k3 = $val $msg\n"; } prt( "$cnt $key $val $msg\n" ) if ($dbg3); last; # exit after FIRST done } $cnt = 0; # done the FIRST, so can CLOSE and add new HEADING on change foreach $key (sort keys %KeysVal) { $cnt++; if ($cnt == 1) { next; # already done FIRST } $val = $KeysVal{$key}; ($nm,$dir,$ext) = fileparse( $val, qr/\.[^.]*/ ); @ks = split('#', $key); if (($k1 ne $ks[0]) || ($k2 ne $ks[1])) { $k1 = $ks[0]; $k2 = $ks[1]; print $fh "</UL>\n"; # close LIST print $fh "<DD>$k1#$k2\n"; # set NEW HEADING print $fh "<UL>\n"; # and OPEN list again } $k3 = $ks[2]; $msg = ''; if ($sb = stat($val)) { $msg = '*ok '.YYYYMMDD2($sb->mtime,"/"); $lcdval = lc(path_u2d($val)); if (!defined $dupes{$lcdval}) { $dupes{$lcdval} = 1; push(@found_projs, [ $sb->mtime, $val ]); if (!defined $names{$nm}) { $names{$nm} = 1; push(@found_names, $nm); } $len = length($val); $g_max_fn = $len if ($len > $g_max_fn); } } else { $msg = "*Not Found"; } if ((lc($ext) eq '.sln') && ( -f $val ) ) { print $fh "<LI>$k3 = <a href=\"".dos_2_unix($val)."\">$val</a> $msg\n"; } else { print $fh "<LI>$k3 = $val $msg\n"; } prt( "$cnt $key $val $msg\n" ) if ($dbg3); } print $fh "</UL>\n"; print $fh "</DL>\n"; if (@found_projs) { my ($tm,$i,$num); my @arr = sort mycmp_decend_n0(@found_projs); my $fcnt = scalar @arr; my $form = '%0'.(length($fcnt)+1).'d'; print $fh "<p>Found up to $fcnt valid projects... listed in DATE order, latest first...\n" if ($fcnt); $cnt = 0; for ($i = 0; $i < $fcnt ; $i++) { $val = $arr[$i][1]; $cnt++; $num = sprintf($form,$cnt); # $num = sprintf("%3d",$cnt); $tm = YYYYMMDD2($arr[$i][0],'/'); print $fh "<br>$num $tm <b>$val</b>\n" } if ($fcnt) { print $fh "</p>\n"; if (@found_names) { my @arr = sort @found_names; print $fh "<p>Alpabetic: "; print $fh join(" ",@arr); print $fh "</p>\n"; } } } if (@inform) { print $fh "<p>\n"; foreach $key (@inform) { print $fh "$key<br>\n"; } print $fh "Written $cnt components to file $htmout ...\n"; print $fh "</p>\n"; } print $fh "<!-- generated by $pgmname on ". scalar localtime(time()) . " -->\n"; print $fh <<"EOF"; </body> </html> EOF prt( "Written $cnt components to file $htmout ...\n" ); } sub exclmsbase { my ($t) = shift; if ($t =~ /^$MSBASE/) { $t = substr($t, length($MSBASE)); } return $t; } ################################################ # My particular time 'translation' sub YYYYMMDD2 { # 0 1 2 3 4 5 6 7 8 my ($tm, $sep) = @_; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($tm); $year += 1900; $mon += 1; my $ymd = "$year"; $ymd .= $sep; if ($mon < 10) { $ymd .= '0'.$mon; } else { $ymd .= "$mon"; } $ymd .= $sep; if ($mday < 10) { $ymd .= '0'.$mday; } else { $ymd .= "$mday"; } return $ymd; } # RENAME A FILE TO .OLD, or .BAK # 0 - do nothing if file does nto exist. # 1 - rename to .OLD if .OLD does NOT exist # 2 - rename to .BAK, if .OLD already exists, # 3 - deleting any previous .BAK ... sub rename_2_old_bak { my ($fil) = shift; my $ret = 0; if ( -f $fil ) { my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ ); my $nmbo = $dir . $nm . '.old'; $ret = 1; if ( -f $nmbo) { $ret = 2; $nmbo = $dir . $nm . '.bak'; if ( -f $nmbo ) { $ret = 3; unlink $nmbo; } } rename $fil, $nmbo; } return $ret; } sub LTrim { my ($ln) = shift; while ($ln =~ /^\s/) { $ln = substr($ln,1); # remove all LEADING space } return $ln; } sub RTrim { my ($ln) = shift; while ($ln =~ /\s$/) { $ln = substr($ln,0, length($ln) - 1); # remove all TRAILING space } return $ln; } sub prt2 { my ($msg) = shift; prt( "$msg\n" ); push(@inform, $msg); } sub dos_2_unix { my ($p) = shift; $p =~ s/\\/\//g; return $p; } # eof - mruvc8-02.pl