![]() |
Re: Synchronize und die Messagequeue
So, ich habe den "Fehler" gefunden:
Meine Anwendung hat ein Konsolenfenster zur Debugausgabe. Dieses habe ich mittels
Delphi-Quellcode:
erstellt. Lasse ich das Konsolenfenster weg, so geht es.
{$APPTYPE CONSOLE}
Irgendeinen Weg die Applikation trotzdem am Laufen zu halten? Workarounds? Vorschläge? Danke an alle bisher Antwortenden, Andreas |
Re: Synchronize und die Messagequeue
TApplication und 'Consolenanwendung' schließen sich imho aus. Verwende etwas anderes zur Log-Ausgabe, z.b. ein einfaches Fenster mit einer MEMO, an die Du per Message deine Logausgaben schickst.
|
Re: Synchronize und die Messagequeue
Zitat:
Naja, wenn es nicht anders geht... |
Re: Synchronize und die Messagequeue
Statt {$APPTYPE CONSOLE} einfach
![]() z.B.:
Delphi-Quellcode:
UseConsole := AttachConsole(ATTACH_PARENT_PROCESS) or AllocConsole;
If UseConsole Then ConsoleHandle := GetStdHandle(STD_OUTPUT_HANDLE); If UseConsole Then WriteLn(ConsoleHandle, 'Debugausgabe'); kleine Erklärung zu einigen Änderungen: * TAuSyncMgr.Create - der Vorfahre wird besser zuerst initialisiert * leere Try-Except-Blöcke sind eigentlich nicht so schön * mgr kann nie NIL sein, denn diese Unit, bzw. deren finalization wird erst aufgerufen, wenn die Unit nirgendwo mehr benötigt wird ... drum kann nichts mehr danach (nach mgr.Free) etwas hiervon aufrufen (es sei denn jemand umgeht diese Hierarchie und gibt einen Pointer auf eine deiner beiden Prozeduren an eine Stelle, wo mgr doch schon freigegeben wurde, aber dann ist er für die darauffolgende Exception selber Schuld) * das N in ifNdef übersieht man schnell mal
Delphi-Quellcode:
{*******************************************************}
{ } { Audorra Digital Audio Library } { Copyright (c) Andreas St�ckel, 2009 } { Audorra is an "Andorra Suite" Project } { } {*******************************************************} {The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at [url]http://www.mozilla.org/MPL/[/url] Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. The Initial Developer of the Original Code is Andreas St�ckel. All Rights Reserved. Alternatively, the contents of this file may be used under the terms of the GNU General Public License license (the �GPL License�), in which case the provisions of GPL License are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of the GPL License and not to allow others to use your version of this file under the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL License. If you do not delete the provisions above, a recipient may use your version of this file under either the MPL or the GPL License. File: AuSyncUtils.pas Author: Andreas St�ckel } {AuSyncUtils allows threads to send messages to each other.} unit AuSyncUtils; interface {$IFDEF FPC} {$MODE DELPHI} {$ENDIF} {$I commons_conf.inc} uses SysUtils, Classes, AcSyncObjs, AcPersistent, AcSysUtils; {Adds a method to the queue. It is unknown wheter or when the method will be executed. Do not use this function for important messages, but only for notifying. If you're working in a console/non VCL-Application, you have to declare the NO_VCL compiler switch.} procedure AuQueueCall(AProc: TThreadMethod); {Removes an object from the queue - this prozedure should be called, if a method, which is able to have calls on the queue, is freed.} procedure AuQueueRemove(AObj: Pointer); implementation type PThreadMethod = ^TThreadMethod; PMethod = ^TMethod; TAuSyncMgr = class(TThread) private FCallList: TList; FCritSect: TAcCriticalSection; protected procedure Execute; override; public procedure QueueCall(AProc: TThreadMethod); procedure DeleteObject(AObj: Pointer); constructor Create; destructor Destroy; override; end; constructor TAuSyncMgr.Create; begin inherited Create(False); FCallList := TList.Create; FCritSect := TAcCriticalSection.Create; end; procedure TAuSyncMgr.DeleteObject(AObj: Pointer); var i: Integer; mem: PMethod; begin FCritSect.Enter; try i := FCallList.Count - 1; while i >= 0 do begin mem := PMethod(FCallList[i]); if mem^.data = AObj then begin FreeMem(FCallList[i]); FCallList.Delete(i); end; Dec(i); end; finally FCritSect.Leave; end; end; destructor TAuSyncMgr.Destroy; var i: integer; begin for i := FCallList.Count - 1 downto 0 do FreeMem(FCallList[i]); FCallList.Free; FCritSect.Free; inherited; end; procedure TAuSyncMgr.Execute; var CurMem: TThreadMethod; begin while not Terminated do begin FCritSect.Enter; try if FCallList.Count > 0 then begin CurMem := PThreadMethod(FCallList[0])^; FreeMem(FCallList[0]); FCallList.Delete(0); end else CurMem := nil; finally FCritSect.Leave; end; if Assigned(CurMem) then try {$IFDEF DO_NOT_USE_VCL} CurMem; {$ELSE} Synchronize(CurMem); {$ENDIF} except // end; Sleep(1); end; end; procedure TAuSyncMgr.QueueCall(AProc: TThreadMethod); var mem: PThreadMethod; begin FCritSect.Enter; try GetMem(mem, SizeOf(TThreadMethod)); mem^ := AProc; FCallList.Add(mem); finally FCritSect.Leave; end; end; var mgr: TAuSyncMgr; procedure AuQueueCall(AProc: TThreadMethod); begin mgr.QueueCall(AProc); end; procedure AuQueueRemove(AObj: Pointer); begin mgr.DeleteObject(AObj); end; initialization mgr := TAuSyncMgr.Create; finalization mgr.Terminate; mgr.WaitFor; mgr.Free; end. |
Re: Synchronize und die Messagequeue
Hallo,
Zitat:
Zitat:
Zitat:
Zitat:
Trotzdem vielen Dank fürs durchschauen des Codes, besonders das mit den Try-Except-Blöcken übernehme ich. Der Code hat jetzt auch schon mehr als ein Jahr lang "Reifung" hinter sich, also nicht wundern... |
Re: Synchronize und die Messagequeue
Zitat:
Zitat:
Ich hab es einmal gemacht und versucht alle möglichen Fehler abzufangen ... ist jetzt vielleich schon 4-5 Jahre her und am Ende waren über 80% des Codes nur noch Fehlerbehandlung und dabei war noch nichtmal alles behandelt. :shock: OK, ein FreeAndNil erzeugt wenigstens noch eine aussagekräftge Fehlermeldung, wenn/falls doch nochmal mgr genutzt würde.
Delphi-Quellcode:
finalization
mgr.Terminate; mgr.WaitFor; FreeAndNil(mgr); end. |
Re: Synchronize und die Messagequeue
Zitat:
Zitat:
Delphi-Quellcode:
Weiterhin würde ich den Thread nicht ständig im Kreis rennen lassen, verwende doch einfach eine Semaphore oder ein Event. im Execute wartest Du auf das Event (WaitForSingleObject), im AuQueueCall zuppelst Du am Event (SetEvent).
constructor TAuSyncMgr.Create;
begin inherited Create(True); // <--- Der Parameter heißt 'CreateSuspended' FCallList := TList.Create; FCritSect := TAcCriticalSection.Create; Resume; // <--- Aufwecken, geht auch später end; |
Re: Synchronize und die Messagequeue
Der Thread wird erst dort gestartet, also nach dem Constructor.
Delphi-Quellcode:
Aber notfalls/sicherheitshalber ginge auch alzaimars Variante.
procedure TThread.AfterConstruction;
begin if not FCreateSuspended and not FExternalThread then Resume; end; |
Re: Synchronize und die Messagequeue
Resume und Suspend werden unter Linux nicht unterstützt und sollten (aus gutem Grund) auch nicht verwendet werden. ;-)
Aber sonst habt ihr natürlich recht. Mir war fast klar, dass der Thread erst in "AfterConstruction" erzeugt wird, wie gesagt, ich war nur zu Faul nachzuschauen. Und der Speicher für das Objekt wird ja schon in "BeforeConstruction" reserviert - also sehe ich mit meiner Methode kein Problem. Mit Events habe ich noch nie gearbeitet, aber intern sollten die doch auch nicht viel anders arbeiten, oder? Wäre ich damit endlich mal vom Scheduler losgelöst, der mir nach dem Aufruf von "Sleep" erst nach ca. 20ms wieder die Kontrolle über mein Programm zurückgibt, dann würde ich es sofort verwenden. |
Re: Synchronize und die Messagequeue
Zitat:
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:52 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz