mruvc8.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:46 2010 from mruvc8.pl 2007/04/11 9.4 KB.

#!/perl -w
# NAME: mruvc8.pl
# AIM: To enumerate the Microsoft Visual Studio 8 Express (MSVC8) from registry
# geoff mclane - http://geoffmclane.com/mperl/samples/index.htm - 20070402
use strict;
use warnings;
use File::Basename;
use File::Copy;
use Win32::Registry;
use Win32::TieRegistry( Delimiter => "#", ArrayValues => 0 );
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $outfile = 'temp.'.$0.'.txt';
if ($0 =~ /\w{1}:\\.*/) {
   my @tmpsp = split(/\\/,$0);
   $outfile = 'temp.'.($tmpsp[-1]).'.txt';
}
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );
my $regcnt = 0;
my %PathMap = ();
my %KeysVal = ();
my $htmout = 'mruvc8.htm';
my $netcpy = "\\\\PRO-1\\PSAVES\\.";
my @inform = ();
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 $MSVC8MRUP = $MSBASE.'VCExpress/8.0/ProjectMRUList';
my $MSVC8MRUF = $MSBASE.'VCExpress/8.0/FileMRUList';
my $pound = $Registry->Delimiter("/");
my $ymd = YYYYMMDD2( time(), '' );
my $cnt = 0;
prt2( "Using DATE [$ymd] ..." );
Read_Previous( $htmout );
if ($do_reg) {
   show_REG_list( $MSVC8MRUP ); 
   show_REG_list( $MSVC8MRUF );
   $cnt = 0;
}
if ($write_file) {
   rename_2_old_bak( $htmout );
   if (open $FH, ">$htmout") {
      Out_2_File($FH);
      close $FH;
      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" );
      }
   } else {
      prt( "Creation of $htmout FAILED! ... $! ...\n" );
      if ( !$dbg1 ) {
         prt( "Simple listing of components read from registry ...\n" );
         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 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
         $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] );
                     $key = $pt1 . '#' . $pt2;
                     $KeysVal{$key} = $pt3;
                  }
               }
            }
            $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);
   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";
   foreach $key (sort keys %KeysVal) {
      $cnt++;
      $val = $KeysVal{$key};
      @ks = split('#', $key);
      $k1 = $ks[0];
      $k2 = $ks[1];
      $k3 = $ks[2];
      print $fh "<DD>$k1#$k2\n";
      print $fh "<UL>\n";
      print $fh "<LI>$k3 = $val\n";
      prt( "$cnt $key $val\n" ) if ($dbg3);
      last;
   }
   $cnt = 0;
   foreach $key (sort keys %KeysVal) {
      $cnt++;
      if ($cnt == 1) {
         next;
      }
      $val = $KeysVal{$key};
      @ks = split('#', $key);
      if (($k1 ne $ks[0]) || ($k2 ne $ks[1])) {
         $k1 = $ks[0];
         $k2 = $ks[1];
         print $fh "</UL>\n";
         print $fh "<DD>$k1#$k2\n";
         print $fh "<UL>\n";
      }
      $k3 = $ks[2];
      print $fh "<LI>$k3 = $val\n";
      prt( "$cnt $key $val\n" ) if ($dbg3);
   }
   print $fh "</UL>\n";
   print $fh "</DL>\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 <<"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;
}
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;
   if ( $tkey = $Registry->{$tx} ) {
      $PathMap{$tx2} = $tx;
      $ecnt = 0;
      $added = 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" );
   }
}
################################################
# 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 trimall {
   my ($ln) = shift;
   chomp $ln;         # remove CR (\n)
   $ln =~ s/\r$//;      # remove LF (\r)
   $ln =~ s/\t/ /g;   # TAB(s) to a SPACE
   while ($ln =~ /\s\s/) {
      $ln =~ s/\s\s/ /g;   # all double space to SINGLE
   }
   while ($ln =~ /^\s/) {
      $ln = substr($ln,1); # remove all LEADING space
   }
   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);
}
# eof - mruvc8.pl

index -|- top