sortlists.pas

由delphi实现的bt下载器示例程序

unit SortLists;

interface

//{$DEFINE DEBUGMSG}

uses
  SysUtils, Windows, Classes{$IFDEF DEBUGMSG}, DebugUnit{$ENDIF};

const
  CACHE_ALIGN             =   16;

type
  TTraverseEvent = procedure (List: TObject; Item: Pointer; WParam, LParam: Integer) of object;
  TTraverseProc = procedure (oSelf, List: TObject; Item: Pointer; WParam, LParam: Integer);

  TCompareKeyProc = function (Key, Item: Pointer): Integer of object;
  TCreateItemFunc = function (Key: Pointer) : Pointer of object;
  TReleaseDataProc = procedure (Data: Pointer) of object;

  TListRef = class(TObject)
  public
    FList: PPointerList;
    FCount: Integer;
    FCapacity: Integer;
  end;

  TSortedList = class(TList)
  protected
    function DefCompareKey(Key, Item: Pointer): Integer; dynamic;
    function DefCompareItem(Item1, Item2: Pointer): Integer; dynamic;
    procedure DefReleaseData(Data: Pointer); dynamic;

    procedure QuickSort(L, R: Integer);

  public
    CompareKey: TCompareKeyProc;
    CompareItem: TCompareKeyProc;
    ReleaseData: TReleaseDataProc;

    constructor Create;
    destructor Destroy; override;
    procedure Clear; override;
    procedure Resort; virtual;

    //procedure AddRef;
    //procedure ReleaseRef;

    function GetItem(Key: Pointer; CreateItem: TCreateItemFunc = nil): Pointer; virtual;
    function LocateItem(Key: Pointer; CompareProc: TCompareKeyProc = nil): Pointer; virtual;
    function InsertItem(Key, Item: Pointer; Unique: Boolean = false): Pointer; virtual;
    function RemoveItem(Key: Pointer): Pointer; virtual;
    function DeleteItem(Key: Pointer): Boolean; virtual;
    procedure DeleteRange(Key: Pointer; CompareProc: TCompareKeyProc); virtual;

    function FindItem(Key: Pointer; var Pos: Integer; CompareProc: TCompareKeyProc = nil): Boolean;
    function FindRange(Key: Pointer; var BPos, EPos: Integer; CompareProc: TCompareKeyProc = nil): Boolean;

    function GetInnerData: string; virtual;
    procedure SetInnerData(const Data: string); virtual;
  end;

  TLockList = class(TSortedList)
  private
    FLock: TRTLCriticalSection;
    function GetCount: Integer;
    procedure SetCount(const Value: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear; override;
    procedure Resort; override;

    procedure Lock;
    function TryLock: Boolean;
    procedure Unlock;

    //procedure ItemAddRef(Item: Pointer); dynamic;
    //procedure ItemReleaseRef(Item: Pointer); dynamic;

    function GetItem(Key: Pointer; CreateItem: TCreateItemFunc = nil): Pointer; override;
    function LocateItem(Key: Pointer; CompareProc: TCompareKeyProc = nil): Pointer; override;
    function InsertItem(Key, Item: Pointer; Unique: Boolean = false): Pointer; override;
    function RemoveItem(Key: Pointer): Pointer; override;
    procedure DeleteRange(Key: Pointer; CompareProc: TCompareKeyProc); override;
    function GetInnerData: string; override;
    procedure SetInnerData(const Data: string); override;

    procedure LockTraverse(WParam, LParam: Integer; Callback: TTraverseEvent); overload;
    procedure LockTraverse(WParam, LParam: Integer; Callback: TTraverseProc; oSelf: TObject); overload;
    procedure Traverse(WParam, LParam: Integer; Callback: TTraverseEvent); overload;
    procedure Traverse(WParam, LParam: Integer; Callback: Pointer; oSelf: TObject); overload;
    property CountL: Integer read GetCount write SetCount;
  end;

  TRuler = class(TList)
  private
    FLock: TRTLCriticalSection;
    function GetCount: Integer;
    procedure SetCount(const Value: Integer);
  public
    constructor create(Len: Cardinal);
    destructor Destroy; override;
    procedure Lock;
    procedure Unlock;
    //procedure AddRef;
    //procedure ReleaseRef;
    procedure ValidRange(BPos, Len: Cardinal);
    procedure InvalidRange(BPos, Len: Cardinal);
    function IsRangeValid(BPos, Len: Cardinal): Boolean;
    function HasValidPart(BPos, EPos: Cardinal): Boolean;
    function hasInvalidPart(BPos, EPos: Cardinal): Boolean;
    procedure Reset(Len: Cardinal);
    procedure AdjustEnd(EPos: Cardinal; NewValid: Boolean);
    function GetBlock(var BPos, Len: Cardinal; Peek: Boolean; Rand: Boolean=false; MaxLen: Cardinal = 0): Boolean;
    function GetValidRange(BPos, EPos: Cardinal; var Dest: Pointer): Integer; overload;
    function GetValidRange(BPos, EPos: Cardinal): string; overload;
    function GetInvalidRange(BPos, EPos: Cardinal; var Dest: Pointer): Integer; overload;
    function GetInvalidRange(BPos, EPos: Cardinal): string; overload;
    procedure InvertRuler(BPos, EPos: Cardinal);
    procedure CombineWithValid(ARuler: TRuler);
    procedure CombineWithInvalid(ARuler: TRuler);
    procedure CopyValidFrom(ARuler: TRuler; BPos, EPos: Cardinal);
    procedure CopyInvalidFrom(ARuler: TRuler; BPos, EPos: Cardinal);
    function GetInnerData: string;
    procedure SetInnerData(s: string); overload;
    procedure SetInnerData(const Buf; Cnt: Integer); overload;
    function GetValidBlock(RangeB, RangeE: Cardinal; IsRand: Boolean; var BPos, Len: Cardinal): Boolean;
    function GetInvalidBlock(RangeB, RangeE: Cardinal; IsRand: Boolean; var BPos, Len: Cardinal): Boolean;

    property Count: Integer read GetCount write SetCount;
  end;

function IsRangeValid(Blocks: Pointer; BlockCnt: Integer; BPos, EPos: Cardinal): Boolean;
function HasValidPart(Blocks: Pointer; BlockCnt: Integer; BPos, EPos: Cardinal): Boolean;
function HasInvalidPart(Blocks: Pointer; BlockCnt: Integer; BPos, EPos: Cardinal): Boolean;
function GetValidPart(Blocks: Pointer; BlockCnt: Integer; var BPos, EPos: Cardinal): Boolean;
function GetInvalidPart(Blocks: Pointer; BlockCnt: Integer; var BPos, EPos: Cardinal): Boolean;
function GetValidInfo(Blocks: Pointer; BlockCnt: Integer; RangeB, RangeE: Cardinal; var BPos, EPos: Integer): Boolean;
function GetInvalidInfo(Blocks: Pointer; BlockCnt: Integer; RangeB, RangeE: Cardinal; var BPos, EPos: Integer): Boolean;
function CombineValid(Blocks: Pointer; BlockCnt: Integer; RangeB, RangeE: Cardinal; MaxLen: Cardinal;
    IsRand: Boolean; var BPos, Len: Cardinal): Boolean;
function CombineInvalid(Blocks: Pointer; BlockCnt: Integer; RangeB, RangeE: Cardinal; MaxLen: Cardinal;
    IsRand: Boolean; var BPos, Len: Cardinal): Boolean;
function CombineValidFromList(Blocks: Pointer; BlockCnt: Integer; FromList: Pointer; ListCnt: Integer;
    MaxLen: Cardinal; IsRand: Boolean; var BPos, Len: Cardinal): Boolean;
function CombineInvalidFromList(Blocks: Pointer; BlockCnt: Integer; FromList: Pointer; ListCnt: Integer;
    MaxLen: Cardinal; IsRand: Boolean; var BPos, Len: Cardinal): Boolean;

{$IFDEF DEBUGMSG}
function Ruler2Str(ARuler: string): string; overload;
function Ruler2Str(ARuler: Pointer; Len: Integer): string; overload;
{$ENDIF}

var
  Default_Cache_Size : Integer = 300 * 1024 * 1024 div CACHE_ALIGN;
  Cache_Inc_Size : Integer = 8 * 1024 * 1024 div CACHE_ALIGN;

implementation

{$IFDEF DEBUGMSG}
function Ruler2Str(ARuler: string): string; overload;
begin
  result := ruler2str(pointer(aruler), length(aruler) div 4);
end;

function Ruler2Str(ARuler: Pointer; Len: Integer): string; overload;
var
  i: Integer;
  p: PCardinal;
begin
  result := '';
  p := aruler;
  for i := 1 to len do
  begin
    result := result + inttostr(p^)+' ';
    inc(p);
  end;
end;
{$ENDIF}

{ TSortedList }

constructor TSortedList.Create;
begin
  CompareKey := DefCompareKey;
  CompareItem := DefCompareItem;
  ReleaseData := DefReleaseData;
end;

destructor TSortedList.Destroy;
begin
  inherited;
end;

function TSortedList.FindItem(Key: Pointer; var Pos: Integer;
  CompareProc: TCompareKeyProc): Boolean;
var
  b, e, n: Integer;
begin
  if not assigned(CompareProc) then
    compareproc := compareKey;
  b := 0;
  e := count - 1;
  result := false;
  while b <= e do
  begin
    pos := (b + e) shr 1;
    n := compareproc(key, Items[pos]);
    if n < 0 then
      e := pos-1
    else if n > 0 then
      b := pos+1
    else begin
      result := true;
      exit;
    end;
  end;
  pos := b;
end;

function TSortedList.FindRange(Key: Pointer; var BPos,
  EPos: Integer; CompareProc: TCompareKeyProc): Boolean;
var
  b, e, n: Integer;
begin
  if not assigned(CompareProc) then
    compareproc := compareKey;
  result := false;
  b := 0;
  e := count-1;
  while b <= e do
  begin
    bpos := (b + e) shr 1;
    n := compareproc(key, Items[bpos]);
    if n < 0 then
      e := bpos-1
    else if n > 0 then
      b := bpos+1
    else begin
      result := true;
      e := bpos - 1;
    end;
  end;
  bpos := b;
  if not result then exit;
  e := count - 1;
  while b <= e do
  begin
    epos := (b + e) shr 1;
    n := compareproc(key, Items[epos]);
    if n < 0 then
      e := epos-1
    else b := epos+1;
  end;
  epos := b;
end;

function TSortedList.GetItem(Key: Pointer;
  CreateItem: TCreateItemFunc): Pointer;
var
  n: Integer;
begin
  if not finditem(key, n) then
    if assigned(createitem) then
    begin
      result := createitem(Key);
      insert(n, result);
    end
    else result := nil
  else result := Items[n];
end;

function TSortedList.InsertItem(Key, Item: Pointer; Unique: Boolean): Pointer;
var
  n: Integer;
  temp: Pointer;
begin
  result := Item;
  if Item = nil then exit;
  if not finditem(key, n) or not Unique then
    insert(n, item)
  else if Item <> Items[n] then
  begin
    temp := Items[n];
    Items[n] := Item;
    releasedata(temp);
  end;
end;

function TSortedList.RemoveItem(Key: Pointer): Pointer;
var
  n: Integer;
begin
  if finditem(key, n) then
  begin
    result := Items[n];
    delete(n);
  end
  else result := nil;
end;

function TSortedList.DefCompareKey(Key, Item: Pointer): Integer;
begin
  result := integer(key)-integer(item);
end;

procedure TSortedList.QuickSort(L, R: Integer);
var
  I, J: Integer;
  P, T: Pointer;
begin
  repeat
    I := L;
    J := R;
    P := List^[(L + R) shr 1];
    repeat
      while CompareItem(List^[I], P) < 0 do
        Inc(I);
      while CompareItem(List^[J], P) > 0 do
        Dec(J);
      if I <= J then
      begin
        T := List^[I];
        List^[I] := List^[J];
        List^[J] := T;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(L, J);
    L := I;
  until I >= R;
end;

procedure TSortedList.Resort;
begin
  if count > 0 then
    quicksort(0, count - 1);
end;

procedure TSortedList.Clear;
var
  i, l: Integer;
  pl: PPointerList;
begin
  pl := self.List;
  l := count;
  with TListRef(Self) do
  begin
    FList := nil;
    FCount := 0;
    FCapacity := 0;
  end;
  for i := l - 1 downto 0 do
    try
      releasedata(pl[i]);
    except
    end;
  reallocmem(pl, 0);
end;

function TSortedList.DefCompareItem(Item1, Item2: Pointer): Integer;
begin
  result := integer(item1)-integer(item2);
end;

function TSortedList.DeleteItem(Key: Pointer): Boolean;
var
  p: Pointer;
begin
  p := removeitem(key);
  Result := p <> nil;
  if p <> nil then
  try
    releasedata(p);
  except
  end;
end;

procedure TSortedList.DefReleaseData(Data: Pointer);
begin
// do nothing
end;

function TSortedList.LocateItem(Key: Pointer;
  CompareProc: TCompareKeyProc): Pointer;
var
  n: Integer;
begin
  result := nil;
  try
    if finditem(key, n, compareproc) then
      result := Items[n];
  except
  end;
end;

//procedure TSortedList.AddRef;
//begin
//  InterlockedIncrement(FRefCnt);
//end;

//procedure TSortedList.ReleaseRef;
//begin
//  if InterlockedDecrement(FRefCnt) < 0 then
//    Free;
//end;

function TSortedList.GetInnerData: string;
begin
  setlength(result, count * 4);
  system.Move(list^, result[1], length(result));
end;

procedure TSortedList.SetInnerData(const Data: string);
var
  x: PPointerList;
  i, l: Integer;
begin
  with TListRef(Self) do
  begin
    x := FList;
    FList := nil;
    l := FCount;
    FCount := Length(data) div 4;
    FCapacity := FCount;
    if length(data)>0 then
    begin
      GetMem(FList, Length(Data));
      system.Move(Data[1], FList^, length(data));
    end;
  end;
  for i := l - 1 downto 0 do
    releasedata(x[i]);
end;

procedure TSortedList.DeleteRange(Key: Pointer;
  CompareProc: TCompareKeyProc);
var
  i, b, e: Integer;
  d: Pointer;
begin
  if findrange(key, b, e, compareproc) then
    for i := e - 1 downto b do
    begin
      d := Items[i];
      delete(i);
      releasedata(d);
    end;
end;

{ TLockList }

constructor TLockList.Create;
begin
  initializecriticalsection(flock);
  inherited Create;
end;

destructor TLockList.Destroy;
begin
  lock;
  try
  inherited;
  except
  end;
  unlock;
  deletecriticalsection(flock);
end;

procedure TLockList.Clear;
var
  i, l: Integer;
  pl: PPointerList;
begin
  l := 0;
  lock;
  try
    pl := self.List;
    l := count;
    with TListRef(Self) do
    begin
      FList := nil;
      FCount := 0;
      FCapacity := 0;
    end;
  except
  end;
  unlock;
  for i := l - 1 downto 0 do
    try
      //releaseref(p1[i]);
      releasedata(pl[i]);
    except
    end;
  reallocmem(pl, 0);
end;

function TLockList.GetItem(Key: Pointer;
  CreateItem: TCreateItemFunc): Pointer;
begin
  result := nil;
  lock;
  try
    result := inherited GetItem(key, createitem);
  //if result <> nil then
  //  Itemaddref(result);
  except
  {$IFDEF DEBUGMSG}
  on e: exception do
    LogDbgMsg('TLockList.GetItem error: '+e.Message);
  {$ENDIF}
  end;
  unlock;
end;

function TLockList.InsertItem(Key, Item: Pointer; Unique: Boolean): Pointer;
var
  n: Integer;
  tmp: Pointer;
begin
  result := Item;
  if Item = nil then exit;
  try
    Lock;
    try
      if not finditem(key, n) or not Unique then
      begin
        Insert(n, Item);
        Item := nil;
      end
      else begin
        tmp := Items[n];
        Items[n] := Item;
        Item := tmp;
        if Item = Items[n] then
          Item := nil;
      end;
    finally
      Unlock;
    end;
    if Item <> nil then
      releasedata(item);
  except
  end;
end;

function TLockList.LocateItem(Key: Pointer;
  CompareProc: TCompareKeyProc): Pointer;
begin
  result := nil;
  lock;
  try
    result := inherited locateitem(key, compareproc);
  //if result <> nil then
  //  Itemaddref(result);
  except
  {$IFDEF DEBUGMSG}
  on e: exception do
    LogDbgMsg('TLockList.LocateItem error: '+e.Message);
  {$ENDIF}
  end;
  unlock;
end;

procedure TLockList.Lock;
begin
  entercriticalsection(flock);
end;

procedure TLockList.LockTraverse(WParam, LParam: Integer;
  Callback: TTraverseEvent);
var
  i: Integer;
begin
  Lock;
  try
    for i := count - 1 downto 0 do
    try
      callback(self, Items[i], wparam, i);
    except
    end;
  except
  end;
  Unlock;
end;

procedure TLockList.LockTraverse(WParam, LParam: Integer;
  Callback: TTraverseProc; oSelf: TObject);
var
  i: Integer;
begin
  Lock;
  try
    for i := count-1 downto 0 do
    try
      callback(oself, self, Items[i], wparam, i);
    except
    end;
  except
  end;
  Unlock;
end;

function TLockList.RemoveItem(Key: Pointer): Pointer;
begin
  result := nil;
  lock;
  try
    result := inherited removeitem(key);
  except
  {$IFDEF DEBUGMSG}
  on e: exception do
    LogDbgMsg('TLockList.RemoveItem error: '+e.Message);
  {$ENDIF}
  end;
  unlock;
end;

procedure TLockList.Traverse(WParam, LParam: Integer;
  Callback: TTraverseEvent);
begin
  with TMethod(callback) do
    traverse(wparam, lparam, code, TObject(Data));
end;

procedure TLockList.Traverse(WParam, LParam: Integer; Callback: Pointer;
  oSelf: TObject);
var
  i, l: Integer;
  buf: PPointerList;
begin
  buf := nil;
  l := 0;
  Lock;
  try
    l := count;
    getmem(buf, l*4);
    system.Move(List^, buf^, l * 4);
    //for i := 0 to l - 1 do
    //begin
    //  buf[i] := Items[i];
    //  Itemaddref(buf[i]);
    //end;
  except
  end;
  Unlock;
  for i := 0 to l - 1 do
  begin
    try
      TTraverseProc(callback)(oself, self, buf[i], wparam, lparam);
    except
    end;
    //Itemreleaseref(buf[i]);
  end;
  reallocmem(buf, 0);
end;

function TLockList.TryLock: Boolean;
begin
  result := tryentercriticalsection(flock);
end;

procedure TLockList.Unlock;
begin
  leavecriticalsection(flock);
end;

procedure TLockList.Resort;
begin
  lock;
  try
    inherited;
  except