Ignore:
Timestamp:
Nov 2, 2012, 12:11:21 PM (12 years ago)
Author:
chronos
Message:
  • Added: Custom new version info form with option to show release notes.
  • Fixed: Run setup with elevated privileges.
  • Added: Can read version info file from local filesystem.
  • Added: Demo application.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • UpdateChecker/UUpdateChecker.pas

    r404 r433  
    66
    77uses
    8   {$IFDEF Windows}Windows, ShellApi, {$ENDIF}Forms, Classes, SysUtils, httpsend, DOM, XMLWrite, XMLRead, UXMLUtils,
    9   FileUtil, Dialogs, Process, Blcksock, UFormDownloadProgress;
     8  {$IFDEF Windows}Windows, ShellApi, {$ENDIF}Forms, Classes, SysUtils,
     9  httpsend, DOM, XMLWrite, XMLRead, UXMLUtils,
     10  FileUtil, Dialogs, Process, Blcksock, UFormDownloadProgress, Controls;
    1011
    1112type
    … …  
    1819  end;
    1920
     21  TVersionInfoItem = (viiId, viiVersion, viiSourceURL, viiReleaseTime,
     22    viiReleaseNotes);
     23  TVersionInfoItems = set of TVersionInfoItem;
     24
    2025  { TUpdateChecker }
    2126
    … …  
    2328  private
    2429    FBranchId: Integer;
     30    FShowReleaseNotes: Boolean;
    2531    FVersionInfo: TVersionInfo;
    2632    HTTPSender: THTTPSend;
    2733    FOnTerminate: TNotifyEvent;
    2834    FVersionInfoURL: string;
     35    InstallerFileName: string;
    2936    function DownloadHTTP(URL, TargetFile: string): Boolean;
    30     function InstallerFileName: string;
    3137    function IsSystemAdmin: Boolean;
    3238    procedure SockStatus(Sender: TObject; Reason: THookSocketReason;
    33     const Value: String);
     39      const Value: String);
     40    function StripTags(XMLText: string): string;
     41    function GetFile(URI: string; Content: TMemoryStream): Boolean;
    3442  public
    3543    FormDownloadProgress: TFormDownloadProgress;
    3644    constructor Create(AOwner: TComponent); override;
    3745    destructor Destroy; override;
    38     function LoadVersionInfo: Boolean;
     46    function LoadVersionInfo(Items: TVersionInfoItems = []): Boolean;
    3947    { Download source file using HTTP protocol and save it to temp folder }
    4048    procedure Download;
    4149    procedure Install;
     50    procedure Check(CurrentReleaseDate: TDateTime);
    4251    property VersionInfo: TVersionInfo read FVersionInfo write FVersionInfo;
    4352  published
    4453    property VersionInfoURL: string read FVersionInfoURL write FVersionInfoURL;
    4554    property BranchId: Integer read FBranchId write FBranchId;
     55    property ShowReleaseNotes: Boolean read FShowReleaseNotes write FShowReleaseNotes;
    4656    property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
    4757  end;
    … …  
    5565  SFile = 'File:';
    5666  SProgress = 'Progress:';
     67  SYouHaveLatestVersion = 'You have latest version';
     68  SNewVersionAvailable = 'New version available: %s. Do you want to download and install it now?';
     69  SErrorCheckingNewVersion = 'New version check failed.';
     70  SCheckUpdates = 'Check updates';
     71  SChangesInNewVersion = 'Changes in new version:';
     72  SWhatsNew = 'What''s new?';
     73  SYes = 'Update';
     74  SNo = 'Later';
    5775
    5876implementation
     77
     78uses
     79  UFormNewVersionOffer;
    5980
    6081{$IFDEF Windows}
    … …  
    7293end;
    7394
     95function RunAsAdmin(const Handle: Hwnd; const Path, Params: string): Boolean;
     96var
     97  sei: TShellExecuteInfoA;
     98begin
     99  FillChar(sei, SizeOf(sei), 0);
     100  sei.cbSize := SizeOf(sei);
     101  sei.Wnd := Handle;
     102  sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
     103  sei.lpVerb := 'runas';
     104  sei.lpFile := PAnsiChar(Path);
     105  sei.lpParameters := PAnsiChar(Params);
     106  sei.nShow := SW_SHOWNORMAL;
     107  Result := ShellExecuteExA(@sei);
     108end;
     109
    74110{ TUpdateChecker }
    75111
    76 function TUpdateChecker.LoadVersionInfo: Boolean;
    77 var
    78   Content: string;
     112function TUpdateChecker.LoadVersionInfo(Items: TVersionInfoItems = []): Boolean;
     113var
    79114  URL: string;
    80115  XmlDocument: TXMLDocument;
    … …  
    82117  Node2: TDOMNode;
    83118  Node3: TDOMNode;
    84 begin
     119  Content: TMemoryStream;
     120begin
     121  Result := False;
    85122  FVersionInfo.Version := '';
    86123  FVersionInfo.Id := 0;
    87124  FVersionInfo.SourceURL := '';
    88   with HTTPSender do begin
    89     Clear;
    90     URL := VersionInfoURL + '?BranchId=' + IntToStr(BranchId) +
    91     '&Id&Version&SourceURL&ReleaseTime&Limit=1';
    92     if HTTPMethod('GET', URL) then begin
    93       Document.Position := 0;
     125  URL := VersionInfoURL;
     126  if Pos('://', VersionInfoURL) > 0 then begin
     127    URL := URL + '?BranchId=' + IntToStr(BranchId) +
     128    '&Limit=1';
     129    if viiVersion in Items then URL := URL + '&Version';
     130    if viiReleaseNotes in Items then URL := URL + '&ReleaseNotes';
     131    if viiReleaseTime in Items then URL := URL + '&ReleaseTime';
     132    if viiSourceURL in Items then URL := URL + '&SourceURL';
     133    if viiId in Items then URL := URL + '&Id';
     134  end;
     135  try
     136    Content := TMemoryStream.Create;
     137    if GetFile(URL, Content) then begin
    94138      try
    95       ReadXMLFile(XmlDocument, Document);
     139      ReadXMLFile(XmlDocument, Content);
    96140      if XmlDocument.DocumentElement.NodeName <> 'SourceList' then
    97141        raise Exception.Create(SWrongFileFormat);
    … …  
    112156          if Assigned(Node3) then
    113157            FVersionInfo.ReleaseTime := XMLTimeToDateTime(Node3.TextContent);
     158          Node3 := Node2.FindNode('ReleaseNotes');
     159          if Assigned(Node3) then
     160            FVersionInfo.ReleaseNotes := UTF8Encode(string(Node3.TextContent));
    114161          Node2 := Node2.NextSibling;
    115162        end;
    116163      end;
     164      Result := True;
    117165      finally
    118166        XmlDocument.Free;
    119167      end;
    120168    end;
    121   end;
    122   Result := (FVersionInfo.Version <> '') and (VersionInfo.Id <> 0) and
    123     (VersionInfo.SourceURL <> '');
     169  finally
     170    Content.Free;
     171  end;
    124172end;
    125173
    … …  
    127175begin
    128176  if FVersionInfo.SourceURL <> '' then begin
    129     HTTPSender.Clear;
    130     try
    131       FormDownloadProgress.Show;
    132       FormDownloadProgress.ProgressBar1.Max := 0;
    133       FormDownloadProgress.LabelFileName.Caption := VersionInfo.SourceURL;
    134       HTTPSender.Sock.OnStatus := SockStatus;
    135       if HTTPSender.HTTPMethod('GET', FVersionInfo.SourceURL) then
    136         HTTPSender.Document.SaveToFile(InstallerFileName);
    137     finally
    138       FormDownloadProgress.Hide;
    139       HTTPSender.Sock.OnStatus := nil;
     177    if FileExistsUTF8(FVersionInfo.SourceURL) then
     178      InstallerFileName := FVersionInfo.SourceURL
     179    else begin
     180      InstallerFileName := UTF8Encode(GetTempDir) + DirectorySeparator +
     181        ExtractFileName(FVersionInfo.SourceURL);
     182      HTTPSender.Clear;
     183      try
     184        FormDownloadProgress.Show;
     185        FormDownloadProgress.ProgressBar1.Max := 0;
     186        FormDownloadProgress.LabelFileName.Caption := VersionInfo.SourceURL;
     187        HTTPSender.Sock.OnStatus := SockStatus;
     188        if HTTPSender.HTTPMethod('GET', FVersionInfo.SourceURL) then
     189          HTTPSender.Document.SaveToFile(InstallerFileName);
     190      finally
     191        FormDownloadProgress.Hide;
     192        HTTPSender.Sock.OnStatus := nil;
     193      end;
    140194    end;
    141195  end;
    … …  
    147201begin
    148202  if FileExistsUTF8(InstallerFileName) then begin
    149     if not IsSystemAdmin then
    150       try
     203    if not IsSystemAdmin then begin
     204      RunAsAdmin(FormNewVersionOffer.Handle, InstallerFileName, '');
     205      (*try
    151206        Process := TProcess.Create(nil);
    152207        Process.CommandLine := 'runas ' + InstallerFileName;
    153208        Process.Options := Process.Options + [];
    154         Process.Execute;
     209        //Process.Execute;
    155210      finally
    156211        Process.Free;
    157       end
    158       //ShellExecute(0, PChar('runas'), PChar(InstallerFileName),
    159       //  0, 0, SW_SHOWNORMAL)
    160     else
     212      end*)
     213    end else
    161214    try
    162215      Process := TProcess.Create(nil);
    … …  
    171224end;
    172225
     226procedure TUpdateChecker.Check(CurrentReleaseDate: TDateTime);
     227begin
     228  if LoadVersionInfo([viiReleaseTime]) then begin
     229    if VersionInfo.ReleaseTime > CurrentReleaseDate then begin
     230      LoadVersionInfo([viiVersion, viiReleaseTime, viiReleaseNotes, viiSourceURL]);
     231      try
     232        FormNewVersionOffer := TFormNewVersionOffer.Create(nil);
     233        FormNewVersionOffer.LabelQuestion.Caption := Format(SNewVersionAvailable, [VersionInfo.Version]);
     234        FormNewVersionOffer.MemoReleaseNotes.Lines.Text := Trim(StripTags(VersionInfo.ReleaseNotes));
     235        if ShowReleaseNotes then FormNewVersionOffer.BitBtnWhatsNew.Click;
     236        if FormNewVersionOffer.ShowModal = mrYes then begin
     237          Download;
     238          Install;
     239        end;
     240      finally
     241        FormNewVersionOffer.Free;
     242      end;
     243    end else ShowMessage(SYouHaveLatestVersion);
     244  end else ShowMessage(SErrorCheckingNewVersion);
     245end;
     246
    173247function TUpdateChecker.DownloadHTTP(URL, TargetFile: string): Boolean;
    174248// Download file; retry if necessary.
    … …  
    180254var
    181255  HTTPGetResult: Boolean;
    182   HTTPSender: THTTPSend;
    183256  RetryAttempt: Integer;
    184257begin
    … …  
    221294end;
    222295
    223 function TUpdateChecker.InstallerFileName: string;
    224 begin
    225   Result := UTF8Encode(GetTempDir) + DirectorySeparator +
    226     ExtractFileName(FVersionInfo.SourceURL);
    227 end;
    228 
    229296constructor TUpdateChecker.Create(AOwner: TComponent);
    230297begin
    … …  
    260327  end;
    261328
    262 
    263329  if bSuccess then
    264330  begin
    … …  
    299365  Num: Integer;
    300366begin
    301   if (Reason = HR_SocketCreate) then begin
     367  if (Reason = HR_SocketCreate) and TryStrToInt(Value, Num) then begin
    302368    FormDownloadProgress.ProgressBar1.Position := Num;
    303369    Application.ProcessMessages;
    … …  
    315381end;
    316382
     383function TUpdateChecker.StripTags(XMLText: string): string;
     384begin
     385  Result := '';
     386  while Pos('<', XMLText) > 0 do begin
     387    Result := Result + Copy(XMLText, 1, Pos('<', XMLText) - 1);
     388    Delete(XMLText, 1, Pos('<', XMLText));
     389    Delete(XMLText, 1, Pos('>', XMLText));
     390  end;
     391  Result := Result + XMLText;
     392end;
     393
     394function TUpdateChecker.GetFile(URI: string; Content: TMemoryStream): Boolean;
     395var
     396  Buffer: array of Byte;
     397  FileStream: TFileStream;
     398begin
     399  Result := False;
     400  Content.Size := 0;
     401  if FileExistsUTF8(URI) then
     402  try
     403    FileStream := TFileStream.Create(URI, fmOpenRead);
     404    Content.CopyFrom(FileStream, FileStream.Size);
     405    Content.Position := 0;
     406    Result := True;
     407  finally
     408    FileStream.Free;
     409  end else
     410  if (Copy(URI, 1, 7) = 'http://') or (Copy(URI, 1, 8) = 'https://') then
     411  with THTTPSend.Create do
     412  try
     413    Clear;
     414    if HTTPMethod('GET', URI) then begin
     415      Document.Position := 0;
     416      Content.CopyFrom(Document, Document.Size);
     417      Content.Position := 0;
     418      Result := True;
     419    end;
     420  finally
     421    Free;
     422  end;
     423end;
     424
    317425end.
    318426
Note: See TracChangeset for help on using the changeset viewer.