⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 使用delphi语言
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  xhTorrentFile := nil;

  Result := True;

end;

function TMainFrm.StopDownload(): boolean;
begin
  result := False;

  if not assigned(hDownloader) then
  begin
    Exit;
  end;

  FTK_GlobalVar_RemoveTorrentSHA1(PAnsiChar(sHexHashKey));

  FTK_Downloader_Release(hDownloader);
  FTK_Downloader_Close(hDownloader);
  hDownloader := nil;

  Result := True;

end;

function IFormatByte(nSize: Int64): string;
begin
  if nSize > 1073741824 then
    Result := FormatFloat('###,##0.00G', nSize / 1073741824)
  else if nSize > 1048576 then
    Result := FormatFloat('###,##0.00M', nSize / 1048576)
  else if nSize > 1024 then
    Result := FormatFloat('###,##00K', nSize / 1024)
  else
    Result := FormatFloat('###,#0', nSize);
end;

function FFormatByte(fSize: Double): string;
begin
  if fSize > 1073741824.0 then
    Result := FormatFloat('###,##0.00G', fSize / 1073741824.0)
  else if fSize > 1048576.0 then
    Result := FormatFloat('###,##0.00M', fSize / 1048576.0)
  else if fSize > 1024.0 then
    Result := FormatFloat('###,##00K', fSize / 1024.0)
  else
    Result := FormatFloat('###,#0', fSize);
end;

{$R *.dfm}

procedure TMainFrm.Button1Click(Sender: TObject);
begin
  OpenDialog1.Filter := 'Torrent files (*.torrent)|*.TORRENT';
  if OpenDialog1.Execute() then
  begin
    Edit1.Text := OpenDialog1.FileName;
    sTorrentFile := Edit1.Text;
  end;
end;

procedure TMainFrm.Button2Click(Sender: TObject);
var
  bRet: boolean;
begin
  if not StartDownload then
  begin
    Memo1.lines.Add('StartDownload:: failed!');
  end;

  Memo1.lines.Add('StartDownload:: success!');
  Edit1.Enabled := False;
  Button1.Enabled := False;
  Button2.Enabled := False;
  Button6.Enabled := True;
end;

procedure TMainFrm.Button3Click(Sender: TObject);
begin
  Close();
end;

procedure TMainFrm.FormCreate(Sender: TObject);
var
  nVer: WORD;
  WSData: TWSAData;
begin

  bSetSeq := False;
  Memo1.Text := '';
  Memo2.Text := '';
  sStartupPath := ExtractFilePath(Application.ExeName);
  Memo1.Lines.Add('Startup Path: ' + sStartupPath);

  if not Startup() then
  begin
    Close();
  end;

  if StartContext() = false then
  begin
    Application.MessageBox('Warnning', 'StartContext:: failed!');
    Exit;
  end;
end;

procedure TMainFrm.FormDestroy(Sender: TObject);
begin
  StopDownload();
  StopContext();
  WSACleanup();
end;

function GetNatType(): string;
var
  nType: Byte;
begin
  Result := '未知';
  nType := FTK_UDPT_GetNatType();
  if (nType = 1) then
  begin
    Result := '公网';
  end
  else if (nType = 2) then
  begin
    Result := '内网U';
  end
  else if (nType = 3) then
  begin
    Result := '内网S';
  end
  else if (nType = 4) then
  begin
    Result := '内网C';
  end;
end;

procedure TMainFrm.Timer1Timer(Sender: TObject);
var
  sValue: string;
  nTotalFileHaveSize: QWORD;
  nSeqFileSize: QWORD;
  fLeftTime: Double;
  fValue: Double;
