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的,为什么老是有错误呢,帮忙各位改正一下