Autoupgrade

最新推荐文章于 2024-09-19 07:01:40 发布

hiyaolee

最新推荐文章于 2024-09-19 07:01:40 发布

阅读量2k

点赞数

分类专栏： Delphi 文章标签： string integer function destructor constructor download

本文链接：https://blog.csdn.net/hiyaolee/article/details/423784

版权

Delphi 专栏收录该内容

35 篇文章 0 订阅

订阅专栏

{-----------------------------------------------------------------------------
Unit Name: AutoUpgrade
Author: Martin
Purpose:Auto upgrade your system.
ChangeDate : 2005/03/09
Describe and License :You may Copy and Change it ,but you must Copy it to
hiyaolee@hotmail.com.
-----------------------------------------------------------------------------}

unit AutoUpgrade;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, StrUtils, IniFiles, ShellApi, IdGlobal,
TLHelp32, Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, ExtCtrls, IdHTTP, DateUtils;

type
TAutoUpgrade = class(TComponent)
private
    TimeWillDo: TTimer;
    Http_Get: TIdHTTP;
    StrHttpUrl: string;
    StrServerIni: string;
    bPureIniMode: Boolean;
    iInterval: Integer;
    AppExe: string;
    bUpdateReStart: Boolean;
    bAllowLogs: Boolean;
    bQuiet: Boolean;
    bRunning: Boolean;

    function GetValue(var Src: string): Integer;
    procedure DoUpGrade(Sender: TObject);
    procedure WriteLog(Str: string);
protected
    function CompStr(Src, Dst: string): Boolean;
    function GetVersion(const StrFileName: string): string;
    function GetOldVer(iniFile, StrSection, StrFile: string): string;
    procedure DeleteOldRunFiles;
    procedure SetExecute(const Value: Boolean);
public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure StartDoUpGrade;
    property ExecuteDo: Boolean write SetExecute;
    function Kill_Task(ExeFileName: string): integer;
published
    property TimeInterval: Integer read iInterval write iInterval default 2500;
    property HttpUrl: string read StrHttpUrl write StrHttpUrl;
    property ServerIni: string read StrServerIni write StrServerIni;
    property PureIniMode: Boolean read bPureIniMode write bPureIniMode;
    property UpdateReStart: Boolean read bUpdateReStart write bUpdateReStart default false;
    property AllowLogs: Boolean read bAllowLogs write bAllowLogs default True;
    property QuietUpgrade: Boolean read bQuiet write bQuiet default False;
end;

const
TrashRunFiles: string = 'update/TrashFiles.Ini';

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Upgrade', [TAutoUpgrade]);
end;

{ TAutoUpgrade }

constructor TAutoUpgrade.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
if TimeWillDo <> nil then
FreeAndNil(TimeWillDo);
if Http_Get <> nil then
FreeAndNil(Http_Get);
HttpUrl := 'http://192.168.11.192/autoupgrade/';
ServerIni := 'update.Ini';
AppExe := Application.ExeName;
PureIniMode := True;
TimeWillDo := TTimer.Create(Self);
TimeWillDo.Interval := 2500;
TimeWillDo.OnTimer := DoUpGrade;
SetExecute(False);
{$I-}
CreateDir(ExtractFilePath(AppExe) + 'Update');
{$I+}
Http_Get := TIdHTTP.Create(Self);
Http_Get.Port := 80;
bRunning := False;
end;

destructor TAutoUpgrade.Destroy;
begin
if TimeWillDo <> nil then
FreeAndNil(TimeWillDo);
if Http_Get <> nil then
FreeAndNil(Http_Get);
inherited;
end;

function TAutoUpgrade.CompStr(Src, Dst: string): Boolean;
var
i: Integer;
StrSrc: string;
StrDst: string;
iSrc, iDst: integer;
begin
//xxxx.xxxx.xxxx.xxxx
//x.x.x.x
Result := False;
StrSrc := Src;
StrDst := Dst;
for i := 0 to 3 do
begin
    iSrc := GetValue(StrSrc);
    iDst := GetValue(StrDst);
    if iSrc > IDst then
    begin
      Result := True;
      Break;
    end;
end;
end;

function TAutoUpgrade.GetValue(var Src: string): Integer;
begin
Result := 0;
if pos('.', Src) > 0 then
begin
    Result := StrToIntDef(Copy(Src, 0, pos('.', Src) - 1), 0);
    Src := Copy(Src, pos('.', Src) + 1, Length(Src) - pos('.', Src));
