开发环境: Win7+ Delphi 2007
看到手游有一个自动更新的功能,尝试着用Delphi也弄一个看看,百度了些文章,看了下实现方式,时间都花费在FTP全路径检索的递归方法上面,修改了好久,终于可以了。
1. 在IIS上配置一个带有多层目录结构的产品目录, 做好准备工作. 如下图所示(cwx为需要下载或更新的程序目录):
2. 测试程序界面如下所示,功能一目了然
3. 工程文件DelphiAutoUpdate源码如下:
program DelphiAutoUpdate;
uses
Forms,
uFrmMain in 'uFrmMain.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
4. 测试窗体uFrmMain.pas代码如下:
一定要注意uses有两部分,不然会出现idftp.DirectoryListing.Count= 0。
unit uFrmMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, UrlMon, IdHTTP, IdBaseComponent, IdAntiFreezeBase,
IdAntiFreeze, IdComponent, IdTCPConnection, IdTCPClient, ComCtrls,
IdExplicitTLSClientServerBase, IdFTP, FileCtrl;
const
DT_Format= 'yyyy-MM-dd hh:mm:ss';
type
TAppPara = class
public
class function AppPath: string;
class function AppName: string;
class function Path: string;
end;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
IdAntiFreeze1: TIdAntiFreeze; //该控件可避免下载过程中程序无响应
IdHTTP1: TIdHTTP;
ProgressBar1: TProgressBar;
Button3: TButton;
btn_connect: TButton;
IdFTP1: TIdFTP;
Memo1: TMemo;
Button4: TButton;
Label1: TLabel;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Integer);
procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
procedure Button3Click(Sender: TObject);
procedure btn_connectClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure Download_All(IdFTP: TIdFTP; root, dir: string);
procedure Download_Changed(IdFTP: TIdFTP; root, dir: string);
{获取文件的创建时间 或 修改时间 或 访问时间}
function CovFileDateTime(fd: _FILETIME): TDateTime;
{校验修改时间}
function CheckModifyDate(dModify: TDateTime; sFile: string): Boolean;
end;
var
Form1: TForm1;
implementation
uses IdFTPList, IdFTPCommon, IdFTPListParseWindowsNT, IdAllFTPListParsers;
{$R *.dfm}
function downLoadFile(source, dest: string): Boolean;
begin
try
Result:= URLDownloadToFile(nil, PChar(source), PChar(dest), 0, nil)= 0;
except
Result:= False;
end;
end;
procedure TForm1.btn_connectClick(Sender: TObject);
var
list: TStrings;
sRoot: string;
begin
{连接FTP测试}
list:= TStringList.Create;
IdFTP1.Connect;
try
sRoot:= IdFTP1.RetrieveCurrentDir; //初始目录
IdFTP1.ChangeDir('cwx'); //进入 程序A 目录
IdFTP1.List(list); //得到目录下的所有文件列表
Memo1.Lines.Assign(list);
ShowMessage('S');
finally
IdFTP1.Disconnect;
FreeAndNil(list);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
fileDir, downUrl: string;
begin
{函数下载(单文件URL)}
fileDir:= 'client.zip';
downUrl:= 'http://download.pingan.com.cn/bank/client.zip';
if downLoadFile(downUrl, fileDir) then
ShowMessage('S')
else
ShowMessage('F');
end;
procedure TForm1.Button2Click(Sender: TObject);
var
fileStream: TFileStream;
begin
{IdHttp下载(单文件URL)}
fileStream:= TFileStream.Create('client.zip', fmCreate);
try
IdHTTP1.Get('http://download.pingan.com.cn/bank/client.zip', fileStream);
finally
FreeAndNil(fileStream);
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
tStream: TMemoryStream;
begin
{IdHttp下载2(单文件URL)}
tStream:= TMemoryStream.Create;
try
try
IdHTTP1.Get('http://download.pingan.com.cn/bank/client.zip', tStream);
tStream.SaveToFile('client.zip');
ShowMessage('S');
except
ShowMessage('F');
end;
finally
FreeAndNil(tStream);
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
{下载(FTP全路径检索,直接覆盖本地)}
Label2.Caption:= Format('开始更新 %s ...', ['']);
IdFTP1.Connect;
try
Download_All(IdFTP1, 'cwx', 'cwx');
finally
IdFTP1.Disconnect;
end;
Label2.Caption:= Format('更新完毕 %s ...', ['']);
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
{下载(FTP全路径检索, 检查文件的修改时间, 不一致则覆盖本地)}
Label2.Caption:= Format('开始更新 %s ...', ['']);
IdFTP1.Connect;
try
Download_Changed(IdFTP1, 'cwx', 'cwx');
finally
IdFTP1.Disconnect;
end;
Label2.Caption:= Format('更新完毕 %s ...', ['']);
end;
procedure TForm1.Button6Click(Sender: TObject);
var
tp: TSearchRec;
t1, t2: string;
begin
{获取文件时间(创建时间和修改时间)}
FindFirst(TAppPara.Path, faAnyFile, tp);
t1:= '创建时间: '+ FormatDateTime(DT_Format, CovFileDateTime(tp.FindData.ftCreationTime));
t2:= '修改时间: '+ FormatDateTime(DT_Format, CovFileDateTime(tp.FindData.ftLastWriteTime));
ShowMessage(t1+ #13#10+ t2);
end;
procedure TForm1.Button7Click(Sender: TObject);
var
Save_Cursor: TCursor;
path: string;
begin
{选择文件夹(SelectDirectory)}
Save_Cursor:= Screen.Cursor;
Screen.Cursor:= crHourGlass;
try
// caption标题是长字符串容
// const Root指定浏览的根目录
// out Directory返回所选目录
if SelectDirectory('请选择文件夹', '', path) then
begin
ShowMessage(Path);
end;
finally
Screen.Cursor:= Save_Cursor;
end;
end;
function TForm1.CheckModifyDate(dModify: TDateTime; sFile: string): Boolean;
var
tp: TSearchRec;
begin
Result:= False;
FindFirst(sFile, faAnyFile, tp);
if dModify> CovFileDateTime(tp.FindData.ftLastWriteTime) then
Result:= True;
end;
function TForm1.CovFileDateTime(fd: _FILETIME): TDateTime;
var
tct: _SYSTEMTIME;
temp: _FILETIME;
begin
FileTimeToLocalFileTime(fd, temp);
FileTimeToSystemTime(temp, tct);
Result:= SystemTimeToDateTime(tct);
end;
procedure TForm1.Download_All(IdFTP: TIdFTP; root, dir: string);
var
t: TIdFTPListItem;
i, dirCount: integer;
fileName, foldName, sDir: string;
begin //连接
idftp.ChangeDir('\'+ root);
if not DirectoryExists(TAppPara.AppPath+ dir) then //如果本地目录不存在则创建文件夹
begin
ForceDirectories(TAppPara.AppPath+ dir); //创建一个全路径的文件夹
end;
idftp.ChangeDir('\'+ dir);
idftp.List(nil); //获取当前目录的信息
dirCount:= idftp.DirectoryListing.Count;
idftp.TransferType := ftBinary; //指定为二进制文件 或文本文件ftASCII
for i := 0 to dirCount- 1 do
begin
t := idftp.DirectoryListing.Items[i]; //得到一个文件相关信息
fileName := t.FileName; //获取文件名
if t.ItemType = ditFile then //如果是文件,则直接下载
begin
Label2.Caption:= Format('正在下载 %s ...', [filename]);
idftp.Get(fileName, TAppPara.AppPath+ dir + '\' + fileName, True); //下载到本地,并为覆盖
Label2.Update;
end
else if (t.ItemType = ditdirectory) then //如果是文件夹,则往下循环下载文件夹的内容
begin
foldName := t.FileName;
sDir:= dir + '\' + foldName;
Download_All(idftp, root, sDir); //递归调用,往下一层一层的循环下载子文件夹数据
idftp.ChangeDirUp;
idFTP.List(nil);
end;
end;
end;
procedure TForm1.Download_Changed(IdFTP: TIdFTP; root, dir: string);
var
t: TIdFTPListItem;
i, dirCount: integer;
fileName, foldName, sDir: string;
begin //连接
idftp.ChangeDir('\'+ root);
if not DirectoryExists(TAppPara.AppPath+ dir) then //如果本地目录不存在则创建文件夹
begin
ForceDirectories(TAppPara.AppPath+ dir); //创建一个全路径的文件夹
end;
idftp.ChangeDir('\'+ dir);
idftp.List(nil); //获取当前目录的信息
dirCount:= idftp.DirectoryListing.Count;
idftp.TransferType := ftBinary; //指定为二进制文件 或文本文件ftASCII
for i := 0 to dirCount- 1 do
begin
t := idftp.DirectoryListing.Items[i]; //得到一个文件相关信息
fileName := t.FileName; //获取文件名
if t.ItemType = ditFile then //如果是文件,则直接下载
begin
Label2.Caption:= Format('正在下载 %s ...', [filename]);
if FileExists(TAppPara.AppPath+ dir + '\' + fileName) then
if not CheckModifyDate(t.ModifiedDate, TAppPara.AppPath+ dir + '\' + fileName) then
Continue;
idftp.Get(fileName, TAppPara.AppPath+ dir + '\' + fileName, True); //下载到本地,并为覆盖
Label2.Update;
end
else if (t.ItemType = ditdirectory) then //如果是文件夹,则往下循环下载文件夹的内容
begin
foldName := t.FileName;
sDir:= dir + '\' + foldName;
Download_All(idftp, root, sDir); //递归调用,往下一层一层的循环下载子文件夹数据
idftp.ChangeDirUp;
idFTP.List(nil);
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IdFTP1.Host:= '192.168.2.188';
IdFTP1.Port:= 21;
IdFTP1.Username:= 'android';
IdFTP1.Password:= '123qwe,.';
IdFTP1.TransferType:= ftBinary;
Self.DoubleBuffered:= True;
end;
procedure TForm1.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
begin
ProgressBar1.Position:= AWorkCount;
Update;
end;
procedure TForm1.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Integer);
begin
//获取文件总大小
ProgressBar1.Max:= AWorkCountMax;
Update;
end;
{ TAppPara }
class function TAppPara.AppName: string;
begin
Result := ExtractFileName(Application.ExeName);
end;
class function TAppPara.AppPath: string;
begin
Result := ExtractFilePath(Application.ExeName);
end;
class function TAppPara.Path: string;
begin
Result:= ExtractFilePath(Application.ExeName)+ ExtractFileName(Application.ExeName);
end;
end.
5. 测试效果
未下载前:
下载后:
多层目录也下载正常
注意:
1. 当首次下载的时候,本地的文件的创建时间,修改时间,访问时间系统默认的都是当前Now时间
2. 全路径检索下载的时候,进度条不知如何处理(单个下载的时候没有问题)。
待后续...
结束!