unaclasses.pas

Voice Commnucation Components for Delphi

(*
	----------------------------------------------

	  unaClasses.pas
	  basic classes

	----------------------------------------------
	  This source code cannot be used without
	  proper license granted to you as a private
	  person or an entity by the Lake of Soft, Ltd

	  Visit http://lakeofsoft.com/ for more information.

	  Copyright (c) 2001, 2007 Lake of Soft, Ltd
		     All rights reserved
	----------------------------------------------

	  created by:
		Lake, 25 Aug 2001

	  modified by:
		Lake, Aug-Dec 2001
		Lake, Jan-Dec 2002
		Lake, Jan-Dec 2003
		Lake, Jan-Dec 2004
		Lake, Jan-Dec 2005
		Lake, Jan-Dec 2006
		Lake, Jan-Apr 2007

	----------------------------------------------
*)

{$I unaDef.inc }

{xxx $DEFINE UNA_GATE_DEBUG }
{xxx $DEFINE UNA_GATE_DEBUG_TIMEOUT }

{$DEFINE UNA_USE_CS }	// use CriticalSections instead of own gates

{$IFDEF UNA_USE_CS }
  {xx $DEFINE UNA_USE_CS_LOG }	// use CriticalSections logging
{$ENDIF }


unit
  unaClasses;

{DP:UNIT
  Contains base classes, such as lists, threads and events, which are often used by other classes and routines.
}

interface

uses
  Windows,
  unaTypes, unaUtils
{$IFDEF UNA_PROFILE}
  , unaProfile
{$ENDIF}
{$IFDEF __SYSUTILS_H_ }
  , Math, SysUtils
{$ENDIF}
  ;

