btdemof.pas

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

unit BTDemoF;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Grids, Gauges, btutils, ThreadTimer, FileCtrl,
  Math;

type
  TBTMain = class(TForm)
    StringGrid1: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1TopLeftChanged(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    procedure DoTimer(WParam, LParam: Integer);  // 定时器, 用于刷新显示下载进度
    procedure DoTimer2(WParam, LParam: Integer); // 第二定时器, 用于刷新显示下载/上传速度
    procedure AdjustGauges(ACol, ARow: Integer; var Rect: TRect);
  public
    { Public declarations }
    BTJobs: TList;         // count = stringgrid.rowcount - 1, 用于存储所有的TBTJob
    Timer: Cardinal;       // 定时器句柄
    Timer2: Cardinal;      // 第二定时器句柄
    BTManager: TBTMngr;    // BT下载管理类
  end;

  { 下载任务显示相关类 }
  TBTJob = class
  private
    Info: TBTInfo;                // bt对象
    Index: Integer;               // stringgrid中对应的行号
    Gauge: TGauge;                // 进度条
    Analyzed: Boolean;            // False表示正在分析torrent文件， True表示正在下载
    FinishedSize: Int64;          // 已经下载过的大小
    SavDown, SavUp: Int64;        // 用于计算下载/上传速度
    procedure StartJob(WParam, LParam: Integer); // 线程函数，初始化bt并开始下载
    procedure GetProgressInfo;  // 获取下载信息
    procedure GetUpDownInfo;    // 计算上传/下载速度
  public
    constructor Create(TorrentFile, DestPath: string);
    destructor Destroy; override;
  end;

var
  BTMain: TBTMain;

implementation

{$R *.dfm}

{ TBTJob }

constructor TBTJob.Create(TorrentFile, DestPath: string);
begin
  if not directoryexists(DestPath) then
    forcedirectories(DestPath);
  { 创建bt类 }
  Info := TBTInfo.Create(nil);
  Info.WorkPath := DestPath;
  Info.Tag := Integer(Self);

  { 创建进度条 }
  Gauge := TGauge.Create(BTMain);
  Gauge.Parent := BTMain.StringGrid1;
  Gauge.BackColor := clWhite;
  Gauge.ForeColor := $0080FFFF;
  Gauge.ShowText := false;

  { 添加到Form.StringGrid中 }
  Index := BTMain.BTJobs.Add(pointer(self))+1;
  BTMain.StringGrid1.RowCount := BTMain.BTJobs.Count + 1;
  with BTMain.StringGrid1 do
  begin
    Cells[0, Self.Index] := TorrentFile;
    Cells[1, Self.Index] := DestPath;
  end;

  { 加载torrent }
  Info.LoadTorrent(TorrentFile);
  globaltimer.AddJob(0, 0, 0, StartJob, true, true);  // 切换到线程中继续初始化bt数据
end;

destructor TBTJob.Destroy;
begin
  if not BTMain.BTManager.DeleteInfo(Info) then
    Info.Free;
  Gauge.Free;
  inherited;
end;

procedure TBTJob.GetProgressInfo;
var
  d, t: double;
begin
  if analyzed then
  begin
    Gauge.BackColor := $0080FFFF;
    Gauge.ForeColor := $0080FF80;
    Gauge.ShowText := true;
    d := info.DownSize + finishedsize;
    t := info.TotalSize;
    with BTMain.StringGrid1 do
    begin
      Cells[2, Index] := IntToStr(Info.SeedCnt);
      Cells[5, Index] := formatfloat('0.##', d / 1024 / 1024) + ' / '+ formatfloat('0.##', t / 1024 / 1024)+' MB';
    end;
  end
  else begin
    d := info.AnalyzedSize;
    t := info.TotalSize;
    BTMain.StringGrid1.Cells[2, Index] := 'Analyzing...';
  end;
  Gauge.Progress := floor(d / t * 100);
end;

procedure TBTJob.GetUpDownInfo;
var
  u, d: Int64;
begin
  u := Info.UpSize;
  d := Info.DownSize;
  with BTMain.StringGrid1 do
  begin
    Cells[3, Index] := formatfloat('0.##', (u-SavUp) / 1024) + ' K/s';
    Cells[4, Index] := formatfloat('0.##', (d-SavDown) / 1024) + ' K/s';
  end;
  SavUp := u;
  SavDown := d;
end;

procedure TBTJob.StartJob(WParam, LParam: Integer);
begin
  Info.InitBitFlags;                // 初始化
  FinishedSize := Info.TotalSize - Info.RestSize;  // 获取已下载过的大小
  Analyzed := True;
  Info.Owner := BTMain.BTManager;  // 开始下载
end;

{ TBTMain }

procedure TBTMain.FormCreate(Sender: TObject);
var
  i: Integer;
begin
// 初始化
  with StringGrid1 do
  begin
    DoubleBuffered := True;
    Cells[0, 0] := 'Name';
    Cells[1, 0] := 'Save to';
    Cells[2, 0] := 'Users';
    Cells[3, 0] := 'Up';
    Cells[4, 0] := 'Down';
    Cells[5, 0] := 'Size';
    Cells[6, 0] := 'Progress';
  end;

  BTJobs:= TList.Create;
  BTManager:= TBTMngr.Create;
  BTManager.WorkPath := ExtractFilePath(ParamStr(0));
  { 激活bt管理器 }
  for i := 1 to 10 do  // 最多重试10次
  begin
    BTManager.ListenPort := Random(12000) + 8000;  // 设置bt管理器工作端口为8000~20000之间的一个随机值
    if BTManager.Open then
    begin
      RegisterTimer(Timer, 0, 0, 200, DoTimer, false, false);     // 创建间隔为200ms的定时器
      RegisterTimer(Timer2, 0, 0, 1000, DoTimer2, false, false);  // 创建间隔为1s的第二定时器
      Exit;
    end;
  end;
  { bt管理器初始化失败 }
  Application.Terminate;
  Halt;
end;

procedure TBTMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i: Integer;
begin
// 释放资源
  UnregisterTimer(Timer);
  UnregisterTimer(Timer2);
  for i := 0 to BTJobs.Count - 1 do
    TBTJob(BTJobs.Items[i]).Free;
  BTJobs.Free;
  BTManager.Free;
end;

procedure TBTMain.AdjustGauges(ACol, ARow: Integer; var Rect: TRect);
var
  i: Integer;
begin
  while ACol < StringGrid1.ColCount - 1 do
  begin
    OffsetRect(Rect, StringGrid1.ColWidths[ACol]+1, 0);
    Inc(ACol);
  end;
  Rect.Right := Rect.Left + StringGrid1.ColWidths[ACol];
  InflateRect(Rect, -2, -4);
  for i := 0 to BTJobs.Count - 1 do
    with TBTJob(BTJobs.Items[i]) do
      if (i < ARow - 1) or (i >= ARow + StringGrid1.VisibleRowCount) then
        Gauge.Visible := False
      else begin
        Gauge.SetBounds(Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
        Gauge.Visible := True;
        OffsetRect(Rect, 0, StringGrid1.RowHeights[i + 1] + 1);
      end;
end;

procedure TBTMain.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
// 调整进度条位置和大小
  if (ACol = StringGrid1.LeftCol) and (ARow = StringGrid1.TopRow) then
  begin
    AdjustGauges(ACol, ARow, Rect);
  end;
end;

procedure TBTMain.StringGrid1TopLeftChanged(Sender: TObject);
var
  R: TRect;
begin
// 调整进度条位置和大小
  with StringGrid1 do
  begin
    R := CellRect(LeftCol, TopRow);
    AdjustGauges(LeftCol, TopRow, R);
  end;
end;

procedure TBTMain.DoTimer(WParam, LParam: Integer);
var
  i: Integer;
begin
// 200ms定时器
  Label1.Caption := format('Total links: %d   ', [BTManager.Links.CountL]);
  for i := 0 to BTJobs.Count - 1 do
    TBTJob(BTJobs.Items[i]).GetProgressInfo;
end;

procedure TBTMain.DoTimer2(WParam, LParam: Integer);
var
  i: Integer;
begin
// 1s定时器
  for i := 0 to BTJobs.Count - 1 do
    TBTJob(BTJobs.Items[i]).GetUpDownInfo;
end;

procedure TBTMain.Button1Click(Sender: TObject);
begin
// 选择torrent文件
  if OpenDialog1.Execute then
    Button1.Caption := OpenDialog1.FileName;
end;

procedure TBTMain.Button2Click(Sender: TObject);
var
  s: string;
begin
// 选择目的路径
  s := Button2.Caption;
  if SelectDirectory('Save to path:', '', s) then
  begin
    if (s<>'') and (s[length(s)] <> '\') then s := s + '\';
    Button2.Caption := s;
  end;
end;

procedure TBTMain.Button3Click(Sender: TObject);
var
  fn, ps: string;
begin
// 添加任务
  fn := Button1.Caption;
  ps := Button2.Caption;
  if FileExists(fn) then
  begin
    Button1.Caption := 'Click to select a .torrent file';
    Button2.Caption := 'Save to: DEFAULT';
    if (ps<>'') and (ps[length(ps)] <> '\') then
      ps := '';
    TBTJob.Create(fn, ps);
  end;
end;

procedure TBTMain.StringGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  Job: TBTJob;
  i: Integer;
begin
  if (Shift = []) and (Key = VK_DELETE) and (StringGrid1.Row <= BTJobs.Count) then  // 删除当前选中任务
  begin
    i := StringGrid1.Row - 1;
    Job := TBTJob(BTJobs.Items[i]);
    BTJobs.Delete(i);
    Job.Free;
    while i < BTJobs.Count do
    begin
      TBTJob(BTJobs.Items[i]).Index := i + 1;
      Inc(i);
    end;
    for i := StringGrid1.Row + 1 to StringGrid1.RowCount - 1 do
      StringGrid1.Rows[i-1] := StringGrid1.Rows[i];
    for i := 0 to StringGrid1.ColCount - 1 do
        StringGrid1.Cells[i, StringGrid1.RowCount - 1] := '';
    if Stringgrid1.RowCount > 2 then
      StringGrid1.RowCount := StringGrid1.RowCount - 1;
  end;
end;

end.