btutils.pas

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

  astream.Read(BlockSize, 4);
  astream.Read(l, 4);
  setlength(Blocks, l);
  if l > 0 then
    astream.Read(blocks[1], l);
  astream.Read(TotalSize, 8);
  astream.Read(l, 4);
  setlength(FilePath, l);
  if l > 0 then
    astream.Read(filepath[1], l);
  astream.Read(l, 4);
  count := l;
  for i := 0 to count-1 do
  begin
    f := TBTFile.Create;
    f.Index := i;
    f.Parent := self;
    Items[i] := pointer(f);
    f.loadfromstream(astream);
  end;
  //InitBitFlags;
end;

procedure TBTInfo.SaveToStream(AStream: TStream);
var
  i, l: Integer;
begin
  astream.Write(infohash, 20);
  l := length(announce);
  astream.Write(l, 4);
  if l > 0 then
    astream.Write(announce[1], l);
  l := length(comment);
  astream.Write(l, 4);
  if l > 0 then
    astream.Write(comment[1], l);
  astream.Write(CreateDate, 4);
  astream.Write(BlockSize, 4);
  l := length(blocks);
  astream.Write(l, 4);
  if l > 0 then
    astream.Write(blocks[1], l);
  astream.Write(TotalSize, 8);
  l := length(filepath);
  astream.Write(l, 4);
  if l > 0 then
    astream.Write(filepath[1], l);
  l := count;
  astream.Write(l, 4);
  for i := 0 to l-1 do
    TBTFile(Items[i]).SaveToStream(astream);
end;

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

function TBTInfo.TryLock(TimeOut: Cardinal): Boolean;
var
  tick: Cardinal;
begin
  if timeout = 0 then result := tryentercriticalsection(flock)
  else begin
    result := false;
    tick := GetTickCount;
    while not result and (cardinal(gettickcount - tick) < timeout) do
    begin
      result := tryentercriticalsection(flock);
      if result then break;
      sleep(1);
    end;
  end;
end;

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

function TBTInfo.MakeAnnounce(evt: string; num: Integer): string;
var
  a: in_addr;
begin
  if (evt = '') and not registered then
  begin
    evt := 'started';
    num := CLIENTS_WANTED;
    Lock;
    try
      if Completed then
      begin
        num := 0;
        if owner <> nil then
          globaltimer.AddJob(integer(self), 0, 0, owner.DoBTFinish, true, false);
      end;
    finally
      Unlock;
    end;
  end;
  result := announce + '?info_hash='+httpencode(infohash, sizeof(TSHA1))+'&peer_id='+httpencode(PEER_ID+PEER_ID2)+'&port='+
     inttostr(owner.ListenPort)+'&uploaded='+inttostr(self.UpSize)+'&downloaded='+inttostr(self.DownSize)+
     '&left='+inttostr(self.RestSize);
  if evt <> '' then
    result := result + '&event='+evt;
  a.S_addr := getwanip;
  if islanip(a.S_addr) then
    result := result + '&ip='+inet_ntoa(a);
  result := result + '&numwant='+inttostr(num);
end;

procedure TBTInfo.DoTracker(Sender: TBTTracker);
var
  s: string;
begin
  trackertick := gettickcount;
  if completed then requestcnt := 0;
  s := makeannounce('', requestcnt);
  {$IFDEF DEBUGMSG}
    LogDbgMsg('Tracker::<-- '+s);
  {$ENDIF}
  tracker := requestbuf(s, sender.callback, pointer(self), TRACKER_TIMEOUT);
end;

procedure TBTInfo.StopTracker;
begin
  if tracker <> nil then
  begin
    droprequest(tracker);
    tracker := nil;
  end;
  requestbuf(makeannounce('stopped', 0), nil, nil, 1000);
  registered := false;
  upsize := 0;
  downsize := 0;
end;

function TBTInfo.GetBlockBuffer(Index: Integer): string;
var
  f: TBTFile;
  n, l, len: Integer;
  off: Int64;
  flg: Boolean;
begin
  result := '';
  if blocktofile(index, n, off) then
  begin
    if Index = length(blocks) div sizeof(TSHA1) - 1 then
    begin
      len := TotalSize mod BlockSize;
      if len = 0 then
        len := BlockSize;
    end
    else len := BlockSize;
    setlength(result, len);
    l := 0;
    while l < len do
    begin
      f := TBTFile(Items[n]);
      if f.ReadToBuffer(result[1], length(result), off, l, flg) then
      begin
        inc(n);
        off := 0;
      end;
    end;
  end;
end;

procedure TBTInfo.SetBlockBuffer(Index: Integer; const Buf; Len: Integer);
var
  f: TBTFile;
  n, l: Integer;
  off: Int64;
  p: PByte;
begin
  p := @Buf;
  if blocktofile(Index, n, off) then
  begin
    while len > 0 do
    begin
      f := TBTFile(Items[n]);
      if f.WriteFromBuffer(p^, len, off, l) then
      begin
        inc(n);
        off := 0;
      end;
      dec(len, l);
      inc(p, l);
    end;
    Lock;
    try
      bitflags.Bits[Index] := true;
      restsize := restsize - len;
      if Completed and (owner <> nil) then
      begin
      {$IFDEF DEBUGMSG}
        LogDbgMsg('Download finished');
      {$ENDIF}
        globaltimer.AddJob(integer(self), 0, 0, owner.doBTFinish, true, false);
      end;
    finally
      unlock;
    end;
  end;
end;

function TBTInfo.GetBitField: string;
begin
  result := '';
  try
    Lock;
    try
      result := bitflags.ToString(length(blocks) div sizeof(TSHA1));
    finally
      Unlock;
    end;
  except
  end;
end;

function TBTInfo.Completed: Boolean;
begin
  result := bitflags.FSetCnt >= length(blocks) div sizeof(TSHA1);
end;

procedure TBTInfo.SetOwner(const Value: TBTMngr);
begin
  if FOwner <> Value then
  begin
    if FOwner <> nil then
      FOwner.BTInfos.RemoveItem(@infohash);
    FOwner := Value;
    if value <> nil then
    begin
      if workpath = '' then
        workpath := value.WorkPath;
      value.InnerAddInfo(self);
    end;
  end;
end;

function TBTInfo.PeekClient(var a: TSockAddrIn): Boolean;
begin
  result := false;
  Lock;
  try
    if Clients.Count > 0 then
    begin
      a.sin_family := 2;
      a.sin_port := htons(integer(clients.Objects[0]));
      a.sin_addr.S_addr := hosttoip(clients.Strings[0]);
      clients.Delete(0);
      result := true;
    end;
  finally
    Unlock;
  end;
end;

function TBTInfo.LoadTorrent(ATorrent: string): Boolean;
var
  d: TBencodeDict;
  s: string;
  fid, l: Integer;
  p: PChar;
begin
  result := false;
  if not fileexists(atorrent) then exit;
  fid := fileopen(atorrent, fmOpenRead or fmShareDenyNone);
  setlength(s, Getfilesize(fid, nil));
  if s <> '' then
    fileread(fid, s[1], length(s));
  fileclose(fid);
  if s = '' then exit;
  p := pchar(s);
  l := length(s) - 1;
  inc(p);
  d := TBencodeDict.Create;
  d.Bdecode(p, l);
  Init(d);
  d.Free;
  result := true;
end;

{ TBTFile }

destructor TBTFile.Destroy;
begin
  inherited;
end;

procedure TBTFile.BdecodeName(Names: TBencodeList);
var
  i: Integer;
begin
  filename := '';
  for i := 0 to names.Count - 1 do
    if i > 0 then
      filename := filename+'\'+names.StrValue[i]
    else filename := names.StrValue[i];
end;

function TBTFile.BencodeName: TBencodeList;
var
  b, e: Integer;
