Check-in [ceddd9826e]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Prepare for refactoring of auto-update to enable showing UI all along (including a progress bar).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | develop
Files: files | file ages | folders
SHA1:ceddd9826e2f920849cd54ed1133d50fa5343ef0
User & Date: tinus 2015-08-12 11:08:07
Context
2015-09-04
19:46
The Text Preview engine cares as little about file locks as possible. check-in: 2d46e0b905 user: Martijn tags: develop
2015-08-12
11:08
Prepare for refactoring of auto-update to enable showing UI all along (including a progress bar). check-in: ceddd9826e user: tinus tags: develop
2015-08-11
20:15
Merged auto-update feature into develop. check-in: 29b572ad96 user: Martijn tags: develop
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ZPreview/src/Delphi/F_AutoUpdate.dfm.

1
2
3
4
5
6
7
8
9
10
11
object frmAutoUpdate: TfrmAutoUpdate
  Left = 0
  Top = 0
  Caption = 'Update'
  ClientHeight = 448
  ClientWidth = 576
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'



|







1
2
3
4
5
6
7
8
9
10
11
object frmAutoUpdate: TfrmAutoUpdate
  Left = 0
  Top = 0
  Caption = 'Check for updates'
  ClientHeight = 448
  ClientWidth = 576
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'

Changes to ZPreview/src/Delphi/F_AutoUpdate.pas.

34
35
36
37
38
39
40


41
42
43
44
45
46
47
48
49
50
51
52
53



54
55
56
57
58
59
60
61
...
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
143
...
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
...
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
...
274
275
276
277
278
279
280

281
282
283
284
285
286
287
...
322
323
324
325
326
327
328












329
330
331
332
333
334
335
...
446
447
448
449
450
451
452

453
454

455
456
457
458
459
460
461
462
463
464
465
466
467
    function UUIDFromNode(const xmlItem: TXmlNode): string;
  public
    { Public declarations }
    procedure Populate(const UpdateChecker: TUpdateChecker);
  end;

  TUpdateChecker = class


  private
    FBaseURL: string;
    FTagName: string;
    FXmlFeed: TNativeXml;
    FVersions: TDictionary<TDateTime,TXmlNode>;
    FForm: TfrmAutoUpdate;

    procedure LoadFeed;
    function  DownloadFromURL(const URL: string): TStream;
  public
    constructor Create(const BaseURL, BranchName: string);
    destructor  Destroy; override;




    function  CheckForUpdate: boolean;
    function  AskUserForUpdate(out UUID: string): boolean;
    procedure UpdateToVersion(const UUID: string);

    property BaseURL: string                            read FBaseURL;
    property TagName: string                            read FTagName;
    property XmlFeed: TNativeXml                        read FXmlFeed;
    property Versions: TDictionary<TDateTime,TXmlNode>  read FVersions;
................................................................................
      FreeAndNil(FXmlFeed);
      raise;
    end;
  end;
end {TUpdateChecker.LoadFeed};

{ ------------------------------------------------------------------------------------------------ }
function TUpdateChecker.CheckForUpdate: boolean;
var
  en_US: TFormatSettings;
  rexDateTime: TRegEx;
  xmlChannel: TXmlNode;
  xmlItems: TList;
  i, mi: Integer;
  xmlItem: TXmlNode;
  sPubDate: string;
  PubDate: TDateTime;
  Match: TMatch;
  Day, Month, Year: Integer;
begin

  LoadFeed;

  rexDateTime := TRegEx.Create('(\d{1,2})\s+(\w{2,})\s+(\d{4})\s+(\d?\d:\d\d:\d\d)', [roCompiled]);
  en_US := TFormatSettings.Create('en-US');

  Result := False;
  xmlChannel := FXmlFeed.Root.NodeByName('channel');
  xmlItems := TList.Create;
................................................................................

  WorkPath := ExtractFilePath(ExeName);
  BackupPrefix := '~';
  if ExeVersion <> '' then
    BackupPrefix := BackupPrefix + ExeVersion;

  // download the zip from http://fossil.2of4.net/zaap/zip/zpreview.zip?uuid={UUID}
  {$MESSAGE HINT 'Pass a routine to update the progress bar? — Martijn 2015-08-11'}
  ZipStream := DownloadFromURL(FBaseURL + 'zip/' + URIEncode(FTagName) + '.zip?uuid=' + URIEncode(UUID));
  if not Assigned(ZipStream) then
    raise Exception.Create('Failed to download release ' + UUID + '.');
  try
    Zip := TZipFile.Create;
    try
      Zip.Open(ZipStream, zmRead);
................................................................................
        PathName := ExtractFilePath(FileName);
        FileName := ExtractFileName(FileName);
        if FileName <> '' then begin
          if PathName <> '' then
            ForceDirectories(WorkPath + PathName);

          // Test for existing file, and rename that
          {$MESSAGE HINT 'TODO: Save all new files to temp files in the same dir, then afterwards, use ReplaceFile for each of them — MCO 25-02-2015'}
          if FileExists(WorkPath + PathName + FileName) then begin
            RenameFile(WorkPath + PathName + FileName, WorkPath + PathName + ChangeFileExt(FileName, BackupPrefix + ExtractFileExt(FileName)));
          end;

          Zip.Extract(i, WorkPath + PathName, False);

          // adjust the new file's modified time
................................................................................
  // Close the current instance...
  Application.Tag := -1; // signal for the single-instance algorithm that we're shutting down
  Application.OnException := nil;
  Application.Terminate;
  Application.MainForm.Close;

  // ...and start a new one

  if not CreateProcess(nil, PChar(ExeName), nil, nil, True, 0, nil, nil, SI, PI) then
    RaiseLastOSError;
end {TUpdateChecker.UpdateToVersion};

{ ------------------------------------------------------------------------------------------------ }
function TUpdateChecker.DownloadFromURL(const URL: string): TStream;
var
................................................................................
    InternetCloseHandle(UrlHandle);

    Result.Position := 0;
  finally
    InternetCloseHandle(NetHandle);
  end;
end {TUpdateChecker.DownloadFromURL};

















{ ================================================================================================ }
{ TfrmAutoUpdate }
................................................................................
  xmlItem: TXmlNode;
begin
  if Selected = False then begin
    btnInstall.Enabled := False;
    btnWebpage.Enabled := False;
    mmoChanges.Clear;
  end else begin

    xmlItem := TXmlNode(Item.Data);
    if Assigned(xmlItem) then begin

      mmoChanges.Lines.Text := xmlItem.ReadUnicodeString('description', '(no description provided)');
      btnInstall.Enabled := True;
      btnWebpage.Enabled := True;
    end else begin
      btnInstall.Enabled := False;
      btnWebpage.Enabled := True;
    end;
  end;
end {TfrmAutoUpdate.lvwVersionsSelectItem};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmAutoUpdate.btnInstallClick(Sender: TObject);
begin







>
>













>
>
>
|







 







|












>
|







 







|







 







<







 







>







 







>
>
>
>
>
>
>
>
>
>
>
>







 







>


>


<


<







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
...
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
...
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
...
253
254
255
256
257
258
259

260
261
262
263
264
265
266
...
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
...
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
...
464
465
466
467
468
469
470
471
472
473
474
475
476

477
478

479
480
481
482
483
484
485
    function UUIDFromNode(const xmlItem: TXmlNode): string;
  public
    { Public declarations }
    procedure Populate(const UpdateChecker: TUpdateChecker);
  end;

  TUpdateChecker = class
  type
    TProgressDelegate = reference to procedure(Sender: TObject; Position: integer; MaxPos: integer);
  private
    FBaseURL: string;
    FTagName: string;
    FXmlFeed: TNativeXml;
    FVersions: TDictionary<TDateTime,TXmlNode>;
    FForm: TfrmAutoUpdate;

    procedure LoadFeed;
    function  DownloadFromURL(const URL: string): TStream;
  public
    constructor Create(const BaseURL, BranchName: string);
    destructor  Destroy; override;

    procedure ShowForm;
    procedure HideForm;

    function  CheckForUpdate(const UpdateProgress: TProgressDelegate = nil): boolean;
    function  AskUserForUpdate(out UUID: string): boolean;
    procedure UpdateToVersion(const UUID: string);

    property BaseURL: string                            read FBaseURL;
    property TagName: string                            read FTagName;
    property XmlFeed: TNativeXml                        read FXmlFeed;
    property Versions: TDictionary<TDateTime,TXmlNode>  read FVersions;
................................................................................
      FreeAndNil(FXmlFeed);
      raise;
    end;
  end;
end {TUpdateChecker.LoadFeed};

{ ------------------------------------------------------------------------------------------------ }
function TUpdateChecker.CheckForUpdate(const UpdateProgress: TProgressDelegate): boolean;
var
  en_US: TFormatSettings;
  rexDateTime: TRegEx;
  xmlChannel: TXmlNode;
  xmlItems: TList;
  i, mi: Integer;
  xmlItem: TXmlNode;
  sPubDate: string;
  PubDate: TDateTime;
  Match: TMatch;
  Day, Month, Year: Integer;
begin
  {$MESSAGE WARN 'TODO: If we have a form, then clear it to indicate we’re loading — MCO 12-08-2015'}
  LoadFeed{TODO: (UpdateProgress)};

  rexDateTime := TRegEx.Create('(\d{1,2})\s+(\w{2,})\s+(\d{4})\s+(\d?\d:\d\d:\d\d)', [roCompiled]);
  en_US := TFormatSettings.Create('en-US');

  Result := False;
  xmlChannel := FXmlFeed.Root.NodeByName('channel');
  xmlItems := TList.Create;
................................................................................

  WorkPath := ExtractFilePath(ExeName);
  BackupPrefix := '~';
  if ExeVersion <> '' then
    BackupPrefix := BackupPrefix + ExeVersion;

  // download the zip from http://fossil.2of4.net/zaap/zip/zpreview.zip?uuid={UUID}
  {$MESSAGE HINT 'TODO: Pass a routine to update the progress bar? — Martijn 2015-08-11'}
  ZipStream := DownloadFromURL(FBaseURL + 'zip/' + URIEncode(FTagName) + '.zip?uuid=' + URIEncode(UUID));
  if not Assigned(ZipStream) then
    raise Exception.Create('Failed to download release ' + UUID + '.');
  try
    Zip := TZipFile.Create;
    try
      Zip.Open(ZipStream, zmRead);
................................................................................
        PathName := ExtractFilePath(FileName);
        FileName := ExtractFileName(FileName);
        if FileName <> '' then begin
          if PathName <> '' then
            ForceDirectories(WorkPath + PathName);

          // Test for existing file, and rename that

          if FileExists(WorkPath + PathName + FileName) then begin
            RenameFile(WorkPath + PathName + FileName, WorkPath + PathName + ChangeFileExt(FileName, BackupPrefix + ExtractFileExt(FileName)));
          end;

          Zip.Extract(i, WorkPath + PathName, False);

          // adjust the new file's modified time
................................................................................
  // Close the current instance...
  Application.Tag := -1; // signal for the single-instance algorithm that we're shutting down
  Application.OnException := nil;
  Application.Terminate;
  Application.MainForm.Close;

  // ...and start a new one
  {$MESSAGE HINT 'TODO: This goes wrong when the executable name has changed... — MCO 12-08-2015'}
  if not CreateProcess(nil, PChar(ExeName), nil, nil, True, 0, nil, nil, SI, PI) then
    RaiseLastOSError;
end {TUpdateChecker.UpdateToVersion};

{ ------------------------------------------------------------------------------------------------ }
function TUpdateChecker.DownloadFromURL(const URL: string): TStream;
var
................................................................................
    InternetCloseHandle(UrlHandle);

    Result.Position := 0;
  finally
    InternetCloseHandle(NetHandle);
  end;
end {TUpdateChecker.DownloadFromURL};

{ ------------------------------------------------------------------------------------------------ }
procedure TUpdateChecker.ShowForm;
begin
  {$MESSAGE WARN 'TUpdateChecker.ShowForm — MCO 12-08-2015'}
end {TUpdateChecker.ShowForm};

{ ------------------------------------------------------------------------------------------------ }
procedure TUpdateChecker.HideForm;
begin
  {$MESSAGE WARN 'TODO: TUpdateChecker.HideForm — MCO 12-08-2015'}
end {TUpdateChecker.HideForm};





{ ================================================================================================ }
{ TfrmAutoUpdate }
................................................................................
  xmlItem: TXmlNode;
begin
  if Selected = False then begin
    btnInstall.Enabled := False;
    btnWebpage.Enabled := False;
    mmoChanges.Clear;
  end else begin
    btnWebpage.Enabled := True;
    xmlItem := TXmlNode(Item.Data);
    if Assigned(xmlItem) then begin
      {$MESSAGE HINT 'TODO: Use a different control that enables links — MCO 12-08-2015'}
      mmoChanges.Lines.Text := xmlItem.ReadUnicodeString('description', '(no description provided)');
      btnInstall.Enabled := True;

    end else begin
      btnInstall.Enabled := False;

    end;
  end;
end {TfrmAutoUpdate.lvwVersionsSelectItem};

{ ------------------------------------------------------------------------------------------------ }
procedure TfrmAutoUpdate.btnInstallClick(Sender: TObject);
begin

Changes to ZPreview/src/Delphi/F_Main.dfm.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32


33
34
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
..
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
..
69
70
71
72
73
74
75

76
77
78
79
80
81
82
83
84
85
86


87
88
89
90
91
92
93
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object tbcPreview: TTabControl
    AlignWithMargins = True
    Left = 3
    Top = 70
    Width = 806
    Height = 412
    Align = alClient
    DoubleBuffered = True
    ParentDoubleBuffered = False
    TabOrder = 0
    Tabs.Strings = (
      'Sophie.jpg')
    TabIndex = 0


  end
  object pnlError: TPanel
    Left = 0
    Top = 26
    Width = 816
    Height = 41
    Align = alTop
    TabOrder = 1
    Visible = False
    OnDblClick = pnlErrorDblClick

    object lblError: TLabel
      AlignWithMargins = True
      Left = 4
      Top = 4
      Width = 3
      Height = 13
      Align = alClient
................................................................................
      WordWrap = True
    end
  end
  object acttbMain: TActionToolBar
    Left = 0
    Top = 0
    Width = 816
    Height = 26
    ActionManager = ActionManager
    Caption = 'acttbMain'
    Color = clMenuBar
    ColorMap.DisabledFontColor = 7171437
    ColorMap.HighlightColor = clWhite
    ColorMap.BtnSelectedFont = clBlack
    ColorMap.UnusedColor = clWhite
................................................................................
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
    ParentShowHint = False
    ShowHint = True
    Spacing = 0

  end
  object pnlRight: TPanel
    Left = 812
    Top = 67
    Width = 4
    Height = 418
    Align = alRight
    AutoSize = True
    Constraints.MaxWidth = 4
    DockSite = True
    TabOrder = 3


  end
  object sbrMain: TStatusBar
    Left = 0
    Top = 485
    Width = 816
    Height = 20
    DoubleBuffered = True







|

|







>
>



|






>







 







|







 







>



|

|





>
>







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
..
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
..
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object tbcPreview: TTabControl
    AlignWithMargins = True
    Left = 3
    Top = 67
    Width = 806
    Height = 415
    Align = alClient
    DoubleBuffered = True
    ParentDoubleBuffered = False
    TabOrder = 0
    Tabs.Strings = (
      'Sophie.jpg')
    TabIndex = 0
    ExplicitTop = 70
    ExplicitHeight = 412
  end
  object pnlError: TPanel
    Left = 0
    Top = 23
    Width = 816
    Height = 41
    Align = alTop
    TabOrder = 1
    Visible = False
    OnDblClick = pnlErrorDblClick
    ExplicitTop = 26
    object lblError: TLabel
      AlignWithMargins = True
      Left = 4
      Top = 4
      Width = 3
      Height = 13
      Align = alClient
................................................................................
      WordWrap = True
    end
  end
  object acttbMain: TActionToolBar
    Left = 0
    Top = 0
    Width = 816
    Height = 23
    ActionManager = ActionManager
    Caption = 'acttbMain'
    Color = clMenuBar
    ColorMap.DisabledFontColor = 7171437
    ColorMap.HighlightColor = clWhite
    ColorMap.BtnSelectedFont = clBlack
    ColorMap.UnusedColor = clWhite
................................................................................
    Font.Height = -11
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
    ParentShowHint = False
    ShowHint = True
    Spacing = 0
    ExplicitHeight = 26
  end
  object pnlRight: TPanel
    Left = 812
    Top = 64
    Width = 4
    Height = 421
    Align = alRight
    AutoSize = True
    Constraints.MaxWidth = 4
    DockSite = True
    TabOrder = 3
    ExplicitTop = 67
    ExplicitHeight = 418
  end
  object sbrMain: TStatusBar
    Left = 0
    Top = 485
    Width = 816
    Height = 20
    DoubleBuffered = True

Changes to ZPreview/src/Delphi/F_Main.pas.

75
76
77
78
79
80
81

82
83
84
85
86
87
88
var
  frmMain: TfrmMain;

implementation
uses
  System.IOUtils, System.Types, System.Masks, System.Generics.Defaults,
  Winapi.PsApi, Winapi.ShellAPI,

  Vcl.Imaging.GIFImg, Vcl.Imaging.jpeg, Vcl.Imaging.pngimage,
  U_ShellItemImage,
  F_Sentinel, F_Info, F_ManageEnginesAndRenderers, F_AutoUpdate;

{$R *.dfm}









>







75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
var
  frmMain: TfrmMain;

implementation
uses
  System.IOUtils, System.Types, System.Masks, System.Generics.Defaults,
  Winapi.PsApi, Winapi.ShellAPI,
  System.UITypes,
  Vcl.Imaging.GIFImg, Vcl.Imaging.jpeg, Vcl.Imaging.pngimage,
  U_ShellItemImage,
  F_Sentinel, F_Info, F_ManageEnginesAndRenderers, F_AutoUpdate;

{$R *.dfm}