Roth Consulting Perl Script: Modules.pl

#   Modules.pl
#   -----------
#   Dump the list of modules for a given process.
#
#   Copyright © 1999 by Dave Roth
#   Courtesty of Roth Consulting
#   http://www.roth.net/
#   Based on code from ModuleList.pl (Example: 7.17)
#   From "Win32 Perl Scripting: Administrators Handbook" by Dave Roth
#   Published by New Riders Publishing.
#   ISBN # 1-57870-215-1
#
#  This script demonstrates the PSAPI by listing all loaded DLL (module) files
#  that each process has.

use Win32::API;
use Getopt::Long;

$VERSION = 20030524;

# Define some contants
$DWORD_SIZE = 4;
$PROC_ARRAY_SIZE = 100;
$MODULE_LIST_SIZE = 200;

# Define some Win32 API constants
$PROCESS_QUERY_INFORMATION = 0x0400;
$PROCESS_VM_READ = 0x0010;

Configure( \%Config ) || die;
if( $Config{help} )
{
  Syntax();
  exit;
}
if( $Config{kill_process} )
{
  PrepareMorgue();
}

foreach $Param ( @ARGV )
{
  if( $Param =~ /^\d+$/ )
  {
    push( @PidList, $Param );
  }
  else
  {
    push( @ModuleList, $Param );
  }
}

$OpenProcess = new Win32::API( 'kernel32.dll', 'OpenProcess', [N,I,N], N ) || die "Can not link to open proc";
$CloseHandle = new Win32::API( 'kernel32.dll', 'CloseHandle', [N], I ) || die "Can not link to CloseHandle()";
$EnumProcesses = new Win32::API( 'psapi.dll', 'EnumProcesses', [P,N,P], I ) || die;
$EnumProcessModules = new Win32::API( 'psapi.dll', 'EnumProcessModules', [N,P,N,P], I ) || die "Can not link EnumProcessModules";
$GetModuleBaseName = new Win32::API( 'psapi.dll', 'GetModuleBaseName', [N,N,P,N], N ) || die "Can not link to GetModuleBaseName\n";
$GetModuleFileNameEx = new Win32::API( 'psapi.dll', 'GetModuleFileNameEx', [N,N,P,N], N ) || die "Could not link to GetModuleFileNameEx\n";
$GetProcessMemoryInfo = new Win32::API( 'psapi.dll', 'GetProcessMemoryInfo', [N,P,N], I ) || die "Can not link GetProcessMemoryInfo()\n";

if( 0 == scalar @PidList ) 
{
    @PidList = GetPidList();
}

if( Win32::IsWinNT() )
{
    my $iTotal = 0;

    # Create a buffer
    $ProcArray = MakeBuffer( $DWORD_SIZE * $PROC_ARRAY_SIZE );
    $ProcNum = MakeBuffer( $DWORD_SIZE );

    foreach $Pid ( @PidList )
    {
        my $iModuleCount = 0;
        my $ProcInfo = GetProcessInfo( $Pid, \@ModuleList );

        # If we have been looking for a particular module then
        # go to the next one unless we found one of the modules
        next unless( $ProcInfo->{fModuleFound} );

        print "\n$ProcInfo->{pid} ($ProcInfo->{name})\n";
        if( scalar @{$ProcInfo->{modules}} )
        {
            printf( "  Current memory use: %s\n  Peak memory use: %s\n",
                    FormatNumber( $ProcInfo->{workingset} ),
                    FormatNumber( $ProcInfo->{workingsetpeak} ) );
            if( ! $Config{supress_module_list} )
            {
              print "  Module list:\n"; 
  
              foreach $Module ( @{$ProcInfo->{modules}} )
              {
                  printf( "    % 3d) %s\n", ++$iModuleCount, $Module );
              }
            }
            push( @KillList, { pid => $ProcInfo->{pid}, name => $ProcInfo->{name} } ) if( $Config{kill_process} );
        }
        else
        {
            print "  Unable to get process information.\n";
        }
    }

    if( $Config{kill_process} )
    {
      my $iCount = 0;
      print "\n\nKilling:\n";
      foreach my $Process ( sort { $a->{name} cmp $b->{name} } @KillList )
      {
        printf( "  % 3d) PID: % 5d ( %s )\n", ++$iCount, $Process->{pid}, $Process->{name} );
      }
      if( $Config{no_kill_prompt} )
      {
        KillListOfProcesses( @KillList );
      }
      else
      {
        print "\n    DO YOU WANT TO KILL THESE PROCESSES? 'Yes' or 'No'?\n    >";
        my $Result = <STDIN>;
        chomp( $Result );
        if( "yes" eq lc $Result )
        {
          KillListOfProcesses( @KillList );
        }
        else
        {
          print "\n    ABORTING. These will NOT be killed.\n";
        }
      }
    }
}
else
{
    print "Windows 95/98/ME are not supported.\n";
}

