📄 main.pas
字号:
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 + -