程序自我更新

//注：本源码由中国软件研发联盟122058606  管理员 广州-广州仔 提供

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    procedure GetBuildInfo(FileName:string;var vs:string);//获取软件版本号
    procedure Writefilebat;//生成bat文件并调用
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

var qu:boolean;

{$R *.dfm}

//获取软件的版本号（该软件须在设计时在菜单Project的options里设置version info了才可获得，否则为空）

procedure TForm1.GetBuildInfo(FileName:string; var vs:string);
var VerInfoSize,VerValueSize,Dummy:DWORD;
    VerInfo: Pointer;
    VerValue: PVSFixedFileInfo;
    V1,V2,V3,V4:Word;
begin
  vs:='';
  if not FileExists(FileName) then exit;
  VerInfoSize:=GetFileVersionInfoSize(PChar(FileName),Dummy);
  if VerInfoSize=0 then exit;
  GetMem(VerInfo,VerInfoSize);
  if not GetFileVersionInfo(PChar(FileName),0,VerInfoSize,VerInfo) then exit;
  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  with VerValue^ do
  begin
    V1:=dwFileVersionMS shr 16;
    V2:=dwFileVersionMS and $FFFF;
    V3:=dwFileVersionLS shr 16;
    V4:=dwFileVersionLS and $FFFF;
    vs:=inttostr(v1)+'.'+inttostr(v2)+'.'+inttostr(v3)+'.'+inttostr(v4);
  end;
  FreeMem(VerInfo,VerInfoSize);
end;

procedure TForm1.Writefilebat;  //生成bat文件并调用
var f: TextFile;
    win_path,dos_path,tmp_path,exefilename,tmpfilename:string;
begin
  exefilename:=ExtractFileName(Application.ExeName);

  win_path:=ExtractFilePath(Application.ExeName);//获取当前程序的WINDOWS路径
  SetLength(tmp_path,MAX_PATH);
  GetShortPathName(PChar(win_path),PChar(tmp_path),MAX_PATH);
  dos_path:=StrPas(PChar(tmp_path));//获取当前程序的 DOS 路径
  tmpfilename:=dos_path+'updata\Project1.exe';
  AssignFile(F,dos_path+'Delself.bat'); //在当前位置建立 Delself.bat 文件
  Rewrite(F);

//以下是在Delself.bat文件追加dos指令：
  Writeln(F, '@ECHO OFF'); //运行时不显示
  Writeln(F, ':go');       //无条件转移标记
  Writeln(F, 'del '+dos_path+exefilename+'>nul');//删除旧版本程序
  Writeln(F, 'if exist "'+dos_path+exefilename+'" goto go');//等待exe程序结束，结束就删除exe文件
  Writeln(F, 'copy '+tmpfilename+' '+dos_path+exefilename);//把临时文件复制到程序运行的文件夹
//若临时文件就在当前位置且不再保留，则不用对上一句，改为：
//Writeln(F, 'ren '+tmpfilename+' '+dos_path+exefilename);//把临时文件把临时文件名字改为原来运行的名字
  Writeln(F, 'start '+dos_path+exefilename);//重新启动exe程序
  Writeln(F, 'del %0');//Delself.bat文件内容 //删除bat文件本身

  CloseFile(f);//对Delself.bat文件作覆盖性保存

  winexec(PChar(win_path+'Delself.bat'), SW_SHOWNORMAL);//执行Delself.bat
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.FormShow(Sender: TObject);
var version,newversion,serverfile:string;
begin
  GetBuildInfo(Application.ExeName,version);//获取自己的版本号
  StatusBar1.Panels[0].Text:='正在运行的版本是： '+version;

  serverfile:=ExtractFilePath(Application.ExeName)+'updata\'+ExtractFileName(Application.ExeName);//"服务器"上更新程序文件
  //确保"服务器"上有更新程序文件存在（这里假定"服务器"更新文件在当前下的updata文件夹中）
  if not fileexists(serverfile) then exit;

  GetBuildInfo(serverfile,newversion);//获取服务器上程序的版本号(若通过数据库等获知更新版本号，则不用这个函数)
  if version<>newversion then  //比较两版本号
  begin
    if MessageDlg('您当前运行的软件是旧的版本，要立即更新吗？',mtConfirmation,[mbYes, mbNo],0)=mrYes then
    begin
      qu:=true;  //设置要更新操作的标记
      close;
    end
    else
    begin
      showmessage('由于旧版本无法正常处理数据，程序结束。');
      close;
    end;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if qu then Writefilebat; //有标记则更新
end;

end.