Need Explorer Event/Message

[Peter Weis]

[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     

[Pierre Bellisle]

Peter,

This might help...

ReadDirectoryChangesW by Balthasar

FindFirstChangeNotification, FindCloseChangeNotification and FindNextChangeNotification by Wayne

Pierre

[Patrice Terrier]

Code Select Expand

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

Code Select Expand

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


Code Select Expand


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


Code Select Expand


' 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


[Peter Weis]

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

[Pierre Bellisle]

Hallo Peter,

Here is a version that use SHChangeNotifyRegister and monitor files and folders for rename, creation and deletion...

Pierre

Code Select Expand


'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
'______________________________________________________________________________
'


[Peter Weis]

Hello, I just decided for this solution. It is simple and safe! And goes well with wide Unicode

Code Select Expand



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

                     
                                     


[Peter Weis]

[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!

Code Select Expand


#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

[Peter Weis]

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.

Code Select Expand




#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

[José Roca]

See: http://msdn.microsoft.com/en-us/library/windows/desktop/aa365261%28v=vs.85%29.aspx

[Peter Weis]

[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.

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

[Peter Weis]

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.

Hallo
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

Code Select Expand


           IF (dwNumberbytes) AND WaitWatch = 0 THEN
                m_WatchWriteProc.SUSPEND()
                FilesystemWatchNotifierPush m_Queue, Buffer
                m_WatchWriteProc.resume()

            END IF                       


Zum anderen macht die QueueCollection von Powerbasic probleme wen Windows 7 64 Bit läuft. Deswegen habe ich eine eigene Pipeline geschrieben

Code Select Expand


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