btutils.pas

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

  {$IFDEF DEBUGMSG}
    LogDbgMsg('Inet send error: '+inttostr(-code));
  {$ENDIF}
  end;
end;

procedure TBTTracker.DoTimer(WParam, LParam: Integer);
begin
  traverse(GetTickCount, WParam, dotracker);
end;

procedure TBTTracker.DoTracker(List: TObject; Item: Pointer; WParam,
  LParam: Integer);
begin
  with TBTInfo(Item) do
    if (Tracker = nil) and ((LParam <> 0) or (RequestCnt > 0) or (cardinal(WParam) - TrackerTick >= cardinal(Interval))) then
    begin
      dotracker(self);
    end;
end;

{ TBTBlock }

constructor TBTBlock.Create(AOwner: TBTMngr; AInfo: TBTInfo;
  AIndex: Integer);
var
  fid, len: Integer;
  buf: string;
begin
  initializecriticalsection(flock);
  Owner := AOwner;
  Key.Info := AInfo;
  Key.Index := AIndex;
  if Key.Index = length(Key.info.Blocks) div sizeof(TSHA1) - 1 then
    if Key.info.TotalSize mod key.info.BlockSize = 0 then
      len := key.info.BlockSize
    else len:= key.info.TotalSize mod key.info.BlockSize
  else len := key.info.BlockSize;
  blocklen := len;
  blocks := TRuler.create(len);
  wants := TRuler.create(len);
  cache := alloctempfile('', 'TMP', '.bt', true);
  fid := fileopen(cache, fmOpenWrite);
  if key.Info.BitFlags.Bits[AIndex] then
  begin
    buf := ainfo.GetBlockBuffer(AIndex);
    filewrite(fid, buf[1], length(buf));
    blocks.Clear;
    wants.Clear;
  end
  else begin
    fileseek(fid, len, 0);
    setendoffile(fid);
  end;
  fileclose(fid);
  LastRequest := GetTickCount;
end;

destructor TBTBlock.Destroy;
begin
  deletefile(cache);
  blocks.Free;
  wants.Free;
  inherited;
  deletecriticalsection(flock);
end;

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

function TBTBlock.ReadCache: string;
var
  fid: Integer;
  sha: TDCP_sha1;
  dst: TSHA1;
  p: PSHA1Arr;
begin
  fid := fileopen(cache, fmOpenRead or fmShareDenyNone);
  setlength(result, getfilesize(fid, nil));
  if length(result) > 0 then
    fileread(fid, result[1], length(result));
  fileclose(fid);
  sha := TDCP_sha1.Create(nil);
  sha.Init;
  sha.Update(result[1], length(result));
  sha.Final(dst);
  sha.Free;
  p := pointer(key.Info.Blocks);
  if comparesha1(dst, p[key.Index]) <> 0 then
    result := '';
end;

function TBTBlock.ReadPart(Offset, Len: Integer): string;
var
  fid: Integer;
begin
  fid := fileopen(cache, fmOpenRead or fmShareDenyNone);
  setlength(result, len);
  fileseek(fid, offset, 0);
  if len >0 then
    fileread(fid, result[1], len);
  fileclose(fid);
  key.Info.Lock;
  try
    key.Info.UpSize := key.Info.UpSize+len;
  finally
    key.Info.Unlock;
  end;
end;

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

function TBTBlock.WriteCache(Offset: Integer; const buf; len: Integer; IsInit: Boolean): Boolean;
var
  fid: Integer;
  flg: Boolean;
begin
  result := false;
  lock;
  try
    flg := blocks.IsRangeValid(offset, len) ;
    if not flg then
    begin
      fid := fileopen(cache, fmOpenWrite or fmShareDenyNone);
      fileseek(fid, offset, 0);
      filewrite(fid, buf, len);
      fileclose(fid);
      blocks.ValidRange(offset, len);
      result := blocks.Count = 0;
    end;
  finally
    unlock;
  end;
  if not isinit and not flg then
  begin
    key.Info.Lock;
    try
      key.Info.DownSize := key.Info.DownSize + len;
    finally
      key.Info.Unlock;
    end;
  end;
