Changeset 433


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.
Location:
UpdateChecker
Files:
14 added
1 deleted
9 edited

Legend:

Unmodified
Added
Removed

  • UpdateChecker/Languages/UUpdateChecker.cs.po

    r379 r433  
    99"MIME-Version: 1.0\n"
    1010"Content-Transfer-Encoding: 8bit\n"
     11"X-Generator: Poedit 1.5.4\n"
    1112
    1213#: uupdatechecker.scantexecutefile
    … …  
    1415msgstr "Nelze spustit instalátor \"%s\""
    1516
     17#: uupdatechecker.schangesinnewversion
     18#| msgid "Changes in new version"
     19msgid "Changes in new version:"
     20msgstr "Změny v nové verzi:"
     21
     22#: uupdatechecker.scheckupdates
     23msgid "Check updates"
     24msgstr "Kontrola aktualizací"
     25
    1626#: uupdatechecker.sdownloadprogress
    1727msgid "Download progress"
    1828msgstr "Průběh stahování"
     29
     30#: uupdatechecker.serrorcheckingnewversion
     31msgid "New version check failed."
     32msgstr "Kontrola nové verze selhala."
    1933
    2034#: uupdatechecker.sfile
    … …  
    2337msgstr "Soubor:"
    2438
     39#: uupdatechecker.snewversionavailable
     40msgid "New version available: %s. Do you want to download and install it now?"
     41msgstr "Je dostupná nová verze: %s. Chcete ji nyní stáhnout a nainstalovat?"
     42
     43#: uupdatechecker.sno
     44#| msgid "No"
     45msgid "Later"
     46msgstr "Později"
     47
    2548#: uupdatechecker.sprogress
    2649#| msgid "Progress"
    … …  
    2851msgstr "Průběh:"
    2952
     53#: uupdatechecker.swhatsnew
     54msgid "What's new?"
     55msgstr "Co je nového?"
     56
    3057#: uupdatechecker.swrongfileformat
    3158msgid "Wrong file format"
    3259msgstr "Nesprávný formát souboru"
    3360
     61#: uupdatechecker.syes
     62#| msgid "Yes"
     63msgid "Update"
     64msgstr "Aktualizovat"
     65
     66#: uupdatechecker.syouhavelatestversion
     67msgid "You have latest version"
     68msgstr "Máte nejnovější verzi"

  • UpdateChecker/Languages/UUpdateChecker.po

    r379 r433  
    66msgstr ""
    77
     8#: uupdatechecker.schangesinnewversion
     9msgid "Changes in new version:"
     10msgstr ""
     11
     12#: uupdatechecker.scheckupdates
     13msgid "Check updates"
     14msgstr ""
     15
    816#: uupdatechecker.sdownloadprogress
    917msgid "Download progress"
     18msgstr ""
     19
     20#: uupdatechecker.serrorcheckingnewversion
     21msgid "New version check failed."
    1022msgstr ""
    1123
    … …  
    1426msgstr ""
    1527
     28#: uupdatechecker.snewversionavailable
     29msgid "New version available: %s. Do you want to download and install it now?"
     30msgstr ""
     31
     32#: uupdatechecker.sno
     33msgid "Later"
     34msgstr ""
     35
    1636#: uupdatechecker.sprogress
    1737msgid "Progress:"
     38msgstr ""
     39
     40#: uupdatechecker.swhatsnew
     41msgid "What's new?"
    1842msgstr ""
    1943
    … …  
    2246msgstr ""
    2347
     48#: uupdatechecker.syes
     49msgid "Update"
     50msgstr ""
     51
     52#: uupdatechecker.syouhavelatestversion
     53msgid "You have latest version"
     54msgstr ""
     55

  • UpdateChecker/ReadMe.txt

    r379 r433  
    1 =Application information=
     1=UpdateChecker=
    22
    3 * Application name
    4 * Application group
    5 * Version
    6 * Release notes
    7 * Architecture
    8 * OS version
    9 * Branch
    10 * File location (Mirrors)
    11 * Dependencies
     3Allow users to check for new application updates. If new version is available then information windows is shown and use can proceed to download and install refered setup program.
    124
    13 =Possible update methods=
     5==Features==
    146
    15 * Download and execute installer (NSIS, InnoSetup, etc.)
    16 * Download and extract archive, rename exe file, restart application
     7* Can download setup from http or filesystem location
     8* Can read latest version description file and determine newest version
     9* Show new version changes
     10* Allow run setup with elevated privileges and exit currently running program
     11
     12
     13* Require Lazarus 1.0 FPC 2.6.0
     14

  • UpdateChecker/UFormDownloadProgress.lfm

    r379 r433  
    11object FormDownloadProgress: TFormDownloadProgress
    2   Left = 599
     2  Left = 410
    33  Height = 75
    4   Top = 212
     4  Top = 278
    55  Width = 376
    66  Caption = 'Download progress'
    … …  
    2020  object Label1: TLabel
    2121    Left = 7
    22     Height = 14
     22    Height = 13
    2323    Top = 8
    24     Width = 21
     24    Width = 20
    2525    Caption = 'File:'
    2626    ParentColor = False
    … …  
    2828  object LabelFileName: TLabel
    2929    Left = 72
    30     Height = 14
     30    Height = 13
    3131    Top = 8
    32     Width = 13
     32    Width = 12
    3333    Caption = '    '
    3434    ParentColor = False
    … …  
    3636  object Label2: TLabel
    3737    Left = 8
    38     Height = 14
     38    Height = 13
    3939    Top = 25
    40     Width = 47
     40    Width = 46
    4141    Caption = 'Progress:'
    4242    ParentColor = False
    … …  
    4444  object LabelProgress: TLabel
    4545    Left = 72
    46     Height = 14
     46    Height = 13
    4747    Top = 25
    48     Width = 13
     48    Width = 12
    4949    Caption = '    '
    5050    ParentColor = False

  • UpdateChecker/UFormDownloadProgress.lrs

    r379 r433  
    22
    33LazarusResources.Add('TFormDownloadProgress','FORMDATA',[
    4   'TPF0'#21'TFormDownloadProgress'#20'FormDownloadProgress'#4'Left'#3'W'#2#6'He'
    5   +'ight'#2'K'#3'Top'#3#212#0#5'Width'#3'x'#1#7'Caption'#6#17'Download progress'
     4  'TPF0'#21'TFormDownloadProgress'#20'FormDownloadProgress'#4'Left'#3#154#1#6'H'
     5  +'eight'#2'K'#3'Top'#3#22#1#5'Width'#3'x'#1#7'Caption'#6#17'Download progress'
    66  +#12'ClientHeight'#2'K'#11'ClientWidth'#3'x'#1#8'OnCreate'#7#10'FormCreate'#8
    77  +'Position'#7#14'poScreenCenter'#10'LCLVersion'#6#3'1.1'#0#12'TProgressBar'#12
    88  +'ProgressBar1'#4'Left'#2#8#6'Height'#2#20#3'Top'#2'0'#5'Width'#3'h'#1#7'Anch'
    99  +'ors'#11#6'akLeft'#7'akRight'#8'akBottom'#0#8'TabOrder'#2#0#0#0#6'TLabel'#6
    10   +'Label1'#4'Left'#2#7#6'Height'#2#14#3'Top'#2#8#5'Width'#2#21#7'Caption'#6#5
     10  +'Label1'#4'Left'#2#7#6'Height'#2#13#3'Top'#2#8#5'Width'#2#20#7'Caption'#6#5
    1111  +'File:'#11'ParentColor'#8#0#0#6'TLabel'#13'LabelFileName'#4'Left'#2'H'#6'Hei'
    12   +'ght'#2#14#3'Top'#2#8#5'Width'#2#13#7'Caption'#6#4'    '#11'ParentColor'#8#0
    13   +#0#6'TLabel'#6'Label2'#4'Left'#2#8#6'Height'#2#14#3'Top'#2#25#5'Width'#2'/'#7
     12  +'ght'#2#13#3'Top'#2#8#5'Width'#2#12#7'Caption'#6#4'    '#11'ParentColor'#8#0
     13  +#0#6'TLabel'#6'Label2'#4'Left'#2#8#6'Height'#2#13#3'Top'#2#25#5'Width'#2'.'#7
    1414  +'Caption'#6#9'Progress:'#11'ParentColor'#8#0#0#6'TLabel'#13'LabelProgress'#4
    15   +'Left'#2'H'#6'Height'#2#14#3'Top'#2#25#5'Width'#2#13#7'Caption'#6#4'    '#11
     15  +'Left'#2'H'#6'Height'#2#13#3'Top'#2#25#5'Width'#2#12#7'Caption'#6#4'    '#11
    1616  +'ParentColor'#8#0#0#0
    1717]);

  • 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

  • UpdateChecker/UpdateChecker.lpk

    r379 r433  
    1919    </CompilerOptions>
    2020    <Description Value="Check for updates and perform application update"/>
    21     <License Value="GNU/GPL"/>
    22     <Version Minor="1"/>
    23     <Files Count="3">
     21    <License Value="GNU/GPLv3"/>
     22    <Version Minor="2"/>
     23    <Files Count="4">
    2424      <Item1>
    2525        <Filename Value="UUpdateChecker.pas"/>
    … …  
    3535        <UnitName Value="UFormDownloadProgress"/>
    3636      </Item3>
     37      <Item4>
     38        <Filename Value="UFormNewVersionOffer.pas"/>
     39        <UnitName Value="UFormNewVersionOffer"/>
     40      </Item4>
    3741    </Files>
    3842    <i18n>

  • UpdateChecker/UpdateChecker.pas

    r379 r433  
    88
    99uses
    10   UUpdateChecker, UFormDownloadProgress, LazarusPackageIntf;
     10  UUpdateChecker, UFormDownloadProgress, UFormNewVersionOffer,
     11  LazarusPackageIntf;
    1112
    1213implementation
Note: See TracChangeset for help on using the changeset viewer.