sub GetPidList()
{
    my( @PidList );
    my $ProcArrayLength = $PROC_ARRAY_SIZE;
    my $iIterationCount = 0;
    my $ProcNum;
    my $pProcArray;

    do
    {
        my $ProcArrayByteSize;
        my $pProcNum = MakeBuffer( $DWORD_SIZE );
        # Reset the number of processes since we later use it to test
        # if we worked or not
        $ProcNum = 0;
        $ProcArrayLength = $PROC_ARRAY_SIZE * ++$iIterationCount;
        $ProcArrayByteSize = $ProcArrayLength * $DWORD_SIZE;
        # Create a buffer
        $pProcArray = MakeBuffer( $ProcArrayByteSize );
        if( 0 != $EnumProcesses->Call( $pProcArray, $ProcArrayByteSize, $pProcNum ) )
        {
            # Get the number of bytes used in the array
            # Check this out -- divide by the number of bytes in a DWORD
            # and we have the number of processes returned!
            $ProcNum = unpack( "L", $pProcNum ) / $DWORD_SIZE;
            print "Total procs: $ProcNum\n";
        }
    } while( $ProcNum >= $ProcArrayLength );
    
    if( 0 != $ProcNum )
    {
        # Let's play with each PID
        # First we must unpack each PID from the returned array
        @PidList = unpack( "L$ProcNum", $pProcArray );
    }
    return( @PidList );
}


sub GetProcessInfo()
{
    my( $Pid, $ModuleList ) = @_;
    my( %ProcInfo );

    $ProcInfo{name} = "unknown";
    $ProcInfo{pid}  = $Pid;
    @{$ProcInfo{modules}} = ();

    # We can not open the system Idle process so just hack it.
    $ProcInfo{name} = "Idle" if( 0 == $Pid );

    my( $hProcess ) = $OpenProcess->Call( $PROCESS_QUERY_INFORMATION | $PROCESS_VM_READ, 0, $Pid );
    if( $hProcess )
    {
        my( $BufferSize ) = $MODULE_LIST_SIZE * $DWORD_SIZE;
        my( $MemStruct ) = MakeBuffer( $BufferSize );
        my( $iReturned ) = MakeBuffer( $BufferSize );

        # If we are looking for particular modules OR if we
        # are not looking for any module in particular then 
        # indicate that we want to display this process
        $ProcInfo{fModuleFound} = ( scalar @{$ModuleList} )? 0:1;
        
        if( $EnumProcessModules->Call( $hProcess, $MemStruct, $BufferSize, $iReturned ) )
        {
            my( $StringSize ) = 255 * ( ( Win32::API::IsUnicode() )? 2 : 1 );
            my( $ModuleName ) = MakeBuffer( $StringSize );
            my( @ModuleList ) = unpack( "L*", $MemStruct );
            my $hModule = $ModuleList[0];
            my $TotalChars;

            # Like EnumProcesses() divide $Returned by the # of bytes in an HMODULE
            # (which is the same as a DWORD)
            # and that is the number of module handles returned.
            # In this case we only want 1; the first returned in the array is
            # always the module of the process (typically an executable).
            $iReturned = unpack( "L", $iReturned ) / $DWORD_SIZE;

            if( $TotalChars = $GetModuleBaseName->Call( $hProcess, $hModule, $ModuleName, $StringSize ) )
            {
                $ProcInfo{name} = FixString( $ModuleName );
            }
            else
            {
                $ProcInfo{name} = "unknown";
            }

            for( $iIndex = 0; $iIndex < $iReturned; $iIndex++ )
            {
                $hModule = $ModuleList[$iIndex];
                $ModuleName = MakeBuffer( $StringSize );
                if( $GetModuleFileNameEx->Call( $hProcess,
                                            $hModule,
                                            $ModuleName,
                                            $StringSize ) )
                {
                  my $ModuleNameFixed = FixString( $ModuleName );
                    if( 0 == $iIndex )
                    {
                        $ProcInfo{fullname} = $ModuleNameFixed;
                    }
                    push( @{$ProcInfo{modules}}, $ModuleNameFixed );

                    # If we have not determined if we need to display this
                    # process (no specified modules have been found) then
                    # let's look to see if any of the specified modules 
                    # are here
                    if( 0 == $ProcInfo{fModuleFound} )
                    {
                      foreach my $TargetModule ( @{$ModuleList} )
                      {
                        $ProcInfo{fModuleFound} = ( $ModuleNameFixed =~ /$TargetModule/i );
                      }
                    }
                }
            }
        }

        $BufSize = 10 * $DWORD_SIZE;
        $MemStruct = pack( "L10", ( $BufSize, split( "", 0 x 9 ) ) );

        if( $GetProcessMemoryInfo->Call( $hProcess, $MemStruct, $BufSize ) )
        {
          my( @MemStats ) = unpack( "L10", $MemStruct );
          $ProcInfo{workingsetpeak} = $MemStats[2];
          $ProcInfo{workingset} = $MemStats[3];
          $ProcInfo{pagefileuse} = $MemStats[8];
          $ProcInfo{pagefileusepeak} = $MemStats[9];
        }

        $CloseHandle->Call( $hProcess );
    }
    return( \%ProcInfo );
}

