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.