unit_main.pas

用Delphi编写的升级程序,很实用,用户可以用该升级程序到指定站点升级程序

unit Unit_main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Gauges, Buttons,inifiles, Psock, NMHttp,shellapi,
  ImgList, ComCtrls;

type
  TForm_Update = class(TForm)
    Image1: TImage;
    Notebook_step: TNotebook;
    Label1: TLabel;
    ListBox_servers: TListBox;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    Edt_url: TEdit;
    Label3: TLabel;
    Gauge_process: TGauge;
    btn_pre: TButton;
    btn_next: TButton;
    HTTPFiles: TNMHTTP;
    ListView_files: TListView;
    ImageList: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure btn_nextClick(Sender: TObject);
    procedure Notebook_stepPageChanged(Sender: TObject);
    procedure btn_preClick(Sender: TObject);
    procedure ListBox_serversClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure HTTPFilesPacketRecvd(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    g_path:string;
    sys_id:string;
    AppIni: TIniFile;
    files:TStringList;
    function ExistNewFile:boolean;
  public
    { Public declarations }
  end;

var
  Form_Update: TForm_Update;

implementation

{$R *.dfm}

procedure TForm_Update.FormCreate(Sender: TObject);
var
  servers:TStrings;
  i:integer;
begin
   files:=TStringList.Create;
   Notebook_step.PageIndex:=0;
   ListBox_servers.Items.Clear;
 try
   g_path:=ExtractFilePath(application.ExeName);
   if copy(g_path,length(g_path),1)<>'\' then g_path:=g_path+'\';
   AppIni := TIniFile.Create(g_path+'chis.ini');
   sys_id:=appini.ReadString('chis','SubSys','');
   servers:=TStringList.Create;
   AppIni.ReadSectionValues('update',servers);
   for i:=0 to servers.Count-1 do
   begin
       ListBox_servers.Items.Add(copy(servers[i],1,pos('=',servers[i])-1));
       if i=0 then edt_url.Text:=copy(servers[i],pos('=',servers[i])+1,length(servers[i]));
   end;
 finally
   AppIni.Free;
 end;

end;

procedure TForm_Update.btn_nextClick(Sender: TObject);
var iFileHandle,i: Integer;
    FileDateTime:TDateTime;
    run_exe:string;
    Flist:TListItem;
begin
   if btn_next.Caption='完成升级' then
   begin
      btn_next.Enabled:=false;
      btn_next.Caption:='复制新文件..';
      for i:=0 to files.Count-1 do    //备份旧文件
      begin
         //备份一份文件出来
         if not DirectoryExists(ExtractFilePath(Application.ExeName)+'bak\') then
            CreateDir(ExtractFilePath(Application.ExeName)+'bak\');
         copyfile(pchar(g_path+files[i]),pchar(g_path+'bak\'+files[i]+'.bak'),false);
         //deletefile(g_path+files[i]);
      end;
      if not DirectoryExists(ExtractFilePath(Application.ExeName)+'update\') then
            CreateDir(ExtractFilePath(Application.ExeName)+'update\');
      for i:=0 to files.Count-1 do    //从update复制新文件
      begin
         copyfile(pchar(g_path+'update\'+files[i]),pchar(g_path+files[i]),false);
         deletefile(g_path+'update\'+files[i]);
      end;
      try
         AppIni := TIniFile.Create(g_path+'chis.ini');
         run_exe:=AppIni.ReadString('chis','exe','');
         if run_exe<>'' then  shellexecute(handle,'open',pchar(run_exe),nil,nil,sw_show);
      finally
         AppIni.Free;
      end;
      Application.Terminate;
      exit;
   end;
   Notebook_step.PageIndex:=Notebook_step.PageIndex+1;

   Gauge_process.MaxValue:=100;
   Gauge_process.Progress:=0;
   ListView_files.Items.Clear;
   Flist:=ListView_files.Items.Add;
   Flist.Caption:='取得要升级的文件...';
   Flist.StateIndex:=0;
   Flist.ImageIndex:=0;

   if ExistNewFile then
   begin
          ListView_files.Items.Clear;
          Gauge_process.Progress:=0;
          for i:=0 to files.Count-1 do
          begin
             Flist:=ListView_files.Items.Add;
             Flist.Caption:=files[i];
             Flist.StateIndex:=-1;
             Flist.ImageIndex:=-1;
          end;
          //下载升级文件
          btn_next.Enabled:=false;
          btn_next.Caption:='正下载文件..';
          try
              AppIni := TIniFile.Create(g_path+'update\update.ini');
              for i:=0 to files.Count-1 do
              try
                     Gauge_process.MaxValue:=2000;
                     Gauge_process.Progress:=1;
                     ListView_files.Items[i].StateIndex:=0;
                     ListView_files.Items[i].ImageIndex:=0;
                     begin
                              try
                                  HTTPFiles.InputFileMode := true;
                                  HTTPFiles.OutputFileMode := FALSE;
                                  HTTPFiles.ReportLevel := Status_Basic;
                                  HTTPFiles.Body:=g_path+'update/'+files[i];
                                  HTTPFiles.Get(Edt_url.Text+files[i]);
                               except
                                  //下载文件失败
                                  ListView_files.Items[i].StateIndex:=2;
                                  ListView_files.Items[i].ImageIndex:=2;
                               end;
                     end;
                     ListView_files.Items[i].StateIndex:=1;
                     ListView_files.Items[i].ImageIndex:=1;
              except
              end;
          finally
               AppIni.Free;
          end;
          Gauge_process.Progress:=Gauge_process.MaxValue;
          btn_next.Enabled:=true;
          if Notebook_step.PageIndex=Notebook_step.Pages.Count-1 then  btn_next.Caption:='完成升级';
   end;
end;

procedure TForm_Update.Notebook_stepPageChanged(Sender: TObject);
begin
  if Notebook_step.PageIndex=0 then
  begin
         btn_pre.Enabled:=false;
         btn_next.Caption:='下一步';
         btn_next.Enabled:=true;
  end
  else btn_pre.Enabled:=true;
end;

procedure TForm_Update.btn_preClick(Sender: TObject);
begin
   try
       HTTPFiles.Disconnect;
   except
   end;
   Notebook_step.PageIndex:=Notebook_step.PageIndex-1;
   btn_next.Caption:='下一步';
   btn_next.Enabled:=true;
end;

procedure TForm_Update.ListBox_serversClick(Sender: TObject);
var i:integer;
begin
  Edt_url.Text:='';
  for i:=0 to ListBox_servers.Items.Count-1 do
       if ListBox_servers.Selected[i] then
       begin
            try
              AppIni := TIniFile.Create(g_path+'\chis.ini');
              edt_url.Text:=AppIni.ReadString('update',ListBox_servers.Items[i],'http://');
            finally
              AppIni.free;
            end;
       end;
end;

procedure TForm_Update.FormShow(Sender: TObject);
begin
 btn_next.SetFocus;
end;

procedure TForm_Update.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
   try
       HTTPFiles.Disconnect;
   except
   end;
   files.free;
end;

function TForm_Update.ExistNewFile:boolean;
var i,iFileHandle:integer;
    FileDateTime:TDateTime;
begin
   result:=false;
  //下载文件
   files.Clear;
   try
      HTTPFiles.InputFileMode := true;
      HTTPFiles.OutputFileMode := FALSE;
      HTTPFiles.ReportLevel := Status_Basic;
      HTTPFiles.Body:=g_path+'update/update.ini';
      if copy(Edt_url.Text,length(edt_url.Text),1)<>'/' then Edt_url.Text:=Edt_url.Text+'/';
      HTTPFiles.Get(Edt_url.Text+sys_id+'.htm');

   except
      MessageBox(handle,'取得升级信息出错！','错误提示',MB_OK+MB_ICONERROR);
      exit;
   end;
   files.Clear;
   try
              AppIni := TIniFile.Create(g_path+'\update\update.ini');
              AppIni.ReadSections(files);
   finally
              AppIni.free;
   end;
   result:=true;
end;

procedure TForm_Update.HTTPFilesPacketRecvd(Sender: TObject);
begin
   Gauge_process.Progress:=Gauge_process.Progress+1;
   if Gauge_process.Progress>=Gauge_process.MaxValue then Gauge_process.Progress:=Gauge_process.MaxValue-1000;
end;

procedure TForm_Update.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
   CanClose:=true;
   if HTTPFiles.Connected then
   begin
       if MessageBox(handle,'正在下载文件，要退出吗？','信息提示',MB_YESNO+MB_ICONQUESTION)=ID_YES then CanClose:=true else CanClose:=false;
   end;
   if btn_next.Caption='完成升级' then
   begin
       if MessageBox(handle,'文件下载已经完成，但并没有更新文件，要退出吗？','信息提示',MB_YESNO+MB_ICONQUESTION)=ID_YES then CanClose:=true else CanClose:=false;
   end;
end;

end.