Matthias Hoffmann - Other Utilities - Dirwatcher

This tool is waiting around for directory-changes, carrying out specified actions if changes are detected

It demonstrates the usage of some win32-API-calls and shows how hard it is, to detect what changes really going on in the filesystem. It mainly uses FindFirstChangeNotification(), WaitForSingleObject(), etc. As time of writing, twapi does not offer a high-level-solution for the script-level, so I coded the program in my second favorite language, PowerBasic [L1 ].

 '==============================================================================
 ' dirmon.bas v1.20 23.10.2004 (c) HMK 2001-2004, Matthias Hoffmann
 ' Wartet, bis sich das angegebene Verzeichnis ändert (NICHT-rekursiv);
 ' gibt dann die Aenderung (ADD:/DEL:/CHG:) sowie die Dateinamen auf STDOUT aus,
 ' fuehrt wahlweise eine Aktion durch und setzt anschliessend wahlweise die
 ' Überwachtung fort. Entwickelt aus waitdchg.bas.
 ' 1.10 22.10.2004: Löschdatei wird automatisch entfernt; Versionsanzeige
 '                  korrigiert; aktuellstes `parsecmd` eingebunden.
 ' 1.20 23.10.2004: -min, -halt
 '==============================================================================
 ' - Checken: Abbruch, wenn dieses Programm als Pseudo-Service läuft? ggf. echter
 '   Service!
 ' - Verschiedene -ffcnflags testen!
 ' - Win32 FindFirst, FindNext direkt benutzen + Strukturen sofort sichern
 ' - Abbruchsteuerung - wie? (WaitForMultipleObjects, aber WORAUF NOCH?), ggf.
 '   auch Taste/Signal etc. checken, immer wenn Wait...() durch Timeout endet
 ' - RENAME wird jetzt immer als DEL/ADD erkannt... hm...
 ' - evtl. Erkennungsdatum-/Zeit ausgeben?
 ' - Weitere konfigurierbare Aktionen und Variablen dort (-cmdxxx)
 ' - Parameterprüfungen, z.B. ms-Range
 ' - wahlweise MEHRERE Dirs (posarg1 bis n) überwachbar machen, warten dann mit
 ' - Paralleles Logging (stdout DUPpen - möglich?)
 ' - Programm bei Fehler wieder maximieren (dazu exit_prog trappen?->PBDOS)?
 '   nützt nichts, wenn es DIREKT aufgerufen wurde, da es dann ja sofort endet
 '   (anders vom CMD.EXE-Prompt).

 #tools off
 #include "win32api.inc"

 '*******************************************************************************
 '* Konstanten                                                                  *
 '*******************************************************************************

 $Version = $CRLF & "dirmon v1.20 (c) HMK, M.H. 2001-2004"              & $CRLF & $CRLF & _
            "Ueberwachung eines Ordners auf Aenderungen (nicht rekursiv)."      & $CRLF & _
            "Anzeige der Aenderungen, wahlweise Aktionen ausfuehren."   & $CRLF & $CRLF & _
            "Aufruf: dirmon <verzeichnisname> [-schalter]"

 '*******************************************************************************
 '* Module                                                                      *
 '*******************************************************************************

 %parsecmd_static_required = 1
 %parseDebug = 0
 #include "parsecmd.inc"

 '-------------------------------------------------------------------------------
 ' *** Unterroutinen ***
 '-------------------------------------------------------------------------------

 '-------------------------------------------------------------------------------
 ' Verzeichnis NICHT-REKURSIV einlesen in String (kann bei Bedarf mittels
 '  PARSE in ein Array zerlegt werden) zwecks Vergleich vorher<>nachher
 '
 function readDir (mask as string) as string
    dim tmpBuffer as local string
    dim tmpResult as local string
    tmpBuffer = dir$(mask, 23)
    while len(tmpBuffer)
       tmpResult = tmpResult & "," & $DQ & tmpBuffer & $DQ
       tmpBuffer = dir$
    wend
    function = mid$(tmpResult,2)
 end function


 '-------------------------------------------------------------------------------
 ' Prüfen, ob Angabe ein DIRECTORY ist; wenn ja, nachfolgenden Backslash ggf.
 '  entfernen und den Namen nochmals zurückgeben (Leerstring andernfalls);
 '  zusätzlich / in \ wandeln (falls mit -cmdxxx gearbeitet wird)
 '
 function testDir (inDir as string) as string
    dim t as local string
    dim a as local long
    a = getattr(inDir)
    if isfalse(err) then
       if (a and 16) = 16 then
          t = rtrim$(inDir,"\")
          replace "/" with "\" in t
          function = t
       end if
    end if
 end function

 '-------------------------------------------------------------------------------
 ' Zu einer gegebenen Datei die Win32_Find_Data-Struktur einlesen (leider
 '  bietet PowerBASICs dir$ keinen direkten Zugang hierzu; es sollten also
 '  eigentlich besser gleich die API-Varianten benutzt werden!), und sich alles
 '  merken, was zur Erkennung jeglicher Dateiveränderung nötig ist (aber, aus
 '  Platzgründen, auch nicht mehr!). GRUND: Das Betriebssystem ist doof. Es
 '  übernimmt ja bereits die Überwachung jedglicher Änderung des Dateisystems,
 '  teilt einem aber leider nicht mit, WAS GENAU sich nun geändert hat! Also
 '  muss man die gesamte Erkennung quasi nachbilden; lediglich etwas CPU-Last
 '  kann man durch FindFirstChangeNotification() sparen, da das System den
 '  WaitForSingleObject() erst zurückkehren lässt, wenn tatsächlich eine
 '  Änderung eingetreten ist.
 '
 function getFileInfo (fileSpec as string) as string

    dim fd    as local WIN32_FIND_DATA
    dim hFile As local long

    hFile = FindFirstFile(byval strptr(fileSpec),fd)
    if isfalse hFile then
       exit function
    end if

    ' Hinweise: Eine Veränderung des DateiINHALTS muss immer eine Fortführung des
    '            Zeitstempels bewirken! (im Rahmen natürlich der Granularität);
    '           leider wirken DateiATTRIBUTänderungen NICHT auf den Zeitstempel
    '            aus!
    '           OPEN WRITE z.B. aus Tcl bewirkt bereits Zeitstempeländerung ->
    '            CHG wird gemeldet.
    function = mkdwd$(fd.ftLastWriteTime.dwLowDateTime)  & _
               mkdwd$(fd.ftLastWriteTime.dwHighDateTime) & _
               mkdwd$(fd.dwFileAttributes)
    ' Noch testen: Grössenänderung der Datei durch Abschneiden? Müsste Schreib-
    ' Zugriff sein, der das Datum aktualisiert!

    FindClose hFile

 end function


 '-------------------------------------------------------------------------------
 ' *** MAIN ***
 '-------------------------------------------------------------------------------

 function pbmain()

    console name extract$(mid$($Version,3),"(c)")

    dim lpPathName    as local asciiz*%MAX_PATH ' muss ein DIRECTORY-Name sein!
    dim bWatchSubtree as local long
    dim hNotify       as local long
    dim lReturn       as local long
    dim ffcnflags     as local long

    dim dirM          as local string
    dim dirS          as local string
    dim dir1          as local string
    dim atr()         as local string
    dim dir2          as local string
    dim i             as local long
    dim tmp           as local string
    dim tmpcmd        as local string
    dim movdest       as local string

    ffcnflags = %FILE_NOTIFY_CHANGE_LAST_WRITE or _
                %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_CREATION

    '-------------------------------------------------------------------------------
    ' Hilfe initialisieren
    '

    dim dirName as local long
    dim forever as local long
    dim delayms as local long
    dim timeoms as local long
    dim cmd_add as local long
    dim cmd_chg as local long
    dim ffflags as local long
    dim stopfil as local long
    dim movedir as local long
    dim minimiz as local long
    dim haltpgm as local long

    dirName = parseRegister(%parsePosArgRequired,""       ,""             ,_
              "Name des zu beobachtenden Verzeichnisses, erforderlich!")
    forever = parseRegister(%parseTypeFlag      ,"loop"   ,""             ,_
              "Andauernde Ueberwachung (sonst Ende nach erkannten Aenderungen)")
    delayms = parseRegister(%parseTypeOption    ,"delay"  ,"500"          ,_
              "Wartezeit in ms nach OS-Signal, vor Aenderungs-Erkennung")
    timeoms = parseRegister(%parseTypeOption    ,"timeout",format$(%INFINITE),_
              "Timeout in ms fuer WaitForSingleObject()")
    cmd_add = parseRegister(%parseTypeOption    ,"cmdadd" ,""             ,_
              "Externer Befehl bei ADD; Name ersetzt %~n, vollst.Name %~f")
    cmd_chg = parseRegister(%parseTypeOption    ,"cmdchg" ,""             ,_
              "Externer Befehl bei CHG; Name ersetzt %~n, vollst.Name %~f")
    ffflags = parseRegister(%parseTypeOption ,"ffcnflags" ,format$(ffcnflags),_
              "Notify-Filter fuer FindFirstChangeNotificaton(), OR-Verkn. aus:" & $CRLF & $TAB & $TAB & _
              "%FILE_NOTIFY_CHANGE_FILE_NAME  = &H00000001*" & $CRLF & $TAB & $TAB & _
              "%FILE_NOTIFY_CHANGE_DIR_NAME   = &H00000002*" & $CRLF & $TAB & $TAB & _
              "%FILE_NOTIFY_CHANGE_ATTRIBUTES = &H00000004*" & $CRLF & $TAB & $TAB & _
              "%FILE_NOTIFY_CHANGE_SIZE       = &H00000008*" & $CRLF & $TAB & $TAB & _
              "%FILE_NOTIFY_CHANGE_LAST_WRITE = &H00000010*" & $CRLF & $TAB & $TAB & _
              "%FILE_NOTIFY_CHANGE_CREATION   = &H00000040*" & $CRLF & $TAB & $TAB & _
              "%FILE_NOTIFY_CHANGE_SECURITY ? = &H00000100")
    stopfil = parseRegister(%parseOptionRequired,"stopfile","$__dirmon.stop",_
              "Ende bei Erscheinen dieser Datei im Dir.")
    movedir = parseRegister(%parseTypeOption    ,"movedir",""             ,_
              "Ordner; wenn angegeben, (nur) neue Dateien (ADD:) nach dort"     & $CRLF & $TAB & $TAB & _
              "verschieben. (erfolgt ggf. NACH einem -cmdadd-Exit!)")
    minimiz = parseRegister(%parseTypeFlag      ,"min"    ,""             ,_
              "Programm nach dem Starten in Taskbar minimieren")
    haltpgm = parseRegister(%parseTypeFlag      ,"halt"   ,""             ,_
              "Laufende Instanz beenden (=stopfile anlegen)")

    i = parseParse(command$)
    ' stdout parseDump
    if i < 0 then
       if i = %parseHlpRequest or i = %parseErrNoInput then
          stdout parseHelp($Version, _
          "Sobald eine Aenderung eintritt, wird ein Kuerzel ADD:, CHG: oder DEL: gefolgt"    & $CRLF & _
          "vom Dateinamen, auf STDOUT ausgegeben (ermoeglicht z.B. das Mitlesen ueber TCLs"  & $CRLF & _
          "FileEvent-Handler). Via -cmdxyz angegebene Kommandos werden als CMX: geloggt."    & $CRLF & _
          "Fehlt -loop, endet das Programm nach den ersten Aenderungen mit Errorlevel 1."    & $CRLF & _
          "Der Abbruch kann durch Strg+Untbr oder Erzeugen der Datei -stopfile im Ordner"    & $CRLF & _
          "erfolgen (RC0). Mit -delay kann eine geblockte Verarbeitung erreicht werden."     & $CRLF & _
          "Vorgabe fuer -timeout ist %INFINITE (muss nur geaendert werden bei zeitlich"      & $CRLF & _
          "begrenzter Ueberwachung). Bei Ende ueber Timeout ist der Errorlevel 2. -movedir"  & $CRLF & _
          "dient als Ersatz fuer die bisherige Funktion Druckdatenarchivierung (Finanzen),"  & $CRLF & _
          "es werden dabei die beiden Kuerzel @CP und @DL geloggt. Nachfolger von waitdchg."           _
          ,0)
          function = 255
          exit function
       else
          stdout "Fehlerhaftes Token: " & parseLastToken()
          stdout "Fehler: " & str$(i)
          stdout "Fehlertext: " & parseErrorText(i)
          stdout "(Hilfe mit -?)"
          function = 255
          exit function
       end if
    end if

    movdest = parseArg(movedir)
    if len(movdest) then
       movdest = testDir(movdest)
       if len(movdest) = 0 then
          stdout "Verzeichnis -movedir nicht vorhanden: " & parseArg(movedir)
          function = 255
          exit function
       end if
    end if

    dirM = testDir(parseArg(dirName))
    if len(dirM) = 0 then
       stdout "Verzeichnis <1> nicht vorhanden: " & parseArg(dirName)
       function = 255
       exit function
    end if

    lpPathName = dirM
    dirS       = dirM & "\"
    dirM       = dirM & "\*.*"
    dir1       = readDir dirM

    ' v1.20: zusätzliche Flags -min und -stop behandeln
    if parseArg(minimiz) = "1" then
       showWindow conshndl,%SW_MINIMIZE
    end if
    if parseArg(haltpgm) = "1" then
       open dirS & parseArg(stopfil) for output as #1
       close #1
       function = err
       exit function
    end if

    do

       redim atr(1:parsecount(dir1))
       rem Dateiattribute sicherstellen
       for i=1 to parsecount(dir1)
           atr(i) = getFileInfo(dirS & parse$(dir1,i))
       next

       bWatchSubtree = %FALSE

       hNotify = FindFirstChangeNotification(lpPathName,bWatchSubtree,val(parseArg(ffflags)))

       if hNotify = %INVALID_HANDLE_VALUE then
          stdout "FindFirstChangeNotification() gescheitert, Rc :=" & str$(hNotify)
          function = 64
          exit function
       end if

       function = 0 ' Strg+Untbr?
            lReturn = WaitForSingleObject(hNotify, val(parseArg(timeoms)))
       if lReturn = 0 then
          function = 1 ' Irgendeine Änderung ist eingetreten
       elseif lReturn = 258 then ' Timeout
          function = 2
       end if

       rem stdout "rc(WaitForSingleObject) :=" & str$(lReturn) ' 0, timeout = 258

       lReturn = FindCloseChangeNotification(hNotify)
       ' Jetzt Chance für Tastendruck/anderweitigen Abbruchcheck

       ' gibt dem OS Zeit, die Änderungen zu reflektieren (vermutlich
       '  zu wenig!) - verhindert evtl. Doppelterkennungen bei REN/DEL
       sleep val(parseArg(delayms))

       dir2 = readDir dirM

       ' Herausfinden, welche Änderungen aufgetreten sind

       for i=1 to parsecount(dir1)
           tmp = parse$(dir1,i)
           if instr(dir2,tmp) = 0 then
              stdout "DEL: " & tmp
           elseif atr(i) <> getFileInfo(dirS & tmp) then
              ' Bugfix v1.2: bei Verwendung ohne -loop wurde Stopfile (tw.?) als CHG: erkannt
              if tmp = parseArg(stopfil) then
                 ' v1.10: stopfil sofort wieder löschen
                 setattr dirS & tmp,0
                 kill    dirS & tmp
                 function = 0
                 exit function
              end if
              ' >>> Problem: getFileInfo reflektiert evtl. schon wieder einen SPÄTEREN
              ' Zustand als der readDir() weiter oben; das darf nicht sein! ===>
              ' Win32-FindFirst/FindNext muss benutzt werden mit SOFORTIGER Sicherstellung
              ' der relevanten Attribute!
              stdout "CHG: " & tmp
              tmpcmd = parseArg(cmd_chg)
              if len(tmpcmd) then
                 replace "%~f" with dirS & tmp in tmpcmd
                 replace "%~n" with        tmp in tmpcmd
                 shell tmpcmd
                 stdout "CMC: " & tmpcmd & " (ready)"
              end if
           end if
       next
       for i=1 to parsecount(dir2)
           tmp = parse$(dir2,i)
           if instr(dir1,tmp) = 0 then
              if tmp = parseArg(stopfil) then
                 ' v1.10: stopfil sofort wieder löschen
                 setattr dirS & tmp,0
                 kill    dirS & tmp
                 function = 0
                 exit function
              end if
              stdout "ADD: " & tmp
              tmpcmd = parseArg(cmd_add)
              if len(tmpcmd) then
                 replace "%~f" with dirS & tmp in tmpcmd
                 replace "%~n" with        tmp in tmpcmd
                 shell tmpcmd
                 stdout "CMA: " & tmpcmd & " (ready)"
              end if
              if len(movdest) then
                 if len(dir$(dirS & tmp, 23)) then
                    ' Abfrage, falls Datei bereits von -cmdadd gelöscht
                    filecopy dirS & tmp, movdest & "\" & tmp
                    stdout "@CP: " & tmp & " -> " & movdest & " (" & format$(Errclear) & ")"
                    setattr dirS & tmp,0
                    kill dirS & tmp
                    stdout "@DL: " & tmp & " (" & format$(Errclear) & ")"
                 end if
              end if
           end if
       next
       dir1 = dir2

       if parseArg(forever) = "0" then
          exit loop
       end if

    loop

 end function