Multibler FolderWatch

22/09/2008 - 18:03 von Karl Schmidt | Report spam
Hallo,

beisse mir seit Tagen die Zàhne an o.g. Problem aus und alle Ansàtze führen
in's Leere.

Die einfachste Lösung mit SHChangeNotifyRegister feuert zwar auf allen OS
und in allen Subfoldern SHCNE_CREATE korrekt, wenn OS < Vista und eine
existierende Datei erneut gespeichert wird, jedoch SHCNE_UPDATEITEM
überhaupt nicht und SHCNE_UPDATEDIR in Subfoldern nicht.

Der zweite Ansatz mit FindFirstChangeNotification und WaitForMultipleObjects
funktioniert prinzipiell, doch bringt dies meine App nahezu zum Stillstand.

Der dritte Ansatz, 2. in eine sep. Exe auszulagern und neue/geànderte
Dateien per WM_CopyData an die App zu übermitteln, gefàllt mir nicht
sonderlich.

Beim vierten und letzten Ansatz habe ich nun versucht, 2. und 3. zu
kombinieren und die Abfrageschleife in einen separaten Thread innerhalb der
App zu packen.
Funktioniert in der IDE perfekt, beim Ausführen der EXE erhalte ich jedoch
Speicherfehler "Die Anweisung in 0x?? verweist auf Speicher in 0x??. Der
Vorgang written konnte..."
Mache demnach irgendwas falsch und poste nachfolgend einfach mal den Code,
vielleicht entdeckt ja jemand den Fehler



'CLASS FOLDERWATCHER

Option Explicit

Private Declare Function FindFirstChangeNotification Lib "kernel32" Alias
"FindFirstChangeNotificationA" (ByVal lpPathName As String, ByVal
bWatchSubtree As Long, ByVal dwNotifyFilter As Long) As Long
Private Declare Function FindNextChangeNotification Lib "kernel32" (ByVal
hChangeHandle As Long) As Long
Private Declare Function FindCloseChangeNotification Lib "kernel32" (ByVal
hChangeHandle As Long) As Long

Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA"
(lpEventAttributes As SECURITY_ATTRIBUTES, ByVal bManualReset As Long, ByVal
bInitialState As Long, ByVal lpName As String) As Long
Private Declare Function SetEvent Lib "kernel32" (ByVal hEvent As Long) As
Long

Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As
Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter
As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long)
As Long
Private Declare Function SetThreadPriority Lib "kernel32" (ByVal hThread As
Long, ByVal nPriority As Long) As Long

Private Declare Function CreateMutex Lib "kernel32" Alias "CreateMutexA"
(lpMutexAttributes As SECURITY_ATTRIBUTES, ByVal bInitialOwner As Long,
ByVal lpName As String) As Long
Private Declare Function ReleaseMutex Lib "kernel32" (ByVal hMutex As Long)
As Long

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle
As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long)
As Long


Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Private Type FOLDERWATCHER
Handle As Long
Files As Collection
End Type


Private Const FILE_NOTIFY_CHANGE_LAST_WRITE As Long = &H10

Private Const CREATE_SUSPENDED = &H4
Private Const THREAD_BASE_PRIORITY_MIN = -2


Private m_Thread As Long
Private m_Watchers() As FOLDERWATCHER


Public Sub StartWatch()
Dim sa As SECURITY_ATTRIBUTES, lCnt As Long

ReDim m_Watchers(g_Options.WatchedFolders.Count)

For lCnt = 1 To g_Options.WatchedFolders.Count
With m_Watchers(lCnt)
Set .Files = New Collection
Call ScanFiles(QualifyPath(g_Options.WatchedFolders.Item(lCnt)),
lCnt, True, "")
.Handle =
FindFirstChangeNotification(QualifyPath(g_Options.WatchedFolders.Item(lCnt)),
1, FILE_NOTIFY_CHANGE_LAST_WRITE)
End With
Next

sa.nLength = Len(sa)
m_Watchers(0).Handle = CreateEvent(sa, 1, 0, vbNullString)
'g_Mutex = CreateMutex(sa, ByVal 0&, vbNullString)

