*/ 出自： 编程中国 http://www.bc-cn.net
*/ 作者： anthony634
*/ 时间： 2007-10-22 编程论坛首发
*/ 声明： 尊重作者劳动，转载请保留本段文字
*/ --------------------------------------------------------------------------------------
上周有位本论坛的朋友在QQ里问到传奇私服的自动更新的问题，当时在网吧打游戏随便回答了一些问题，今天早上刚好有空，抽了些时间，写了段demo，其实如果下载了indy，它是自带有demo 的，这里用到了线程和地址重定向，算是一个简单的实例吧，由于时间仓促，封装和命名上就马虎了。注析也不详细。
下载文件是http://www.bc-cn.net/Soft/kfyy/delphi/edu/200604/296.html
界面部分：
Unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Unit2, ComCtrls, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ProgressBar1: TProgressBar;
Button2: TButton;
Button3: TButton;
Memo1: TMemo;
Button4: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
fWeb: string;
fDownLoadThread: TDownLoadThread;
public
{ Public declarations }
procedure OnShowProgress(DownCount: Integer);
procedure OnGetFileSize(fileSize: Integer);
procedure OnShowStatus(aString: string);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
fDownLoadThread := TDownLoadThread.Create(True);
fDownLoadThread.FreeOnTerminate := True;
fDownLoadThread.OnDownLoadCount := OnShowProgress;
fDownLoadThread.OnShowString := OnShowStatus;
fDownLoadThread.OnGetFileSize := OnGetFileSize;
fDownLoadThread.initDownLoad(fWeb);
fDownLoadThread.Resume();
end;
procedure TForm1.OnShowProgress(DownCount: Integer);
begin
if DownCount > ProgressBar1.Max then
Exit
else
ProgressBar1.Position := DownCount;
end;
procedure TForm1.OnGetFileSize(fileSize: Integer);
begin
ProgressBar1.Position := 0;
ProgressBar1.Max := fileSize;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
fDownLoadThread.Terminate();
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
fDownLoadThread.Suspend();
end;
procedure TForm1.OnShowStatus(aString: string);
begin
Memo1.Lines.Add(aString);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
// 页面是 http://www.bc-cn.net/Soft/kfyy/delphi/edu/200604/296.html
fWeb := 'http://www.bc-cn.net/Soft/ShowSoftDown.asp?UrlID=1&SoftID=296';
Edit1.Text := '目标地址：' + fWeb;
end;
end.
下载线程部分
unit Unit2;
interface
uses
Classes, SysUtils, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdHTTP, IdFTP;
type
TOnDownLoadCount = procedure(DownCount: Integer) of object;
TOnShowString = procedure(aString: string) of object;
TDownLoadThread = class(TThread)
private
{ Private declarations }
fDestFileName: string;
fFileSize: Integer;
FDestWebAddr: string;
fIdHttp: TIdHTTP;
fIdFtp: TIdFTP;
fDownLoadItem: TFileStream;
fOnDownLoadCount: TOnDownLoadCount;
fOnShowString: TOnShowString;
fOnGetFileSize: TOnDownLoadCount;
procedure OnDownLoadWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure OnWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure OnStatus(axSender: TObject; const axStatus: TIdStatus;
const asStatusText: String);
procedure OnRedirect(Sender: TObject; var dest: String;
var NumRedirect: Integer; var Handled: Boolean);
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy(); override;
procedure initDownLoad(aWeb: string);
property OnDownLoadCount: TOnDownLoadCount write fOnDownLoadCount;
property OnShowString: TOnShowString write fOnShowString;
property OnGetFileSize: TOnDownLoadCount write fOnGetFileSize;
end;
implementation
{ TDownLoadThread }
procedure TDownLoadThread.Execute;
begin
{ Place thread code here }
try
fIdHttp.Connect();
fIdHttp.Head('/Soft/ShowSoftDown.asp?UrlID=1&SoftID=296');
except
if FDestWebAddr <> '' then
fOnShowString('地址重定向到：' + FDestWebAddr)
else
fOnShowString('连接失败.');
end;
// 这里这里应该分析重定向后的地址FDestWebAddr，根据地址决定是http下载还是ftp下载 这里省略了。
// 得到的地址是：ftp://down1:008@down1.bc-cn.net/down1_18/1_kfyy/5_delphi/edu/delphi7_zjjfbsyykf.rar
// 分析地址应该使用ftp,并得到一下信息
fIdFtp := TIdFTP.Create(nil);
fIdFtp.User := 'down1'; // 用户名
fIdFtp.Password := '008'; // 密码
fIdFtp.Host := 'down1.bc-cn.net'; // 主机
fIdFtp.Port := 21; // 端口，可以不设，默认就是21的 ，这里用的是端口模式。
fIdFtp.OnWork := Self.OnDownLoadWork; // 实现相应的事件，这是下载过程
fIdFtp.OnWorkBegin := Self.OnWorkBegin; // 下载开始
fIdFtp.OnStatus := Self.OnStatus;
fIdFtp.Connect();
fFileSize := fIdFtp.Size('/down1_18/1_kfyy/5_delphi/edu/delphi7_zjjfbsyykf.rar');
fOnShowString('文件大小： ' + IntToStr(fFileSize));
fIdFtp.Get('/down1_18/1_kfyy/5_delphi/edu/delphi7_zjjfbsyykf.rar', fDownLoadItem);
end;
procedure TDownLoadThread.OnDownLoadWork(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
begin
if Self.Terminated then
begin
try
TIdTCPConnection(Sender).DisconnectSocket();
except
fOnShowString(' DisconnectSocket');
end;
end;
fOnDownLoadCount(AWorkCount);
fOnShowString('目前下载量：' + IntToStr(AWorkCount));
end;
procedure TDownLoadThread.OnWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
if fFileSize <> 0 then
fOnGetFileSize(fFileSize);
end;
procedure TDownLoadThread.OnStatus(axSender: TObject; const axStatus: TIdStatus;
const asStatusText: String);
begin
fOnShowString(asStatusText);
end;
procedure TDownLoadThread.initDownLoad(aWeb: string);
begin
// 论坛的一个文件地址
//aWeb = http://www.bc-cn.net/Soft/ShowSoftDown.asp?UrlID=1&SoftID=296
// 这里分析得到主机名为 www.bc-cn.net， 要下载的文件是/Soft/ShowSoftDown.asp?UrlID=1&SoftID=296
// 这里省略了
fIdHttp.Host := 'www.bc-cn.net';
fIdHttp.Port := 80;
fIdHttp.HandleRedirects := True; // 设置重定向
fIdHttp.OnRedirect := Self.OnRedirect;
fIdHttp.OnStatus := Self.OnStatus;
end;
constructor TDownLoadThread.Create(CreateSuspended: Boolean);
begin
fIdHttp := TIdHTTP.Create(nil);
inherited Create(CreateSuspended);
end;
destructor TDownLoadThread.Destroy();
begin
fIdHttp.Free();
inherited Destroy();
end;
procedure TDownLoadThread.OnRedirect(Sender: TObject; var dest: String;
var NumRedirect: Integer; var Handled: Boolean);
var
i: Integer;
begin
i := LastDelimiter('/', dest);
FDestWebAddr := dest;
fDestFileName := Copy(dest, i + 1, Length(dest));
fDownLoadItem := TFileStream.Create(fDestFileName, fmCreate);
end;
end.