end else
begin
    Result := StrToIntDef(Src, 0);
end;
end;

procedure TAutoUpgrade.SetExecute(const Value: Boolean);
begin
TimeWillDo.Enabled := Value;
end;

procedure TAutoUpgrade.StartDoUpGrade;
var
Url: string;
IniDirs: TStrings;
FileList: TStrings;
StrPath, StrFile: string;
IniFile, IniTrash, IniUpdateOk: TIniFile;
MsStream: TMemoryStream;
i, k: Integer;
StrNewVer, StrOldVer: string;
bTernal, bUpgrade: Boolean; //bTernal:Don't agree upgrade;bupgrade:agree upgrade
bMoveFail: Boolean;
GetNewFile: Boolean;
CurCursor: TCursor;
StrAtTime: string;
begin
TimeWillDo.Enabled := False;
DeleteOldRunFiles;
TimeWillDo.Interval := TimeInterval;

if bRunning then Exit;
bRunning := True;

Url := HttpUrl + ServerIni;

StrPath := ExtractFilePath(application.ExeName);

MsStream := TMemoryStream.Create;
WriteLog('Begin checking version....');

try
    Http_Get.Get(url, MsStream);
    MsStream.SaveToFile(StrPath + 'Update/NewUpdate.ini');
    WriteLog('Download:' + StrPath + 'Update/NewUpdate.ini');
except
    TimeWillDo.Enabled := True;
    FreeAndNil(MsStream);
    bRunning := False;
    WriteLog('End checking version....');
    Exit;
end;
FreeAndNil(MsStream);

IniDirs := TStringlist.Create;
FileList := TStringList.Create;
IniDirs.Clear;
IniFile := TIniFile.Create(StrPath + 'update/NewUpdate.ini');
IniFile.ReadSections(IniDirs);
bTernal := False;
bUpgrade := False;
bMoveFail := false;
CurCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
MsStream := TMemoryStream.Create;

for i := 0 to IniDirs.Count - 1 do
begin
FileList.Clear;
IniFile.ReadSection(IniDirs[i], FileList);

    for k := 0 to FileList.Count - 1 do
    begin
      StrFile := StrPath + IniDirs[i] + '/' + FileList[k];
      StrNewVer := IniFile.ReadString(IniDirs[i], FileList[k], '1.0.0.0');
      if PureIniMode then //The Exe,Dll File No Version info
        StrOldVer := GetOldVer(StrPath + 'update/Update.ini', IniDirs[i], FileList[k])
      else
        StrOldVer := GetVersion(StrFile);
      if not CompStr(StrNewVer, StrOldVer) then Continue;

      if not bUpgrade then
      begin
        if not QuietUpgrade then
        begin
          if Application.MessageBox('发现新的更新程序，现在就升级吗？', '提示', MB_YESNO + MB_ICONQUESTION) = IDNO then
          begin
            bTernal := True;
            Break;
          end else
          begin
            bUpgrade := True;
          end;
        end else
        begin
          bUpgrade := True;
        end;
      end;
      GetNewFile := False;
      MsStream.Clear;
      try
        Http_Get.Get(HttpUrl + IniDirs[i] + '/' + FileList[k], MsStream);
        MsStream.SaveToFile(StrPath + 'update/' + FileList[k]);
        GetNewFile := True;
        WriteLog('Download:' + HttpUrl + IniDirs[i] + '/' + FileList[k] + ' Ok');
      except
        GetNewFile := False;
        WriteLog('Download fail:' + HttpUrl + IniDirs[i] + '/' + FileList[k] + ',May be HTTP server not support the file extension');
      end;