begin
  //显示内网穿透的信息
  Caption := '';
  Caption := '本机IP: ' + FTK_UDPT_GetRealIP() + ' 网络类型: ' + GetNatType() + ' 在线人数: ' + IntToStr(FTK_UDPT_GetUserCount());

  if not Assigned(hDownloader) then
  begin
    Exit;
  end;

  Memo2.Text := '';

  if FTK_Downloader_GetState(hDownloader) = DLSTATE_CHECKING then
  begin
    Memo2.Lines.Add('Status: checking file...');
  end
  else if FTK_Downloader_GetState(hDownloader) = DLSTATE_DOWNLOAD then
  begin
    Memo2.Lines.Add('Status: downloading...');

    {if bSetSeq = False then
    begin
      //如果想顺序下载,请调用此函数,参数为True,如果想恢复原来的下载模式,
      //也调用此函数,参数为False
      FTK_Downloader_SetSeqPicker(hDownloader, True);
      bSetSeq := True;
    end;}
  end
  else if FTK_Downloader_GetState(hDownloader) = DLSTATE_FETALERR then
  begin
    Memo2.Lines.Add('Status: downloading error...');
  end
  else if FTK_Downloader_GetState(hDownloader) = DLSTATE_TERMINATE then
  begin
    Memo2.Lines.Add('Status: stopping...');
  end;

  sValue := IFormatByte(nTotalFileSize);
  Memo2.Lines.Add('File size: ' + sValue);

  if (FTK_Downloader_GetState(hDownloader) = DLSTATE_CHECKING) and (nPieceCount > 0) then
  begin
    ProgressBar1.Position := FTK_Stat_GetCheckPieceCount(hDownloader) * 100 div nPieceCount;
  end;

  if FTK_Downloader_GetState(hDownloader) < DLSTATE_DOWNLOAD then
  begin
    Exit;
  end;

  if FTK_Downloader_GetState(hDownloader) >= DLSTATE_FETALERR then
  begin
    Exit;
  end;

  nTotalFileHaveSize := FTK_Stat_GetTotalFileHaveSize(hDownloader);
  ProgressBar1.Position := nTotalFileHaveSize * 100 div nTotalFileSize;
  GroupBox2.Caption := 'Downloaded progress: ' + IntToStr(ProgressBar1.Position) + '%';

  nSeqFileSize := FTK_Stat_GetStartSeqFileSize(hDownloader);
  nSeqFileSize := nSeqFileSize div (1024 * 1024);
  sValue := IntToStr(nSeqFileSize);
  Memo2.Lines.Add('Seqence Size: ' + sValue + ' MB');

  sValue := FFormatByte(Double(FTK_Stat_GetDownloadRate(hDownloader)));
  Memo2.Lines.Add('Down Speed: ' + sValue + '/s');

  sValue := FFormatByte(FTK_Stat_GetUploadRate(hDownloader));
  Memo2.Lines.Add('Up Speed: ' + sValue + '/s');

  fLeftTime := FTK_Stat_GetLeftTime(hDownloader);

  fValue := fLeftTime / (60.0 * 60.0);
  sValue := Format('%fh : ', [fValue]);

  fValue := (fLeftTime - fValue) / 60.0;
  sValue := sValue + Format('%fm : ', [fValue]);

  fValue := fLeftTime - fValue;
  sValue := sValue + Format('%fs', [fValue]);

  Memo2.Lines.Add('Left time: ' + sValue);

  sValue := IFormatByte(nTotalFileHaveSize);
  Memo2.Lines.Add('Downloaded: ' + sValue);

  sValue := IFormatByte(FTK_Stat_GetUploaded(hDownloader));
  Memo2.Lines.Add('Uploaded: ' + sValue);

  sValue := 'Peers: ' + IntToStr(FTK_Stat_GetTotalPeerCount(hDownloader));
  sValue := sValue + '(' + IntToStr(FTK_Stat_GetActivePeerCount(hDownloader));
  sValue := sValue + '/' + IntToStr(FTK_Stat_GetPassivePeerCount(hDownloader)) + ')';

  Memo2.Lines.Add(sValue);

  sValue := 'Seeds: ' + IntToStr(FTK_Stat_GetSeedCount(hDownloader));

  Memo2.Lines.Add(sValue);

  sValue := 'Uploaded: ' + IntToStr(FTK_Stat_GetUploadPeerCount(hDownloader));
  sValue := sValue + '/Downloaded: ' + IntToStr(FTK_Stat_GetDownloadPeerCount(hDownloader));

  Memo2.Lines.Add(sValue);

  if ProgressBar1.Position >= 100 then
  begin
    Memo2.Lines.Add('Downloaded OK...');
  end;
end;

procedure TMainFrm.Button4Click(Sender: TObject);
var
  i: Integer;
begin

  if nil = hDownloader then
  begin
    Exit;
  end;

  try
    sTorrentFileName := sTorrentFile;
    FilesForm := TFilesForm.Create(self);
    if FilesForm.ShowModal() = mrOK then
    begin
      for i := 0 to nTotalFileCount - 1 do
      begin
        FTK_Downloader_SetFilePriority(hDownloader, i, aFilePriority[i], FALSE);
      end;
      FTK_Downloader_ForceFilePriority(hDownloader);

    end;
    FilesForm.Destroy();
  except
  end;
end;

procedure TMainFrm.Button5Click(Sender: TObject);
var
  form: TMTForm;
begin
  form := TMTForm.Create(Self);
  try
    form.ShowModal();
  except

  end;
end;

procedure TMainFrm.Button6Click(Sender: TObject);
begin
  StopDownload();
  Button2.Enabled := True;
  Button6.Enabled := False;
  Button1.Enabled := True;
end;

procedure TMainFrm.Timer2Timer(Sender: TObject);
begin
  //
  FTK_UDPT_DoEvents();
end;

//外部设置内网连接通知回调函数的指针
//Define callback function for Nat PEER notification

function ftk_nat_peer_cb(pInfoHash: PByte; lpszIP: PChar; nPort: Short; pPeerID: PByte): Boolean; stdcall;
var
  RCInfo: TRemoteCallInfo;
  i: Integer;
begin
  RCInfo := TRemoteCallInfo.Create;
  CopyMemory(@RCInfo.pPeerID, pPeerID, 20);
  CopyMemory(@RCInfo.pInfoHash, pInfoHash, 20);

  PostMessage(MainFrm.Handle, WM_REMOTE_CALL, Integer(RCInfo), 0);
end;

procedure TMainFrm.WMRemoteCallMsg(var msg: TMessage);
var
  RCInfo: TRemoteCallInfo;
begin
  //
  RCInfo := TRemoteCallInfo(msg.WParam);
  FTK_UDPT_RemoteCallPeer(@RCInfo.pPeerID, @RCInfo.pInfoHash);
  RCInfo.free;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -