Ordner überwachen

Für allgemeine Fragen zur Programmierung mit PureBasic.
CNESM
Beiträge: 311
Registriert: 29.08.2004 15:16
Kontaktdaten:

Ordner überwachen

Beitrag von CNESM »

Hi,

ich möchte gerne einen bestimmten Ordner mit sämtlichen Unterordner auf Veränderung überwachen. Dafür gibt es auch eine entsprechende API, welche ich aus einem Profan Beispiel entnehmen konnte. Leider funktioniert das ganze überhaupt nicht und die Auslastung auf mein System ist echt stark. Vielleicht könnt ihr mal kurz drüber schauen und mal kucken woran das liegt. Ich blick da nicht mehr durch :(

Vorsicht: Speichert vor dem Testen eure Sachen. Im Profan Beispiel wird bereits auf die Belastung hingewiesen. Keine Haftung für Schäden :)

Profan-Code:

Code: Alles auswählen

' PRFellow-Vorlage
' Autor: Thomas Hölzer
' Einen Ordner permanent auf Änderungen überwachen:
' z.B. Dateien einfügen,löschen, speichern, Dateidatum ändern
' Zum Testen bitte erst einen Ordner namens C:\TEST anlegen.
' Dann dieses Programm starten (>= Profan 5.0 - 32).
' Bei allen Änderungen in C:\TEST gibt es einen beep aus.
' Die Prozessorbelastung bei dem im Beispiel eingestellten
' Überwachungs-Interval von 500 Milli-Sekunden beträgt nur 2%.

' Achtung: Der zu überwachende Ordner sollte unbedingt existieren!
' Wird der Ordner nicht gefunden, steigt die Prozessorauslastung auf 100%!
' Bitte auch Kommentar zum Beispiel genau lesen!

Def FindFirstChangeNotification(3) !"KERNEL32","FindFirstChangeNotificationA"
Def FindNextChangeNotification(1) !"KERNEL32","FindNextChangeNotification"
Def FindCloseChangeNotification(1) !"KERNEL32","FindCloseChangeNotification"
Def WaitForSingleObject(2) !"KERNEL32","WaitForSingleObject"
Declare folder#

