Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Win32::ReadDirectoryChangesW

by dfaure (Chaplain)
on Jun 14, 2004 at 08:59 UTC ( #366446=sourcecode: print w/ replies, xml ) Need Help??

Category: Win32 Stuff
Author/Contact Info D. Faure
Description:

Using Win32::API, this module allows the user to use the Win32 ReadDirectoryChangesW API call in order to monitor events relating to files and directory trees.

See MSDN here for a complete description of the features.

package Win32::ReadDirectoryChanges;

use 5.006001;
use strict;
use warnings;

require Exporter;
our @ISA = qw(Exporter);

our @EXPORT = qw(
    FILE_NOTIFY_CHANGE_FILE_NAME
    FILE_NOTIFY_CHANGE_DIR_NAME
    FILE_NOTIFY_CHANGE_NAME
    FILE_NOTIFY_CHANGE_ATTRIBUTES
    FILE_NOTIFY_CHANGE_SIZE
    FILE_NOTIFY_CHANGE_LAST_WRITE
    FILE_NOTIFY_CHANGE_LAST_ACCESS
    FILE_NOTIFY_CHANGE_CREATION
    FILE_NOTIFY_CHANGE_SECURITY

    FILE_ACTION_ADDED
    FILE_ACTION_REMOVED
    FILE_ACTION_MODIFIED
    FILE_ACTION_RENAMED_OLD_NAME
    FILE_ACTION_RENAMED_NEW_NAME
);

our $VERSION = '0.01';

use Win32::API;

## Exported stuff
sub FILE_NOTIFY_CHANGE_FILE_NAME    { 0x00000001 }
sub FILE_NOTIFY_CHANGE_DIR_NAME     { 0x00000002 }
sub FILE_NOTIFY_CHANGE_NAME         { 0x00000003 }
sub FILE_NOTIFY_CHANGE_ATTRIBUTES   { 0x00000004 }
sub FILE_NOTIFY_CHANGE_SIZE         { 0x00000008 }
sub FILE_NOTIFY_CHANGE_LAST_WRITE   { 0x00000010 }
sub FILE_NOTIFY_CHANGE_LAST_ACCESS  { 0x00000020 }
sub FILE_NOTIFY_CHANGE_CREATION     { 0x00000040 }
sub FILE_NOTIFY_CHANGE_EA           { 0x00000080 }
sub FILE_NOTIFY_CHANGE_SECURITY     { 0x00000100 }
sub FILE_NOTIFY_CHANGE_STREAM_NAME  { 0x00000200 }
sub FILE_NOTIFY_CHANGE_STREAM_SIZE  { 0x00000400 }
sub FILE_NOTIFY_CHANGE_STREAM_WRITE { 0x00000800 }

sub FILE_ACTION_ADDED                  { 0x00000001 }
sub FILE_ACTION_REMOVED                { 0x00000002 }
sub FILE_ACTION_MODIFIED               { 0x00000003 }
sub FILE_ACTION_RENAMED_OLD_NAME       { 0x00000004 }
sub FILE_ACTION_RENAMED_NEW_NAME       { 0x00000005 }
sub FILE_ACTION_ADDED_STREAM           { 0x00000006 }
sub FILE_ACTION_REMOVED_STREAM         { 0x00000007 }
sub FILE_ACTION_MODIFIED_STREAM        { 0x00000008 }
sub FILE_ACTION_REMOVED_BY_DELETE      { 0x00000009 }
sub FILE_ACTION_ID_NOT_TUNNELLED       { 0x0000000A }
sub FILE_ACTION_TUNNELLED_ID_COLLISION { 0x0000000B }

## Internal stuff
my ($CloseHandle,
    $GetCurrentProcess,
    $OpenProcessToken,
    $LookupPrivilegeValue,
    $AdjustTokenPrivileges,
    $CreateFile,
    $ReadDirectoryChanges);

sub FILE_LIST_DIRECTORY { 0x00000001 }

sub FILE_SHARE_READ  { 0x00000001 }
sub FILE_SHARE_WRITE { 0x00000002 }

sub OPEN_EXISTING { 3 }

sub FILE_FLAG_BACKUP_SEMANTICS { 0x02000000 }

sub TOKEN_ADJUST_PRIVILEGES { 0x0020 }
sub TOKEN_QUERY             { 0x0008 }

sub SE_BACKUP_NAME        { 'SeBackupPrivilege' }
sub SE_RESTORE_NAME       { 'SeRestorePrivilege' }
sub SE_CHANGE_NOTIFY_NAME { 'SeChangeNotifyPrivilege' }

sub SE_PRIVILEGE_ENABLED  { 2 }

sub DWORD_SIZE { 4 }

sub _InitializeAPI {
    my $kernel32 = 'kernel32.dll';
    my $advapi32 = 'advapi32.dll';

    $CloseHandle = new Win32::API($kernel32,
                                  'CloseHandle',
                                  'N', 'I') || die;
    $GetCurrentProcess     = new Win32::API($kernel32,
                                            'GetCurrentProcess',
                                            '', 'N') || die;
    $OpenProcessToken      = new Win32::API($advapi32,
                                            'OpenProcessToken',
                                            'NNP', 'I' ) || die;
    $LookupPrivilegeValue  = new Win32::API($advapi32,
                                            'LookupPrivilegeValue',
                                            'PPP', 'I') || die;
    $AdjustTokenPrivileges = new Win32::API($advapi32,
                                            'AdjustTokenPrivileges',
                                            'NIPNPP', 'I') || die;
    $CreateFile = new Win32::API($kernel32,
                                 'CreateFileA',
                                 'PNNPNNN', 'N') or die;
    $ReadDirectoryChanges = new Win32::API($kernel32,
                                           'ReadDirectoryChangesW',
                                           'NPNINPPP', 'I') || die;
}

sub _EnablePrivileges {
    my $phToken = pack("L", 0);

    if($OpenProcessToken->Call($GetCurrentProcess->Call(),
                               TOKEN_ADJUST_PRIVILEGES | TOKEN_QUERY,
                               $phToken)) {
        my $hToken = unpack("L", $phToken);

        _SetPrivilege($hToken, SE_BACKUP_NAME, 1);
        _SetPrivilege($hToken, SE_RESTORE_NAME, 1);
        _SetPrivilege($hToken, SE_CHANGE_NOTIFY_NAME, 1);

        $CloseHandle->Call($hToken);
    }
    #print "privileges altered\n";
}

sub _SetPrivilege {
    my ($hToken, $pszPriv, $bSetFlag) = @_;

    my $iResult;
    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($pPrivStr
+uct),
                                                      0, 0));
    }
    return ($iResult);
}