sub MakeBuffer
{
    my( $BufferSize ) = @_;
    return( "\x00"  x $BufferSize );
}

sub FixString
{
    my( $String ) = @_;
    $String =~ s/(.)\x00/$1/g if( Win32::API::IsUnicode() );
    return( unpack( "A*", $String ) );
}

sub FormatNumber
{
    my( $Number ) = @_;
    while ($Number =~ s/^(-?\d+)(\d{3})/$1,$2/){};
    return( $Number );
}

sub KillListOfProcesses 
{
  my( @KillList ) = @_;
  print "\n    Killing...\n";
  $iCount = 0;
  foreach my $Process ( sort { $a->{name} cmp $b->{name} } @KillList )
  {
    printf( "    % 3d) PID: % 5d ( %s ) ... ", ++$iCount, $Process->{pid}, $Process->{name} );
    if( Kill( $Process->{pid} ) )
    {
      print "killed.";
    }
    else
    {
      print "FAILED TO KILL.";
    }
    print "\n";
  }
}

sub Kill 
{
  my( $Pid ) = @_;
  my $fResult = 0;

  if( !( $fResult = kill( $Pid, 0 ) ) )
  {
    $fResult = ForceKill( $Pid );
  }
  return( $fResult );
}

sub ForceKill
{
    my( $Pid ) = @_;
    my $iResult = 0;
    my $phToken = pack( "L", 0 );
    if( $OpenProcessToken->Call( $GetCurrentProcess->Call(), $TOKEN_ADJUST_PRIVILEGES | $TOKEN_QUERY, $phToken ) )
    {
        my $hToken = unpack( "L", $phToken );
        if( SetPrivilege( $hToken, $SE_DEBUG_NAME, 1 ) )
        {
            my $hProcess = $OpenProcess->Call( $PROCESS_TERMINATE, 0, $Pid );
            if( $hProcess )
            {
                SetPrivilege( $hToken, $SE_DEBUG_NAME, 0 );
                $iResult = $TerminateProcess->Call( $hProcess, 0 );
                $CloseHandle->Call( $hProcess );    
            }
        }
        $CloseHandle->Call( $hToken );
    }
    return( $iResult );
}     

sub SetPrivilege
{
    my( $hToken, $pszPriv, $bSetFlag ) = @_;
    my $pLuid = pack( "Ll", 0, 0 );
    if( $LookupPrivilegeValue->Call( "\x00\x00", $pszPriv, $pLuid ) )
    {
        my $pPrivStruct = pack( "LLlL", 1, unpack( "Ll", $pLuid ), ( ( $bSetFlag )? $SE_PRIVILEGE_ENABLED : 0 ) );
        $iResult = ( 0 != $AdjustTokenPrivileges->Call( $hToken, 0,$pPrivStruct, length( $pPrivStruct ), 0, 0 ) );
    }
	return( $iResult );
}

sub PrepareMorgue
{
    $TOKEN_QUERY                = 0x0008;
    $TOKEN_ADJUST_PRIVILEGES    = 0x0020;
    $SE_PRIVILEGE_ENABLED       = 0x02;
    $PROCESS_TERMINATE          = 0x0001;
    $SE_DEBUG_NAME              = "SeDebugPrivilege";

    $GetCurrentProcess = new Win32::API( 'Kernel32.dll', 'GetCurrentProcess', [], N ) || die;
    $OpenProcessToken = new Win32::API( 'AdvApi32.dll', 'OpenProcessToken', [N,N,P], I ) || die;
    $LookupPrivilegeValue = new Win32::API( 'AdvApi32.dll', 'LookupPrivilegeValue', [P,P,P], I ) || die;
    $AdjustTokenPrivileges = new Win32::API( 'AdvApi32.dll', 'AdjustTokenPrivileges', [N,I,P,N,P,P], I ) || die;
    $TerminateProcess = new Win32::API( 'Kernel32.dll', 'TerminateProcess', [N,I], I ) || die;
}

sub Configure
{
  my( $Config ) = @_;
  my $Result;
  Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
  $Result = GetOptions( $Config, qw(
                        supress_module_list|s
                        kill_process|k
                        no_kill_prompt|no_prompt
                        help|?
                        ) );
  return( $Result );
}

sub Syntax 
{
  my $Path = Win32::GetLongPathName( join( "", Win32::GetFullPathName( $0 ) ) );
  my( $Script ) = ( $Path =~ /([^\\]+)$/ );
  print<<"EOT";
$Script

This will display processes and their loaded modules.
Version: $VERSION
                                        
  Syntax:
  $Script [/s][/k [/no_prompt]][/?] <NAME | PID> [<NAME2 | PID2 [...]]
    s...........Supress printing the (possibly lengthy) list of modules
                per process.
    k...........Kill every process that is listed.
    no_prompt...Do not prompt for killing processes.                      
    NAME........The name of a module. This must be the full name such as 
                "wininet.dll" or "shell"
    PID.........A process ID.                    
              
    Example:
      $Script 1234
      $Script wininet.dll
      $Script 1234 332 wininet.dll /s
      $Script wininet.dll /s /k /no_prompt
EOT
}

__END__

History:
  20010119 roth
    - Created.(?)

  20030523 roth
    - Added ability to supress the lengthy module list (/s)
    - Added configuration routine and syntax.

  20030524 roth
    - Added ability to kill resulting list of processes.
    - Added the /no_prompt flag to prevent the prompt if you want to kill processes.
	Are you searching for a children's bike trailer?
	Would you like to try growing an avocado plant?
	Easily lose weight by increasing your metabolism.
	What, exactly, is a Calorie?
	Want to know about schooling your child using the Montessori method.
`Name:`	`Modules.pl`
`Version:`	`20030524`
`Last Updated:`	`2004.04.22`
`Author:`	`Dave Roth`
`Description:`	`Displays modules loaded for a given process`
`Explanation:`	This script displays all modules loaded into a given process. This is really useful if you want to see what processes have loaded a particular DLL file. The module also lets you kill the process that match your criteria. Syntax: MODULES.PL [/s][/k [/no_prompt]][/?] <NAME \| PID> [<NAME2 \| PID2 [...]] s...........Supress printing the (possibly lengthy) list of modules per process. k...........Kill every process that is listed. no_prompt...Do not prompt for killing processes. NAME........The name of a module. This must be the full name such as "wininet.dll" or "shell" PID.........A process ID. Example: MODULES.PL 1234 MODULES.PL wininet.dll MODULES.PL 1234 332 wininet.dll /s MODULES.PL wininet.dll /s /k /no_prompt
Perl Script: Modules.pl

The Modules.pl Script:
