//注:本源码由中国软件研发联盟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.