Question

delphi 实现断点续传 代码

Answer 1

服务器端：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, StdCtrls;
const
BufferSize = 2048;
CPort = 6656;
type
TDataFlag = record
FileName: string;
FileSize: Integer;
WorkFlag: Integer;
end;
PDataFlag = ^TDataFlag;
type
TFrmServerFile = class(TForm)
MmStatus: TMemo;
btn1: TButton;
btn2: TButton;
btn3: TButton;
btn4: TButton;
SServer: TServerSocket;
procedure FormCreate(Sender: TObject);
procedure SServerClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure SServerClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
private
MemoStream: TMemoryStream;
Trancing: Boolean;
userhost: string;
procedure ConneRun;
procedure StopConn;
procedure StartConn;
public

end;

var
FrmServerFile: TFrmServerFile;

implementation

{$R *.dfm}

{ TFrmServerFile }

procedure TFrmServerFile.ConneRun;
begin
Trancing := False;
SServer.Port := CPort;
SServer.Active := True;
MemoStream.Clear;
ShowMessage('服务器已启动!');
end;

procedure TFrmServerFile.StartConn;
begin
if SServer.Socket.ActiveConnections > 0 then
begin
Caption := 'start';
MemoStream.Clear;
Trancing := True;
SServer.Socket.Connections[0].SendText('FiletransferWork');//发送文件信息
MmStatus.Lines.Add('准备好接受文件!');
end;
end;

procedure TFrmServerFile.StopConn;
begin
MemoStream.Clear;
Trancing := False;
if SServer.Socket.ActiveConnections > 0 then
begin
SServer.Socket.Connections[0].SendText('File TransferStop');
MmStatus.Lines.Add('当前任务停止!');
end;
end;

procedure TFrmServerFile.FormCreate(Sender: TObject);
begin
MemoStream := TMemoryStream.Create;
MemoStream.Position := 0;
ConneRun;
end;

