Delphi TIdHttp TIdFtp　文件下载

最新推荐文章于 2023-02-23 22:33:21 发布

ceaningking

最新推荐文章于 2023-02-23 22:33:21 发布

阅读量1k

点赞数

分类专栏： Delphi

本文链接：https://blog.csdn.net/ceaningking/article/details/106471312

版权

Delphi 专栏收录该内容

24 篇文章 7 订阅

订阅专栏

开发环境: 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. 全路径检索下载的时候，进度条不知如何处理(单个下载的时候没有问题)。

待后续...

结束!

ceaningking

关注

0
点赞
踩
4

收藏

觉得还不错? 一键收藏
1
评论
Delphi TIdHttp TIdFtp　文件下载

看到手游有一个自动更新的功能，尝试着用Delphi也弄一个看看，百度了些文章，看了下实现方式，时间都花费在FTP全路径检索的递归方法上面，修改了好久，终于可以了。1. 在IIS上配置一个带有多层目录结构的产品目录, 做好准备工作. 如下图所示(cwx为需要下载或更新的程序目录): 2. 测试程序界面如下所示，功能一目了然 3. 工程文件DelphiAutoUpdate源码如下:program DelphiAutoUpdate;uses Forms, uFr...
复制链接

扫一扫