Application.ProcessMessages;

      if not DirectoryExists(StrPath + IniDirs[i]) then
      begin
{$I-}
        CreateDir(StrPath + IniDirs[i]);
{$I+}
      end;

      if GetNewFile then
      begin
        WriteLog('Move:' + StrPath + 'update/' + FileList[k] + '==>>' + StrPath + IniDirs[i] + '/' + FileList[k]);
        if FileExists(StrPath + 'update/' + FileList[k]) then
        begin
          if MoveFileEx(pchar(StrPath + 'update/' + FileList[k]), pchar(StrPath + IniDirs[i] + '/' + FileList[k]), MOVEFILE_REPLACE_EXISTING) = False then
          begin
            bMoveFail := true;
            StrAtTime := IntToStr(GetTickCount);
            IniTrash := TIniFile.Create(StrPath + TrashRunFiles);
            IniTrash.WriteString('TrashFiles', FileList[k], IniDirs[i] + '/' + Copy(FileList[k], 0, pos('.', FileList[k])) + StrAtTime);
            FreeAndNil(IniTrash);
            WriteLog('Trashes:' + FileList[k] + ' ' + IniDirs[i] + '/' + Copy(FileList[k], 0, pos('.', FileList[k])) + StrAtTime);
            MoveFile(pchar(StrPath + IniDirs[i] + '/' + FileList[k]), pchar(IniDirs[i] + '/' + Copy(FileList[k], 0, pos('.', FileList[k])) + StrAtTime));
            WriteLog('Renname:' + StrPath + IniDirs[i] + '/' + FileList[k] + '==>>' + IniDirs[i] + '/' + Copy(FileList[k], 0, pos('.', FileList[k])) + StrAtTime);
            MoveFile(pchar(StrPath + 'update/' + FileList[k]), pchar(StrPath + IniDirs[i] + '/' + FileList[k]));
            WriteLog('Move:' + StrPath + 'update/' + FileList[k] + '==>>' + StrPath + IniDirs[i] + '/' + FileList[k]);
          end;
          IniUpdateOk := TIniFile.Create(StrPath + 'update/Update.ini');
          IniUpdateOk.WriteString(IniDirs[i], FileList[k], StrNewVer);
          FreeAndNil(IniUpdateOk);
        end;
      end;
    end;

if bTernal then
Break;
end;

FreeAndNil(MsStream);
FreeAndNil(IniDirs);
FreeAndNil(FileList);
FreeAndNil(IniFile);

Screen.Cursor := CurCursor;
if bUpgrade then
begin
    Windows.DeleteFile(pchar(StrPath + 'update/NewUpdate.Ini'));
    WriteLog('Remove:' + StrPath + 'update/NewUpdate.Ini');
    if UpdateReStart then
    begin
      if not QuietUpgrade then
        if bMoveFail then
        begin
          if Application.MessageBox('应用程序升级成功,需要重启应用程序吗?', '提示', MB_YESNO + MB_ICONQUESTION) = IDYES then
          begin
            if TimeWillDo <> nil then
              FreeAndNil(TimeWillDo);
            if Http_Get <> nil then
              FreeAndNil(Http_Get);
            WriteLog('update OK!');
            WriteLog('End checking version....');
            ShellExecute(Application.Handle, 'open', pchar(AppExe), pchar(''), pchar(StrPath), SW_SHOWNORMAL);
            Application.Terminate;
          end;
        end else
        begin
          Application.MessageBox('应用程序升级成功！', '提示', MB_OK);
        end;
    end;
    if not UpdateReStart then
      if not QuietUpgrade then
        Application.MessageBox('程序升级成功,请稍后重新启动运行！', '提示', MB_OK);
    WriteLog('update OK!');
end;

TimeWillDo.Enabled := True;
bRunning := False;

WriteLog('End checking version....');
end;

function TAutoUpgrade.GetVersion(const StrFileName: string): string;
type
PFixedFileInfo = ^TFixedFileInfo;
TFixedFileInfo = record
    dwSignature: DWORD;
    dwStrucVersion: DWORD;
    wFileVersionMS: WORD; //minor version
    wFileVersionLS: WORD; //major version
    wProductVersionMS: WORD; //build
    wProductVersionLS: WORD; //release
    dwFileFlagsMask: DWORD;
    dwFileFlags: DWORD;
    dwFileOS: DWORD;
    dwFileType: DWORD;
    dwFileSubtype: DWORD;
    dwFileDateMS: DWORD;
    dwFileDateLS: DWORD;
end;
var
dwHandle, dwVersionSize: DWORD;
strSubBlock: string;
pTemp: Pointer;
pData: Pointer;
FileInfo: TFixedFileInfo;
begin
if not FileExists(StrFileName) then
begin
    Result := '0.0.0.0';
    Exit;
end;

