[Translation/Theo]
I am working on a "Browse-For Folder" Replacement.
Now if somebody creates a new folder outside my Dialog , or makes changes in the file-system, i would like to reflect that in my dialog.
Or reload things.
Is there an Event or a Message that i can get from the explorer to be notified of file-system changes (and what changes)?
--------------
Hallo
Brauche ein Ereignis das ich in WideDisplayOpen Dialog auswerden kann wen ich von einem Explorer Fenster in ein anderes Explorer Fenster Dateien kopiere. Der Dialog sollte erkennen das die Dateien nicht mehr im Verzeichnis ist, oder das neue dazu gekommen sind. Hat jemand eine idee?
Grüße Peter
Peter,
This might help...
ReadDirectoryChangesW by Balthasar (http://www.powerbasic.com/support/PBforums/showthread.php?p=170706)
FindFirstChangeNotification, FindCloseChangeNotification and FindNextChangeNotification by Wayne (http://www.powerbasic.com/support/pbforums/showthread.php?t=22834)
Pierre
SUB StartMonitorDirThread
CDROM$ = REMOVE$(skDskList, ANY "ABCDEFGHIJKLMNOPQRSTUVWXYZ") ' We don't need to monitor CD-Rom
IF INSTR(CDROM$, LEFT$(LCASE$(bffActiveFolder$), 1)) = 0 THEN ' because content shouldn't change
IF hDirCloseEvent& = 0 THEN
hDirCloseEvent& = CreateEvent(BYVAL %NULL, %TRUE, %FALSE, BYVAL %NULL)
IF hDirCloseEvent& THEN
IF hDirThread& = 0 THEN THREAD CREATE MonitorDirectory&(hDirCloseEvent&) TO hDirThread&
END IF
END IF
END IF
END SUB
FUNCTION MonitorDirectory&(BYVAL hEvent&)
REDIM Events???(1)
Events???(0) = FindFirstChangeNotification((bffActiveFolder$), %FALSE, %FILE_NOTIFY_CHANGE_FILE_NAME OR %FILE_NOTIFY_CHANGE_LAST_WRITE)
IF Events???(0) = &HFFFFFFFF??? THEN ' INVALID HANDLE VALUE
FUNCTION = GetLastError
ELSE
Events???(1) = hEvent& ' To trigger action when the user wants to quit.
DO
' %FALSE = don't check sub folders
hWait??? = WaitForMultipleObjects(2???, BYVAL VARPTR(Events???(0)), %FALSE, %INFINITE)
IF hWait??? = %WAIT_OBJECT_0 THEN
CALL CheckDirectory
IF FindNextChangeNotification(Events???(0)) = %FALSE THEN
FUNCTION = GetLastError: EXIT DO
END IF
ELSE ' Request to leave the Thread
EXIT DO
END IF
LOOP
CALL FindCloseChangeNotification(Events???(0))
END IF
END FUNCTION
SUB CheckDirectory
LOCAL st AS SYSTEMTIME
LOCAL fd AS WIN32_FIND_DATA
STATIC JobCheckDirectoryIsOn&
IF WorkingOnDirectory& THEN EXIT SUB
IF JobCheckDirectoryIsOn& THEN EXIT SUB ' 10-22-2003
JobCheckDirectoryIsOn& = -1 ' 10-22-2003
CALL skFilterChoice(FileSpec$, 0)
UseFileSpec$ = FileSpec$: Use$ = "": LenUse& = 0
IF INSTR(FileSpec$, ";") THEN
Use$ = LCASE$(FileSpec$)
REPLACE ";" WITH $skLim IN Use$
Use$ = TRIM$(Use$, $skLim) + $skLim
LenUse& = LEN(Use$)
UseFileSpec$ = $All
END IF
Spec$ = CurrentPath + UseFileSpec$
CALL skBrowseExclude(Rsd$, 0): LenRsd& = LEN(Rsd$)
IF LenUse& = 0 THEN
CALL skBrowseFilter(Use$, 0): LenUse& = LEN(Use$)
END IF
GetCount& = SendMessage(hDir&, %LB_GETCOUNT, 0, 0)
IF GetCount& > 0 THEN REDIM FlagFile&(0 TO GetCount& - 1)
Added& = 0: FileCount& = 0: zTmp = Spec$
WashFind& = FindFirstFile(zTmp, fd)
hFind& = WashFind&
DO WHILE hFind& > 0
'*'IF UserEvent(0) THEN EXIT DO
IF ASC(fd.cFileName) <> 46 THEN
IF INSTR(CHR$(0,1,32,33,128), CHR$(fd.dwFileAttributes)) THEN
LongName$ = " " + LCASE$(fd.cFileName)
Yes& = -1
So& = INSTR(-1, LongName$, $Dot)
IF So& THEN
Test$ = MID$(LongName$, So&) + $skLim
IF LenRsd& THEN
IF INSTR(LCASE$(Rsd$), Test$) THEN Yes& = 0
END IF
IF LenUse& THEN Yes& = INSTR(LCASE$(Use$), Test$)
ELSEIF LenUse& THEN
Yes& = 0
END IF
IF Yes& THEN
INCR FileCount&
Item& = SendMessage(hDir&, %LB_FINDSTRINGEXACT, -1, STRPTR(LongName$))
IF Item& > %LB_ERR THEN
' Avoid array bound error that would cause GPF 10-22-2003
IF Item& > UBOUND(FlagFile&) THEN REDIM PRESERVE FlagFile&(0 TO Item&) ' 10-22-2003
FlagFile&(Item&) = 1
IF CompareFileTime(LastFileTime, fd.ftLastWriteTime) < 0 THEN
CALL ClearMemoryBitmap(Item&)
Added& = MAX&(UBOUND(T$) + 1, 1)
REDIM PRESERVE T$(1 TO Added&)
T$(Added&) = LongName$
FlagFile&(Item&) = 0
END IF
ELSE ' New files added
Added& = MAX&(UBOUND(T$) + 1, 1)
REDIM PRESERVE T$(1 TO Added&)
T$(Added&) = LongName$
END IF
END IF
END IF
END IF
hFind& = FindNextFile(WashFind&, fd)
LOOP
CALL FindClose(WashFind&)
IF GetCount& > 0 THEN ' 10-22-2003
' Check if they are deleted files
FOR K& = GetCount& - 1 TO 0 STEP - 1
IF FlagFile&(K&) = 0 THEN
' Remove deleted files from listbox
CALL SendMessage(hDir&, %LB_DELETESTRING, K&, 0)
END IF
NEXT
END IF
IF Added& THEN ' Add the new files to the listbox
FOR K& = 1 TO Added&
' Make sure it doesn't already exist in the list 10-22-2003
IF SendMessage(hDir&, %LB_FINDSTRINGEXACT, -1, STRPTR(T$(K&))) = %LB_ERR THEN
CALL skAddStringListBox(hDir&, T$(K&))
END IF
NEXT
CALL MonitorBitmap
END IF
CALL GetSystemTime(st)
CALL SystemTimeToFileTime(st, LastFileTime)
JobCheckDirectoryIsOn& = 0 ' 10-22-2003
CALL ShowFilecount
END SUB
' Watch the TreeView subtrees for directory creation and deletion.
FUNCTION MonitorTreeView&(BYVAL hEvent&)
LOCAL zDirPath AS ASCIIZ * %MAX_PATH, rc AS RECT
Dsk$ = skDskList
LenDsk& = LEN(Dsk$)
DiskNumber??? = 0
REDIM hDsk???(0 TO DiskNumber???)
hDsk???(0) = hEvent&
IF LenDsk& THEN
FOR K& = 1 TO LenDsk&
zDirPath = MID$(Dsk$, K&, 1) + ":\"
IF GetDriveType(zDirPath) <> %DRIVE_REMOVABLE THEN
IF ASC(zDirPath) < 97 THEN
RetCode??? = FindFirstChangeNotification(zDirPath, %TRUE, %FILE_NOTIFY_CHANGE_DIR_NAME)
IF RetCode??? <> &HFFFFFFFF??? THEN
DiskNumber??? = DiskNumber??? + 1
REDIM PRESERVE hDsk???(DiskNumber???)
hDsk???(DiskNumber???) = RetCode???
END IF
END IF
END IF
NEXT
END IF
IF DiskNumber??? = 0 THEN EXIT FUNCTION
DO
hWait??? = WaitForMultipleObjects(DiskNumber??? + 1, BYVAL VARPTR(hDsk???(0)), %FALSE, %INFINITE)
SELECT CASE LONG hWait???
CASE %WAIT_OBJECT_0 + 1 TO DiskNumber???
' Refresh Treee
' here
zDirPath = bffActiveFolder$
hTreeView& = GetDlgItem(hBff&, GetDlgCtrlID(hBff&))
CALL GetClientRect(hTreeView&, rc)
CALL skDCDesktop(%MEM_CREATEDC) ' Allows to catch the screen content
CALL ShowWindow(hTreeView&, %SW_HIDE)
CALL SendMessage(hTreeView&, %WM_SETREDRAW, 0, 0)
CALL Bff_Path(hTreeView&, "", %CSIDL_DESKTOP, 1)'0)
IF LEN(bffNewFolder$) THEN
Ret& = Bff_JumpToFolder(hTreeView&, bffNewFolder$)
IF Ret& THEN
CALL PostMessage(hFrame&, %WM_COMMAND, MAKLNG(%ID_RENFOLDER, 0), Ret&)
bffNewFolder$ = ""
END IF
END IF
CALL Bff_JumpToPath(hTreeView&, zDirPath)
CALL SendMessage(hTreeView&, %WM_SETREDRAW, 1, 0)
CALL ShowWindow(hTreeView&, %SW_SHOW)
CALL skDCDesktop(%MEM_DELETEDC) ' Clear the screen content
IF FindNextChangeNotification(hDsk???(hWait???)) = 0 THEN
FUNCTION = GetLastError: EXIT DO
END IF
CASE %WAIT_OBJECT_0 ' User want to quit
EXIT DO
CASE ELSE
FUNCTION = GetLastError: EXIT DO
END SELECT
LOOP
FOR K& = 0 TO DiskNumber???
CALL FindCloseChangeNotification(hDsk???(K&))
NEXT
END FUNCTION
hallo,
danke erst mal Pierre Bellisle, Patrice Terrier!!
ich muß das erst mal verdauen das mit FindFirstChangeNotification scheint mir Interessant zu sein.
Ich habe noch das Beispiel von Pierre Bellisle gefunden http://pages.videotron.com/lyra/PowerBASIC/WM_DEVICECHANGE.html
habe gelesen das man SHChangeNotifyRegister auch für bestimmte ordner einsetzen kann! Weiß noch nicht was die beste Lösung ist!
Grüße Peter
Hallo Peter,
Here is a version that use SHChangeNotifyRegister and monitor files and folders for rename, creation and deletion...
Pierre
'Files and folders rename, creation or deletion monitoring.
#COMPILE EXE '#Win 8.04#
#DIM ALL
#INCLUDE "Win32api.inc"
GLOBAL hDlg AS DWORD
%Textbox = 101
%SHCNRF_SHELLLEVEL = 2
TYPE SHChangeNotifyEntry
pidl AS ITEMIDLIST POINTER
fRecursive AS LONG
END TYPE
DECLARE FUNCTION SHChangeNotifyRegister LIB "SHELL32.DLL" ALIAS "SHChangeNotifyRegister" _
(BYVAL HWND AS DWORD, BYVAL fSources AS LONG, BYVAL fEvents AS LONG, BYVAL wMsg AS DWORD, _
BYVAL cEntries AS LONG, BYREF ChangeNotifyEntry AS SHChangeNotifyEntry) AS DWORD
DECLARE FUNCTION SHChangeNotifyDeregister LIB "SHELL32.DLL" ALIAS "SHChangeNotifyDeregister" _
(BYVAL ulID AS DWORD) AS LONG
DECLARE FUNCTION SHSimpleIDListFromPath LIB "SHELL32.DLL" ALIAS "SHSimpleIDListFromPath" _
(BYVAL StringPointer AS DWORD) AS DWORD
'______________________________________________________________________________
SUB TextAdd (BYVAL sAddToText AS STRING)
LOCAL sBuffer AS STRING
CONTROL GET TEXT hDlg, %Textbox TO sBuffer
IF LEN(sBuffer) THEN
sBuffer = sBuffer & $CRLF & sAddToText
ELSE
sBuffer = sAddToText
END IF
CONTROL SET TEXT hDlg, %Textbox, sBuffer
CONTROL SET FOCUS hDlg, %Textbox
CONTROL SEND hDlg, %Textbox, %EM_SETSEL, LEN(sBuffer), LEN(sBuffer)
CONTROL SEND hDlg, %Textbox, %EM_SCROLLCARET, 0, 0 'To scroll the caret into view
END SUB
'______________________________________________________________________________
CALLBACK FUNCTION ShowDIALOG1Proc()
LOCAL sMessage AS STRING
LOCAL zPath1 AS ASCIIZ * %MAX_PATH
LOCAL zPath2 AS ASCIIZ * %MAX_PATH
LOCAL ppIdList AS DWORD POINTER
LOCAL pIdList1 AS DWORD POINTER
LOCAL pIdList2 AS DWORD POINTER
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
CONTROL SET FOCUS hDlg, %Textbox
CONTROL SEND hDlg, %Textbox, %EM_SETSEL, -1, -1
CASE %WM_APP + 1 'SHChangeNotifyRegister %SHCNRF_SHELLLEVEL notification
'wParam is a pointer to 1 or 2 PIDLIST_ABSOLUTE depending on the event
'lParam is the event
ppIdList = CBWPARAM
pIdList1 = @ppIdList
ppIdList = ppIdList + 4
pIdList2 = @ppIdList
IF pIdList1 THEN SHGetPathFromIDList(@pIdList1, zPath1) ELSE zPath1 = "Nil"
IF pIdList2 THEN SHGetPathFromIDList(@pIdList2, zPath2) : zPath2 = " - " & zPath2 ELSE zPath2 = ""
SELECT CASE CBLPARAM
CASE %SHCNE_RENAMEITEM : sMessage = "SHCNE_RENAMEITEM - " & zPath1 & zPath2
CASE %SHCNE_CREATE : sMessage = "SHCNE_CREATE - " & zPath1 & zPath2
CASE %SHCNE_DELETE : sMessage = "SHCNE_DELETE - " & zPath1 & zPath2
CASE %SHCNE_MKDIR : sMessage = "SHCNE_MKDIR - " & zPath1 & zPath2
CASE %SHCNE_RMDIR : sMessage = "SHCNE_RMDIR - " & zPath1 & zPath2
CASE %SHCNE_UPDATEDIR : sMessage = "SHCNE_UPDATEDIR - " & zPath1 & zPath2
CASE %SHCNE_UPDATEITEM : sMessage = "SHCNE_UPDATEITEM - " & zPath1 & zPath2
CASE %SHCNE_RENAMEFOLDER : sMessage = "SHCNE_RENAMEFOLDER - " & zPath1 & zPath2
END SELECT
TextAdd(sMessage)
CASE %WM_SIZE
IF CBWPARAM <> %SIZE_MINIMIZED THEN
SetWindowPos(GetDlgItem(hDlg, %Textbox), 0, 5, 5, LO(WORD, CBLPARAM) - 10, HI(WORD, CBLPARAM) - 10, %SWP_NOZORDER)
END IF
END SELECT
END FUNCTION
'______________________________________________________________________________
FUNCTION PBMAIN()
LOCAL ulID AS DWORD
LOCAL ppidl AS DWORD
LOCAL cEntries AS LONG
LOCAL sDrive AS STRING
sDrive = "C:\" '<- Change to target drive
DIALOG NEW %HWND_DESKTOP, "SHChangeNotifyRegister for " & sDrive, , , 500, 150, %WS_POPUP OR %WS_BORDER OR _
%WS_DLGFRAME OR %WS_THICKFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR %WS_CLIPSIBLINGS OR _
%WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
SetClassLong(hDlg, %GCL_HICON, ExtractIcon(GetModuleHandle(""), "Shell32.dll", 243)) 'Set an icon
CONTROL ADD TEXTBOX, hDlg, %Textbox, "Copy or delete files or folders on drive " & sDrive, 5, 5, 940, 225, %WS_CHILD OR %WS_VISIBLE OR _
%WS_TABSTOP OR %WS_HSCROLL OR %WS_VSCROLL OR %ES_LEFT OR %ES_MULTILINE OR %ES_AUTOHSCROLL OR %ES_AUTOVSCROLL OR _
%ES_WANTRETURN OR %ES_NOHIDESEL, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_RIGHTSCROLLBAR OR %WS_EX_LTRREADING
cEntries = 1
DIM pshcne(0 TO cEntries - 1) AS SHChangeNotifyEntry 'Must be only one element when calling SHChangeNotifyRegister
sDrive = UCODE$(sDrive & $NUL)
ppidl = SHSimpleIDListFromPath(BYVAL STRPTR(sDrive))
IF ppidl = 0 THEN MSGBOX "SHSimpleIDListFromPath error !"
pshcne(0).pidl = ppidl
pshcne(0).fRecursive = %TRUE 'Do sub-folder
ulID = SHChangeNotifyRegister(BYVAL hDlg, %SHCNRF_SHELLLEVEL, _
%SHCNE_CREATE OR %SHCNE_DELETE OR %SHCNE_MKDIR OR _
%SHCNE_RENAMEFOLDER OR %SHCNE_RENAMEITEM OR %SHCNE_RMDIR, _
BYVAL %WM_APP + 1, BYVAL cEntries, BYVAL VARPTR(pshcne(0)))
DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc
IF ulID THEN SHChangeNotifyDeregister(ulID)
END FUNCTION
'______________________________________________________________________________
'
Hello, I just decided for this solution. It is simple and safe! And goes well with wide Unicode
SUB StartWatch()
STATIC lpath AS WSTRING
IF lpath <> dread.pathname THEN
StopWatch()
gstruct_libOF_Settings.WatchStart = 0
lpath = dread.pathname
ELSE
EXIT SUB
END IF
IF gstruct_libOF_Settings.WatchStart = 0 THEN
gstruct_libOF_Settings.WatchStart = %TRUE
'Get a handle to the directory
gstruct_libOF_Settings.WatchFile = GetDirHndl(dread.pathname)
IF NOT gstruct_libOF_Settings.WatchFile = %INVALID_HANDLE_VALUE THEN
'Allocate a buffer, 4k should be good
gstruct_libOF_Settings.dynBufferSize = %WIDE_MAX_PATH * 2
gstruct_libOF_Settings.dynBuffer = GlobalAlloc(%GMEM_FIXED, gstruct_libOF_Settings.dynBufferSize)
IF gstruct_libOF_Settings.dynBuffer THEN
gstruct_libOF_Settings.hDirThread = CreateThread(BYVAL 0, 0, CODEPTR (WatchDirectory()), gstruct_libOF_Settings.WatchFile, 0, BYVAL %NULL)
ELSE
StopWatch()
END IF
END IF
END IF
END SUB
SUB StopWatch
gstruct_libOF_Settings.WatchStart = 0
ClearHndl (gstruct_libOF_Settings.WatchFile)
IF gstruct_libOF_Settings.hDirThread <> 0 THEN
CALL TerminateThread(gstruct_libOF_Settings.hDirThread, 0)
gstruct_libOF_Settings.hDirThread = 0
END IF
IF gstruct_libOF_Settings.dynBuffer THEN
GlobalFree(gstruct_libOF_Settings.dynBuffer)
END IF
END SUB
THREAD FUNCTION WatchDirectory() AS LONG
LOCAL lpBytesReturned AS DWORD
LOCAL lRet AS LONG
LOCAL ptrNext AS LONG
LOCAL ptrNextOffset AS LONG
LOCAL ptrAction AS LONG
LOCAL ptrFileLen AS LONG
LOCAL ptrFileName AS STRING
LOCAL sOut, soldname AS WSTRING
LOCAL nr AS LONG
DO
lRet = ReadDirectoryChangesW(gstruct_libOF_Settings.WatchFile, _
BYVAL gstruct_libOF_Settings.dynBuffer, _
gstruct_libOF_Settings.dynBufferSize, _
%false, _ 'trigger on subdirectories too if this param is true
%FILE_NOTIFY_CHANGE_FILE_NAME _ 'Any filename change
OR %FILE_NOTIFY_CHANGE_LAST_WRITE _ 'Any change to the last write time of a file
OR %FILE_NOTIFY_CHANGE_CREATION _
OR %FILE_NOTIFY_CHANGE_LAST_ACCESS _
OR %FILE_NOTIFY_CHANGE_DIR_NAME _
, lpBytesReturned, BYVAL 0, BYVAL 0)
'Or %FILE_NOTIFY_CHANGE_DIR_NAME _ 'Any directory name change
'Or %FILE_NOTIFY_CHANGE_ATTRIBUTES _ 'Any attribute change
'Or %FILE_NOTIFY_CHANGE_SIZE _ 'Any filesize change
'Or %FILE_NOTIFY_CHANGE_LAST_ACCESS _ 'Any change to the last access time of a file
'Or %FILE_NOTIFY_CHANGE_CREATION _ 'Any change on the creation time of a file
'Or %FILE_NOTIFY_CHANGE_SECURITY _ 'Any security descriptor change
IF lpBytesReturned > 0 THEN
IF gstruct_libOF_Settings.tflag = 0 THEN
'Go through the FILE_NOTIFY_INFORMATION structure (manually):
ptrNext = 0
DO
ptrNextOffset = PEEK(gstruct_libOF_Settings.dynBuffer + ptrNext)
ptrAction = PEEK(gstruct_libOF_Settings.dynBuffer + ptrNext + 4)
ptrFileLen = PEEK(gstruct_libOF_Settings.dynBuffer + ptrNext + 8) / 2
sout = PEEK$$(gstruct_libOF_Settings.dynBuffer+ptrNext+12, ptrFileLen)
SELECT CASE ptrAction
CASE %FILE_ACTION_ADDED
nr = dread.eexist(sout)
IF NOT nr THEN
ztrace sout + " abc"
IF (WideGetAttr(dread.pathname+sout) AND %SUBDIR) OR dread.ismask(sout) THEN
dread.appendFilename = sout
ListView_SetItemCountEx(gstruct_libOF_Settings.hListView, dread.filecount(), %LVSICF_NOINVALIDATEALL)
END IF
END IF
CASE %FILE_ACTION_REMOVED ' Aktion Datei oder Odner löschen
nr = dread.eexist(sout)
IF nr THEN ' Datei gelöscht von anderem programm ?
dread.ElementDelete(nr) ' Eintrag löschen in Instance
ListView_DeleteItem(gstruct_libOF_Settings.hListView, nr -1) ' Listview aktualieseiren
END IF
CASE %FILE_ACTION_MODIFIED
sOut = "File modified: "
CASE %FILE_ACTION_RENAMED_OLD_NAME
soldname = sout
'sOut = "Old filename: "
CASE %FILE_ACTION_RENAMED_NEW_NAME ' Rename File or Folder
'sOut = "New filename: "
nr = dread.rename(soldname, sout)
IF nr THEN
ListView_SetItemTextW(gstruct_libOF_Settings.hListView, nr - 1, 0, sout)
RedrawWindow gstruct_libOF_Settings.hListView, BYVAL %NULL, 0, %RDW_ERASE OR %RDW_INVALIDATE OR %RDW_UPDATENOW
END IF
CASE ELSE
sOut = "Undocumented action!"
END SELECT
sOut = sOut & PEEK$$(gstruct_libOF_Settings.dynBuffer+ptrNext+12, ptrFileLen)
ztrace ((sout))
ptrNext = ptrNextOffset
LOOP UNTIL ptrNextOffset = 0
END IF
END IF
LOOP
END FUNCTION
FUNCTION GetDirHndl(BYVAL PathDir AS WSTRING) EXPORT AS DWORD
ON ERROR RESUME NEXT
LOCAL hDir AS LONG
IF RIGHT$(PathDir, 1) <> "\" THEN PathDir = PathDir + "\"
FUNCTION = CreateFileW(CreateWideFileName(PathDir), %FILE_LIST_DIRECTORY, %FILE_SHARE_READ + %FILE_SHARE_WRITE + %FILE_SHARE_DELETE, _
BYVAL 0&, %OPEN_EXISTING, %FILE_FLAG_BACKUP_SEMANTICS OR %FILE_FLAG_OVERLAPPED, BYVAL 0&)
END FUNCTION
SUB ClearHndl(BYREF FHandle AS LONG) EXPORT
IF Fhandle THEN
CloseHandle(FHandle)
FHandle = 0
END IF
END SUB
[Translation/Theo]
Below is my new "File watching Class".
Its a fine piece of code. To use it, you have to give it the pointer to the Thread-Function.
-------------------
Hallo,
Habe neue Watch File Classe geschieben! Die läst sich jetzt sauber beenden da sie Asyncron sucht!
Auserdem ist die Classe gekapselt bis auf die Tread Funktion so das mehrere Programme die Classe aufrufen können!
Der Pointer für die Thread funktion muss übergeben werden!
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "WIN32API.INC"
TYPE FILE_NOTIFY_INFORMATIONX
NextEntryOffset AS LONG
Action AS LONG
FileNameLength AS LONG
#IF %DEF(%WIDE_UNICODE)
Filename AS WSTRINGZ * 32000
#ELSE
Filename AS WSTRINGZ * 1000
#ENDIF
END TYPE
DECLARE FUNCTION zTrace LIB "zTrace.DLL" ALIAS "zTrace"(zMessage AS ASCIIZ) AS LONG
DECLARE SUB WriteProg(BYREF Buffer AS FILE_NOTIFY_INFORMATIONX)
DECLARE SUB Sub1( p1 AS DWORD)
%DEBUG = 1
GLOBAL Watch AS WatchFile
FUNCTION PBMAIN()
LET watch = CLASS "FWwatcher"
watch.init( "f:\PBWin10", CODEPTR(WatchingThread()))
watch.StartWatchThread()
MSGBOX "File Watching End?"
watch.SynchronousAbort
watch = NOTHING
END FUNCTION
THREAD FUNCTION WatchingThread() AS LONG
LOCAL dwObj AS LONG
IF ISOBJECT(watch) THEN
DIM hp(0 TO 1) AS DWORD
hp(0) = watch.IsEvtStopWatching()
hp(1) = watch.getoverlaphevent()
DO
dwObj = WaitForMultipleObjects(2???, hp(0), %FALSE, %INFINITE)
IF (dwObj = %WAIT_OBJECT_0) THEN ' the user asked to quit the program
EXIT DO
END IF
IF (dwObj <> %WAIT_OBJECT_0 + 1) THEN
'// BUG!
'assert(0);
EXIT DO
END IF
watch.NotifyChange()
LOOP
END IF
END FUNCTION
CLASS FWwatcher GUID$( "{A8EEC91D-081A-43BD-BB7F-3EEF617954A8}") AS COM
INSTANCE hWatchingThread AS DWORD
INSTANCE hEvtStopWatching AS DWORD
INSTANCE overl AS OVERLAPPED
INSTANCE hDir AS DWORD
INSTANCE curBuffer AS LONG
INSTANCE M_buffer AS FILE_NOTIFY_INFORMATIONX
INSTANCE pWatchingThread AS DWORD
INSTANCE pathname AS WSTRING
INSTANCE BufferProg AS DWORD
INSTANCE WriteProgPtr AS DWORD
INSTANCE WatchFilter AS DWORD
CLASS METHOD CREATE()
WatchFilter = %FILE_NOTIFY_CHANGE_FILE_NAME OR _
%FILE_NOTIFY_CHANGE_DIR_NAME OR _
%FILE_NOTIFY_CHANGE_ATTRIBUTES OR _
%FILE_NOTIFY_CHANGE_SIZE OR _
%FILE_NOTIFY_CHANGE_LAST_WRITE OR _
%FILE_NOTIFY_CHANGE_LAST_ACCESS OR _
%FILE_NOTIFY_CHANGE_CREATION OR _
%FILE_NOTIFY_CHANGE_SECURITY
END METHOD
INTERFACE WatchFile GUID$( "{D3420B9D-D552-4717-AF85-3E1929C18FC9}")
INHERIT IUNKNOWN
METHOD IsThreadRunning() AS LONG
METHOD = hWatchingThread AND (WaitForSingleObject(hWatchingThread, 0) = %WAIT_TIMEOUT)
END METHOD
' Ask for the thread to stop and waith until it ends
METHOD SynchronousAbort()
SetEvent(hEvtStopWatching)
IF hWatchingThread THEN
WaitForSingleObject(hWatchingThread, %INFINITE)
CloseHandle(hWatchingThread)
hWatchingThread = %NULL
END IF
CloseHandle(overl.hEvent)
overl.hEvent = %NULL
closeHandle(hEvtStopWatching)
hEvtStopWatching = %NULL
CloseHandle(hDir)
hDir = %NULL
END METHOD
' Start watching a file for changes
METHOD StartWatchThread() AS LONG
IF pWatchingThread = 0 THEN
EXIT METHOD
END IF
' if the thread already exists then stop it
IF (me.IsThreadRunning()) THEN
me.SynchronousAbort()
END IF
' reset the hEvtStopWatching event so that it can be set if
' some thread requires the watching thread to stop
ResetEvent(hEvtStopWatching)
'local watchingthreadID as dword
hWatchingThread = CreateThread(BYVAL %NULL, 0, BYVAL pWatchingThread, %NULL, 0, BYVAL 0)
METHOD = hWatchingThread
END METHOD
METHOD ChangeFolder(BYREF folder AS WSTRING) AS LONG
IF folder <> pathname THEN
IF(me.Init(folder, pWatchingThread)) THEN
METHOD = me.StartWatchThread()
END IF
ELSE
METHOD = %FALSE
END IF
END METHOD
PROPERTY GET IsEvtStopWatching() AS LONG
PROPERTY = hEvtStopWatching
END PROPERTY
PROPERTY GET getoverlaphevent() AS LONG
PROPERTY = overl.hEvent
END PROPERTY
PROPERTY SET PtrWatchingThread(BYVAL threadPtr AS DWORD)
pWatchingThread = threadPtr
END PROPERTY
PROPERTY GET Pathname() AS WSTRING
PROPERTY = pathname
END PROPERTY
PROPERTY SET WriteProg(BYVAL WProgPtr AS DWORD)
WriteProgPtr = WprogPtr
END PROPERTY
PROPERTY SET SetWatchFilter(BYVAL WFilter AS DWORD)
WatchFilter = WFilter
END PROPERTY
METHOD Init(BYVAL fileFullPath AS WSTRING, BYVAL pWatchThread AS DWORD) AS LONG
' if the thread already exists then stop it
#IF %DEF(%WIDE_UNICODE)
pathname = CreateWideFileName(fileFullPath)
#ELSE
pathname = fileFullPath
#ENDIF
IF pWatchThread = 0 THEN
EXIT METHOD
ELSE
pWatchingThread = pWatchThread
END IF
IF (me.IsThreadRunning()) THEN
me.SynchronousAbort()
END IF
hDir = CreateFile( _
(pathname), _ ' pointer to the directory containing the tex files
%FILE_LIST_DIRECTORY, _ ' access (read-write) mode
%FILE_SHARE_READ OR _
%FILE_SHARE_DELETE OR _
%FILE_SHARE_WRITE, _ ' share mode
BYVAL %NULL, _ ' security descriptor
%OPEN_EXISTING, _ ' how to create
%FILE_FLAG_BACKUP_SEMANTICS OR _
%FILE_FLAG_OVERLAPPED, _ ' file attributes
BYVAL %NULL) ' file with attributes to copy
ZeroMemory(BYVAL VARPTR(overl), SIZEOF(overl))
ZeroMemory(BYVAL VARPTR(m_buffer), SIZEOF(m_buffer))
overl.hEvent = CreateEvent(BYVAL %NULL, %FALSE, %FALSE, BYVAL %NULL)
hEvtStopWatching = CreateEvent(BYVAL %NULL, %TRUE, %FALSE, BYVAL %NULL)
' watch the directory
ReadDirectoryChangesW( _
hDir, _ ' handle to directory
m_buffer, _ ' read results buffer
SIZEOF(m_buffer), _ ' length of buffer
%FALSE, _ ' monitoring option
_ ' FILE_NOTIFY_CHANGE_CREATION
WatchFilter, _' filter conditions
%NULL, _ ' bytes returned
overl, _ ' overlapped buffer
BYVAL %NULL) ' completion routine
METHOD = %TRUE
END METHOD
' Call ReadDirectoryChangesW to check if the file has changed since the last call.
METHOD CheckForChanges(BYVAL waittime AS DWORD) AS LONG
LOCAL dwObj AS LONG
IF NOT (overl.hEvent) THEN
METHOD = %FALSE
EXIT METHOD
END IF
dwObj = WaitForSingleObject(overl.hEvent, waittime)
IF (dwObj <> %WAIT_OBJECT_0) THEN
METHOD = %FALSE
END IF
METHOD = Me.NotifyChange()
END METHOD
' Call the ReadDirectory API and determine if the file being watched has been modified since the last call.
' Returns true if it is the case.
METHOD NotifyChange() AS LONG
' Read the asynchronous result of the previous call to ReadDirectory
LOCAL dwNumberbytes AS DWORD
GetOverlappedResult(hDir, overl, dwNumberbytes, %FALSE)
' start a new asynchronous call to ReadDirectory in the alternate buffer
ReadDirectoryChangesW( _
hDir, _ ' handle to directory
BYVAL VARPTR(m_buffer), _ ' read results buffer
SIZEOF(m_buffer), _ ' length of buffer
%FALSE, _ ' monitoring option
WatchFilter, _' filter conditions
dwNumberbytes, _ ' bytes returned
overl, _ ' overlapped buffer
BYVAL %NULL) ' completion routine
' Note: the ReadDirectoryChangesW API fills the buffer with WCHAR strings.
IF dwNumberbytes THEN
IF WriteProgPtr THEN
CALL DWORD WriteProgPtr USING WriteProg(m_buffer)
END IF
#IF %DEF(%DEBUG)
LOCAL ptrNextOffset AS DWORD
LOCAL ptrNext AS DWORD
LOCAL ptrAction AS DWORD
LOCAL ptrFileLen AS DWORD
LOCAL sout AS WSTRING
ptrNext = 0
DO
ptrNextOffset = PEEK(VARPTR(m_Buffer) + ptrNext)
ptrAction = PEEK(VARPTR(M_Buffer) + ptrNext + 4)
ptrFileLen = PEEK(VARPTR(M_Buffer) + ptrNext + 8)
SELECT CASE ptrAction
CASE %FILE_ACTION_ADDED
sOut = "File added: "
CASE %FILE_ACTION_REMOVED
sOut = "File removed: "
CASE %FILE_ACTION_MODIFIED
sOut = "File modified: "
CASE %FILE_ACTION_RENAMED_OLD_NAME
sOut = "Old filename: "
CASE %FILE_ACTION_RENAMED_NEW_NAME
sOut = "New filename: "
CASE ELSE
sOut = "Undocumented action!"
END SELECT
sOut = sOut &(PEEK$$(VARPTR(M_Buffer) + ptrNext + 12, ptrFileLen))
ztrace((sOut))
ptrNext = ptrNextOffset
LOOP UNTIL ptrNextOffset = 0
#ENDIF
END IF
END METHOD
END INTERFACE
END CLASS
Grüße Peter
Hallo,
habe Watch Class verbessert habe eine Pipeline. First in First out. Es ist jetzt Komplett gekapselt. Die Threed Funktionen liegen jetzt innerhalb der Classen. Man braucht jetzt nur noch eine Classe aufzurufen.
Watch Class I've improved a pipeline. First in first out. It is now Completely encapsulated. The Threed functions are now within the classes. Therefore you have to call just one class.
#INCLUDE ONCE "win32api.inc"
TYPE FILE_NOTIFY_INFORMATIONX
NextEntryOffset AS LONG
Action AS LONG
FileNameLength AS LONG
#IF %DEF(%WIDE_UNICODE)
Filename AS WSTRINGZ * 32000
#ELSE
Filename AS WSTRINGZ * 1000
#ENDIF
END TYPE
DECLARE FUNCTION zTrace LIB "zTrace.DLL" ALIAS "zTrace" (zMessage AS ASCIIZ) AS LONG
FUNCTION watchInit(BYREF watch AS iWatchFile, BYREF folder AS WSTRING, BYVAL onChangeptr AS DWORD, BYVAL watchFilter AS DWORD, BYVAL watchtree AS LONG) EXPORT AS LONG
IF ISOBJECT (watch) THEN
IF watch.IsThreadRunning() THEN
watch.SynchronousAbort()
END IF
watch = NOTHING
END IF
LET watch = CLASS "FWwatcher"
IF ISOBJECT (watch) THEN
FUNCTION = watch.init(folder, onChangeptr, watchFilter, watchtree)
END IF
END FUNCTION
FUNCTION WatchChangeFolder(BYREF watch AS iWatchFile, folder AS WSTRING) EXPORT AS LONG
LOCAL lfolder AS WSTRING
LOCAL onChageptr AS DWORD
LOCAL watchtree AS LONG
LOCAL watchfilter AS DWORD
#IF %DEF(%WIDE_UNICODE)
lfolder = CreateWideFileName(fileFullPath)
#ELSE
lfolder = folder
#ENDIF
IF ISOBJECT(watch) THEN
IF watch.Pathname <> lfolder THEN
watchfilter = watch.WatchFilter()
onChageptr = watch.WriteprocPtr()
watchtree = watch.watchtree()
IF watchinit(watch, lfolder, onChageptr, watchfilter, watchtree) THEN
FUNCTION = watch.StartWatchThread()
END IF
END IF
ELSE
EXIT FUNCTION
END IF
END FUNCTION
FUNCTION WatchStop(BYREF watch AS iWatchFile) EXPORT AS LONG
IF ISOBJECT (watch) THEN
IF watch.IsThreadRunning() THEN
watch.SynchronousAbort()
END IF
watch = NOTHING
END IF
END FUNCTION
CLASS FWwatcher GUID$( "{A8EEC91D-081A-43BD-BB7F-3EEF617954A8}") AS COM
INSTANCE ThreadParam AS LONG
INSTANCE hWatchingThread AS DWORD
INSTANCE hEvtStopWatching AS DWORD
INSTANCE overl AS OVERLAPPED
INSTANCE m_hDir AS DWORD
INSTANCE buffer AS FILE_NOTIFY_INFORMATIONX
INSTANCE pWatchingThread AS DWORD
INSTANCE m_pathname AS WSTRING
INSTANCE BufferProg AS DWORD
INSTANCE m_WatchFilter AS DWORD
INSTANCE WaitWatch AS DWORD
INSTANCE m_WatchWriteProc AS iWatchWriteProc
INSTANCE M_WriteprocPtr AS DWORD
INSTANCE m_Queue AS iStringQueue
INSTANCE m_Watchtype AS DWORD
INSTANCE m_Watchtree AS LONG
THREAD METHOD MAIN() AS LONG
LOCAL dwObj AS LONG
DIM hp(0 TO 1) AS DWORD
hp(0) = hEvtStopWatching
hp(1) = overl.hEvent
DO
dwObj = WaitForMultipleObjects(2???, hp(0), %FALSE, %INFINITE)
IF (dwObj = %WAIT_OBJECT_0) THEN ' the user asked to quit the program
EXIT DO
END IF
IF (dwObj <> %WAIT_OBJECT_0 + 1) THEN
'// BUG!
'assert(0);
EXIT DO
END IF
me.NotifyChange()
LOOP
END METHOD
' Call the ReadDirectory API and determine if the file being watched has been modified since the last call.
' Returns true if it is the case.
CLASS METHOD NotifyChange() AS LONG
' Read the asynchronous result of the previous call to ReadDirectory
LOCAL dwNumberbytes AS DWORD
GetOverlappedResult(m_hDir, overl, dwNumberbytes, %FALSE)
' start a new asynchronous call to ReadDirectory in the alternate buffer
ReadDirectoryChangesW( _
m_hDir, _ ' handle to directory
BYVAL VARPTR(buffer), _ ' read results buffer
SIZEOF(buffer), _ ' length of buffer
m_Watchtree, _ ' monitoring option
m_WatchFilter, _ ' filter conditions
BYVAL 0, _ ' bytes returned
overl, _ ' overlapped buffer
BYVAL %NULL) ' completion routine
' Note: the ReadDirectoryChangesW API fills the buffer with WCHAR strings.
IF (dwNumberbytes) AND WaitWatch = 0 THEN
FilesystemWatchNotifierPush m_Queue, Buffer
END IF
END METHOD
CLASS METHOD CREATE()
M_WatchFilter = %FILE_NOTIFY_CHANGE_FILE_NAME OR _
%FILE_NOTIFY_CHANGE_DIR_NAME OR _
%FILE_NOTIFY_CHANGE_ATTRIBUTES OR _
%FILE_NOTIFY_CHANGE_SIZE OR _
%FILE_NOTIFY_CHANGE_LAST_WRITE OR _
%FILE_NOTIFY_CHANGE_LAST_ACCESS OR _
%FILE_NOTIFY_CHANGE_CREATION OR _
%FILE_NOTIFY_CHANGE_SECURITY
m_Queue = CLASS "cStringQueue"
m_WatchWriteProc = CLASS "cWatchWriteProc"
END METHOD
CLASS METHOD CheckForChanges(BYVAL waittime AS DWORD) AS LONG
LOCAL dwObj AS LONG
IF NOT (overl.hEvent) THEN
METHOD = %FALSE
EXIT METHOD
END IF
dwObj = WaitForSingleObject(overl.hEvent, waittime)
IF (dwObj <> %WAIT_OBJECT_0) THEN
METHOD = %FALSE
END IF
METHOD = Me.NotifyChange()
END METHOD
CLASS METHOD DESTROY()
IF (hWatchingThread AND (WaitForSingleObject(hWatchingThread, 0) = %WAIT_TIMEOUT)) THEN
SetEvent(hEvtStopWatching)
IF hWatchingThread THEN
WaitForSingleObject(hWatchingThread, %INFINITE)
CloseHandle(hWatchingThread)
hWatchingThread = %NULL
END IF
CloseHandle(overl.hEvent)
overl.hEvent = %NULL
closeHandle(hEvtStopWatching)
hEvtStopWatching = %NULL
CloseHandle(m_hDir)
m_hDir = %NULL
m_WatchWriteProc = NOTHING
m_Queue = NOTHING
END IF
END METHOD
INTERFACE iWatchFile GUID$( "{D3420B9D-D552-4717-AF85-3E1929C18FC9}")
INHERIT IPOWERTHREAD
METHOD IsThreadRunning() AS LONG
METHOD = me.ISALIVE
END METHOD
METHOD ToogleWatch()
WaitWatch = WaitWatch XOR 1
END METHOD
' Ask for the thread to stop and waith until it ends
METHOD SynchronousAbort()
LOCAL fw AS iWatchFile
SetEvent(hEvtStopWatching)
fw = ME
SetEvent(hEvtStopWatching)
fw.Join(fw, 0)
CloseHandle(overl.hEvent)
overl.hEvent = %NULL
closeHandle(hEvtStopWatching)
hEvtStopWatching = %NULL
CloseHandle(m_hDir)
m_hDir = %NULL
IF ISOBJECT(m_WatchWriteProc) THEN
m_WatchWriteProc.WriteProcExit
m_WatchWriteProc.Join(m_WatchWriteProc, 0 )
END IF
IF ISOBJECT(m_Queue) THEN
m_Queue.CLEAR
END IF
END METHOD
' Start watching a file for changes
METHOD StartWatchThread() AS LONG
IF ISOBJECT(m_WatchWriteProc) THEN
m_WatchWriteProc.Launch( BYVAL 0 )
me.Launch( BYVAL 0 )
METHOD = %true
END IF
END METHOD
PROPERTY GET Pathname() AS WSTRING
PROPERTY = m_pathname
END PROPERTY
PROPERTY GET WatchFilter() AS DWORD
PROPERTY = m_WatchFilter
END PROPERTY
PROPERTY SET WatchFilter(BYVAL WFilter AS DWORD)
IF Wfilter THEN
m_WatchFilter = WFilter
END IF
END PROPERTY
PROPERTY GET WriteprocPtr() AS DWORD
PROPERTY = M_WriteprocPtr
END PROPERTY
PROPERTY GET watchtree() AS LONG
PROPERTY = m_Watchtree
END PROPERTY
METHOD Init(BYVAL fileFullPath AS WSTRING, BYVAL writeprocptr AS DWORD, BYVAL watchFilter AS DWORD, BYVAL watchtree AS LONG) AS LONG
' if the thread already exists then stop it
M_WriteprocPtr = writeprocptr
m_watchTree = IIF&( ISTRUE( watchTree ), %TRUE, %FALSE )
IF WatchFilter = 0 THEN WatchFilter = m_WatchFilter
#IF %DEF(%WIDE_UNICODE)
m_pathname = CreateWideFileName(fileFullPath)
#ELSE
m_pathname = fileFullPath
#ENDIF
IF (me.IsThreadRunning()) THEN
me.SynchronousAbort()
END IF
m_WatchWriteProc.Writeinit(m_Queue, M_WriteprocPtr)
m_hDir = CreateFile( _
(m_pathname), _ ' pointer to the directory containing the tex files
%FILE_LIST_DIRECTORY, _ ' access (read-write) mode
%FILE_SHARE_READ OR _
%FILE_SHARE_DELETE OR _
%FILE_SHARE_WRITE, _ ' share mode
BYVAL %NULL, _ ' security descriptor
%OPEN_EXISTING, _ ' how to create
%FILE_FLAG_BACKUP_SEMANTICS OR _
%FILE_FLAG_OVERLAPPED, _ ' file attributes
BYVAL %NULL) ' file with attributes to copy
ZeroMemory(BYVAL VARPTR(overl), SIZEOF(overl))
ZeroMemory(BYVAL VARPTR(buffer), SIZEOF(buffer))
overl.hEvent = CreateEvent(BYVAL %NULL, %FALSE, %FALSE, BYVAL %NULL)
hEvtStopWatching = CreateEvent(BYVAL %NULL, %TRUE, %FALSE, BYVAL %NULL)
' watch the directory
ReadDirectoryChangesW( _
m_hDir, _ ' handle to directory
BYVAL VARPTR(Buffer), _ ' read results buffer
SIZEOF(buffer), _ ' length of buffer
%FALSE, _ ' monitoring option
_ ' FILE_NOTIFY_CHANGE_CREATION
WatchFilter, _ ' filter conditions
%NULL, _ ' bytes returned
overl, _ ' overlapped buffer
BYVAL %NULL) ' completion routine
METHOD = %TRUE
END METHOD
' Call ReadDirectoryChangesW to check if the file has changed since the last call.
METHOD CheckForChanges(BYVAL waittime AS DWORD) AS LONG
METHOD = me.CheckForChanges(waittime)
END METHOD
END INTERFACE
END CLASS
CLASS cStringQueue
INSTANCE Queue AS IQUEUECOLLECTION
CLASS METHOD CREATE()
Queue = CLASS "QueueCollection"
END METHOD
INTERFACE iStringQueue
INHERIT IUNKNOWN
METHOD CLEAR()
Queue.clear
END METHOD
PROPERTY GET COUNT() AS LONG
PROPERTY = Queue.Count
END PROPERTY
PROPERTY GET Queue() AS FILE_NOTIFY_INFORMATIONX
IF Queue.Count THEN
PROPERTY = VARIANT$$(Queue.DEQUEUE())
END IF
END PROPERTY
PROPERTY SET Queue( value AS FILE_NOTIFY_INFORMATIONX)
Queue.ENQUEUE((value))
END PROPERTY
END INTERFACE
END CLASS
SUB FilesystemWatchNotifierPush( Queue AS iStringQueue, value AS FILE_NOTIFY_INFORMATIONX) THREADSAFE
IF ISOBJECT( Queue ) THEN
Queue.Queue = value
END IF
END SUB
FUNCTION FilesystemWatchNotifierPop( Queue AS iStringQueue, value AS FILE_NOTIFY_INFORMATIONX) THREADSAFE AS LONG
IF ISNOTHING( Queue ) OR Queue.Count=0 THEN EXIT FUNCTION
value = Queue.Queue
FUNCTION = -1
END FUNCTION
DECLARE SUB FilesystemWatcherNotifyPattern(BYREF modfile AS WSTRING, BYVAL Action AS LONG)
CLASS cWatchWriteProc GUID$("{762E61EC-F4D8-43A5-A1F7-886A89D78E9D}") AS COM
INSTANCE ThreadParam AS LONG
INSTANCE m_stringQueue AS iStringQueue
INSTANCE m_writeProcPtr AS DWORD
INSTANCE m_extitflag AS LONG
THREAD METHOD MAIN() AS LONG
STATIC buffer AS FILE_NOTIFY_INFORMATIONX
STATIC ptrNextOffset AS DWORD
STATIC ptrNext AS DWORD
STATIC ptrAction AS DWORD
STATIC ptrFileLen AS DWORD
m_extitflag = 0
DO WHILE m_extitflag = 0
IF FilesystemWatchNotifierPop(m_stringQueue, buffer) THEN
ptrNext = 0
DO
ptrNextOffset = PEEK(VARPTR(Buffer) + ptrNext)
ptrAction = PEEK(VARPTR(Buffer) + ptrNext + 4)
ptrFileLen = PEEK(VARPTR(Buffer) + ptrNext + 8) / 2
IF m_writeProcPtr THEN
CALL DWORD m_writeProcPtr USING FilesystemWatcherNotifyPattern(PEEK$$(VARPTR(Buffer) + ptrNext + 12, ptrFileLen), ptrAction)
END IF
#IF %DEF(%DEBUG)
STATIC sout AS WSTRING
SELECT CASE ptrAction
CASE %FILE_ACTION_ADDED
sOut = "File added: "
CASE %FILE_ACTION_REMOVED
sOut = "File removed: "
CASE %FILE_ACTION_MODIFIED
sOut = "File modified: "
CASE %FILE_ACTION_RENAMED_OLD_NAME
sOut = "Old filename: "
CASE %FILE_ACTION_RENAMED_NEW_NAME
sOut = "New filename: "
CASE ELSE
sOut = "Undocumented action!"
END SELECT
sOut = sOut &(PEEK$$(VARPTR(Buffer) + ptrNext + 12, ptrFileLen))
ztrace sOut + STR$(ptrNextOffset)
#ENDIF
ptrNext = ptrNextOffset
LOOP UNTIL (ptrNextOffset = 0)
END IF
LOOP
END METHOD
INTERFACE iWatchWriteProc GUID$("{137700FB-232E-4D89-AA0D-593BB4CCF0CD}")
INHERIT IPOWERTHREAD
METHOD Writeinit(BYREF stringQueue AS iStringQueue, BYVAL WriteProc AS DWORD)
m_stringQueue = stringQueue
m_writeprocPtr = WriteProc
END METHOD
METHOD WriteProcExit
m_extitflag = %TRUE
END METHOD
METHOD IsThreadRunning() AS LONG
METHOD = me.ISALIVE
END METHOD
END INTERFACE
END CLASS
FUNCTION PBMAIN
LOCAL watch AS iWatchFile
IF watchInit(watch, "f:\pbwin10", CODEPTR(onChange), 0, 0) THEN
watch.StartWatchThread
? "watching f:\pbwin10 " + CHR$(13) +_
"goes Watch Folder C:\"
WatchChangeFolder watch, "c:\"
? "watching Abort"
WatchStop watch
END IF
END FUNCTION
SUB OnChange(BYREF filename AS WSTRING, BYVAL changeEvent AS LONG )
SELECT CASE CONST changeEvent
CASE %FILE_ACTION_ADDED
ztrace filename + " Added "
CASE %FILE_ACTION_REMOVED
ztrace (filename + " Removed")
CASE %FILE_ACTION_MODIFIED
ztrace (filename + " Modified")
CASE %FILE_ACTION_RENAMED_OLD_NAME
ztrace (filename + " Rename Old name")
CASE %FILE_ACTION_RENAMED_NEW_NAME
ztrace (filename + " Rename New name")
CASE ELSE
ztrace "Unknown &H" + HEX$( changeEvent )
END SELECT
END SUB
Grüße Peter
See: http://msdn.microsoft.com/en-us/library/windows/desktop/aa365261%28v=vs.85%29.aspx
[Translation/Theo]
Hallo Jose,
thanks for the tip. This problem can now be seen as solved.
The Class that i posted above works perfect.
Note/Theo: I have locked the topic, so that nobody will use time on a solved problem.
Quote
Hallo José
Danke für den Tip. Aber die von mir oben im Beispiel gezeigte Fwatcher Klasse funktioniert sehr gut. Werde sie nicht mehr großartig ändern.
Please, Theo translate
Grüße Peter
Attached a newer version with some minor, but important changes.
Also i am running into problems with the PB "PowerQue" under Win 7/x64 therefore i have done something like this myself.
QuoteHallo
Habe noch zwei Änderungen damit die Classe auch mit Wide Unicode und windows 7 64bit Stabil läuft
zum einen der Thread Wait for Event (class) "FWwatcher" muss immer vorrang gegen über Thread Write Class "cWatchWriteProc".
wen Thread Wait for Event etwas schreiben möchte muß Thread Write angehalten werden
IF (dwNumberbytes) AND WaitWatch = 0 THEN
m_WatchWriteProc.SUSPEND()
FilesystemWatchNotifierPush m_Queue, Buffer
m_WatchWriteProc.resume()
END IF
QuoteZum anderen macht die QueueCollection von Powerbasic probleme wen Windows 7 64 Bit läuft. Deswegen habe ich eine eigene Pipeline geschrieben
CLASS cStringQueue GUID$("{0BAA02AD-6163-40E8-A22A-C2F733DC59B4}") AS COM
INSTANCE m_Queue() AS FILE_NOTIFY_INFORMATIONX
INSTANCE m_count AS DWORD
INTERFACE iStringQueue GUID$("{CBE6163F-4E31-4A53-A028-042448541E8D}")
INHERIT IUNKNOWN
METHOD CLEAR()
REDIM m_Queue(0 TO 0)
m_count = 0
END METHOD
PROPERTY GET COUNT() AS LONG
PROPERTY = m_count
END PROPERTY
PROPERTY GET Queue() AS FILE_NOTIFY_INFORMATIONX
IF me.Count THEN
PROPERTY = m_Queue(0)
ARRAY DELETE m_Queue(0)
m_count-=1
REDIM PRESERVE m_Queue(0 TO m_count)
END IF
END PROPERTY
PROPERTY SET Queue( value AS FILE_NOTIFY_INFORMATIONX)
REDIM PRESERVE m_Queue(0 TO m_count)
m_Queue(m_count) = value
m_count+=1
END PROPERTY
END INTERFACE
END CLASS
Grüße Peter