xingke 发表于 2007-12-14 16:22:16

关于自动更新的下载部分

作者:anthony6

上周有位本论坛的朋友在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:[email protected]/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.
页: [1]
查看完整版本: 关于自动更新的下载部分