Synchronize und die Messagequeue

[himitsu]

Statt {$APPTYPE CONSOLE} einfach AllocConsole aufrufen, um ein Konsolenfenster zu erstellen.

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.