sortlists.pas

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

  end;
  unlock;
end;

//procedure TLockList.ItemAddRef(Item: Pointer);
//begin
//
//end;

//procedure TLockList.ItemReleaseRef(Item: Pointer);
//begin
//
//end;

function TLockList.GetInnerData: string;
begin
  Lock;
  try
    result := inherited GetInnerData;
  finally
    Unlock;
  end;
end;

procedure TLockList.SetInnerData(const Data: string);
var
  x: PPointerList;
  i, l: Integer;
begin
  Lock;
  try
    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;
  finally
    Unlock;
  end;
  for i := l - 1 downto 0 do
  try
    releasedata(x[i]);
  except
  end;
end;

function IsRangeValid(Blocks: Pointer; BlockCnt: Integer; BPos, EPos: Cardinal): Boolean;
var
  b, e, c: Integer;
  p: PPointerList;
begin
  if BlockCnt = 0 then
  begin
    result := true;
    exit;
  end;
  b := 0;
  e := BlockCnt - 1;
  p := Blocks;
  while b <= e do
  begin
    c := (b + e) shr 1;
    if bpos < cardinal(p[c]) then
      e := c - 1
    else if bpos > cardinal(p[c]) then
      b := c + 1
    else begin
      e := c - 1;
      break;
    end;
  end;

  if e and 1 = 0 then
    inc(e);

  result := (e>=blockcnt) or (((e < 0) or (cardinal(p[e])<=BPos)) and ((e+1>=Blockcnt) or (cardinal(p[e+1])>=EPos)));
end;

function HasValidPart(Blocks: Pointer; BlockCnt: Integer; BPos, EPos: Cardinal): Boolean;
var
  b, e, c: Integer;
  p: PPointerList;
begin
  if BlockCnt = 0 then
  begin
    result := true;
    exit;
  end;
  p := Blocks;
  b := 0;
  e := BlockCnt - 1;
  while b <= e do
  begin
    c := (b + e) shr 1;
    if BPos < Cardinal(p[c]) then
      e := c - 1
    else if BPos > Cardinal(p[c]) then
      b := c + 1
    else begin
      e := c;
      break;
    end;
  end;

  if e and 1 = 0 then
    inc(e);

  result := (e<0) or (e>=blockcnt) or (cardinal(p[e])<EPos);

end;

function HasInvalidPart(Blocks: Pointer; BlockCnt: Integer; BPos, EPos: Cardinal): Boolean;
var
  b, e, c: Integer;
  p: PPointerList;
begin
  b := 0;
  e := BlockCnt - 1;
  P := blocks;
  while b <= e do
  begin
    c := (b + e) shr 1;
    if BPos < Cardinal(p[c]) then
      e := c - 1
    else if BPos > Cardinal(p[c]) then
      b := c + 1
    else begin
      e := c;
      break;
    end;
  end;

  if e and 1 <> 0 then
    inc(e);

  result := (e < blockcnt) and (cardinal(p[e]) < EPos);

end;

function GetValidPart(Blocks: Pointer; BlockCnt: Integer; var BPos, EPos: Cardinal): Boolean;
var
  b, e, c: Integer;
  p: PPointerList;
begin
  p := Blocks;
  b := 0;
  e := BlockCnt - 1;
  while b <= e do
  begin
    c := (b + e) shr 1;
    if BPos < Cardinal(p[c]) then
      e := c - 1
    else if BPos > Cardinal(p[c]) then
      b := c + 1
    else begin
      b := c + 1;
      break;
    end;
  end;
  if b and 1 = 0 then
    dec(b);
  e := b + 1;
  if (b > 0) and (b < blockcnt) and (cardinal(p[b])>BPos) then
    BPos := Cardinal(p[b]);
  if (e < BlockCnt) and (cardinal(p[e]) < EPos) then
    EPos := Cardinal(p[e]);
  result := bpos < epos;
end;

function GetInvalidPart(Blocks: Pointer; BlockCnt: Integer; var BPos, EPos: Cardinal): Boolean;
var
  b, e, c: Integer;
  p: PPointerList;
begin
  p := Blocks;
  b := 0;
  e := BlockCnt - 1;
  while b <= e do
  begin
    c := (b + e) shr 1;
    if BPos < Cardinal(p[c]) then
      e := c - 1
    else if BPos > Cardinal(p[c]) then
      b := c + 1
    else begin
      b := c + 1;
      break;
    end;
  end;
  if b and 1 <> 0 then
    dec(b);
  e := b + 1;

  if (b >= blockcnt) or (e >= blockcnt) then
    BPos := EPos
  else begin
    if (b >= 0) and (cardinal(p[b])>BPos) then
      BPos := Cardinal(p[b]);
    if (e < BlockCnt) and (cardinal(p[e]) < EPos) then
      EPos := Cardinal(p[e]);
  end;
  result := bpos < epos;
end;

function GetValidInfo(Blocks: Pointer; BlockCnt: Integer; RangeB, RangeE: Cardinal; var BPos, EPos: Integer): Boolean;
var
  b, e, c: Integer;
  p: PIntegerArray;
begin
  if BlockCnt = 0 then
  begin
    result := true;
    BPos := -1;
    EPos := 1;
    exit;
  end;
  p := blocks;
  b := 0;
  e := blockcnt-1;
  while b <= e do
  begin
    c := (b + e) shr 1;
    if RangeB < cardinal(p[c]) then
      e := c - 1
    else
      b := c + 1;
  end;
  bpos := e;
  if bpos and 1 = 0 then
    inc(bpos);
  e := blockcnt - 1;
  while b <= e do
  begin
    c := (b + e) shr 1;
    if RangeE>Cardinal(p[c]) then
      b := c + 1
    else e := c - 1;
  end;
  epos := b;
  if epos and 1 = 0 then
    inc(epos);
  result := epos > bpos;
end;

function GetInvalidInfo(Blocks: Pointer; BlockCnt: Integer; RangeB, RangeE: Cardinal; var BPos, EPos: Integer): Boolean;
var
  b, e, c: Integer;
  p: PIntegerArray;
begin
  p := Blocks;
  b := 0;
  e := blockcnt-1;
  while b <= e do
  begin
    c := (b + e) shr 1;
    if RangeB< cardinal(p[c]) then
      e := c - 1
    else
      b := c + 1;
  end;
  bpos := e;
  if bpos and 1 <> 0 then
    inc(bpos);
  e := blockcnt - 1;
  while b <= e do
  begin
    c := (b + e) shr 1;
    if RangeE>Cardinal(p[c]) then
      b := c + 1
    else e := c - 1;
  end;
  epos := b;
  if epos and 1 <> 0 then
    inc(epos);
  result := epos > bpos;
end;

function CombineValid(Blocks: Pointer; BlockCnt: Integer; RangeB, RangeE: Cardinal; MaxLen: Cardinal;
    IsRand: Boolean; var BPos, Len: Cardinal): Boolean;
var
  b, e: Integer;
  p: PIntegerArray;
begin
//{$IFDEF DEBUGMSG}
//  LogDbgMsg('  Get valid block in range ['+inttostr(rangeb)+','+inttostr(rangee)+'] from list ('+ruler2str(blocks, blockcnt)+')');
//{$ENDIF}
  p := Blocks;
  result := getvalidinfo(blocks, blockcnt, rangeb, rangee, b, e);
  if result then
    if isrand then
    begin
      inc(b, random(e-b));
      if b and 1 = 0 then dec(b);
      if b < 0 then bpos := rangeb
      else bpos := cardinal(p[b]);
      if b + 1 < blockcnt then
        len := cardinal(p[b+1])
      else len := rangee;
      if bpos < rangeb then
        bpos := rangeb;
      if len > rangee then
        len := rangee;
      dec(len, bpos);
      if maxlen < len then
      begin
        inc(bpos, random(len-maxlen));
        len := maxlen;
      end;
    end
    else begin
      if b >= 0 then
        BPos := Cardinal(p[b])
      else bpos := rangeb;
      if b + 1 < blockcnt then
        len := cardinal(p[b+1])
      else len := rangee;
      if bpos < rangeb then
        bpos := rangeb;
      if len > rangee then
        len := rangee;
      dec(len, bpos);
      if maxlen < len then
        len := maxlen;
    end;
  //{$IFDEF DEBUGMSG}
  //  LogDbgMsg('  Get valid block result in ['+inttostr(bpos)+','+inttostr(bpos+len)+']');
  //{$ENDIF}