strSubBlock := '/';
FileInfo.wFileVersionMS := 0;
FileInfo.wFileVersionLS := 0;
FileInfo.wProductVersionMS := 0;
FileInfo.wProductVersionLS := 0;
dwVersionSize := GetFileVersionInfoSize(PChar(StrFileName), dwHandle);
if dwVersionSize <> 0 then
begin
    GetMem(pTemp, dwVersionSize);
    try
      if GetFileVersionInfo(PChar(StrFileName), dwHandle, dwVersionSize, pTemp) then
        if VerQueryValue(pTemp, PChar(strSubBlock), pData, dwVersionSize) then
          FileInfo := PFixedFileInfo(pData)^;
    finally
      FreeMem(pTemp);
    end;
end;
Result := IntToStr(FileInfo.wFileVersionLS) + '.' + IntToStr(FileInfo.wFileVersionMS)
    + '.' + IntToStr(FileInfo.wProductVersionLS) + '.' + IntToStr(FileInfo.wProductVersionMS);
end;

procedure TAutoUpgrade.DeleteOldRunFiles;
var
IniFile: TIniFile;
StrKeys: TStrings;
i: Integer;
StrFile: string;
StrPath: string;
begin
if not FileExists(ExtractFilePath(Application.ExeName) + TrashRunFiles) then Exit;
StrPath := ExtractFilePath(application.ExeName);
StrKeys := TStringList.Create;
IniFile := TIniFile.Create(TrashRunFiles);
IniFile.ReadSection('TrashFiles', StrKeys);
for i := 0 to StrKeys.Count - 1 do
begin
    StrFile := IniFile.ReadString('TrashFiles', StrKeys[i], '');
    if FileExists(StrPath + 'update/' + StrKeys[i]) then
    begin
      if MoveFileEx(pchar(StrPath + 'update/' + StrKeys[i]), pchar(ExtractFilePath(StrPath + StrFile) + StrKeys[i]), MOVEFILE_REPLACE_EXISTING) then
      begin
        WriteLog('Last Move:' + StrPath + 'update/' + StrKeys[i] + '==>>' + ExtractFilePath(StrPath + StrFile) + StrKeys[i]);
        IniFile.DeleteKey('TrashFiles', StrKeys[i]);
        WriteLog('Remove:' + StrPath + StrFile);
      end;
    end else
      if FileExists(StrPath + StrFile) then
        if Windows.DeleteFile(pchar(StrPath + StrFile)) then
        begin
          IniFile.DeleteKey('TrashFiles', StrKeys[i]);
          WriteLog('Remove:' + StrPath + StrFile);
        end;
end;
FreeAndNil(IniFile);
FreeAndNil(StrKeys);
end;

function TAutoUpgrade.GetOldVer(iniFile, StrSection, StrFile: string): string;
var
IniFilex: TIniFile;
begin
Result := '0.0.0.0';
IniFilex := TIniFile.Create(iniFile);
if IniFilex.SectionExists(StrSection) then
Result := IniFilex.ReadString(StrSection, StrFile, '0.0.0.0');
FreeAndNil(IniFilex);
end;

procedure TAutoUpgrade.WriteLog(Str: string);
var
F: TextFile;
begin
{I-}
AssignFile(F, ExtractFilePath(Application.ExeName) + 'update/update.log');
if FileExists(ExtractFilePath(Application.ExeName) + 'update/update.log') then
begin
    if FileSizeByName(ExtractFilePath(Application.ExeName) + 'update/update.log') > 1024 * 50 then
      ReWrite(F);
end else
    ReWrite(F);
Append(F);
Writeln(F, FormatDateTime('yyyy/MM/dd hh:mm:ss ', Now) + Str);
writeln(F, '');
CloseFile(F);
{I+}
end;

function TAutoUpgrade.Kill_Task(ExeFileName: string): integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
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;
end;

procedure TAutoUpgrade.DoUpGrade(Sender: TObject);
begin
if not bRunning then
StartDoUpGrade;
end;

end.

{
;调用方法及INI文件格式
;方法1:
; mesupdate := TAutoUpgrade.Create(Application);
; mesupdate.HttpUrl := 'http://192.168.11.192/mesupdate/';
; mesupdate.ServerIni := 'update.ini';
; MesUpdate.ExecuteDo := true;
; mesupdate.TimeInterval := 60*60*1000;
;方法2:
;界面上放置组件
;FormCreate时,MesUpdate.ExecuteDo := true
;
update.ini说明:
[.]
MESMainProject.exe=1.0.0.1

[system]
MESMainProject.exe=1.0.0.1

[system/help]
MESMainProject.exe=1.0.0.1

;[system/dat]

;[system/dat/backup]

}