Autoupgrade

{-----------------------------------------------------------------------------
 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
           [e-mail].
-----------------------------------------------------------------------------}

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]

}