begin
  result := TBencodeList.Create;
  b := 1;
  while b <= length(filename) do
  begin
    e := b;
    while (e<=length(filename)) and (filename[e] <> '\') do
      inc(e);
    result.AddStr(copy(filename, b, e-b));
    b := e + 1;
  end;
end;

function TBTFile.ReadToBuffer(var Buffer; BufLen: Integer; var FileOff: Int64;
  var SkipLen: Integer; var BufChg: Boolean): Boolean;
var
  fid, l: Integer;
  p: Pointer;
  ps, s: string;
begin
  result := true;
  fid := -1;
  s := parent.WorkPath+filename;
  if not fileexists(s) then
    {if fileexists(parent.WorkPath+originfile) then
      copyfilefromorigin(parent.WorkPath+originfile, parent.WorkPath+filename)
    else }
  begin
    ps := extractfilepath(s);
    if not directoryexists(ps) then
      forcedirectories(ps);
    fid := filecreate(s);
    //fileseek(fid, filesize-1, 0);
    //filewrite(fid, l, 1);
    fileseek(fid, filesize, 0);
    setendoffile(fid);
    fileclose(fid);
  end;
  if fileexists(s) then
    fid := fileopen(s, fmOpenRead or fmShareDenyNone);
  l := buflen - skiplen;
  if fileoff+l > filesize then l := filesize-fileoff else result := false;
  p := pointer(integer(@buffer)+skiplen);
  inc(skiplen, l);
  if fid >= 0 then
  begin
    fileseek(fid, fileoff, 0);
    fileread(fid, p^, l);
    bufchg := true;
    fileclose(fid);
  end;
  fileoff := fileoff+l;
end;


function TBTFile.WriteFromBuffer(const Buffer; BufLen: Integer;
  var FileOff: Int64; var WriteLen: Integer): Boolean;
var
  fid: Integer;
begin
  result := false;
  writelen := 0;
  fid := fileopen(parent.WorkPath+filename, fmOpenWrite or fmShareDenyNone);
  if fid < 0 then exit;
  if fileoff >= filesize then exit;
  writelen := buflen;
  if fileoff+buflen >= filesize then
  begin
    writelen := filesize-fileoff;
    result := true;
  end;
  fileseek(fid, fileoff, 0);
  filewrite(fid, buffer, writelen);
  fileoff := fileoff+writelen;
  fileclose(fid);
end;

procedure TBTFile.LoadFromStream(AStream: TStream);
var
  l: Integer;
begin
  astream.Read(l, 4);
  setlength(filename, l);
  if l > 0 then
    astream.Read(filename[1], l);
  astream.Read(l, 4);
  setlength(originfile, l);
  if l > 0 then
    astream.Read(originfile[1], l);
  astream.read(FileSize, 8);
  astream.Read(StartOff, 8);
end;

procedure TBTFile.SaveToStream(AStream: TStream);
var
  l: Integer;
begin
  l := length(filename);
  astream.Write(l, 4);
  if l > 0 then
    astream.Write(filename[1], l);
  l := length(originfile);
  astream.Write(l, 4);
  if l > 0 then
    astream.Write(originfile[1], l);
  astream.Write(filesize, 8);
  astream.Write(startoff, 8);
end;

function TBTFile.MakeComment: string;
begin
  result := '';
  if parent.BTExt then
  begin
  end;
end;

procedure TBTFile.InitInfo(Info: string);
begin

end;

{ TBTTracker }

constructor TBTTracker.Create(AOwner: TBTMngr);
begin
  inherited create;
  Owner := AOwner;
  CompareKey := compareBT;
  releasedata := releasebt;
end;

destructor TBTTracker.Destroy;
begin
  Active := false;
  inherited;
end;

function TBTTracker.GetActive: Boolean;
begin
  result := Timer <> 0;
end;

procedure TBTTracker.SetActive(const Value: Boolean);
begin
  if Value <> GetActive then
    if Value then
    begin
      registertimer(timer, 0, 0, TRACKER_INTERVAL, dotimer, false, true);
      dotimer(1, 0);
    end
    else begin
      unregistertimer(timer);
      clear;
    end;
end;

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

procedure TBTTracker.ReleaseBT(Data: Pointer);
begin
  with TBTInfo(data) do
    stoptracker;
end;

procedure TBTTracker.Callback(Sender: TInetJob; Code: Integer);
var
  info: TBTInfo;
  dt, dt1: TBencodeDict;
  lst: TBencodeList;
  p: Pchar;
  i, n, l: Integer;
  ip: string;
  prt: word;
begin
  info := TBTInfo(sender.UsrData);
  if info <> nil then
    info.Tracker := nil;
  if code = INET_SUCCESS then
  try
  {$IFDEF DEBUGMSG}
    LogDbgMsg('Tracker::--> '+sender.Buffer);
  {$ENDIF}
    p := pointer(sender.Buffer);
    l := sender.FinishedLen;
    inc(p);
    dec(l);
    dt := TBencodeDict.Create;
    dt.Bdecode(p, l);
    info.Lock;
    try
      info.registered := true;
      n := dt.IntValue['interval'];
      if n > 0 then
        info.Interval := n * 1000;
      lst := dt.ListValue['peers'];
      if lst <> nil then
      begin
      {$IFDEF DEBUGMSG}
        LogDbgMsg('Got '+inttostr(lst.Count)+' links');
      {$ENDIF}
        info.requestcnt := 0;
        for i := 0 to lst.Count - 1 do
        begin
          dt1 := lst.DictValue[i];
          if dt1 <> nil then
          begin
            ip := dt1.StrValue['ip'];
            prt := dt1.IntValue['port'];
            info.Clients.AddObject(ip, TObject(prt));
          end;
        end;
      end;
    finally
      info.Unlock;
      dt.Free;
    end;
    owner.RequestMoreLinks(info);
  except
  {$IFDEF DEBUGMSG}
    on e: exception do
      LogDbgMsg('TBTTracker.Callback error: '+e.message);
  {$ENDIF}
  end
  else begin