## Methods
sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my $self = {
        # the defaults
        path    => undef,
        subtree => 0,
        filter  => FILE_NOTIFY_CHANGE_NAME,
        # overridden
        @_,
    };
    bless $self, $class;
    return $self if $self->initialize(@_);
    return undef;
}

sub initialize {
    my $self = shift;

    $CloseHandle->Call($self->{handle}) if (exists($self->{handle}) &&
                                            $self->{handle} > 0);
    $self->{handle} = $CreateFile->Call($self->{path},
                                        FILE_LIST_DIRECTORY,
                                        FILE_SHARE_READ | FILE_SHARE_W
+RITE,
                                        0,
                                        OPEN_EXISTING,
                                        FILE_FLAG_BACKUP_SEMANTICS,
                                        0);

    return ($self->{handle} > 0) ? 1 : undef;
}

sub read_changes {
    my $self = shift;

    return undef unless (exists($self->{handle}) && $self->{handle} > 
+0);

    my $nBufferLength = 1024; #1024 * DWORD_SIZE;
    my $pBuffer = "\x00" x $nBufferLength;

    my $pBytesReturned = pack("L", 0);

    my $iResult = $ReadDirectoryChanges->Call($self->{handle},
                                              $pBuffer,
                                              $nBufferLength,
                                              $self->{subtree},
                                              $self->{filter},
                                              $pBytesReturned,
                                              0, 0);
    my $bytesReturned = unpack("L", $pBytesReturned);
    my @results = ();

    if ($bytesReturned > 0) {
        my ($NextEntryOffset, $Action, $FileNameLength, $FileName);

        while (1) {
            ($NextEntryOffset, $Action, $FileNameLength) = unpack("LLL
+", $pBuffer);
            (undef, undef, undef, $FileName) = unpack("LLLa$FileNameLe
+ngth", $pBuffer);

            $FileName = pack "C*", unpack "S*", $FileName;

            push @results, $Action => $FileName;

            last if($NextEntryOffset <= 0);

            $pBuffer = substr($pBuffer, $NextEntryOffset);
        }

    }
    return @results;
}

DESTROY {
    my $self = shift;

    $CloseHandle->Call($self->{handle}) if (exists($self->{handle}) &&
                                            $self->{handle} > 0);
}

_InitializeAPI;
_EnablePrivileges;

1;

__END__

=head1 NAME

Win32::ReadDirectoryChanges - Quick and dirty ReadDirectoryChangesW Pe
+rl wrapper

=head1 SYNOPSIS

    use Win32::ReadDirectoryChanges;

    $rdc = new Win32::ReadDirectoryChanges(path    => $path,
                                           subtree => 1,
                                           filter  => $filter);

    @results = $rdc->read_changes;

    while (scalar @results) {
      my ($action, $filename) = splice(@results, 0, 2);

    }

=head1 DESCRIPTION

Using Win32::API, this module allows the user to use the Win32
ReadDirectoryChangesW API call in order to monitor events relating to 
+files and
directory trees.

See MSDN for a complete description of the features.

=head2 Methods

=over 4

=item $rdc = new Win32::ReadDirectoryChanges( %options )

This method constructs a new C<Win32::ReadDirectoryChanges> object and
+ returns
it. Key/value pair arguments may be provided to set up the initial sta
+te.
The following options correspond to attribute methods described below:

   KEY       DEFAULT                
   -------   -----------------------
   path      undef
   subtree   0
   filter    FILE_NOTIFY_CHANGE_NAME

=item @results = $rdc->read_changes;

This method waits until modifications occured to monitored directory t
+ree.
The returned array contains type of change codes and related file name
+ relative
to directory tree.

=head1 SEE ALSO

See L<"Win32::API">, L<"Win32::ChangeNotify">.

=head1 REMARKS

This module is a rework of several things found on the Net. It's more 
+a proof
of concept than something really usuable.

=head1 AUTHOR

D. Faure, E<lt>dfaure@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2004 by D. Faure

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.3 or,
at your option, any later version of Perl 5 you may have available.


=cut

Comment on Win32::ReadDirectoryChangesW
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://366446]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (10)
As of 2015-07-29 11:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (263 votes), past polls