Hallo,
ich möchte gern aus einem Thread heraus erzeugte Ereignisse auf einem Konsoleprogramm empfangen können. Bedauerlicher Weise klappt das nicht. Egal ob ich nun eine Endlosschleife mittels Variable, mittels
Messageloop oder - wie embarcadero es selbst nennt - mittels
ReadLn; // Vor dem Schließen Konsole auf Pause setzen
erzeuge, kommt nichts an.
Ich habe jetzt schon ein zweites Projekt angefangen, abgeleitet von TThread und habe langsam dieses Im Verdacht "Schuld" zu sein. Das Hauptprogramm sieht so aus:
Delphi-Quellcode:
Program DirThread.nonVCL;
{$APPTYPE CONSOLE}
Uses
Winapi.Windows,
System.SysUtils,
DirPolling
in '
..\DirPolling.pas';
Type
THelper =
Class
Procedure ShowChange(FileName:
String);
End;
Procedure THelper.ShowChange(FileName:
String);
Begin
WriteLn(FormatDateTime('
yyyy.mm.dd hh:nn:ss ', Now) + FileName);
End;
Var
Helper : THelper;
Msg : TMsg;
Begin
Helper:= THelper.Create;
Try
With TDirThread.Create('
D:\', Helper.ShowChange)
Do
Try
While GetMessage(Msg, 0, 0, 0)
Do
Begin
TranslateMessage(Msg);
DispatchMessage(Msg);
End;
Finally
Free;
End;
Except
On E:
Exception Do Writeln(E.ClassName, '
: ', E.
Message);
End;
Helper.Free;
End.
Unter einem
VCL-Programm kommt das Ereignis von folgendem Code sauber an:
Delphi-Quellcode:
nit DirPolling;
Interface
Uses
System.SysUtils,
System.Classes;
Type
TDirEvent = Procedure(FileName: String) Of Object;
TDirThread = Class(TThread)
Public
Constructor Create(Directory: String; OnChange: TDirEvent);
Destructor Destroy; Override;
Protected
fDir : String;
fFileName : String;
fOnChange : TDirEvent;
fOldList : TStringList;
Procedure FireEvent;
Procedure Execute; Override;
End;
Implementation
Constructor TDirThread.Create(Directory: String; OnChange: TDirEvent);
Begin
fDir:= IncludeTrailingPathDelimiter(Directory);
fFileName:= '';
fOnChange:= OnChange;
fOldList:= TStringList.Create;
Inherited Create(False);
Priority:= tpIdle;
End;
Destructor TDirThread.Destroy;
Begin
fOldList.Free;
Inherited;
End;
Procedure TDirThread.FireEvent;
Begin
If Assigned(fOnChange) Then fOnChange(fDir + fFileName);
End;
Procedure TDirThread.Execute;
Var
NewList : TStringList;
SR : TSearchRec;
I : Integer;
Begin
NewList:= TStringList.Create;
Try
While (Not Terminated) Do
Begin
If (FindFirst(fDir + '*.*', faAnyFile, SR) = 0) Then
Repeat
If (SR.Attr And faDirectory = 0) Then // Verzeichnisse ignoroieren
NewList.Append(SR.Name); // zur Liste hinzufügen
Until (FindNext(SR) <> 0) Or Terminated; // bis nichts mehr gefunden wird
FindClose(SR); // Speicher freigeben
If (NewList.Count > 0) Then // Gibt es Einträge?
Begin
NewList.Sort; // zuerst sortieren
For I:= 0 To Pred(NewList.Count) Do // ganze liste druchgehen
If (fOldList.IndexOf(NewList[I]) = -1) Then
Begin // => neuer Eintrag gefunden
fFileName:= NewList[I]; // Dateinamen merken
Synchronize(FireEvent); // Ereignis ausgeben
End;
End;
fOldList.Text:= NewList.Text; // neue = neue alte Liste
NewList.Clear; // Liste löschen
Sleep(10); // kurz schlafen legen
End;
Finally
NewList.Free;
End;
End;
End.
Denselben Effekt habe ich - wie schon gesagt - mit einer Komponente auf Basis von TThread, die ReadDirectoryChanges() nutzt - in
VCL alles schick und auf der Konsole kommen keine Ereignisse mehr an. Ich habe nun schon mehrere Codes in Suchmaschinen untersucht und kann die Ursache nicht finden. Möglicher Weise liegt es an den sprichwörtlichen Tomaten...