m_Thread = CreateThread(ByVal 0&, ByVal 0&, AddressOf WatchFolders, ByVal
UBound(m_Watchers), CREATE_SUSPENDED, ByVal 0&)

If m_Thread = 0 Then

MsgBox "Error creating new thread"

Else

SetThreadPriority m_Thread, THREAD_BASE_PRIORITY_MIN

'Bis hierher funktioniert's, danach kracht's

ResumeThread m_Thread

End If

End Sub


Public Property Get EventHandle(ByVal Index As Long) As Long
'WaitForSingleObject g_Mutex, INFINITE
EventHandle = m_Watchers(Index).Handle
'ReleaseMutex g_Mutex
End Property


Public Sub Change(ByVal Index As Long)
Dim sChanged As String

'WaitForSingleObject g_Mutex, INFINITE

With m_Watchers(Index)

Call ScanFiles(QualifyPath(g_Options.WatchedFolders.Item(Index)), Index,
False, sChanged)

If Len(sChanged) > 0 Then frmMain.List1.AddItem CStr(Now) & " " &
sChanged, 0

Call FindNextChangeNotification(.Handle)

End With

'ReleaseMutex g_Mutex

End Sub


Private Sub Class_Terminate()
Dim lCnt As Long

If m_Thread <> 0 Then
If m_Watchers(0).Handle <> 0 Then SetEvent m_Watchers(0).Handle
WaitForSingleObject m_Thread, 0
CloseHandle m_Thread
End If

If m_Watchers(0).Handle <> 0 Then CloseHandle m_Watchers(0).Handle

For lCnt = 1 To UBound(m_Watchers)
With m_Watchers(lCnt)
If .Handle <> 0 Then FindCloseChangeNotification .Handle
Set .Files = New Collection
End With
Next

End Sub

'END CLASS FOLDERWATCHER




'THREAD MODULE

Option Explicit

Private Declare Function WaitForMultipleObjects Lib "kernel32" (ByVal nCount
As Long, lpHandles As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As
Long) As Long
Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)


Public Const INFINITE = &HFFFF


Public g_FolderWatchers As FolderWatchers
'Public g_Mutex As Long


Public Sub WatchFolders(ByVal Count As Long)
Dim lRes As Long, lCnt As Long, lHandles() As Long

ReDim lHandles(Count)
For lCnt = 0 To Count
lHandles(lCnt) = g_FolderWatchers.EventHandle(lCnt)
Next

Do

lRes = WaitForMultipleObjects(UBound(lHandles) + 1, lHandles(0), False,
INFINITE)

If lRes = 0 Then

Exit Do

Else

Call g_FolderWatchers.Change(lRes)

End If

Loop

ExitThread 1&

End Sub

'END THREAD MODULE


Habe auch mit den auskommentierten Mutex getestet, ohne wirklich zu wissen,
was die bewirken oder machen (habe das in einem Beispiel gefunden und nehme
an, es hàngt mit Thread Sicherheit zusammen)

Für alle Anregungen besten Dank

Karl
 

Lesen sie die antworten

#1 Timo Kunze
22/09/2008 - 18:26 | Warnen spam
Karl Schmidt schrieb:
Die einfachste Lösung mit SHChangeNotifyRegister feuert zwar auf allen OS
und in allen Subfoldern SHCNE_CREATE korrekt, wenn OS < Vista und eine
existierende Datei erneut gespeichert wird, jedoch SHCNE_UPDATEITEM
überhaupt nicht und SHCNE_UPDATEDIR in Subfoldern nicht.


So korrekt làuft das auf keinem OS. Hàufen sich die SHCNE_*-Ereignisse,
werden sie nàmlich zu SHCNE_UPDATEITEM oder SHCNE_UPDATEDIR (mit dem
Desktop als geànderter Item) zusammengefasst. Das sollte man bedenken
wenn man diese Methode zur Überwachung von Verzeichnissen nutzt.

Timo
www.TimoSoft-Software.de - Unicode controls for VB6
"Those who sacrifice freedom for safety deserve neither."
"Demokratie ist per Definition unsicher. Ihr Schutz entsteht aus der
Überzeugung, dass die demokratischen Kràfte überwiegen und sich – auf
demokratischem Wege – durchsetzen."

Ähnliche fragen