type
  //
  // -- basic class --
  //
  unaObject = class
  private
    f_inheritedCreateWasCalled: bool;
    //
    function getThis(): unaObject;
    function getClassID(): string;
  public
    constructor create();
    //
    property _this: unaObject read getThis;
    property _classID: string read getClassID;
    //
    procedure AfterConstruction(); override;
  end;

  //
  // -- unaEvent --
  //

  {DP:CLASS
    This is a wrapper class for Windows Events.
  }
  unaEvent = class(unaObject)
  private
    f_handle: tHandle;
    f_name: wideString;
  public
    {DP:METHOD
      Constructs an event. Specify initialState and manualReset parameters.
      If manualReset is true you have to reset the event manually every time it was set to signaled state.
      By default this parameter is false, what means event will be reset automatically.
      initialState parameter specifies the initial state of event.
      Default value is false (non-signaled). Specify optional name parameter to set the name of event.
      You can use this name later to reopen the event.
      Refer to MSDN documentation for more details about Windows events.
    }
    constructor create(manualReset: bool = false; initialState: bool = false; const name: wideString = '');
    destructor Destroy(); override;
    //
    {DP:METHOD
      Sets state of the event to signaled or non-signaled.
    }
    procedure setState(signaled: bool = true);
    {DP:METHOD
      Used to wait until the state of event will be set to signaled.
      Returns true if the event was set to signaled state and false if timeout was expired (event remains in non-signaled state).
      timeout parameter specifies the timeout in milliseconds.
      This method blocks execution of caller thread, so use it carefully when specifying INFINITE value for timeout.
    }
    function waitFor(timeout: unsigned = 1): bool;
    //
    {DP:METHOD
      Windows handle of event.
    }
    property handle: tHandle read f_handle;
    property name: wideString read f_name;
  end;


  //
  // -- unaAbstractGate --
  //

  unaAbstractGate = class(unaObject)
  private
  {$IFDEF DEBUG}
    f_title: string;
    f_masterName: string;
  {$ENDIF}
  {$IFDEF UNA_GATE_PROFILE}
    f_profileIndex: unsigned;
  {$ENDIF}
  protected
    f_isBusy: bool;
    //
    function gateEnter(timeout: unsigned = INFINITE{$IFDEF DEBUG}; const masterName: string = ''{$ENDIF}): bool; virtual;
    procedure gateLeave(); virtual;
  public
    constructor create({$IFDEF DEBUG}const title: string = ''{$ENDIF});
    {DP:METHOD
      Enters the gate. timeout parameter specifies the amount of time (in milliseconds) attempt to enter the gate should last.
      Returns false if gate cannot be entered and timeout was expired.
      Returns true if gate was entered successfully.
      Default timeout value is INFINITE. That means routine should wait forever, until gate will be freed.
      Use this default value carefully, as it could lead to deadlocks in your application.
    }
    function enter(timeout: unsigned = INFINITE{$IFDEF DEBUG}; const masterName: string = ''{$ENDIF}): bool;
    {DP:METHOD
      Every successful enter() must be followed by leave().
      Do not call leave() unless enter() returns true.
    }
    procedure leave();
  {$IFDEF DEBUG}
    property masterName: string read f_masterName;
  {$ENDIF}
    {DP:METHOD
      Indicates if gate is busy by one ore more threads.
      Do not use this property if you want to make sure gate is free. Use enter() instead.
      The only good use for this property is in some kind of visual indication to end-user whether the gate is free.
    }
    property isBusy: bool read f_isBusy;
  end;


  //
  // -- unaOutProcessGate --
  //

  {DP:CLASS
    This class is useful when you wish to ensure some block of code to be executed only by one thread at a time.
    Only one instance can enter the gate. You should use <STRONG>try</STRONG> <STRONG>finally</STRONG> block to ensure you always leave the gate.
  }
  unaOutProcessGate = class(unaAbstractGate)
  private
    f_inside: bool;
    f_masterThread: tHandle;
  {$IFDEF DEBUG}
    f_title: string;
  {$ENDIF}
    f_event: unaEvent;
  protected
    function gateEnter(timeout: unsigned = INFINITE{$IFDEF DEBUG}; const masterName: string = ''{$ENDIF}): bool; override;
    procedure gateLeave(); override;
  public
    constructor create({$IFDEF DEBUG}const title: string = ''{$ENDIF});
    destructor Destroy(); override;
    //
    function checkDeadlock(timeout: unsigned = INFINITE; const name: string = ''): bool;
    //
  {$IFDEF DEBUG}
    property title: string read f_title;
  {$ENDIF}
  end;


  //
  // -- unaInProcessGate --
  //

  {DP:CLASS
    Only one thead at a time can enter this gate. This thread can enter the gate as many times as required.
    Gate will be released when thread will leave it exactly same number of times as was entered.
  }
  unaInProcessGate = class(unaAbstractGate)
  private
{$IFDEF UNA_USE_CS }
    f_CS: _RTL_CRITICAL_SECTION;
{$ELSE }
    f_waitEvent: handle;	// event used to wait for gate to became free
    f_tryLockCount: unsigned;	// gate try lock count
				// zero when gate is free
    f_recursionLockCount: int;
    f_owningThreadId: unsigned;
{$ENDIF }
    //
{$IFDEF UNA_GATE_DEBUG}
    f_leaveCount: unsigned;
{$ENDIF}
    //
{$IFDEF UNA_USE_CS }
{$ELSE }
    function getWaitEvent(): handle;
{$ENDIF }
    //
    function getOwningThread: unsigned;
    function getRecursionLockCount: int;
    function getTryLockCount: int;
    //
  protected
    function gateEnter(timeout: unsigned = INFINITE{$IFDEF DEBUG}; const masterName: string = ''{$ENDIF}): bool; override;
    procedure gateLeave(); override;
    //
  public
    procedure AfterConstruction(); override;
    procedure BeforeDestruction(); override;
    {DP:METHOD
      Owning thread ID.
    }
    property owningThreadId: unsigned read getOwningThread;
    {DP:METHOD
      Number of locks made by owning thread.
    }
    property recursionLockCount: int read getRecursionLockCount;
    {DP:METHOD
      Gate try lock count. Number of tries made to lock the gate at the same time from different threads.
      <BR />zero when gate is free.
      Avoid the usage "if (0 = lockCount) then ..." for checking the gate availability.
      Use "if (gateEnter(0)) then try ... finally gateLeave(); end;" code instead.
    }
    property tryLockCount: int read getTryLockCount;
  end;


  // --  --
  unaListCopyOpEnum = (unaco_add, unaco_replaceExisting, unaco_insert, unaco_assign);

  //
  // -- unaList --
  //

  {DP:METHOD
    Fires when list item is needed to be released. NOTE: item[index] could be nil.
  }
  unaListOnItemReleaseEvent = procedure(index: unsigned; var doFree: unsigned) of object;
  {DP:METHOD
    Fires when list item is about to be removed from the list.
  }
  unaListOnItemBeforeRemoveEvent = procedure(index: unsigned) of object;

  {DP:CLASS
    This is general purpose list of items.
    It is multi-threaded safe, so you can use it by several threads without any special care.
  }
  unaList = class(unaObject)
  private
    f_count: unsigned;
    f_capacity: unsigned;
    f_timeout: unsigned;
    f_isObjects: bool;
    f_autoFree: bool;
    f_oneThreadUser: bool;
    f_onItemRelease: unaListOnItemReleaseEvent;
    f_onItemBeforeRemove: unaListOnItemBeforeRemoveEvent;
    //
    f_forceZeroFree: bool;	// used in doSetCapacity
				// usually set to true only in destructor
  {$IFDEF DEBUG }
    f_debugTitle: string;
  {$ENDIF }
    //
    f_list: pPtrArray;
    f_gate: unaInProcessGate;
    f_aboutToDestroy: bool;
    f_dataEvent: unaEvent;
    //
    procedure doSetItem(index: unsigned; value: pointer);
  protected
    function mapDoFree(doFree: unsigned): bool;
    //
    procedure doSetCapacity(value: unsigned); virtual;
    {DP:METHOD
      Disposes the item.
    }
    procedure releaseItem(index: unsigned; doFree: unsigned); virtual;
    procedure notifyBeforeRemove(index: unsigned); virtual;
    //
    function add2(item: pointer): unsigned; overload; virtual;
    function insert2(index: unsigned; item: pointer): int; virtual;
    procedure setItem2(index: unsigned; item: pointer; doFree: unsigned = 2); overload; virtual;
    //
    procedure doReverse(); virtual;
    function doCopyFrom(list: pInt32Array; listSize: int = -1; copyOperation: unaListCopyOpEnum = unaco_add; startIndex: unsigned = 0): int; virtual;
  public
    constructor create(isObjects: bool = false{$IFDEF DEBUG}; const debugTitle: string = ''{$ENDIF});
    procedure BeforeDestruction(); override;
    //
    {DP:METHOD
      Locks the list. Returns false if lock cannot be set in a timeout period.
      If INFINITE is passed timeOut property will be used instead.
    }
    function lock(timeout: unsigned = INFINITE): bool;
    procedure unlock();
    {DP:METHOD
      Clears the list. All items will be removed and count will be reset to 0.
    }
    procedure clear(doFree: unsigned = 2);
    {DP:METHOD
      Adds item to the end of the list.
      Returns list index of inserted item (usually count - 1).
    }
    function add(item: pointer): unsigned; overload;
    function add(item: int): unsigned; overload;
    {DP:METHOD
      Inserts an item at specified position (index parameter) in the list.
      Does nothing if index is bigger than count.
      Returns index.
    }
    function insert(index: unsigned; item: pointer): unsigned;
    {DP:METHOD
      Removes an item from the list.
      index specifies the index of item to be removed.
      doFree specifies an action which should be taken if item is object (see unaObjectList):
      <UL>
	<LI>0 -- do not free the object</LI>
	<LI>1 -- free object always</LI>
	<LI>2 -- use the autoFree member of unaObjectList to decide whether to free the object.</LI>
      <UL>
    }
    {DP:METHOD
      Reverses items in the list.
    }
    procedure reverse();
    {DP:METHOD
      Removes item with specified index from the list.
      Returns true if item was removed, or false otherwise.
    }
    function removeByIndex(index: unsigned; doFree: unsigned = 2): bool; overload;
    {DP:METHOD
      Removes specifed item from the list.
      Returns true if item was removed, or false otherwise.
    }
    function removeItem(item: int; doFree: unsigned = 0): bool; overload;
    {DP:METHOD
      Removes specified item from the list.
      Returns true if item was removed, or false otherwise.
    }
    function removeItem(item: pointer; doFree: unsigned = 2): bool; overload;
    {DP:METHOD
      Removes first (removeFirst = true) or last (removeFirst = false) item from the list (if it presents).
      Returns true if item was removed, or false otherwise.
    }
    function removeFromEdge(removeFromBegining: bool = true): bool;
    {DP:METHOD
    }
    function asString(const delimiter: string; treatAsSigned: bool = true; base: unsigned = 10): string;
    {DP:METHOD
      Returns item from the list.
      index specifies the index of item to be returned.
    }
    function get(index: unsigned): pointer;
    {DP:METHOD
      Returns item with specified index as object.
    }
    function getObject(index: unsigned): tObject;
    {DP:METHOD
      Sets item value in the list.
      index specifies the index of item to be set.
      item is value of item. Old item will be freed.
      If old item is object, doFree parameter specifies the action should be taken.
    }
    procedure setItem(index: unsigned; item: pointer; doFree: unsigned = 2); overload;
    procedure setItem(index: unsigned; item: int); overload;
    function setItem(itemToReplace: pointer; newItem: pointer; doFree: unsigned = 2): unsigned; overload;
    {DP:METHOD
    }
    procedure setCapacity(value: unsigned);
    {DP:METHOD
      Searches the list for specified item. Returns -1 if no item was found.
    }
    function locate(value: pointer): int; overload;