Delphi做的软件自动更新
2009-04-03 11:23
162 查看
自己整理做的delphi自动更新程序,关键技术要感谢僵哥提供的获取版本号功能和startluck提供的批处理删除自身的功能,以及在网上查找资料所不能列举的各位好朋友!(本文章仅作为自己备忘所用)
unit UnitUpG;
interface
uses
Forms,
Windows,
SysUtils,
Classes,
Controls,
URLMON,
SHellAPi,
iniFiles,
Tlhelp32;
procedure UpGrade;
procedure KillExe;
var
SName:String;
UpGradeB:Boolean;
type
TLANGANDCODEPAGE=record
wLanguage,wCodePage:Word;
end;
PLANGANDCODEPAGE=^TLANGANDCODEPAGE;
type
TUpDateThread=class(TThread)
protected
procedure Execute;override;
end;
implementation
uses UNIT1;
function ShowVersion:String;
var
VerInfo:PChar;
lpTranslate:PLANGANDCODEPAGE;
FileName:String;
VerInfoSize,cbTranslate:DWORD;
VerValueSize:DWORD;
Data:String;
VerFileV:PChar;
lpFileVersion:string;
begin
Result:='0.0.0.0';
FileName:=Application.ExeName;
VerInfoSize:=GetFileVersionInfoSize(PChar(FileName),VerInfoSize);
if VerInfoSize>0 then
begin
VerInfo:=AllocMem(VerInfoSize);
GetFileVersionInfo(PChar(FileName),0,VerInfoSize,VerInfo);
VerQueryValue(VerInfo, PChar('/VarFileInfo/Translation'), Pointer(lpTranslate),cbTranslate);
if cbTranslate<>0 then
begin
Data := format('/StringFileInfo/%.4x%.4x/FileVersion',[lpTranslate^.wLanguage,lpTranslate^.wCodePage]);
VerQueryValue(VerInfo, PAnsiChar(data),Pointer(VerFileV), VerValueSize);
if VerValueSize <> 0 then
begin
SetString(lpFileVersion,VerFileV,VerValueSize-1);
Result:=lpFileVersion;
end;
end;
FreeMem(VerInfo,VerInfoSize);
end
else begin
Result:='0.0.0.0';
Application.MessageBox('獲取文件版本信息時遇到致命錯誤,請重新打開軟件。','錯誤',MB_OK+MB_ICONSTOP);
Application.Terminate;
end;
end;
function KillTask(ExeFileName:string):integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOLean;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result :=0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE,BOOL(0),
FProcessEntry32.th32ProcessID),0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
procedure TUpDateThread.Execute;
var
FindUD:Boolean;
inifile:TiniFile;
i,Num:integer;
DownFile,FSaveFile:String;
Name,Path,CliVersion,SerVersion:String;
begin
FindUD:=False;
inifile:=TiniFile.Create(ExtractFilePath(Application.ExeName)+'UpDate.ini');
Num:=StrToInt(inifile.ReadString('Program Number','Num',''));
for i:=1 to Num do
begin
Name:=inifile.ReadString('session'+inttostr(i),'Name','');
Path:=inifile.ReadString('session'+inttostr(i),'Path','');
SerVersion:=inifile.ReadString('session'+inttostr(i),'Version','');
CliVersion:=ShowVersion;
if (Name=ExtractFileName(Application.ExeName)) and (CliVersion<>SerVersion) then
begin
FindUD:=True;
DownFile:=Path+Name;
SName:=DownFile;
FSaveFile:=Application.ExeName;
break;
end;
end;
try
DeleteFile(ExtractFilePath(Application.ExeName)+Name+'.old');
except
On E:Exception do
Application.MessageBox('刪除舊版本失敗!','Error',MB_OK);
end;
if FindUD then
begin
if Application.MessageBox('發現一個新版本的軟件,是否更新軟件?','軟件更新',MB_OKCancel)=mrOK then
begin
if Application.MessageBox('請選擇更新軟件的時間!現在更新點''yes'',關閉軟件時更新點''No''','軟件更新',MB_YESNO)=mrYes then
begin
Application.MessageBox('軟件更新期間請停止對軟件的操作,更新成功會自動重新打開程序!','軟件更新',MB_OK);
Application.ProcessMessages;
Screen.Cursor:=crHourGlass;
try
ReNameFile(FSaveFile,FSaveFile+'.old');
except
On E:Exception do
Application.MessageBox('拷貝文件副本失敗!','Error',MB_OK);
end;
try
URLDownloadToFile(nil,PAnsiChar(DownFile),PAnsiChar(FSaveFile),0,nil);
ShellExecute(0, 'open', PChar(Name),PChar(ExtractFilePath(Application.ExeName)), nil, SW_SHOWNORMAL);
KillTask(ExtractFileName(Application.ExeName));
except
On E:Exception do
begin
ReNameFile(FSaveFile+'.old',FSaveFile);
Application.MessageBox('下載失敗!','Error',MB_OK);
Screen.Cursor:=crDefault;
end;
end;
end
else begin
UpGradeB:=True;
end;
end;
end;
iniFile.Free;
end;
procedure KillExe;
var
BatchFile: TextFile;
BatchFileName: string;
ProcessInfo: TProcessInformation;
StartUpInfo: TStartupInfo;
begin
BatchFileName := ExtractFilePath(ParamStr(0)) + '_KillExe.bat';
AssignFile(BatchFile, BatchFileName);
Rewrite(BatchFile);
Writeln(BatchFile, 'del "' + ParamStr(0) + '.old"');
Writeln(BatchFile,
'if exist "' + ParamStr(0) + '.old"' + ' goto try');
Writeln(BatchFile, 'del %0');
CloseFile(BatchFile);
FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
StartUpInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(BatchFileName), nil, nil,
False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
ProcessInfo) then
begin
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
end;
procedure UpGrade;
var
FSaveFile,DownFile:String;
begin
if UpGradeB then
begin
DownFile:=SName;
FSaveFile:=Application.ExeName;
Application.MessageBox('軟件更新期間請停止對軟件的操作!','軟件更新',mb_OK);
Application.ProcessMessages;
Screen.Cursor:=crHourGlass;
try
DeleteFile(FSaveFile+'.old');
except
On E:Exception do
Application.MessageBox('刪除舊軟件失敗!','軟件更新',mb_OK);
end;
try
ReNameFile(FSaveFile,FSaveFile+'.old');
except
On E:Exception do
Application.MessageBox('拷貝文件副本失敗!','Error',mb_OK);
end;
try
URLDownloadToFile(nil,PAnsiChar(DownFile),PAnsiChar(FSaveFile),0,nil);
Screen.Cursor:=crdefault;
Application.MessageBox('軟件更新成功!','軟件更新',mb_OK);
except
On E:Exception do
begin
ReNameFile(FSaveFile+'.old',FSaveFile);
Application.MessageBox('更新軟件失敗,原軟件將恢復!','Error',mb_OK);
end;
end;
try
KillExe;
except
On E:Exception do
begin
Application.MessageBox('刪除舊軟件失敗!','Error',mb_OK);
end;
end;
end;
end;
end.
unit UnitUpG;
interface
uses
Forms,
Windows,
SysUtils,
Classes,
Controls,
URLMON,
SHellAPi,
iniFiles,
Tlhelp32;
procedure UpGrade;
procedure KillExe;
var
SName:String;
UpGradeB:Boolean;
type
TLANGANDCODEPAGE=record
wLanguage,wCodePage:Word;
end;
PLANGANDCODEPAGE=^TLANGANDCODEPAGE;
type
TUpDateThread=class(TThread)
protected
procedure Execute;override;
end;
implementation
uses UNIT1;
function ShowVersion:String;
var
VerInfo:PChar;
lpTranslate:PLANGANDCODEPAGE;
FileName:String;
VerInfoSize,cbTranslate:DWORD;
VerValueSize:DWORD;
Data:String;
VerFileV:PChar;
lpFileVersion:string;
begin
Result:='0.0.0.0';
FileName:=Application.ExeName;
VerInfoSize:=GetFileVersionInfoSize(PChar(FileName),VerInfoSize);
if VerInfoSize>0 then
begin
VerInfo:=AllocMem(VerInfoSize);
GetFileVersionInfo(PChar(FileName),0,VerInfoSize,VerInfo);
VerQueryValue(VerInfo, PChar('/VarFileInfo/Translation'), Pointer(lpTranslate),cbTranslate);
if cbTranslate<>0 then
begin
Data := format('/StringFileInfo/%.4x%.4x/FileVersion',[lpTranslate^.wLanguage,lpTranslate^.wCodePage]);
VerQueryValue(VerInfo, PAnsiChar(data),Pointer(VerFileV), VerValueSize);
if VerValueSize <> 0 then
begin
SetString(lpFileVersion,VerFileV,VerValueSize-1);
Result:=lpFileVersion;
end;
end;
FreeMem(VerInfo,VerInfoSize);
end
else begin
Result:='0.0.0.0';
Application.MessageBox('獲取文件版本信息時遇到致命錯誤,請重新打開軟件。','錯誤',MB_OK+MB_ICONSTOP);
Application.Terminate;
end;
end;
function KillTask(ExeFileName:string):integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOLean;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
Result :=0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE,BOOL(0),
FProcessEntry32.th32ProcessID),0));
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
CloseHandle(FSnapshotHandle);
end;
procedure TUpDateThread.Execute;
var
FindUD:Boolean;
inifile:TiniFile;
i,Num:integer;
DownFile,FSaveFile:String;
Name,Path,CliVersion,SerVersion:String;
begin
FindUD:=False;
inifile:=TiniFile.Create(ExtractFilePath(Application.ExeName)+'UpDate.ini');
Num:=StrToInt(inifile.ReadString('Program Number','Num',''));
for i:=1 to Num do
begin
Name:=inifile.ReadString('session'+inttostr(i),'Name','');
Path:=inifile.ReadString('session'+inttostr(i),'Path','');
SerVersion:=inifile.ReadString('session'+inttostr(i),'Version','');
CliVersion:=ShowVersion;
if (Name=ExtractFileName(Application.ExeName)) and (CliVersion<>SerVersion) then
begin
FindUD:=True;
DownFile:=Path+Name;
SName:=DownFile;
FSaveFile:=Application.ExeName;
break;
end;
end;
try
DeleteFile(ExtractFilePath(Application.ExeName)+Name+'.old');
except
On E:Exception do
Application.MessageBox('刪除舊版本失敗!','Error',MB_OK);
end;
if FindUD then
begin
if Application.MessageBox('發現一個新版本的軟件,是否更新軟件?','軟件更新',MB_OKCancel)=mrOK then
begin
if Application.MessageBox('請選擇更新軟件的時間!現在更新點''yes'',關閉軟件時更新點''No''','軟件更新',MB_YESNO)=mrYes then
begin
Application.MessageBox('軟件更新期間請停止對軟件的操作,更新成功會自動重新打開程序!','軟件更新',MB_OK);
Application.ProcessMessages;
Screen.Cursor:=crHourGlass;
try
ReNameFile(FSaveFile,FSaveFile+'.old');
except
On E:Exception do
Application.MessageBox('拷貝文件副本失敗!','Error',MB_OK);
end;
try
URLDownloadToFile(nil,PAnsiChar(DownFile),PAnsiChar(FSaveFile),0,nil);
ShellExecute(0, 'open', PChar(Name),PChar(ExtractFilePath(Application.ExeName)), nil, SW_SHOWNORMAL);
KillTask(ExtractFileName(Application.ExeName));
except
On E:Exception do
begin
ReNameFile(FSaveFile+'.old',FSaveFile);
Application.MessageBox('下載失敗!','Error',MB_OK);
Screen.Cursor:=crDefault;
end;
end;
end
else begin
UpGradeB:=True;
end;
end;
end;
iniFile.Free;
end;
procedure KillExe;
var
BatchFile: TextFile;
BatchFileName: string;
ProcessInfo: TProcessInformation;
StartUpInfo: TStartupInfo;
begin
BatchFileName := ExtractFilePath(ParamStr(0)) + '_KillExe.bat';
AssignFile(BatchFile, BatchFileName);
Rewrite(BatchFile);
Writeln(BatchFile, 'del "' + ParamStr(0) + '.old"');
Writeln(BatchFile,
'if exist "' + ParamStr(0) + '.old"' + ' goto try');
Writeln(BatchFile, 'del %0');
CloseFile(BatchFile);
FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
StartUpInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(BatchFileName), nil, nil,
False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
ProcessInfo) then
begin
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
end;
procedure UpGrade;
var
FSaveFile,DownFile:String;
begin
if UpGradeB then
begin
DownFile:=SName;
FSaveFile:=Application.ExeName;
Application.MessageBox('軟件更新期間請停止對軟件的操作!','軟件更新',mb_OK);
Application.ProcessMessages;
Screen.Cursor:=crHourGlass;
try
DeleteFile(FSaveFile+'.old');
except
On E:Exception do
Application.MessageBox('刪除舊軟件失敗!','軟件更新',mb_OK);
end;
try
ReNameFile(FSaveFile,FSaveFile+'.old');
except
On E:Exception do
Application.MessageBox('拷貝文件副本失敗!','Error',mb_OK);
end;
try
URLDownloadToFile(nil,PAnsiChar(DownFile),PAnsiChar(FSaveFile),0,nil);
Screen.Cursor:=crdefault;
Application.MessageBox('軟件更新成功!','軟件更新',mb_OK);
except
On E:Exception do
begin
ReNameFile(FSaveFile+'.old',FSaveFile);
Application.MessageBox('更新軟件失敗,原軟件將恢復!','Error',mb_OK);
end;
end;
try
KillExe;
except
On E:Exception do
begin
Application.MessageBox('刪除舊軟件失敗!','Error',mb_OK);
end;
end;
end;
end;
end.
相关文章推荐
- Delphi实现软件自动更新源代码
- Delphi做的软件自动更新
- Delphi + IIS + VbScript(*.asp) 实现多线上传下载和软件自动更新.
- Android软件的自动更新
- linux让软件停止自动更新
- Android 软件自动更新功能的实现
- AntiVir个人版本,来自德国的免费杀毒软件.可以查杀超过50000种病毒,在很多的期刊的测评中都名列前茅,支持网络自动更新.AntiVir Personal Edition 7.0 (6.34.00.154)
- android开发进行自动更新时怎么下载软件到手机内存,显示实现下载到SD卡了
- 采用C#实现软件自动更新的方法
- (转)Android 软件自动更新功能的实现
- Android中的软件的自动更新(包括静默更新,需Root权限)
- DELPHI 2010自动更新问题
- 软件的自动更新实现
- Delphi自动获取软件版本信息的类
- 用C#开发软件自动更新程序
- 关闭WIN10的UAC/自动更新/杀毒软件(兼容WIN7/8/8.1)
- Android中实现软件检测更新和自动安装
- C++实现软件自动更新功能
- 利用webservice实现软件自动更新(auto update)
- SUS 实现软件自动更新!