断点续传和一些(50分)

  • 主题发起人 主题发起人 cemer815
  • 开始时间 开始时间
C

cemer815

Unregistered / Unconfirmed
GUEST, unregistred user!
我在做一个下载和断点续传,和软件的自动升级,在网上找了一个方法,但是实现起来有点困难,请大虾们帮助一下,小第不胜感激。我的qq:57798768,没分了,大家不要介意啊!
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdHTTP, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdFTP;

type
TForm1 = class(TForm)
IdHTTP1: TIdHTTP;
ComboBox1: TComboBox;
Button1: TButton;
Button2: TButton;
Button3: TButton;
ProgressBar1: TProgressBar;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure Button2Click(Sender: TObject);
procedure IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
private
{ Private declarations }

AbortTransfer :boolean;
BytesToTransfer : integer;
public
{ Public declarations }
function GetURLFileName(aURL: string): string;
function GetProt(aURL: string): Byte;
procedure HttpDownLoad(aURL, aFile: string; bResume: Boolean);

procedure MyDownLoad(aURL, aFile: string; bResume: Boolean);


end;

var
Form1: TForm1;

// AbortTransfer :boolean;

implementation

{$R *.dfm}

function TForm1.GetURLFileName(aURL: string): string;
var
i: integer;
s: string;
begin //返回下载地址的文件名
s := aURL;
i := Pos('/', s);
while i <> 0 do //去掉"/"前面的内容剩下的就是文件名了
begin
Delete(s, 1, i);
i := Pos('/', s);
end;
Result := s;
end;




function TForm1.GetProt(aURL: string): Byte;
begin //检测下载的地址是http还是ftp
Result := 0;
if Pos('http', LowerCase(aURL)) = 1 then
Result := 1;
if Pos('ftp', LowerCase(aURL)) = 1 then
Result := 2;
end;


procedure TForm1.HttpDownLoad(aURL, aFile: string; bResume: Boolean);
var
tStream: TFileStream;
begin //Http方式下载
if FileExists(aFile) then //如果文件已经存在
tStream := TFileStream.Create(aFile, fmOpenWrite) else
tStream := TFileStream.Create(aFile, fmCreate);

if bResume then //续传方式
begin
IdHTTP1.Request.ContentRangeStart := tStream.Size - 1;
tStream.Position := tStream.Size - 1; //移动到最后继续下载
IdHTTP1.Head(aURL);
IdHTTP1.Request.ContentRangeEnd := IdHTTP1.Response.ContentLength;
end else //覆盖或新建方式
begin
IdHTTP1.Request.ContentRangeStart := 0;
end;

try
IdHTTP1.Get(aURL, tStream); //开始下载
finally
tStream.Free;
end;
end;


procedure TForm1.MyDownLoad(aURL, aFile: string; bResume: Boolean);
begin
case GetProt(aURL) of
0: ShowMessage('不可识别的地址!');
1: HttpDownLoad(aURL, aFile, bResume);
// 2: FtpDownLoad(aURL, aFile, bResume);
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
aURL, aFile: string;
begin
aURL := ComboBox1.Text; //下载地址,例如"http://www.2ccc.com/update/demo.exe"
aFile := GetURLFileName(aURL); //得到文件名,例如"demo.exe"
if FileExists(aFile) then
begin
case MessageDlg('文件已经存在,是否续传?', mtConfirmation, mbYesNoCancel, 0) of
mrYes: MyDownLoad(aURL, aFile, True); //续传
mrNo: MyDownLoad(aURL, aFile, False); //覆盖
mrCancel: Exit; //取消
end;
end else MyDownLoad(aURL, aFile, False); //建立新文件下载
end;

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if AbortTransfer then
begin //中断下载
IdHTTP1.Disconnect;
IdFTP1.Abort;
end;
ProgressBar1.Position := AWorkCount;
Application.ProcessMessages;

end;

procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
AbortTransfer := False;
if AWorkCountMax > 0 then
ProgressBar1.Max := AWorkCountMax else
ProgressBar1.Max := BytesToTransfer;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
AbortTransfer := True;
end;

procedure TForm1.IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
ProgressBar1.Position := 0;
end;

end.
我只是先做了http的,为什么老是有错误呢,帮忙各位改正一下
 
后退
顶部