Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
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

In reply to Win32::ReadDirectoryChangesW by dfaure

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others wandering the Monastery: (3)
    As of 2021-03-07 20:50 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      My favorite kind of desktop background is:











      Results (122 votes). Check out past polls.

      Notices?