procedure TFrmServerFile.SServerClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
DataF: PDataFlag;
begin
DataF := new(pdataFlag);
DataF.FileName := '';
DataF.FileSize := 0;
DataF.WorkFlag := 0;
Socket.Data := DataF;
Socket.SendText('已经连接好，准备传输文件!'#13#10);
end;

procedure TFrmServerFile.SServerClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
Buf: array[0..BufferSize] of Char;
dataf: PDataFlag;
numberBytes: Integer;
cmd: string;
begin
dataf := Socket.Data;
case dataf.workflag of
0:
begin //接受文件大小，名称等信息
cmd := Trim(Socket.ReceiveText);
if Pos('sendfileinfo',cmd) > 0 then
begin
dataf.FileName := Trim(Copy(cmd,Pos(';',cmd)+1,Length(cmd)));
dataf.FileSize := StrToInt(Copy(Dataf.FileName,Pos(';',dataf.FileName)+1,
Length(dataf.FileName)));
dataf.FileName := Trim(Copy(dataf.FileName,0,Pos(';',dataf.FileName)-1));
dataf.WorkFlag := 1;
Socket.Data := dataf;
MmStatus.Lines.Add('文件名:' + dataf.FileName + '文件大小:'+inttostr(dataf.FileSize));
userhost := Socket.RemoteHost;
end;
end;
1:
begin //接受文件
if Trancing then
begin
begin
numberBytes := Socket.ReceiveLength;
Socket.ReceiveBuf(Buf,numberBytes);
MemoStream.Write(buf,numberBytes);
if numberBytes >= buffersize then
begin
Socket.SendText('filetransferwork');
MmStatus.Lines.Add(IntToStr(numberBytes));
end;
if numberBytes < buffersize then
begin
Socket.SendText('FileTransferStop');
MemoStream.Position := 0;
try
MmStatus.Lines.Add('来自:' + Socket.RemoteHost+'的文件传送完毕!');
Trancing := False;
dataf.WorkFlag := 0;
Socket.Data := dataf;
MemoStream.SaveToFile(dataf.FileName);
except
ShowMessage('在保存文件时出现错误!');
Exit;
end;
MemoStream.Clear;
end;
end;
end;
end;
end;
end;
procedure TFrmServerFile.btn1Click(Sender: TObject);
begin
StartConn;
end;

procedure TFrmServerFile.btn2Click(Sender: TObject);
begin
StopConn;
end;

end.

客户端：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters,
cxContainer, cxEdit, dxSkinsCore, dxSkinBlack, dxSkinBlue, dxSkinCaramel,
dxSkinCoffee, dxSkinDarkRoom, dxSkinDarkSide, dxSkinFoggy,
dxSkinGlassOceans, dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky,
dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMoneyTwins,
dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black,
dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinPumpkin, dxSkinSeven,
dxSkinSharp, dxSkinSilver, dxSkinSpringTime, dxSkinStardust,
dxSkinSummer2008, dxSkinsDefaultPainters, dxSkinValentine,
dxSkinXmas2008Blue, cxLabel, ScktComp, StdCtrls;
const
BufferSize = 2048;
CPort = 6656;
type
TForm1 = class(TForm)
Mm1: TMemo;
eDIPAddr: TEdit;
btn1: TButton;
btn2: TButton;
sclient: TClientSocket;
cxLabel1: TcxLabel;
procedure sclientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
private
FFileStream: TMemoryStream;
SFlagSize: Integer;
FFileName: string;
procedure SendFile;
procedure LoadSendFile;
procedure StarSend;
function ConnectionServer(const Server: string):Boolean;
function GetFileSize(const FileName: string):Integer;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

function TForm1.ConnectionServer(const Server: string): Boolean;
begin
if sclient.Active then
sclient.Active := False;
sclient.Port := CPort;;
sclient.Host := Server;
try
sclient.Active := True;
Result := True;
except
ShowMessage('连接服务器失败!');
Result := False;
end;
end;

function TForm1.GetFileSize(const FileName: string): Integer;
var
Files: TFileStream;
begin
Files := TFileStream.Create(FileName,fmOpenRead or fmShareDenyNone);
Result := Files.Size;
Files.Free;
end;

procedure TForm1.LoadSendFile;
begin
with FFileStream do
begin
Clear;
LoadFromFile(FFileName);
Position := 0;
SFlagSize := Size;
end;
end;

procedure TForm1.SendFile;
var
Sendsize: Integer;
buf: array[0..BufferSize] of Char;
begin
if FFileStream.Size < 1 then
loadsendfile;
if SFlagSize >= BufferSize then
Sendsize := BufferSize
else
Sendsize := SFlagSize;
FFileStream.ReadBuffer(buf,Sendsize);
SFlagSize := SFlagSize - Sendsize;
if SFlagSize = 0 then
begin
FFileStream.Clear;
end;
try
sclient.Socket.SendBuf(buf,Sendsize);
Mm1.Lines.Add('文件传输完毕!');
except
FFileStream.Clear;
Mm1.Lines.Add('文件传输错误!');
end;
end;

procedure TForm1.StarSend;
var
FlagStr: string;
begin
with TOpenDialog.Create(nil) do
begin
if Execute then
begin
FlagStr := 'SendFileinfo;'+ExtractFileName(FileName)+';'+inttostr(GetFileSize(FileName));
FFileName := FileName;
sclient.Socket.SendText(FlagStr);
Mm1.Lines.Add(FlagStr);
Mm1.Lines.Add('准备发送');
end;
end;
end;
procedure TForm1.sclientRead(Sender: TObject; Socket: TCustomWinSocket);
var
receiveS: string;
begin
receiveS := Socket.ReceiveText;
Mm1.Lines.Add(receiveS);
if receiveS = 'FiletransferWork' then
begin
SendFile;
end;
if receiveS = 'FileTransferStop' then
begin
FFileStream.Clear;
FFileStream.SetSize(0);
end;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
Self.ConnectionServer(EDIPAddr.text);
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
Self.StarSend;
end;

end.

Answer 2

点量Http/FTP组件的功能简介：

标准Http和FTP下载支持：完全标准的Http和FTP协议支持，内部通过网址自动区分是Http还是FTP下载。
极速下载（2.0以后版本）：超越国内绝大多数下载软件的下载速度。新版内核在2M ADSL的环境下下载，有些文件的速度可以达到1400K字节/秒以上，超过了带宽的极限。下载速度可以用极速形容。
多线程传输：可以将文件自动分块，并采用多线程下载。并可自由设置线程数目。
断点续传：点量Http/FTP有优秀的断点续传支持，每次启动自动从上次下载的位置开始，不需要重复下载。
提供详细的下载详情接口（2.0以后版本）：可以看到整个下载过程的步骤，比如开启了多少线程、服务器的应答过程、错误信息等。
支持多种高级设置：设置线程数目、磁盘缓存大小、搜索镜像服务器的详细参数设置、下载文件完成后同步文件为服务器上的文件时间、下载过程中可以自定义文件临时后缀、未完成的文件设为隐藏属性。
支持磁盘缓存：点量Http/FTP下载DLL支持设置磁盘缓存，减少对磁盘的读写，并提升下载速度。
支持设置Refer：点量Http/FTP下载组件支持设置下载时的Refer，以便可以绕过一些防盗链的网站，直接下载内容。
限速功能：点量Http/FTP下载组件可方便的设置下载限速。
多种磁盘分配方式：点量Http/FTP下载组件支持预分配和边下载边分配两种磁盘方式，满足多种下载需求。
自动搜索镜像加速：点量Http/FTP内置了镜像搜索功能，在下载文件的同时，会自动搜索哪些其它网站还有这个文件，自动从其它网址下载加速。
可提供源码：支付一定的费用，便可以获得全部的点量Http/FTP下载组件的源代码，免除您的所有后顾之忧。
良好的服务：作为点量软件旗下的软件，可享受到点量软件的优秀服务，我们的服务让您如同拥有一个称心的专业员工。

点量Http/FTP 下载组件可以适用于任何Http和FTP下载的领域，让您可以在1天内完成一个完整的Http下载软件的全部功能。比如，您可以用于产品的升级、文件的下载和传输等。