lists.pas

木马源程序,供大家研究

{------------------------------------------------------------------------------}
{                       List object unit
{       Copyright xxxxxxxxxxxxxxxxxxxxxxxx 2003. All right resvered.
{-------------------------------------------------------------------------------
{  Date: 2003.01.16
{  Last update: 2003.01.17
{  Author: Clark.Dong , Green.Wang , Kingron
{  Platform: Delphi 6 ,Wintel
{------------------------------------------------------------------------------}
{  Histroy & function:
{    1) TValueList: Support record,integer and other user define data type
{                   Auto memory manager
{    2) TObjectList: Support Object List,Auto memory manager
{    3) You can use DefaultSort method to sort List.
{       If the LowToHigh = True,The Method Compare Item By Low Bit to High Bit,
{       Asc : Sort Order? True = Asc order, False = Desc Order
{       LowToHigh:
{           False: use for MultiByte Data Type like Word,Integer,Int64 .....
{           True: use for SingleByte Data Type like array of char,string[N]
{------------------------------------------------------------------------------}
{  Warnning:
{    NOT use string in record when use TValueList to store record.
{        When use record,the record must be fixed size.
{    The DefaultSort Only use for x86 arch,
{        not use for Motorola and other cpu Architive
{------------------------------------------------------------------------------}
unit Lists;

interface

uses
  Classes, SysUtils, Windows;

resourcestring
  SRead = 'read';
  SWrite = 'write';
  SErrSetItemSize = 'Can''t resize ItemSize when count > 0, Current Count:%d.';
  SErrStream = 'Stream %s error. Expect Size: %d,actual size: %d.';
  SErrOutBounds = 'Out of bounds,The value %d not between 0 and %d.';
  SErrClassType = 'Class type mismatch. Expect: %s , actual: %s';

type
  EValueList = class(Exception);
  EObjectList = class(Exception);

  { Value List Class,Can use for Integer,Int64,Float,Record... }
  { Auto memory manager,Auto Free memory                       }
  TValueList = class(TList)
  private
    FItemSize: Integer;
    FTag: Integer;
    FData: Pointer;
    FName: string;

    function MakePointerFromValue(const Value): Pointer;
    procedure SetItemSize(const Value: Integer);
  protected
    procedure DoSetItems(Index: integer; const Value);
    procedure DoAssign(Dest: TValueList); virtual;
  public
    function Add(const Value): Integer; { Add Item By Value }
    function AddPointer(Item: Pointer): Integer; { Add Item By Pointer }
    procedure Insert(Index: Integer; const Value); { Insert Item By Value }
    procedure InsertPointer(Index: integer; Value: Pointer);
    procedure Delete(Index: Integer); { Delete Item By Position }
    function Remove(const Value): integer; { Delete Item By Value }
    procedure RemoveAll(const Item); { Delete All Item By Value }
    procedure Clear; override; { Clear All Item,Auto Free }
    function IndexOf(const Value): Integer;
    procedure FreeItem(Index: integer); { Free Item and Set nil }
    procedure Assign(Source: TValueList);
    function Duplicate: TValueList;
    function Equal(Item: TValueList): Boolean;
    { DefaultSort Only use for integer,word,int64.....not for record }
    { Asc: Order of Asc | Desc ? True = Asc order , False = Desc Order }
    procedure DefaultSort(const Asc: Boolean = True;
      const LowToHigh: Boolean = True);
    function BinSearch(const Value; CompareProc: TListSortCompare = nil): integer;
    function Item(Index: integer): Pointer;

    procedure ReadFromStream(Stream: TStream);
    procedure WriteToStream(Stream: TStream);
    constructor Create(Size: Integer);
    destructor Destroy; override;
    property Data: Pointer read FData write FData;
  published
    property Name: string read FName write FName;
    property ItemSize: Integer read FItemSize write SetItemSize;
    property Tag: Integer read FTag write FTag;
  end;

  TOrderValueList = class(TValueList) { Order value List ,Like integer,int64...}
  public
    procedure Sort(const AscOrder: Boolean = True);
  end;

  TIntegerList = class(TOrderValueList)
  private
    function GetItems(Index: integer): integer;
    procedure SetItems(Index: integer; const Value: integer);
  public
    constructor Create;
    procedure Add(Value: integer);
    function ValueExist(Value: integer): Boolean;
    property Items[Index: integer]: integer read GetItems write SetItems; default;
  end;

  TInt64List = class(TOrderValueList)
  private
    function GetItems(Index: integer): Int64;
    procedure SetItems(Index: integer; const Value: Int64);
  public
    constructor Create;
    property Items[Index: integer]: Int64 read GetItems write SetItems; default;
  end;

  TObjectList = class(TList) { TObjectList,Auto Memeroy Manager,Auto Free }
  private
    FClassType: TClass;
    FData: Pointer;
    FName: string;
    FTag: integer;
    function GetItems(Index: Integer): TObject;
    procedure SetItems(Index: Integer; const Value: TObject);
  protected
    procedure ClassTypeError(Message: string);
  public
    function Expand: TObjectList;
    function Add(AObject: TObject): Integer;
    function IndexOf(AObject: TObject): Integer; overload;
    procedure Delete(Index: Integer); overload;
    function Remove(AObject: TObject): Integer;
    procedure Clear; override;
    procedure Insert(Index: Integer; Item: TObject);
    procedure FreeItem(Index: integer);
    function First: TObject;
    function Last: TObject;
    property ItemClassType: TClass read FClassType;
    property Items[Index: Integer]: TObject read GetItems write SetItems; default;

    constructor Create; overload;
    constructor Create(AClassType: TClass); overload;
    destructor Destroy; override;
    property Data: Pointer read FData write FData;
  published
    property Tag: integer read FTag write FTag;
    property Name: string read FName write FName;
  end;

implementation

var
  ByteToCompare: integer;
  SortOrderAsc: Boolean;

  { TValueList }

constructor TValueList.Create(Size: Integer);
begin
  inherited Create;
  FItemSize := Size;
  FData := nil;
  FTag := 0;
end;

destructor TValueList.Destroy;
begin
  Clear;
  inherited Destroy;
end;

{ Get memory and Make Pointer from the value }

function TValueList.MakePointerFromValue(const Value): Pointer;
var
  pNewItem: Pointer;
begin
  GetMem(pNewItem, FItemSize);
  if Assigned(@Value) then
    System.Move(Value, pNewItem^, FItemSize)
  else
    FillChar(pNewItem^, FItemSize, 0);
  Result := pNewItem;
end;

function TValueList.Add(const Value): Integer;
begin
  Result := AddPointer(MakePointerFromValue(Value));
end;

function TValueList.AddPointer(Item: Pointer): Integer;
begin
  Result := inherited Add(Item);
end;

procedure TValueList.Assign(Source: TValueList);
begin
  if Assigned(Source) then
    Source.DoAssign(Self);
end;

procedure TValueList.DoAssign(Dest: TValueList);
var
  iCount: Integer;
begin
  Dest.Clear;
  Dest.FItemSize := FItemSize;
  Dest.FName := FName;
  Dest.FTag := FTag;
  Dest.FData := FData;
  for iCount := 0 to Count - 1 do
    Dest.Add(Items[iCount]^);
end;

procedure TValueList.Clear;
begin
  while Count > 0 do
    Delete(Count - 1);
  inherited Clear;
end;

procedure TValueList.RemoveAll(const Item);
begin
  repeat until Remove(Item) < 0;
end;

procedure TValueList.Delete(Index: Integer);
begin
  FreeItem(Index);
  inherited Delete(Index);
end;

function TValueList.Remove(const Value): integer;
begin
  Result := IndexOf(Value);
  if Result >= 0 then Delete(Result);
end;

function TValueList.Duplicate: TValueList;
var
  iCount: Integer;
begin
  Result := TValueList.Create(FItemSize);
  for iCount := 0 to Count - 1 do
    Result.Add(Items[iCount]^);
end;

function TValueList.Equal(Item: TValueList): Boolean;
var
  iCount: Integer;
begin
  Result := (FItemSize = Item.FItemSize) and (Count = Item.Count);
  if Result then
    for iCount := 0 to Count - 1 do
    begin
      if Items[iCount] = Item.Items[iCount] then Continue;
      if Assigned(Items[iCount]) and Assigned(Item.Items[iCount]) then
        Result := Result and CompareMem(Items[iCount], Item.Items[iCount],
          FItemSize)
      else
        Result := False;
    end;
end;

function TValueList.IndexOf(const Value): Integer;
var
  pItem: Pointer;
begin
  pItem := @Value;
  if Assigned(pItem) then
    for Result := 0 to Count - 1 do
      if CompareMem(pItem, Items[Result], ItemSize) then Exit;
  Result := -1;
end;

procedure TValueList.Insert(Index: Integer; const Value);
var
  Temp: Pointer;
begin
  Temp := MakePointerFromValue(Value);
  try
    InsertPointer(Index, Temp);
  except
    FreeMem(Temp, FItemSize);
    raise;
  end;
end;

procedure TValueList.ReadFromStream(Stream: TStream);
var
  i, C, R: Integer;
  Temp: Pointer;
begin
  Clear;
  C := 0;
  FItemSize := 0;

  with Stream do
  begin
    R := Read(C, SizeOf(C));
    if R <> SizeOf(C) then
      raise EValueList.CreateFmt(SErrStream, [SRead, SizeOf(C), R]);

    R := Read(FItemSize, Sizeof(FItemSize));
    if R <> SizeOf(C) then
      raise EValueList.CreateFmt(SErrStream, [SRead, SizeOf(FItemSize), R]);

    GetMem(Temp, FItemSize);
    try
      for i := 1 to C do
      begin
        R := Read(Temp^, FItemSize);
        if R <> SizeOf(C) then
          raise EValueList.CreateFmt(SErrStream, [SRead, FItemSize, R]);
        Add(Temp^);
      end;
    finally
      FreeMem(Temp, FItemSize);
    end;
  end;
end;

procedure TValueList.WriteToStream(Stream: TStream);
var
  C, i, R: Integer;
begin
  C := Count;
  with Stream do