end;

{ TBTClient }

constructor TBTClient.Create(AOwner: TBTMngr);
begin
  initializecriticalsection(flock);
  Owner := AOwner;
  Flags := TBTBits.Create;
  lastreadtick := gettickcount;
  lastwritetick := lastreadtick;
  KeepAliveTick := lastreadtick;

  UnchokedTick:=lastreadtick;
  RemoteUnchokedTick:= lastreadtick;
  InterestedTick:= lastreadtick;
end;

destructor TBTClient.Destroy;
begin
  Flags.Free;
  inherited;
  deletecriticalsection(flock);
end;

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

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

procedure TBTClient.DoGetBitField(const Buf; Len: Integer);
var
  s: string;
begin
{$IFDEF DEBUGMSG}
  LogDbgMsg('Got remote bitfields from '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
{$ENDIF}
  info.Lock;
  try
    s := info.BitFlags.ToString(len * 8);
  finally
    info.Unlock;
  end;
  lock;
  try
    flags.FromString(s);
    flags.Invert(len * 8);
    flags.ANDBits(buf, len * 8);
    if flags.FSetCnt > 0 then inc(info.seedcnt);
  finally
    unlock;
  end;
  requestrandomblock(0, 0);
end;

procedure TBTClient.DoHaveBlock(Index: Integer);
var
  f: Boolean;
begin
{$IFDEF DEBUGMSG}
  LogDbgMsg('Remote has block '+inttostr(Index)+' from '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
{$ENDIF}
  f := info.BitFlags.Bits[Index];
  if not f then
  begin
    Lock;
    try
      if flags.FSetCnt <= 0 then
        inc(info.SeedCnt);
      flags.Bits[Index] := true;
    finally
      unlock;
    end;
    requestblock(Index);
  end;
end;

procedure TBTClient.DoReadBlock(Index, Off: Integer; const Buf;
  Len: Integer);
var
  blk: TBTBlock;
  blkKey: TBTBlockKey;
begin
{$IFDEF DEBUGMSG}
  LogDbgMsg('Received remote block '+inttostr(index)+' data at offset '+inttostr(off)+' len '+inttostr(len)+' from '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
{$ENDIF}
  blkkey.Info := info;
  blkkey.Index := Index;
  blk := TBTBlock(owner.Blocks.GetItem(@BlkKey));
  if blk <> nil then
  begin
    lastreadtick := gettickcount;
    dec(downloading);
    dec(owner.Requesting, len);
    if blk.WriteCache(off, buf, len) then
      haveblock(blk)
    else requestrandomblock(0, 0);
  end;
end;

procedure TBTClient.HaveBlock(Blk: TBTBlock);
var
  buf: string;
  i, b, e: Integer;
  lst: TList;
begin
  buf := blk.ReadCache;
  if buf <> '' then
  begin
  {$IFDEF DEBUGMSG}
    LogDbgMsg(' Block '+inttostr(blk.Key.Index)+' downloaded.');
  {$ENDIF}
    info.SetBlockBuffer(blk.Key.Index, buf[1], length(buf));
    lst := TList.Create;
    owner.Links.Lock;
    try
      if owner.Links.FindRange(pointer(info), b, e, owner.compareclient2) then
        for i := b to e - 1 do
          lst.Add(owner.Links.Items[i]);
    finally
      owner.Links.Unlock;
    end;
    for i := 0 to lst.Count - 1 do
      with TBTClient(lst.Items[i]) do
      try
        Lock;
        try
          if Flags.Bits[blk.Key.Index] then
          begin
            flags.Bits[blk.Key.Index] := false;
            if flags.FSetCnt <= 0 then
              dec(info.SeedCnt);
          end
          else
            sock.Send(owner.makecmd(4, makebuffer([htonl(blk.Key.Index)])));
        finally
          unlock;
        end;
      except
      end;
    lst.Free;
  end
  else begin
  {$IFDEF DEBUGMSG}
    LogDbgMsg('  Invalid block '+inttostr(blk.Key.Index)+' data received, reset download size');
  {$ENDIF}
    info.Lock;
    try
      info.DownSize := info.DownSize - blk.BlockLen;
    finally
      info.Unlock;
    end;
    blk.Blocks.Reset(blk.BlockLen);
    blk.Wants.Reset(blk.BlockLen);
  end;
  globaltimer.AddJob(0, 0, 0, requestrandomblock, true, true);
end;

procedure TBTClient.RequestRandomBlock(WParam, LParam: Integer);
var
  i, n, cnt: Integer;
begin
  if (downloading >= MAX_RECV_LIMIT) or (owner.Requesting > owner.BandLimit) then exit;
  cnt := length(info.Blocks) div sizeof(TSHA1);
  if RANDOMBLOCK then
    i := random(flags.FSetCnt)+1
  else i := 1;
  repeat
    lock;
    try
      n := flags.GetBitIndex(true, i);
    finally
      unlock;
    end;
    if (n>=0) and (n<cnt) and requestblock(n) then
      n := -1;
    inc(i);
  until (n < 0) or (n >= cnt);
  if unchoked and (flags.FSetCnt = 0) then
  begin
    sock.Send(owner.MakeCmd(3, ''));
  end

end;

function TBTClient.RequestBlock(Index: Integer): Boolean;
var
  blk: TBTBlock;
  off, len: cardinal;
begin
  if unchoked then
  begin
    result := false;
    blk := owner.getblock(info, index);
    if blk = nil then exit;
    result := blk.Wants.GetBlock(off, len, false, false, REQUEST_BLOCK_SIZE);
    if not result and (gettickcount - blk.LastRequest >= REQUERY_INTERVAL)
        and (blk.Wants.GetInnerData <> blk.Blocks.GetInnerData) then
    begin
      blk.Wants.SetInnerData(blk.Blocks.GetInnerData);
      //flg := blk.Wants.GetBlock(off, len, false, RANDOMBLOCK, REQUEST_BLOCK_SIZE);
    end;
    if result then
    repeat
    {$IFDEF DEBUGMSG}
      LogDbgMsg('Requesting block('+inttostr(blk.Key.Index)+') to '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
    {$ENDIF}
      blk.LastRequest := gettickcount;
      LastReadTick := blk.LastRequest;
      inc(downloading);
      inc(owner.Requesting, len);
      sock.Send(owner.MakeCmd(6, makebuffer([htonl(Index), htonl(off), htonl(len)])));
    until (downloading >= MAX_RECV_LIMIT) or (owner.Requesting > owner.bandlimit)
        or not blk.Wants.GetBlock(off, len, false, false, REQUEST_BLOCK_SIZE);
  end
  else begin
  {$IFDEF DEBUGMSG}
    LogDbgMsg('Notify interested to '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
  {$ENDIF}
    result := true;
    sock.Send(owner.makecmd(2, ''));
  end;
end;

procedure TBTClient.DoRemoteChoke;
begin
{$IFDEF DEBUGMSG}
  LogDbgMsg('Remote Choked: '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
{$ENDIF}
  if unchoked then
  begin
    unchoked := false;
    lastreadtick := gettickcount;
    unchokedtick := lastreadtick;
    if flags.FSetCnt > 0 then
    begin
    {$IFDEF DEBUGMSG}
      LogDbgMsg('Notify interested to '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
    {$ENDIF}
      sock.Send(owner.MakeCmd(2, ''));
    end;
  end;
end;

procedure TBTClient.DoRemoteUnchoke;
begin
{$IFDEF DEBUGMSG}
  LogDbgMsg('Remote unchoked: '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
{$ENDIF}
  if not unchoked then
  begin
    Unchoked := true;
    unchokedtick := gettickcount;
    requestrandomblock(0, 0);
  end;
end;

procedure TBTClient.DoRemoteInterested;
begin
{$IFDEF DEBUGMSG}
  LogDbgMsg('Remote interested from '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
{$ENDIF}
  if not remoteunchoked and (owner.UpCnt < MAX_SERVICE) then
  begin
    unchokeremote;
  end
  else if not remoteunchoked then
  begin
    remoteinterested := true;
    InterestedTick := gettickcount;
  end;
end;

procedure TBTClient.DoRemoteNotInterested;
begin
{$IFDEF DEBUGMSG}
  LogDbgMsg('Remote not interested, choking: '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
{$ENDIF}
  remoteinterested := false;
  if remoteunchoked then
  begin
    chokeremote;
  end;
end;

procedure TBTClient.DoRequestBlock(Index, Off, Len: Integer);
var
  blk: TBTBlock;
  v: Integer;
begin
  if remoteunchoked then
  begin
  {$IFDEF DEBUGMSG}
    LogDbgMsg('Remote request block '+inttostr(Index)+' at offset '+inttostr(off)+' len '+inttostr(len)+' from '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
  {$ENDIF}
    blk := owner.GetBlock(info, Index);
    if (blk <> nil) and blk.Blocks.IsRangeValid(off, len) then
    begin
      lastwritetick := gettickcount;
      sock.Send(owner.MakeCmd(7, makebuffer([htonl(Index), htonl(off), blk.ReadPart(off, len)])));
      if owner.UpCnt > 0 then
        v := owner.SendLimit div cardinal(owner.UpCnt)
      else
        v := owner.SendLimit;
      if sock.BufferUsed > v then
      begin
      {$IFDEF DEBUGMSG}
        LogDbgMsg('Remote request too many data, choking '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
      {$ENDIF}
        chokeremote;
      end;
    end;
  end;
end;

procedure TBTClient.UnChokeRemote;
begin
  if not remoteunchoked then
  begin
  {$IFDEF DEBUGMSG}
    LogDbgMsg('Unchoking remote: '+inet_ntoa(sock.Addr.sin_addr)+':'+inttostr(ntohs(sock.Addr.sin_port))+'('+inttostr(sock.Handle)+')');
  {$ENDIF}
    remoteunchoked := true;
    remoteinterested := false;
    inc(owner.UpCnt);
    LastWriteTick := gettickcount;
    remoteunchokedtick := lastwritetick;
    sock.Send(owner.MakeCmd(1, ''));
  end;
end;

procedure TBTClient.ChokeRemote;
begin
  if remoteunchoked then
  begin
    dec(owner.UpCnt);
    remoteunchoked := false;
    remoteunchokedtick := gettickcount;
    sock.Send(owner.MakeCmd(0, ''));
  end;
end;

{ TBTMngr }

constructor TBTMngr.Create;
begin
  Tracker:= TBTTracker.Create(self);
  Links:= TLockList.Create;
  Links.CompareKey := CompareClient;
  Links.ReleaseData := ReleaseClient;
  Connections := TLockList.Create;
  Connections.CompareKey := CompareConnection;
  BTInfos:= TLockList.Create;
  BTInfos.CompareKey := CompareBTInfo;
  BTInfos.ReleaseData := ReleaseInfo;
  Blocks:= TLockList.Create;
  Blocks.CompareKey := CompareBTBlock;
  Blocks.ReleaseData := ReleaseBlock;
  SendLimit := MAX_SEND_LIMIT;
  BandLimit := Cardinal(-1);
end;

destructor TBTMngr.Destroy;
begin
  close;
  Tracker.Free;
  Links.Free;
  Blocks.Free;
  BTInfos.Free;
  inherited;
end;

procedure TBTMngr.Close;
begin
  if timer <> 0 then
  begin
    unregistertimer(timer);
    unregiste