Delphi 实现软件自动升级的功能

    Delphi 实现软件自动升级的功能

    原理简单,在FTP上维护一个Update.ini文件,里面记录着要更新文件的版本号,本地也有一个Update.ini文件,每次启动更新程序时,先从FTP上下载Update.ini文件到本地名字为Update_new.ini,然后比较这两个文件,如果新的版本号大于旧的,或者新的文件在就ini中没有,这些就表示要更新的文件,然后逐一下载。

        本程序名字为AutoUpdate,你生成这个exe,然后和主程序一起打包,创建桌面快捷方式时,指向AutoUpdate,而不是主程序。

        在本地还有一个ini文件,比如叫ftp.ini吧,里面内容是

    [coninfo]
    main=Project1.exe
    param={app}sayyes.pj2 -y bde.txt

    main=Project1.exe:是主程序名称,和升级程序在同一目录

    param={app}sayyes.pj2 -y bde.txt:这是命令行参数,app为当前路径,在程序中替换掉,传递给主程序(如果需要的话)

    update.ini的内容格式如下

    [root]

    办事处查询.txt=20100519
    [dbcard]
    sayyes.pj2=20100519
    FTP用户密码.txt=20100519

    [root]代表根目录,后面的[dbcard]代表子目录,依次类推

    
    unit Main; 
     
    interface 
     
    uses 
     Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
     Dialogs, StdCtrls, IdHTTP, IdBaseComponent, IdComponent, IdTCPConnection, 
     IdTCPClient, IdFTP, ComCtrls, ExtCtrls,IniFiles,ShellAPI, jpeg; 
     
    type 
     TfrmMain = class(TForm) 
      IdFTP1: TIdFTP; 
      IdHTTP1: TIdHTTP; 
      ProgressBar1: TProgressBar; 
      GroupBox1: TGroupBox; 
      ld_host: TLabeledEdit; 
      ld_username: TLabeledEdit; 
      ld_psw: TLabeledEdit; 
      ld_port: TLabeledEdit; 
      Label1: TLabel; 
      cb_mode: TComboBox; 
      ProgressBar2: TProgressBar; 
      Label3: TLabel; 
      list_file: TListView; 
      Label4: TLabel; 
      procedure IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode; 
       const AWorkCount: Integer); 
      procedure IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode); 
      procedure FormCreate(Sender: TObject); private 
      { Private declarations } 
      FSize:Integer; 
      FPath: string; 
      FExePath: string; 
      FInitPath: string; 
      FIniFile:TIniFile; 
      FHandle:HWND; 
      FMainExe:string; 
      FParam: string; 
     
      procedure CheckUpdateList; 
      function ConnectFTP:Boolean; 
      procedure DownLoadFile; 
      procedure LoadIni; 
      procedure SaveIni; 
     public 
      { Public declarations } 
     end; 
     
    var 
     frmMain: TfrmMain; 
     
    implementation 
    uses 
     Flash; 
    {$R *.dfm} 
    //下载进度 
    procedure TfrmMain.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode; 
     const AWorkCount: Integer); 
    begin 
     ProgressBar1.Position := AWorkCount; 
     Application.ProcessMessages; 
    end; 
     
    procedure TfrmMain.IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode); 
    begin 
     ProgressBar1.Position := 0; 
     ProgressBar2.StepBy(1); 
    end; 
     
    procedure TfrmMain.FormCreate(Sender: TObject); 
    var 
     frm: TfrmFlash; 
    begin 
     Self.Visible := False; 
     //闪屏,可以不加 
     frm := TfrmFlash.Create(nil); 
     frm.Show; 
     Application.ProcessMessages; 
     FExePath := ExtractFilePath(Application.ExeName); 
     FIniFile := TIniFile.Create(FExePath+'ftp.ini'); 
     //加载ini信息,就是主机和端口之类的信息 
     LoadIni; 
     try 
      ConnectFTP; 
      CheckUpdateList; 
      Self.Visible := True; 
      Application.ProcessMessages; 
      DownLoadFile; 
     finally 
       
      FreeAndNil(frm); 
      IdFTP1.Quit; 
      FParam := StringReplace(FParam,'{app}',FExePath,[rfReplaceAll]); 
    //更新完毕后,启动主程序,并传入命令行参数 
      ShellExecute(Handle,'open',PChar(FExePath+FMainExe),PChar(FParam),nil,SW_NORMAL); 
      Application.Terminate; 
     end; 
    end; 
     
    //检查更新列表 
    procedure TfrmMain.CheckUpdateList; 
    var 
     oldFile,newFile:TStringList; 
     i,ver,index:Integer; 
     itemstr,itempath: string; 
     item:TListItem; 
    begin 
     oldFile := TStringList.Create; 
     newFile := TStringList.Create; 
     try 
      list_file.Clear; 
      //先下载服务器上的update.ini文件,存到本地update_new.ini 
      IdFTP1.Get('update.ini',FExePath+'update_new.ini',True); 
      if FileExists(FExePath + 'update.ini') = False then Exit; 
      oldFile.LoadFromFile(FExePath + 'update.ini'); 
      newFile.LoadFromFile(FExePath + 'update_new.ini'); 
      itempath := ''; 
      //下面开始比较两个list,如果newFile的版本号大于oldFile的版本号或者oldFile中没有的都表示要更新的 
      for i := 0 to newFile.Count - 1 do 
      begin 
       itemstr := newFile.Strings[i]; 
       if itemstr = '' then Continue; 
       if itemstr[1] = '[' then 
       begin 
        itempath := Copy(itemstr,2,Length(itemstr)-2); 
        //如果是根目录 
        if itempath = 'root' then 
         itempath := '/'; 
        Continue; 
       end; 
       itemstr := newFile.Names[i]; 
       index := oldFile.IndexOfName(itemstr); 
       if index = - 1 then 
       begin 
        item := list_file.Items.Add; 
        item.Caption := itemstr; 
        item.SubItems.Add(itempath) 
       end 
       else 
       begin 
        ver := StrToIntDef(newFile.Values[itemstr],0); 
        if ver > StrToIntDef(oldFile.Values[itemstr],0) then 
        begin 
         item := list_file.Items.Add; 
         item.Caption := itemstr; 
         item.SubItems.Add(itempath); 
        end; 
       end; 
      end; 
      if list_file.Items.Count = 0 then Application.Terminate; 
     finally 
      oldFile.Free; 
      newFile.Free; 
     end; 
    end; 
     
    function TfrmMain.ConnectFTP: Boolean; 
    begin 
     Result := False; 
     try 
     IdFTP1.Host := ld_host.Text; 
     IdFTP1.Port := StrToIntDef(ld_port.Text,21); 
     IdFTP1.Username := ld_username.Text; 
     IdFTP1.Password := ld_psw.Text; 
     IdFTP1.Connect; 
     IdFTP1.Passive := cb_mode.ItemIndex = 1; 
     FInitPath := IdFTP1.RetrieveCurrentDir; 
     Result := IdFTP1.Connected; 
     except 
      Result := False; 
     end; 
    end; 
     
    //下载文件更新 
    procedure TfrmMain.DownLoadFile; 
    var 
     i:Integer; 
     path:string; 
     s1,s2:String; 
    begin 
     ProgressBar2.Max := list_file.Items.Count; 
     ProgressBar2.Position := 0; 
     FIniFile.EraseSection('error'); 
     for i := 0 to list_file.Items.Count - 1 do 
     begin 
      Label4.Caption := '正在下载 '+list_file.Items[i].Caption; 
      Application.ProcessMessages; 
      IdFTP1.ChangeDir(FInitPath); 
      path := list_file.Items[i].SubItems.Strings[0]; 
      if path <>'/' then 
      begin 
       IdFTP1.ChangeDir(path); 
       ForceDirectories(FExePath+path); 
       s1 := list_file.Items[i].Caption; 
       s2 := FExePath+path+'/'+list_file.Items[i].Caption; 
       IdFTP1.Get(s1,s2,True); 
      end 
      else 
      begin 
       s1 := list_file.Items[i].Caption; 
       s2 := FExePath+'/'+list_file.Items[i].Caption; 
       IdFTP1.Get(s1,s2,True); 
       //记录失败项 
       FIniFile.WriteString('error',list_file.Items[i].Caption,'成功'); 
      end; 
      except 
       //记录失败项 
       FIniFile.WriteString('error',list_file.Items[i].Caption,'失败'); 
      end; 
     end; 
     Label4.Caption := '所有文件更新完毕!'; 
     DeleteFile(FExePath+'update.ini'); 
     CopyFile(PChar(FExePath+'update_new.ini'),PChar(FExePath+'update.ini'),False); 
    end; 
     
    procedure TfrmMain.LoadIni; 
    begin 
     ld_host.Text := FIniFile.ReadString('coninfo','host','******'); 
     ld_username.Text := FIniFile.ReadString('coninfo','user','******'); 
     ld_psw.Text := FIniFile.ReadString('coninfo','psw','******'); 
     ld_port.Text := FIniFile.ReadString('coninfo','port','21'); 
     cb_mode.ItemIndex := FIniFile.ReadInteger('coninfo','mode',1); 
     FMainExe := FIniFile.ReadString('coninfo','main','Main.exe'); 
     FParam := FIniFile.ReadString('coninfo','param',''); 
    end; 
     
    procedure TfrmMain.SaveIni; 
    begin 
     FIniFile.WriteString('coninfo','host',ld_host.Text); 
     FIniFile.WriteString('coninfo','user',ld_username.Text); 
     FIniFile.WriteString('coninfo','psw',ld_psw.Text); 
     FIniFile.WriteString('coninfo','port',ld_port.Text); 
     FIniFile.WriteInteger('coninfo','mode',cb_mode.ItemIndex); 
    end; 
     
    end. 
    

    如有疑问请留言或者到本站社区交流讨论,感谢阅读,希望能帮助到大家,谢谢大家对本站的支持!