Generated: Sun Aug 21 11:11:00 2011 from findinlib.pl 2011/04/01 12.3 KB.
#!/usr/bin/perl -w # NAME: findinlib.pl # AIM: Uses 'Dump4' utility so is quite specialized # Find a 'function' in a library, or set of libraries # 01/04/2011 - Unless verbosity increased, do NOT show __real@ nor ?? items... # It sould be nice if something could be done about name mangling or name decoration... # from : http://en.wikipedia.org/wiki/Name_mangling # Can be split into 2 type - that for C, and another for C++ # Simple C decoration - 3 cases # int _cdecl f (int x) { return 0; } - normal default so even without [_cdecl] # int _stdcall g (int y) { return 0; } # int _fastcall h (int z) { return 0; } # Decorations # _f # _g@4 # @h@4 # Name mangling in C++ - NO STANDARD - each compiler does its own thing ;=(( Here MSVC C++ only # void h(int) void h(int, char) void h(void) # ?h@@YAXH@Z ?h@@YAXHD@Z ?h@@YAXXZ # from : http://en.wikipedia.org/wiki/Microsoft_Visual_C%2B%2B_Name_Mangling # All mangled C++ names start with ? (question mark). # The structure of mangled names looks like this: Prefix ? - Optional: Prefix @? - Qualified name - Type # Qualification is written in reversed order. # For example myclass::nested::something becomes something@nested@myclass@@. # Name with Template Arguments - Name fragments starting with ?$ have template arguments # For example, we assume the following prototype. # void __cdecl abc<def<int>,void*>::xyz(void); # The name of this function can be obtained by the following process: # abc<def<int>,void*>::xyz - order # xyz@ abc<def<int>,void*> @ - order reversed # xyz@ ?$abc@ def<int> void* @ @ # xyz@ ?$abc@ V def<int> @ PAX @ @ # xyz@ ?$abc@ V ?$def@H@ @ PAX @ @ # xyz@?$abc@V?$def@H@@PAX@@ # So the mangled name for this function is # ?xyz@?$abc@V?$def@H@@PAX@@YAXXZ. # Nested Name # For example, ?nested@??func@@YAXXZ@4HA means variable ?nested@@4HA(int nested) # inside ?func@@YAXXZ(void __cdecl func(void)). The UnDecorateSymbolName function returns # int 'void __cdecl func(void)'::nested for this input. use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load lib_utils.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $load_log = 0; my $in_file = ''; my $debug_on = 0; my $def_file = 'def_file'; my @dir_list = (); my @file_list = (); my $find_func = ''; my $dump_opts = '-lib:X'; my $verbosity = 0; sub VERB1() { return ($verbosity >= 1); } sub VERB2() { return ($verbosity >= 2); } sub VERB5() { return ($verbosity >= 5); } sub VERB9() { return ($verbosity >= 9); } ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; my $max_max_res = 0; my $tot_fun_cnt = 0; my $max_res_fil = ''; # debug my $dbg_01 = 0; # or VERB9() my $dbg_02 = 0; # or VERB5() my $dbg_03 = 0; # or VERB2() my $dbg_04 = 0; sub show_warnings($) { my ($val) = @_; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { # prt( "\nNo warnings issued.\n\n" ); } } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } show_warnings($val); close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub get_dump4_array($) { my ($inf) = @_; my @arr = (); prt("Moment, processing 'dump4 $dump_opts $inf'...\n") if ($dbg_02 || VERB5()); if (open (DIFF, "dump4 $dump_opts $inf |")) { @arr = <DIFF>; close DIFF; } return \@arr; } sub process_file_list($) { my ($rfl) = @_; my $cnt = scalar @{$rfl}; prt("Processing $cnt files, for [$find_func]...\n"); my ($file,$ra,$lcnt,$line,$fcnt); if ($dbg_04) { $line = ''; foreach $file (@{$rfl}) { $file =~ s/^lib\\//; if ($file =~ /_aD\.lib/) { $line .= ";" if (length($line)); $line .= $file; } } prt("$line\n"); } $fcnt = 0; foreach $file (@{$rfl}) { $ra = get_dump4_array($file); $lcnt = scalar @{$ra}; prt("Scanning $lcnt lines from Dump4 scan of [$file]...\n") if ($dbg_03 || VERB9()) ; foreach $line (@{$ra}) { chomp $line; if ($line =~ /$find_func/) { prt("Found in [$file] [$line]\n"); $fcnt++; last; } } } if ($fcnt == 0) { prt("NO FINDS in $cnt searches for [$find_func]\n"); } else { prt("Shown $fcnt finds of [$find_func]...\n"); } } sub process_file_list2($) { my ($rfl) = @_; my $cnt = scalar @{$rfl}; prt("Processing $cnt files, for [$find_func] = ALL functions...\n"); my ($file,$ra,$lcnt,$line,$fcnt,$res,$maxres,$len,$max_fil); my (@list); foreach $file (@{$rfl}) { $ra = get_dump4_array($file); $lcnt = scalar @{$ra}; $fcnt = 0; @list = (); $maxres = 0; foreach $line (@{$ra}) { chomp $line; if ($line =~ /\s+[A-F0-9]+\s+(.+)$/) { $res = $1; next if ($res =~ /^bytes, compiled/); next if ($res eq 'Bytes.'); next if ($res eq 'bytes.'); if (!VERB1()) { next if ($res =~ /^\s*__real\@/); next if ($res =~ /^\s*\?\?/); } $len = length($res); if ($len > $maxres) { $maxres = $len; $max_fil = $file; } push(@list,$res); $fcnt++; } } if ($fcnt == 0) { prt("NO functions in [$file]!\n"); } else { prt("List of $fcnt functions in [$file](max=$maxres).\n"); } if ($maxres > $max_max_res) { $max_max_res = $maxres; $max_res_fil = $max_fil; } $tot_fun_cnt += $fcnt; $fcnt = 0; if (VERB1()) { foreach $line (@list) { $fcnt++; $lcnt = sprintf("%4d",$fcnt); prt("$lcnt: $line\n"); } } else { foreach $line (sort @list) { $fcnt++; $lcnt = sprintf("%4d",$fcnt); prt("$lcnt: $line\n"); } } } prt("Listed total $tot_fun_cnt functions, from $cnt files, max len $max_max_res in $max_res_fil\n"); } ######################################### ### MAIN ### parse_args(@ARGV); if ($find_func eq '*') { process_file_list2(\@file_list); } else { process_file_list(\@file_list); } pgm_exit(0,"Normal exit(0)"); ######################################## sub give_help { prt("$pgmname: version 0.0.2 2011-03-28\n"); prt("\n"); prt("Usage: $pgmname [options] function_name in_file[s]/in_dir\n"); prt("\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" --func <func> (-f) = Function to find. Search is case sensitive.\n"); prt(" --verb[nn] (-v) = Bump (or set [nn]) verbosity - Range 1 to 9.\n"); prt(" --LOG (-L) = Load log file at end in editor.\n"); prt(" --lib <lib> (-l) = Search this library.\n"); prt(" <lib> Can can be a directory, when all .lib files will be searched.\n"); prt(" or a wild card file name. That is using '*' and/or '?' chars.\n"); prt("\n"); prt("Purpose: To find a 'exported' function in a library, using my Dump4 to get the list.\n"); prt(" The source (or just the Dump4 exe) can be downloaded from\n"); prt(" http://geoffair.org/ms/dump.htm#downloads\n"); prt(" Have FUN ;=))\n"); } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av); } sub got_wild($) { my $fil = shift; my ($nm,$dir) = fileparse($fil); return 1 if ($nm =~ /(\*|\?)/); return 0; } sub process_wild($) { my $wild = shift; my ($nm,$dir) = fileparse($wild); my @files = glob($wild); my ($file); my @dirs = (); foreach $file (@files) { next if (($file eq '.')||($file eq '..')); if (-d $file) { push(@dirs,$file); } elsif (-f $file) { push(@file_list,$file); prt("Added [$file] to file list\n") if ($dbg_01 || VERB9()); } else { pgm_exit(1,"ERROR: Wild card not correctly coded wind [$wild] file [$file]!\n"); } } } sub process_in_file($) { my $fil = shift; if (-d $fil) { push(@dir_list,$fil); prt("Added [$fil] to directory list\n"); } elsif (got_wild($fil)) { process_wild($fil); } elsif (-f $fil) { push(@file_list,$fil); prt("Added [$fil] to file list\n") if ($dbg_01 || VERB9()); } else { prt("Is NOT a directory. Is NOT a file, and does not have wild cards!\n"); pgm_exit(1,"ERROR: ABorting in unknown entry [$fil]!\n"); } return 1; } sub scan_dir($) { my $dir = shift; if (!opendir(DIR,$dir)) { pgm_exit(1,"ERROR: Unable to open directory [$dir]\n"); } my @files = readdir(DIR); my @dirs = (); closedir(DIR); $dir .= "\\" if ( !($dir =~ /(\\|\/)$/) ); my ($file,$ff); foreach $file (@files) { next if ($file eq '.'); next if ($file eq '..'); $ff = $dir.$file; if (-d $ff) { push(@dirs,$ff); } elsif ($file =~ /\.lib$/i) { process_in_file($ff); } } } sub parse_args { my (@av) = @_; my ($arg,$sarg,$cnt); $cnt = 0; while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^f/i) { need_arg(@av); shift @av; $sarg = $av[0]; $find_func = $sarg; prt("Set to find function [$sarg]\n"); } elsif ($sarg =~ /^L/) { $load_log = 1; prt("Set to load log at end.\n"); } elsif ($sarg =~ /^l/) { need_arg(@av); shift @av; $sarg = $av[0]; process_in_file($sarg); } elsif ($sarg =~ /^v/i) { if ($sarg =~ /^v(\d+)$/) { $verbosity = $1; prt("Set verbosity to [$verbosity]\n"); } else { while ($sarg =~ /^v/i) { $verbosity++; $sarg = substr($sarg,1); } prt("Bumped verbosity to [$verbosity]\n"); } } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { if ($cnt == 0) { $find_func = $arg; prt("Set to find function [$arg]\n"); } elsif ($cnt == 1) { process_in_file($arg); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } $cnt++; } shift @av; } if (@dir_list) { prt("Expanding directory list...\n") if ($dbg_01 || VERB9()); foreach $arg (@dir_list) { scan_dir($arg); } } if (length($find_func) == 0) { pgm_exit(1,"ERROR: Unable to find function in command! Try -?\n"); } if (! @file_list) { pgm_exit(1,"ERROR: Unable to find file list in command! Try -?\n"); } } # eof - findinlib.pl