|
Registriert seit: 12. Feb 2007 Ort: Berlin 34 Beiträge Delphi 10.2 Tokyo Professional |
#2
Hallo Tom,
ich habe heute leider nicht den Nerv deinen Code zu überprüfen, hatte aber in der Vergangenheit schon mal ein ähnliches Problem und deshalb eine Komponente entwickelt. Vielleicht hilft dir das weiter. Hier die Komponenten:
Delphi-Quellcode:
Zu dieser Komponente gehört noch folgender Thread:
unit FldrControl;
interface uses Windows, SysUtils, Classes, cThread, SyncObjs; // dieser Typ steht für die dwFilter-Konstanten von ReadDirectoryChangesW // er ist erfoderlich, da die Filter-Konstanten nicht direkt verwendet werden können, // da ihr Wertbereich 128 überschreitet und nicht mehr in einen SET OF passen type opTyp = set of (fncFileName,fncDirName,fncAttributes,fncSize,fncLastWrite,fncLastAccess,fncCreation,fncSecurity); // die Funktion dient der Datenübergabe an ein übergeordnetes Fenster Type TOnGetData = Procedure(Folder: String; Action: Integer) of Object; { Nichtvisuelle Komponente zur Ordnerüberwachung Properties: Folder - (lesen/schreiben) der Ordner, ab dem die Struktur überwacht werden soll ThreadExists - (lesen) TRUE, wenn der Überwachungsthread existiert ThreadSuspended - (lesen) TRUE, wenn der Thread suspendiert ist. CtrlTyp - (lesen/schreiben) Ersatz für dwFilter-Konstanten im Objektinspektor OnGetResult - Datenübergabeereignis Funktionen: Create, Destroy GetData - Verbindungsfunktion für Datenübergabe im Objektinspektor StartThread - Start des Überwachungsthreads StopThread - Beenden des Überwachungsthreads SuspendThread - Suspendieren des Überwachungsthreads ResumeThread; - Wiederaufnehme des Überwachungsthreads } type TFldrControl = class(TComponent) private { Private-Deklarationen } ControlThread: CtrlThread; // Zeiger auf das Thread-Objekt FOrdnerName : String; // zu überwachender Ordner SuspEventName: String; // benamter Event für die Einleitung von Suspend TermEventName: String; // benamter Event für die Einleitung von Terminate FOnData : TOnGetData; ThrdExists : boolean; // Kennzeichen für die Existenz des Threads wSelChg : DWORD; // Filter für ReadDirectoryChangesW TypSelChg : opTyp; // Alias für Filter (Objektinspektor) protected { Protected-Deklarationen } procedure SetOrdnerName(NewFolder: String); // ändern Ordnername function GetThreadStatus: boolean; // Abfrage Threadstatus procedure SetTypSelChg(Value: opTyp); // ändern Filter public { Public-Deklarationen } EvOrdner : String; // Rückgabedaten Ordnername bei Ereignis EvAction : integer; // Rückgabedaten Ereignis Constructor Create(AOwner: TComponent); override; Destructor Destroy; override; Procedure StartThread; Procedure StopThread; Procedure SuspendThread; Procedure ResumeThread; procedure GetData; function GetReason(const AdwReasonCode: DWORD): String; published { Published-Deklarationen } Property Folder : String Read FOrdnerName write SetOrdnerName; Property ThreadExists : boolean read ThrdExists default TRUE; Property ThreadSuspend : boolean read GetThreadStatus; Property OnGetResult : TOnGetData read FOnData write FOnData; Property CtrlTyp : opTyp read TypSelChg write SetTypSelChg; end; procedure Register; {*R *.res} implementation procedure Register; begin RegisterComponents('Eigene', [TFldrControl]); end; Constructor TFldrControl.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlThread:=NIL; // überflüssig ThrdExists :=FALSE; // Ausgangssituation SetTypSelChg([fncFileName,fncDirName]); // Standartwert für Filter end; Destructor TFldrControl.Destroy; begin inherited Destroy; end; // Umwandlung opTyp (SET OF) in DWORD für Filterkonstanten procedure TFldrControl.SetTypSelChg; var res: DWORD; begin res:=0; if fncFileName in Value then res:=res or FILE_NOTIFY_CHANGE_FILE_NAME; if fncDirName in Value then res:=res or FILE_NOTIFY_CHANGE_DIR_NAME; if fncAttributes in Value then res:=res or FILE_NOTIFY_CHANGE_ATTRIBUTES; if fncSize in Value then res:=res or FILE_NOTIFY_CHANGE_SIZE; if fncLastWrite in Value then res:=res or FILE_NOTIFY_CHANGE_LAST_WRITE; if fncLastAccess in Value then res:=res or FILE_NOTIFY_CHANGE_LAST_ACCESS; if fncCreation in Value then res:=res or FILE_NOTIFY_CHANGE_CREATION; if fncSecurity in Value then res:=res or FILE_NOTIFY_CHANGE_SECURITY; wSelChg:=res; TypSelChg:=Value; // nach einer Filteränderung muß der Thread eventuell neu gestartet werden! if not ThrdExists then Exit; // außer er existiert nicht // wenn der Thread suspendiert ist.. if ControlThread.Suspended then begin ControlThread.Resume; // dann aktivieren StopThread; // vernichten StartThread; // neu starten end else begin // wenn er schon läuft StopThread; // vernichten StartThread; // neu starten end; end; // function TFldrControl.GetThreadStatus: boolean; begin if ThrdExists then Result:=ControlThread.Suspended else Result:=TRUE; end; procedure TFldrControl.SetOrdnerName; begin FOrdnerName:=NewFolder; if not ThrdExists then Exit; if ControlThread.Suspended then begin ControlThread.Resume; StopThread; StartThread; end else begin StopThread; StartThread; end; end; procedure TFldrControl.GetData; begin if Assigned(OnGetResult) then OnGetResult(EvOrdner,EvAction); end; Procedure TFldrControl.StartThread; var SelfName: String; begin if ThrdExists then exit; if (Length(FOrdnerName)=0) or (Not DirectoryExists(FOrdnerName)) then begin MessageBox(0,'Ordner nicht angegeben','Fehler',MB_OK); Exit; end; if wSelChg=0 then begin MessageBox(0,'Überwachungskriterium nicht angegeben','Fehler',MB_OK); Exit; end; ControlThread:=CtrlThread.Create(self,FOrdnerName,wSelChg); ThrdExists :=TRUE; SelfName :=IntToStr(ControlThread.Handle); SuspEventname:=SelfName+'W'; TermEventName:=SelfName+'N'; ControlThread.SetEventNames(SuspEventname,TermEventName); ControlThread.Resume; end; Procedure TFldrControl.StopThread; var StopEvent: TEvent; begin StopEvent:=TEvent.Create(nil,FALSE,FALSE,TermEventName); PulseEvent(StopEvent.Handle); StopEvent.Free; (**)// am 09.09.2007 zugefügt // wenn der Thread nicht durch Terminate vernichtet wird (FreeOnTerminate=TRUE) // bleibt er nach Änderung des Ordnernamens auf dem alten Ordner stehen ! if ThrdExists then ControlThread.Terminate; (**) ThrdExists:=FALSE; end; Procedure TFldrControl.SuspendThread; var SuspEvent: TEvent; begin SuspEvent:=TEvent.Create(nil,FALSE,FALSE,SuspEventName); SuspEvent.SetEvent; SuspEvent.ResetEvent; SuspEvent.Free; end; Procedure TFldrControl.ResumeThread; begin ControlThread.Resume; end; // Ereignisgrung in Text umwandeln function TFldrControl.GetReason(const AdwReasonCode: DWORD): String; begin case AdwReasonCode of FILE_ACTION_ADDED : Result := 'hinzugefügt'; FILE_ACTION_REMOVED : Result := 'gelöscht'; FILE_ACTION_MODIFIED : Result := 'verändert'; FILE_ACTION_RENAMED_OLD_NAME : Result := 'umbenannt. Alter Name.'; FILE_ACTION_RENAMED_NEW_NAME : Result := 'umbenannt. Neuer Name.'; else Result := 'Ungültiger Reason Code: '+IntToHex(AdwReasonCode,8); end; end; end.
Delphi-Quellcode:
Also dann das Ganze als Komponente registrieren un in des Formulat legen.
unit cThread;
interface uses SysUtils, Classes, Controls, SyncObjs, Windows, ShellApi, ComCtrls; const FILE_LIST_DIRECTORY = $0001; WaitDir = WAIT_OBJECT_0; WaitTerm = WAIT_OBJECT_0+1; WaitSusp = WAIT_OBJECT_0+2; type CtrlThread = class(TThread) private FhFile : DWORD; // Handle von CreateFile auf die kontrollierte Ordnerstruktur FsDirPath : string; // der Pfad zu der Ordnerstruktur, die zu überwachen ist FsFileName : string; // ein Dateiname aus einen Überwachungsereignis der Ordner FAction : DWORD; // Verzeichnisaktion, die erfolgte FileEvent : THandle; // Handle für das Ordnerüberwachungsereignis SuspEvent : TEvent; // Ereignis für das suspendieren des Threads SuspEvName : String; // Name dieses Ereignisses TermEvent : TEvent; // eigenes Ereignis, das für den Abbruch des Threads erforderlich ist TermEvName : String; // Name des Abbruchereignisses Owner : TComponent; // Besitzer des Threads FFilter : DWord; // Filter für procedure SendData; // eine Beispielfunktion für die Datenübergabe public constructor Create(AOwner: TComponent; const AsDirPath: string; AFilter: DWORD); destructor Destroy; override; procedure Execute; override; Procedure SetEventNames(AwEvName,AnEvName: string); end; PFILE_NOTIFY_INFORMATION = ^FILE_NOTIFY_INFORMATION; // Strukturzeiger FILE_NOTIFY_INFORMATION = packed record // Ereignisrecord für !ein! überwachungsereignis dwNextEntryOffset : DWORD; // Offset zum nächsten Eintrag dwAction : DWORD; // Ereignisgrund dwFileNameLength : DWORD; // Länge des Dateinamens dwFileName : WideString; // Dateiname end; implementation uses FldrControl; constructor CtrlThread.Create(AOwner: TComponent; const AsDirPath: string; AFilter: DWORD); begin inherited Create(TRUE); // Thread erstellen und nicht laufen lassen FsDirPath := AsDirPath; // der zu überwachende Pfad Owner := AOwner; // der Besitzer des Threads FFIlter := AFilter; // Filter für .. übernehmen FreeOnTerminate := true; // Thread nach Beendigung vernichten lassen end; // Namen für die Ereignisse: // werden von der Komponente aus gesetzt, was aber erst geschehen kann, // wenn der Thread creiert ist Procedure CtrlThread.SetEventNames(AwEvName,AnEvName: String); begin SuspEvName:=AwEvName; TermEvName:=AnEvName; end; procedure CtrlThread.Execute; var pBuffer : Pointer; // Puffer für die Rückgabedaten von ReadDirectoryChangesW dwBufLen : DWORD; // Größe des Puffers dwRead : DWORD; // Anzahl der Daten im Puffer PInfo : PFILE_NOTIFY_INFORMATION; // Maske für die Pufferdaten dwNextOfs : DWORD; // Position des Folgesatzes im Puffer (bei 0 - keiner) dwFnLen : DWORD; // Dateinamenlänge Overlap : TOverlapped; // Asynchronstruktur WaitResult: DWORD; // Rückgabewert von WaitForMultipleObjects EventArray : Array[0..2] of THandle; // Array der Handles für WaitForMultipleObjects begin // Handle auf das zu überwachende Verzeichnis FhFile:= CreateFile(PChar(FsDirPath), FILE_LIST_DIRECTORY or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE, nil, OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED, 0); if (FhFile = INVALID_HANDLE_VALUE) or (FhFile = 0) then exit; // Ereignis für Asynchronbehandlung von ReadDirectoryChangesW FileEvent:=CreateEvent(nil,FALSE,FALSE,nil); // Asynchronstruktur mit Ereignis besetzen Overlap.hEvent:=FileEvent; // Neues Ereignis erstellen, um später WaitForMultipleObjects abzubrechen // der Abbruch erfolgt von außen durch die Erzeugung des gleichen Events // welcher dann auf signaled gesetzt werden muß TermEvent:=TEvent.Create(nil,FALSE,FALSE,TermEvName); // Neues Ereignis erstellen, um später WaitForMultipleObjects abzubrechen // und den Thread auf suspendet zu setzen // der Abbruch erfolgt von außen durch die Erzeugung des gleichen Events // welcher dann auf signaled gesetzt werden muß SuspEvent:=TEvent.Create(nil,FALSE,FALSE,SuspEvName); // die drei Ereignishandles für WaitForMultipleObjects in ein Array füllen EventArray[0]:=FileEvent; // Ordneränderung EventArray[1]:=TermEvent.Handle; // Abbruch EventArray[2]:=SuspEvent.Handle; // Suspend // Rückgabepuffer für ReadDirectoryChangesW erstellen dwBufLen := 65535; pBuffer := AllocMem(dwBufLen); try // Ablauf starten ... while not terminated do begin // Ordnerüberwachung asynchron erstellen dwRead:=0; if ReadDirectoryChangesW(FhFile,pBuffer,dwBufLen,true, FFilter, //FILE_NOTIFY_CHANGE_FILE_NAME or FILE_NOTIFY_CHANGE_DIR_NAME, @dwRead,@Overlap,NIL) then begin // unendliches warten bis eines der Ereignisse eintritt WaitResult:=WaitForMultipleObjects(3,@EventArray,FALSE,infinite); // wenn das Warten beendet wird, dann ... case WaitResult of // ... weil sich etwas in den Ordnern getan hat WaitDir: begin // Maske über den Puffer legen, um auf die Daten zuzugreifen PInfo:= pBuffer; // und dies wiederholen ... repeat // Offset zum folgenden Datensatz dwNextOfs :=PInfo.dwNextEntryOffset; // Aktion, die im Ordnerbaum sattfand fAction :=PInfo.dwAction; // Länge des betroffenen Ordners oder der Datei dwFnLen :=PInfo.dwFileNameLength; // Dateinamen in AnsiString umsetzen fsFileName:=WideCharLenToString(@PInfo.dwFileName,dwFnLen div 2); // Daten in den Haupttread übergeben Synchronize(SendData); // Maske auf den nächsten Datensatz verschieben pChar(PInfo):=pChar(PInfo)+dwNextOfs; // wenn keiner mehr vorhanden ist, beenden until dwNextOfs=0; end; // ... oder das Abbruchereignis eingetreten ist WaitTerm: Terminate; // ... oder das Ereignis zum suspendieren eingetreten ist WaitSusp: Suspend; else break; end; end; end; finally FreeMem(pBuffer,dwBufLen); end; end; destructor CtrlThread.Destroy; begin // diverse Handles freigeben try if FhFile <> INVALID_HANDLE_VALUE then CloseHandle(FhFile); CloseHandle(FileEvent); TermEvent.Free; SuspEvent.Free; except end; end; // Daten an das Control-Objekt übergeben procedure CtrlThread.SendData; begin TFldrControl(Owner).EvAction:=FAction; TFldrControl(Owner).EvOrdner:=fsFileName; // und dort die Benachrichtigungsfunktion aufrufen TFldrControl(Owner).GetData; end; end. Die Ereignisbehandlungsroutine aufbauen, Pfad setzen und mit StartTread aktivieren. Gruß, Manfred
Manfred Götze
|
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |