ffcn: Implementation of the Win32-API-Call FindFirstChangeNotification()
Notes:
################################################################################
# Modul: ffcn.tcl
# Stand: 11.03.2004
# Zweck: Mapping von Win32-API-Calls: 'FindFirstChangeNotification'
# 'FindCloseChangeNotification'
# 'WaitForSingleObject'
# Autor: (C) M.Hoffmann, März 2004
# Siehe:
# API-Deklaration (Original Win32):
# http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/base/findfirstchangenotification.asp
# FFIDL:
# https://wiki.tcl-lang.org/1197, http://www.elf.org/ffidl/
# API-Deklarationen in PB:
# DECLARE FUNCTION FindFirstChangeNotification LIB "KERNEL32.DLL" ALIAS
# "FindFirstChangeNotificationA" (lpPathName AS ASCIIZ,
# BYVAL bWatchSubtree AS LONG,
# BYVAL dwNotifyFilter AS DWORD) AS DWORD
# DECLARE FUNCTION FindCloseChangeNotification LIB "KERNEL32.DLL" ALIAS
# "FindCloseChangeNotification" (BYVAL hChangeHandle AS DWORD) AS LONG
# DECLARE FUNCTION WaitForSingleObject LIB "KERNEL32.DLL" ALIAS
# "WaitForSingleObject" (BYVAL hHandle AS DWORD,
# BYVAL dwMilliseconds AS DWORD) AS DWORD
# FILE_NOTIFY_CHANGE_FILE_NAME = 0x00000001 default
# FILE_NOTIFY_CHANGE_DIR_NAME = 0x00000002 default
# FILE_NOTIFY_CHANGE_ATTRIBUTES = 0x00000004 default
# FILE_NOTIFY_CHANGE_SIZE = 0x00000008 default
# FILE_NOTIFY_CHANGE_LAST_WRITE = 0x00000010 default
# FILE_NOTIFY_CHANGE_LAST_ACCESS= 0x00000020
# FILE_NOTIFY_CHANGE_CREATION = 0x00000040 default
# FILE_NOTIFY_CHANGE_SECURITY = 0x00000100
# INVALID_HANDLE_VALUE = 0xffffffff
# INFINITE = 0xffffffff
# Datentypen:
# http://www.a-m-i.de/tips/strings/strings.php
# URL homepages.fh-giessen.de/~hg6661/vorlesungen/systemschnittstellen no longer avail
# script/win/datentypen.php
# Offen: Namespace,RoboDOCu,Konstanten implementieren,Catch für ffidl::callout,
# Abbruchmöglichkeit,nicht blockierende Variante,gleich die tatsächlichen
# Änderungen zurückliefern (glob vorher/nachher;intersect liefern)
################################################################################
package provide ffcn 1.0
package require Ffidl 0.5
ffidl::callout dll_ffcn {pointer-utf8 long long} long \
[ffidl::symbol kernel32.dll FindFirstChangeNotificationA]
ffidl::callout dll_fccn {long} long \
[ffidl::symbol kernel32.dll FindCloseChangeNotification]
ffidl::callout dll_wfso {long long} long \
[ffidl::symbol kernel32.dll WaitForSingleObject]
# Dieser Call wartet (wohl blockierend), bis eine Änderung im Verzeichnis auftritt
proc waitChange {pathName {includeSubDirs 0} {notifyFilter 0x5F}} {
# Überwachung einleiten
if {[catch {dll_ffcn $pathName $includeSubDirs $notifyFilter} h] ||
$h == -1} {
return -code error "FindFirstChangeNotification() gescheitert ($h)"
}
# puts $h
# Achtung: das folgende blockiert vermutlich Tcl-Eventloop!
# Überwachung starten (momentan OHNE CATCH)
set r [dll_wfso $h 0xffffffff]
# Überwachung beenden (momentan OHNE CATCH)
set r [dll_fccn $h]
return {}
}
################################################################################Example:
package require ffcn # because of the Win32-API-Call waitForSingleObject(), the following call blocks # the whole program; I haven't found a solution for this yet... # If a file in e:/demodir is created, deleted etc., the call returns: # waitChange e:/demodir
A 'tcl-only' alternative for tracking directory-changes using a polling-method (so the after ms-Value should not be too small because of cpu-load-aspects!):
proc watchDirChange {dir intv {script {}} {lastMTime {}}} {
set nowMTime [file mtime $dir]
if [string eq $lastMTime ""] {
set lastMTime $nowMTime
} elseif {$nowMTime != $lastMTime} {
# synchronous execution, so no other after event may fire in between
catch {uplevel #0 $script}
set lastMTime $nowMTime
}
after $intv [list watchDirChange $dir $intv $script $lastMTime]
}
watchDirChange e:/work 5000 {
puts stdout {Directory 'e:/work' changed!}
}
vwait forever