Mit Debugger starten, oder beim Hängen den Debugger anhängen
Würde ich gerne - aber:
Richtig debuggen kann ich schon lange (mehrere Jahre) nicht mehr - die Delphi
IDE bleibt bei mir hängen, wenn ich versuche eine Applikation im Debugger zu starten - auch, wenn ich es über Remote-Debugging auf dem gleichen Rechner versuche (das funktioniert manchmal noch, aber meistens bleibt es auch hängen, wenn ich mich auf den laufenden Prozess setze).
Das hier...
Das sollte klar sein, aber zur Sicherheit frage ich einfach mal. Du greifst im Thread nicht auf irgendwelche
VCL-Komponenten zu, oder?
Nicht, dass ich wüßte
But you are !
Zitat:
7736FF74 +0044 ntdll.dll RtlEnterCriticalSection
4002FE37 +0007 rtl70.bpl Classes ThreadList.LockList
01984929 +015D vcl70.bpl Controls TWinControl.PaintControls
See, there is no difference if you are accessing the thread itself from
VCL or blocking to
access something shared with a thread.
...und eine private Message von jaenicke hat mich auf die Spur der Ursache gebracht
Da es viele Aktionen abzuarbeiten gibt und das etwas länger dauert, verwende ich eine Mini-Form soz. als "Bitte Warten..."-Anzeige.
In dieser wird ein Anzeigetext gesetzt (ändert sich mit der aktuellen Aktion) und mit zu und abnehmenden "..." wird signalisiert, dass die Arbeit noch am Laufen ist.
Für dieses Zu- und Abnehmen habe ich eine eigene Klasse TTimerThread verwendet, die einen Thread basierten Timer zur Verfügung stellt bzw. stellen soll.
Eigentlich soll diese Klasse auch die Synchronisierung mit der
VCL übernehmen - aber da scheint was nicht richtig zu sein.
Was da genau schief läuft, habe ich noch nicht herausgefunden - vielleicht findet jemand von Euch den Fehler im Code?
Das hier ist die Deklaration:
Delphi-Quellcode:
type
TTimerThread = class( TThread )
public
constructor Create( bSuspend_ : Boolean = false ); virtual;
destructor Destroy(); override;
procedure Start();
procedure Terminate();
procedure SetTimerFunc( evTimerFunc_ : TNotifyEvent );
protected
procedure Execute(); override;
private
_evFlagCancel : TSimpleEvent;
_evFlagEnabled : TSimpleEvent;
_evTimerFunc : TNotifyEvent;
_ui32IntervalInMs : UInt32;
_bCallFuncOnMainThread : Boolean;
procedure SetEnabled( bDoEnable_ : Boolean );
function GetEnabled() : Boolean;
procedure SetInterval( ui32IntervalInMs_ : UInt32 );
procedure SwapToMainThread();
// Properties
public
property Enabled : Boolean
read GetEnabled
write SetEnabled;
property Interval : UInt32
read _ui32IntervalInMs
write SetInterval;
// soll die OnTimer-Methode auf dem Main-Thread ausgeführt werden?
property CallOnTimerOnMainThread : Boolean
read _bCallFuncOnMainThread
write _bCallFuncOnMainThread;
// Anmerkung: OnTimer wird im Thread ausgeführt...
property OnTimer : TNotifyEvent
read _evTimerFunc
write SetTimerFunc;
end; (* END_CLASS TTimerThread *)
und hier die Implementierung:
Delphi-Quellcode:
constructor TTimerThread.Create( bSuspend_ : Boolean = false );
begin
inherited Create( true {* CreateSuspended *} );
_bCallFuncOnMainThread := false;
_ui32IntervalInMs := 1000;
_evTimerFunc := nil;
_evFlagEnabled := TSimpleEvent.Create();
_evFlagEnabled.ResetEvent();
_evFlagCancel := TSimpleEvent.Create();
_evFlagCancel.ResetEvent();
FreeOnTerminate := false;
Priority := tpNormal;
// lass den Thread loslaufen:
if ( NOT bSuspend_ ) then begin
Start();
end;
end; (* END_CONSTRUCTOR TTimerThread.Create *)
destructor TTimerThread.Destroy();
begin
Terminate();
// synchronisieren:
if ( GetCurrentThreadID = MainThreadID ) then begin
WaitFor();
end;
FreeAndNil( _evFlagCancel );
FreeAndNil( _evFlagEnabled );
inherited Destroy();
end; (* END_DESTRUCTOR TTimerThread.Destroy *)
procedure TTimerThread.Terminate();
begin
// Aufruf statische Methode TThread.Terminate:
inherited Terminate();
_evFlagEnabled.ResetEvent(); // Timer stoppen
_evFlagCancel.SetEvent(); // Cancel-Flag setzen
end; (* END_PROC TTimerThread.Terminate *)
procedure TTimerThread.SetTimerFunc(
evTimerFunc_ : TNotifyEvent );
begin
_evTimerFunc := evTimerFunc_;
end; (* END_PROC TTimerThread.SetTimerFunc *)
procedure TTimerThread.SetEnabled(bDoEnable_ : Boolean );
begin
if ( bDoEnable_ ) then begin
_evFlagEnabled.SetEvent();
end
else begin
_evFlagEnabled.ResetEvent();
end;
end; (* END_PROC TTimerThread.SetEnabled *)
function TTimerThread.GetEnabled() : Boolean;
begin
Result := false;
if ( WaitForSingleObject(
_evFlagEnabled.Handle,
0) = WAIT_OBJECT_0 ) then begin
Result := true;
end;
end; (* END_FUNC TTimerThread.GetEnabled *)
procedure TTimerThread.SetInterval(
ui32IntervalInMs_ : UInt32 );
begin
_ui32IntervalInMs := ui32IntervalInMs_;
end; (* END_PROC TTimerThread.SetInterval *)
procedure TTimerThread.Start();
begin
// startet einen bei Create nicht gestarteten Thread...
Resume();
end; (* END_PROC TTimerThread.Start *)
procedure TTimerThread.Execute();
var
arrWaitHandles : TWOHandleArray;
i64WaitInterval : Int64;
i64LastProcTime : Int64;
i64Freq : Int64;
i64Start : Int64;
i64Stop : Int64;
dwWaitResult : DWORD;
begin
QueryPerformanceFrequency( i64Freq );
arrWaitHandles[ 0 ] := _evFlagEnabled.Handle;
arrWaitHandles[ 1 ] := _evFlagCancel.Handle;
arrWaitHandles[ 2 ] := INVALID_HANDLE_VALUE;
i64LastProcTime := 0;
while ( (NOT Terminated) and (NOT Application.Terminated) ) do begin
dwWaitResult := MsgWaitForMultipleObjects(
2, {* nCount *}
arrWaitHandles, {* var pHandles *}
false, {* fWaitAll *}
INFINITE, {* dwMilliseconds *}
QS_ALLINPUT {* dwWakeMask *} );
case dwWaitResult of
WAIT_FAILED: begin // 0xFFFFFFFF
// Fehler beim warten
// --> da hören wir auf (Thread beenden)!
Break;
end;
( WAIT_OBJECT_0 + 1 ): begin // 0x00000001
// Cancel-Event (_evFlagCancel)
// --> Thread beenden
Break;
end;
( WAIT_OBJECT_0 + 0 ): begin // 0x00000000
// Enable-Event (_evFlagEnabled)
// --> Timer-Methode aufrufen
if ( Assigned(_evTimerFunc) ) then begin
i64WaitInterval := Int64( _ui32IntervalInMs ) - i64LastProcTime;
if ( i64WaitInterval < 0 ) then begin
i64WaitInterval := 0;
end;
if ( WaitForSingleObject(
_evFlagCancel.Handle,
i64WaitInterval) <> WAIT_TIMEOUT ) then begin
// Cancel-Event _evFlagCancel
// --> Thread beenden
Break;
end;
if ( Enabled ) then begin
QueryPerformanceCounter( i64Start );
if ( Terminated or Application.Terminated ) then begin
Break;
end;
if ( Assigned(_evTimerFunc) ) then begin
if ( CallOnTimerOnMainThread ) then begin
// Methode indirekt auf dem Main-Thread aufrufen:
Synchronize( SwapToMainThread );
end
else begin
// Methode direkt aufrufen:
try
_evTimerFunc( Self );
except
end;
end;
end; // if ( Assigned(_evTimerFunc) ) then
QueryPerformanceCounter( i64Stop );
i64LastProcTime := ( 1000 * (i64Stop - i64Start) ) div i64Freq;
end; // if ( Enabled ) then
end; // if ( Assigned(_evTimerFunc) ) then
end; // ( WAIT_OBJECT_0 + 1 ): begin
else begin // ( WAIT_OBJECT_0 + 2 ) = 0x00000002
// eine der Eingabe-Events (QS_ALLINPUT)
// --> Nachrichten abarbeiten und wieder warten...
Application.ProcessMessages();
end;
end; // case dwWaitResult of
end; // while ( NOT Terminated ) do
end; (* END_PROC TTimerThread.Execute *)
procedure TTimerThread.SwapToMainThread();
begin
if ( Assigned(_evTimerFunc) ) then begin
try
_evTimerFunc( Self );
except
end;
end; // if ( Assigned(_evTimerFunc) ) then
end; (* END_PROC TTimerThread.SwapToMainThread *)