Proc FolderSpy
 Parameters folder$,milliseconds&
 Declare hchangeobject&,exit%
 Dim folder#,Add(Len(folder$),1)
 String folder#,0=folder$
 WhileNot exit%
  Let hchangeobject&=FindFirstChangeNotification(folder#,0,1)
  If Equ(WaitForSingleObject(hchangeobject&,milliseconds&),0)
  ' Hier nun die Aktion, die bei einer Änderung im überwachten
  ' Verzeichnis ausgeführt werden soll.
	' Im Beispiel ist es nur ein
	 MessageBox "Geändert","Geändert",32
         
 EndIf
 FindNextChangeNotification(hchangeobject&)
 ' Die nächste Zeile ist nur für das TestProgramm
 Case GetFocus(endbutton%): Let exit%=1
 Case Equ(%message,2000): Let exit%=1
Wend

 MessageBox(Add$(Add$("Die Überwachung von ",folder$)," wird beendet!"),"Hinweis",64)
 FindCloseChangeNotification(hchangeobject&)
 Dispose folder#
EndProc

' Beispiel
' Das Spy-Programm muß auf jeden Fall ein Dummy-Fenster haben!!
' Es darf ruhig unsichtbar oder jenseits des Bildschirms sein -
' Hauptsache es kann Nachrichten empfangen und senden
' Für das Beispielprogramm wurde ein Ende-Button eingefügt.
' Vor Übernahme in eigene Programme muß man sich etwas anderes überlegen
' Getesteter Vorschlag:
' Ein Programm als Spy laufen lassen und ein
' Monitorprogramm schreiben, das dieses steuert
' und es mit der benutzerdefinierten Message PostMessage(handle_spy&,2000,0,0)
' ordentlich beendet.

Declare endbutton%
Cls
Let endbutton%=CreateButton(%hwnd,"&Ende",0,0,64,23)
FolderSpy "C:\PRFELLOW",500
Purebasic-Code:

Code: Alles auswählen

Global hchangeobject.l,milliseconds.l

Procedure CheckMalDasOrdner()
  
  *Mem = AllocateMemory(255) 
  text$="C:\PRFELLOW"
  PokeS(*Mem,text$) 
  
  FindFirstChangeNotification_(*Mem,0,1)
   
  While a = 10  ;Wenn 11 dann wird die schleife verlassen a=11
    If WaitForSingleObject_(hchangeobject,milliseconds)=0
      MessageRequester("Information","dd",#PB_MessageRequester_Ok) 
      FindCloseChangeNotification_(hchangeobject)
      FreeMemory(*Mem) 
      End
    EndIf
    FindNextChangeNotification_(hchangeobject)
  Wend 
  
  FindCloseChangeNotification_(hchangeobject)
  FreeMemory(*Mem) 
EndProcedure

If OpenWindow(0, 100, 200, 195, 260, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget, "PureBasic Window")

  Repeat
    EventID.l = WindowEvent()

    If EventID = #PB_Event_CloseWindow  ; If the user has pressed on the close button
      Quit = 1
    EndIf
    
    
    CheckMalDasOrdner()

Until Quit = 1
  
EndIf

End   ; All the opened windows are closed automatically by PureBasic
Andreas
ToolbarKönig
Beiträge: 142
Registriert: 08.09.2004 08:33

Beitrag von Andreas »

Code: Alles auswählen

Global hchangeobject.l

Structure Look
   Directory.s
   Milliseconds.l
EndStructure 


Procedure FolderSpy(*SLook.Look) 
 Protected exit.l
 While exit = 0 
  hchangeobject=FindFirstChangeNotification_(*SLook\Directory,0,1) 
  If WaitForSingleObject_(hchangeobject,*SLook\milliseconds)= 0 
    MessageRequester("Geändert","Geändert",#MB_SYSTEMMODAL) 
   EndIf 
   FindNextChangeNotification_(hchangeobject) 
 Wend 
EndProcedure 


If OpenWindow(0, 100, 200, 195, 260, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget, "PureBasic Window") 
  FLook.Look
  FLook\Directory = "C:\Test";Muss existieren !!
  FLook\Milliseconds = 500
  CreateThread(@Folderspy(),@Flook) 
  Repeat 
    EventID.l = WaitWindowEvent() 
    If EventID = #PB_Event_CloseWindow
      MessageRequester("Hinweis","Die Überwachung von "+FLook\Directory+" wird beendet!",#MB_SYSTEMMODAL) 
      FindCloseChangeNotification_(hchangeobject) 
      Quit = 1 
    EndIf 
Until Quit = 1 
EndIf 
End
Gruss Andreas
CNESM
Beiträge: 311
Registriert: 29.08.2004 15:16
Kontaktdaten:

Beitrag von CNESM »

Hi,

danke für die schnelle Rückantowrt. Werd mir das ganze mal anschauen, hast ja doch ganz schön was verändert :)

Wow :allright:
Benutzeravatar
kunstlust
Beiträge: 259
Registriert: 12.04.2012 23:47
Wohnort: Hannover
Kontaktdaten:

Re: Ordner überwachen

Beitrag von kunstlust »

Kann mir jemand sagen, wie ich das gefunden File mit ausgeben kann?
Danke
Benutzeravatar
Bisonte
Beiträge: 2468
Registriert: 01.04.2007 20:18

Re: Ordner überwachen

Beitrag von Bisonte »

Ich habe den Eindruck, das ist gar nicht vorgesehen.
Zumindest habe ich bei den "Directory Management Functions" nichts gefunden.
(Die Rubrik, wo das FindFirstChangeNotification_() zu finden ist.)
PureBasic 6.21 (Windows x86/x64) | Windows11 Pro x64 | AsRock B850 Steel Legend Wifi | R7 9800x3D | 64GB RAM | GeForce RTX 5080 | ThermaltakeView 270 TG ARGB | build by vannicom​​
Benutzeravatar
kunstlust
Beiträge: 259
Registriert: 12.04.2012 23:47
Wohnort: Hannover
Kontaktdaten:

Re: Ordner überwachen

Beitrag von kunstlust »

Ich habe das was gefunden, was das Problem löst http://purebasic.fr/english/viewtopic.p ... 03&start=0

__________________________________________________
Domain angepasst
13.02.2015
RSBasic
Antworten