etutils.pas

a voice guide client ,it is the second part of voice guide center

(******************************************************************************)
(*                                                                            *)
(*  一些有用的小工具类                                                        *)
(*                                                                            *)
(*                                                                            *)
(******************************************************************************)

{ $Chagelog
  $ 2006-03-09 create by mous 
}

unit etUtils;

interface

uses

  classes
  , SyncObjs
  , Windows
  , SysUtils
  , ExtCtrls
  , Forms
  ;

type


  //////////////////////////////////////////////////////////////////////////////
  TEtListHelper = class
  public                                                
    class procedure ClearObjectList( _list: TList ); overload;
    class procedure ClearObjectList( _list: TStringList ); overload;
    class procedure ClearObjectList( _list: TThreadList ); overload;

    class procedure ClearPointerList( _list: TList ); overload;
    class procedure ClearPointerList( _list: TStringList ); overload;
    class procedure ClearPointerList( _list: TThreadList ); overload;
  end;


  //////////////////////////////////////////////////////////////////////////////
  TEtFileHelper = class
  public
    class procedure GetFileNamesUnderDir( const _dir,_ext: string; _names: TStrings );
  end;


  //////////////////////////////////////////////////////////////////////////////
  TEtIntfObject   = class(TObject, IInterface )
  protected
    FRefCount   : Integer;
    function    QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function    _AddRef: Integer; stdcall;
    function    _Release: Integer; stdcall;
  public
    procedure   AfterConstruction; override;
    procedure   BeforeDestruction; override;

    property    RefCount: Integer read FRefCount;
  end;

  //////////////////////////////////////////////////////////////////////////////


procedure WaitGraceful( _mil_seconds: Cardinal );

implementation

uses
  DateUtils
  ;

procedure WaitGraceful( _mil_seconds: Cardinal );
var
  t_start,
  t_now   : Cardinal;
begin
  t_start := GetTickCount;
  t_now   := 0;

  while ( t_now - t_start < _mil_seconds ) do
  begin
    Application.ProcessMessages;
    t_now := GetTickCount;
  end;
    
end;
                
{-- 以下是 TEtListHelper 的定义 }
(*----------------------------------------------------------------------------*)
class procedure TEtListHelper.ClearObjectList(_list: TList);
var
  obj : TObject;
begin
  while _list.Count > 0 do
  begin
    obj := _list[0];
    _list.Delete(0);
    obj.Free;
  end;
end;

class procedure TEtListHelper.ClearObjectList( _list: TStringList);
var
  obj : TObject;
begin
  while _list.Count > 0 do
  begin
    obj := _list.Objects[0];
    _list.Delete(0);
    obj.Free;
  end;

end;

class procedure TEtListHelper.ClearPointerList(_list: TList);
var
  p   : Pointer;
begin
  while _list.Count > 0 do
  begin
    p := _list[0];
    _list.Delete(0);
    Dispose( p );
  end;
end;

class procedure TEtListHelper.ClearPointerList( _list: TStringList);
var
  p   : Pointer;
begin
  while _list.Count > 0 do
  begin
    p := _list.Objects[0];
    _list.Delete(0);
    Dispose( p );
  end;
end;

class procedure TEtListHelper.ClearObjectList(  _list: TThreadList);
var
  obj : TObject;
begin
  With _list.LockList do
  try
    while Count > 0 do
    begin
      obj := Items[0];
      obj.Free;
      Delete( 0 );
    end;
  finally
    _list.UnlockList;
  end;
end;

class procedure TEtListHelper.ClearPointerList(
  _list: TThreadList);
var
  p   : Pointer;
begin
  with _list.LockList do
  try
    while Count > 0 do
    begin
      p := Items[0];
      Delete( 0 );
      Dispose( p );
    end;
  finally
    _list.UnlockList;
  end;
end;
(*============================================================================*)



{-- 以下是 TReadOnlyMemoryStream 的定义 }
(*----------------------------------------------------------------------------*)


{ TEtDiskSerinalNumber }
(*============================================================================*)


{-- 以下是 TEtFileHelper 的定义 }
(*----------------------------------------------------------------------------*)
class procedure TEtFileHelper.GetFileNamesUnderDir( const _dir, _ext: string; _names: TStrings);
var
  Found     : Integer;
  srName    : String;
  FileName  : string;
  Path      : string;
  Sr        : TSearchRec;
begin
  Path := IncludeTrailingPathDelimiter( _dir );

  try
    srName  := Path + '*.' + _ext;
    Found   := FindFirst( srName , 0, Sr);
    while Found = 0 do
    begin
      FileName  := Sr.Name;
      _Names.Add( Path + FileName );
      Found     := FindNext(Sr);
    end;
  finally
    FindClose(Sr);
  end;

end;

{ TEtFileHelper }
(*=============================================================================*)

{ TTimerTasks }
{-- 以下是 TTimerTasks 的定义 }
(*----------------------------------------------------------------------------*)


{ TEtFileHelper }
(*=============================================================================*)

{ TIntfObject }
{-- 以下是 TIntfObject 的定义 }
(*----------------------------------------------------------------------------*)

function TEtIntfObject._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TEtIntfObject._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  //if Result = 0 then   Destroy;
end;

procedure TEtIntfObject.AfterConstruction;
begin
  InterlockedDecrement(FRefCount);
end;

procedure TEtIntfObject.BeforeDestruction;
begin
  if RefCount <> 0 then ;//Error('reInvalidPtr');
end;

function TEtIntfObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;
{ TEtFileHelper }
(*=============================================================================*)


end.