mruvc8-02.pl to HTML.

index -|- end

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 $entkeys(%$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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional