Padre::Util::Win32 - Padre Win32 Utility Functions

  Padre::Util::Win32::GetLongPathName($path);

  Padre::Util::Win32::Recycle($file_to_recycle);

  Padre::Util::Win32::AllowSetForegroundWindow($pid);

  Padre::Util::Win32::ExecuteProcessAndWait(
	directory  => $directory,
	file       => $file,
	parameters => $parameters,
	show       => $show)

  Padre::Util::Win32::GetCurrentProcessMemorySize;

  Padre::Util::Win32::GetLastError;

package Padre::Util::Win32;

use 5.008;
use strict;
use warnings;

use Padre::Constant ();
use Padre::Logger;

# This module may be loaded by others, so don't crash on Linux when just being loaded:
if (Padre::Constant::WIN32) {
	require Win32::API;
} else {
	TRACE("WARN: Inefficiently loading Padre::Util::Win32 when not on Win32");
}

our $VERSION = '0.86';

my %Types = ();

sub GetLongPathName {

	# Only for win32
	die "Win32 function called!" unless Padre::Constant::WIN32;

	my $path = shift;

	# Allocate a buffer that can take the maximum allowed win32 path
	my $MAX_PATH = 260 + 1;
	my $buf      = ' ' x $MAX_PATH;

	my $func = Win32::API->new( kernel32 => <<'CODE');
	DWORD GetLongPathName(
		LPCTSTR lpszShortPath,
		LPTSTR lpszLongPath,
		DWORD cchBuffer
	);
CODE
	my $length = $func->Call( $path, $buf, $MAX_PATH );

	return $length ? substr( $buf, 0, $length ) : undef;
}

sub Recycle {

	# Only for win32
	die "Win32 function called!" unless Padre::Constant::WIN32;

	my $file_to_recycle = shift;

	unless ( $Types{SHFILEOPSTRUCT} ) {

		# define the win32 structure
		Win32::API::Struct->typedef(
			SHFILEOPSTRUCT => qw(
				HWND hwnd;
				UINT wFunc;
				LPCTSTR pFrom;
				LPCTSTR pTo;
				FILEOP_FLAGS fFlags;
				BOOL fAnyOperationsAborted;
				LPVOID hNameMappings;
				LPCTSTR lpszProgressTitle;
				)
		);
		$Types{SHFILEOPSTRUCT} = 1;
	}

	# prepare structure for win32 call
	my $op = Win32::API::Struct->new('SHFILEOPSTRUCT');
	$op->{wFunc}  = 0x0003;                   # FO_DELETE from ShellAPI.h
	$op->{fFlags} = 0x0040;                   # FOF_ALLOWUNDO from ShellAPI.h
	$op->{pFrom}  = $file_to_recycle . "\0\0";

	# perform the recycling
	my $result = Win32::API->new( shell32 => q{ int SHFileOperation( LPSHFILEOPSTRUCT lpFileOp ) } )->Call($op);

	# failed miserably
	return if $result;

	# user aborted...
	return 0 if $op->{fAnyOperationsAborted};

	# file recycled
	return 1;
}

#
# Enables the specified process to set the foreground window
# via SetForegroundWindow
#
sub AllowSetForegroundWindow {

	die "Win32 function called!" unless Padre::Constant::WIN32;

	my $pid = shift;

	my $func = Win32::API->new( user32 => <<'CODE');
BOOL AllowSetForegroundWindow(
	DWORD dwProcessId
);
CODE
	return $func->Call($pid);
}

sub ExecuteProcessAndWait {
	die "Win32 function called!" unless Padre::Constant::WIN32;

	unless ( $Types{SHELLEXECUTEINFO} ) {
		Win32::API::Struct->typedef(
			'SHELLEXECUTEINFO', qw(
				DWORD cbSize;
				ULONG fMask;
				HWND hwnd;
				LPCTSTR lpVerb;
				LPCTSTR lpFile;
				LPCTSTR lpParameters;
				LPCTSTR lpDirectory;
				int nShow;
				HINSTANCE hInstApp;
				LPVOID lpIDList;
				LPCTSTR lpClass;
				HKEY hkeyClass;
				DWORD dwHotKey;
				HANDLE hIconOrMonitor;
				HANDLE hProcess;
				)
		);
		$Types{SHELLEXECUTEINFO} = 1;
	}

	# XXX Ignore Win32::API warnings. It's ugly but it works :)
	local $SIG{__WARN__} = sub { };

	# Set up for the API call
	my %params = @_;
	my $info   = Win32::API::Struct->new('SHELLEXECUTEINFO');
	$info->{cbSize}       = $info->sizeof;
	$info->{lpVerb}       = 'open';
	$info->{lpDirectory}  = $params{directory} if $params{directory};
	$info->{lpFile}       = $params{file};
	$info->{lpParameters} = $params{parameters};
	$info->{nShow}        = $params{show} ? 1 : 0;
	$info->{fMask}        = 0x40;                                    # SEE_MASK_NOCLOSEPROCESS
	my $ShellExecuteEx = Win32::API->new( shell32 => <<'CODE');
		BOOL ShellExecuteEx(
			LPSHELLEXECUTEINFO lpExecInfo
		);
CODE

	if ( $ShellExecuteEx->Call($info) ) {

		# Wait for the process to finish
		my $WaitForSingleObject = Win32::API->new( kernel32 => <<'CODE');
			DWORD WaitForSingleObject(
				HANDLE hHandle,
				DWORD dwMilliseconds
			);
CODE
		$WaitForSingleObject->Call( $info->{hProcess}, 0xFFFFFFFF );

		# Clean process handle!
		my $CloseHandle = Win32::API->new( kernel32 => <<'CODE');
			BOOL CloseHandle(
				HANDLE hObject
			);
CODE
		$CloseHandle->Call( $info->{hProcess} );

		# And we have finished successfully
		return 1;
	}

	# We failed miserably!
	return 0;
}

sub GetCurrentProcessMemorySize {

	# Retrieves the current process handle
	my $hProcess = Win32::API->new( 'kernel32', <<'CODE' )->Call();
		HANDLE GetCurrentProcess();
CODE

	# Define the process memory counters structure
	Win32::API::Struct->typedef(
		PPROCESS_MEMORY_COUNTERS => qw(
			DWORD  cb;
			DWORD  PageFaultCount;
			SIZE_T PeakWorkingSetSize;
			SIZE_T WorkingSetSize;
			SIZE_T QuotaPeakPagedPoolUsage;
			SIZE_T QuotaPagedPoolUsage;
			SIZE_T QuotaPeakNonPagedPoolUsage;
			SIZE_T QuotaNonPagedPoolUsage;
			SIZE_T PagefileUsage;
			SIZE_T PeakPagefileUsage;
			)
	);

	# Creates the structure
	my $stats = Win32::API::Struct->new('PPROCESS_MEMORY_COUNTERS');
	$stats->{cb} = $stats->sizeof;

	# Retrieves process memory information
	my $GetProcessMemoryInfo = Win32::API->new( 'psapi', <<'CODE' );
		BOOL GetProcessMemoryInfo(
			HANDLE Process,
			PPROCESS_MEMORY_COUNTERS ppsmemCounters,
			DWORD cb
		);
CODE
	$GetProcessMemoryInfo->Call( $hProcess, $stats, $stats->{cb} );

	# Returns the peak memory size as bytes
	return $stats->{PeakWorkingSetSize};
}

# This sub is here to remember everyone that $^E could also be
# used and to keep the link to the error code list in a public
# place.

sub GetLastError {

	return $^E;
}

1;

__END__

# Copyright 2008-2011 The Padre development team as listed in Padre.pm.
# LICENSE
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl 5 itself.