end;

function CombineInvalid(Blocks: Pointer; BlockCnt: Integer; RangeB, RangeE: Cardinal; MaxLen: Cardinal;
    IsRand: Boolean; var BPos, Len: Cardinal): Boolean;
var
  b, e: Integer;
  p: PIntegerArray;
begin
  p := Blocks;
  result := getinvalidinfo(blocks, blockcnt, rangeb, rangee, b, e);
  if result then
    if isrand then
    begin
      inc(b, random(e-b));
      if b and 1 <> 0 then dec(b);
      if b < 0 then bpos := rangeb
      else bpos := cardinal(p[b]);
      if b + 1 < blockcnt then
        len := cardinal(p[b+1])
      else len := rangee;
      if bpos < rangeb then
        bpos := rangeb;
      if len > rangee then
        len := rangee;
      dec(len, bpos);
      if maxlen < len then
      begin
        inc(bpos, random(len-maxlen));
        len := maxlen;
      end;
    end
    else begin
      if b >= 0 then
        BPos := Cardinal(p[b])
      else bpos := rangeb;
      if b + 1 < blockcnt then
        len := cardinal(p[b+1])
      else len := rangee;
      if bpos < rangeb then
        bpos := rangeb;
      if len > rangee then
        len := rangee;
      dec(len, bpos);
      if maxlen < len then
        len := maxlen;
    end;
end;

function CombineValidFromList(Blocks: Pointer; BlockCnt: Integer; FromList: Pointer; ListCnt: Integer;
    MaxLen: Cardinal; IsRand: Boolean; var BPos, Len: Cardinal): Boolean;
var
  n, m: Integer;
  p: PIntegerArray;
begin
//{$IFDEF DEBUGMSG}
//  LogDbgMsg('Combining valid range in (' + ruler2str(blocks, blockcnt)+') from ('+ruler2str(FromList, ListCnt)+')');
//{$ENDIF}
  p := FromList;
  if isrand then
    n := random(ListCnt)
  else n := 0;
  if n and 1 <> 0 then dec(n);
  m := n;
  repeat
    result := combinevalid(blocks, blockcnt, p[n], p[n+1], maxlen, isrand, bpos, len);
    inc(n, 2);
    if n >= ListCnt then n := 0;
  until result or (n=m);
//  {$IFDEF DEBUGMSG}
//    LogDbgMsg('Combining valid range result in ['+inttostr(bpos)+','+inttostr(bpos+len)+']');
//  {$ENDIF}
end;

function CombineInvalidFromList(Blocks: Pointer; BlockCnt: Integer; FromList: Pointer; ListCnt: Integer;
    MaxLen: Cardinal; IsRand: Boolean; var BPos, Len: Cardinal): Boolean;
var
  n, m: Integer;
  p: PIntegerArray;
begin
  p := FromList;
  if isrand then
    n := random(ListCnt)
  else n := 0;
  if n and 1 <> 0 then dec(n);
  m := n;
  repeat
    result := combineinvalid(blocks, blockcnt, p[n], p[n+1], maxlen, isrand, bpos, len);
    inc(n);
  until result or (n=m);
end;

function TLockList.GetCount: Integer;
begin
  Lock;
  try
    result := inherited Count;
  finally
    Unlock;
  end;
end;

procedure TLockList.SetCount(const Value: Integer);
begin
  Lock;
  try
    inherited Count := Value;
  finally
    Unlock;
  end;
end;

procedure TLockList.DeleteRange(Key: Pointer;
  CompareProc: TCompareKeyProc);
var
  i, b, e: Integer;
  buf: PPointerList;
begin
  buf := nil;
  Lock;
  try
    if findrange(key, b, e, compareproc) then
      with TListRef(self) do
      begin
        getmem(buf, (e-b) * 4);
        system.Move(Flist[b], buf[0], (e-b) * 4);
        if e < fcount then
          system.Move(FList[e], FList[b], (FCount - e) * 4);
        dec(fcount, e - b);
      end;
  finally
    Unlock;
  end;
  if buf <> nil then
  begin
    for i := 0 to e - b - 1 do
      releasedata(buf[i]);
    dispose(buf);
  end;
end;

{ TRuler }

constructor TRuler.create(Len: Cardinal);
begin
  initializecriticalsection(flock);
  if len > 0 then
    reset(len);
end;

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

procedure TRuler.AdjustEnd(EPos: Cardinal; NewValid: Boolean);
begin
  try
    lock;
    try
      if count = 0 then
      begin
        if not newvalid then
        begin
          add(nil);
          add(pointer(epos));
        end;
      end
      else if Cardinal(Items[count-1]) <= EPos then
      begin
        if not newvalid then
          Items[Count-1] := Pointer(EPos);
      end
      else
        validrange(EPos, Cardinal(Items[Count-1])-EPos);
    finally
      unlock;
    end;
  except
  end;
end;

function TRuler.GetBlock(var BPos, Len: Cardinal; Peek, Rand: Boolean; MaxLen: Cardinal): Boolean;
var
  n: Integer;
begin
  result := false;
  try
    lock;
    try
      result := count>0;
      if result then
      begin
        if rand then
        begin
          n := random(count) and $FFFFFFFE;
        end
        else n := 0;
        bpos := Cardinal(Items[n]);
        len := Cardinal(Items[n+1])-Cardinal(Items[n]);
        if not Peek then
          if (MaxLen > 0) and (Len > MaxLen) then
          begin
            Items[n] := Pointer(bpos + MaxLen);
            Len := MaxLen;
          end
          else begin
            delete(n);
            delete(n);
          end;
      end;
    finally
      unlock;
    end;
  except
  end;
end;

function TRuler.IsRangeValid(BPos, Len: Cardinal): Boolean;
begin
  result := false;
  try
    lock;
    try
      result := SortLists.IsRangeValid(List, Count, BPos, BPos+Len);
    finally
      unlock;
    end;
  except
  end;
end;

function TRuler.HasValidPart(BPos, EPos: Cardinal): Boolean;
begin
  result := false;
  try
    lock;
    try
      result := SortLists.HasValidPart(List, Count, BPos, EPos);
    finally
      unlock;
    end;
  except
  end;
end;

function TRuler.hasInvalidPart(BPos, EPos: Cardinal): Boolean;
begin
  result := false;
  try
    lock;
    try
      result := SortLists.HasInvalidPart(List, Count, BPos, EPos);
    finally
      unlock;
    end;
  except
  end;
end;

procedure TRuler.Reset(Len: cardinal);
begin
  try
    lock;
    try
      clear;
      if len > 0 then
      begin
        add(nil);
        add(pointer(len));
      end;
    finally
      unlock;
    end;
  except
  end;
end;

procedure TRuler.ValidRange(BPos, Len: Cardinal);
var
  b, e, n, c: Integer;
begin
  if len = 0 then exit;
  try
    lock;
    try
      b := 0;
      e := count - 1;
      while b <= e do
      begin
        c := (b + e) shr 1;
        if bpos < Cardinal(items[c]) then
          e := c - 1
        else if bpos > cardinal(items[c]) then
          b := c + 1
        else begin
          b := c;
          break;
        end;
      end;
      if b >= count then
      begin
        exit;
      end;
      if b and 1 <> 0 then
        if Cardinal(items[b]) > bpos + len then
        begin
          insert(b, pointer(bpos+len));
          insert(b, pointer(bpos));
          exit;
        end
        else begin
          items[b] := pointer(bpos);
          inc(b);
        end;

      n := b;
      e := count - 1;
      while b <= e do
      begin
        c := (b + e ) shr 1;
        if bpos+len < cardinal(items[c]) then
          e := c - 1
        else if bpos+len > cardinal(items[c]) then
          b := c + 1
        else begin
          e := c;
          break;
        end;
      end;

      if e and 1 = 0 then
      begin
        items[e] := pointer(bpos+len);
        dec(e);
      end;