My favorites | Sign in
Project Home Issues Source
Checkout   Browse   Changes  
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
unit updatecheck;

interface

uses
Windows, Messages, SysUtils, Classes, Forms, StdCtrls, IniFiles, Controls, Graphics,
helpers;

type
TfrmUpdateCheck = class(TForm)
btnCancel: TButton;
groupBuild: TGroupBox;
btnBuild: TButton;
groupRelease: TGroupBox;
btnRelease: TButton;
lblStatus: TLabel;
memoRelease: TMemo;
memoBuild: TMemo;
procedure FormCreate(Sender: TObject);
procedure btnBuildClick(Sender: TObject);
procedure btnReleaseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
CheckfileDownload: THttpDownLoad;
ReleaseURL, BuildURL : String;
FLastStatusUpdate: Cardinal;
FCheckFilename: String;
procedure Status(txt: String);
procedure ReadCheckFile;
procedure DownloadProgress(Sender: TObject);
public
{ Public declarations }
AutoClose: Boolean; // Automatically close dialog after detecting no available downloads
BuildRevision: Integer;
CheckForBuildsInAutoMode: Boolean;
BuildSize: Integer;
end;

implementation

uses main;

{$R *.dfm}

{$I const.inc}



{**
Set defaults
}
procedure TfrmUpdateCheck.FormCreate(Sender: TObject);
begin
// Should be false by default. Callers can set this to True after Create()
AutoClose := False;
InheritFont(Font);
end;

{**
Update status text
}
procedure TfrmUpdateCheck.Status(txt: String);
begin
lblStatus.Caption := txt;
lblStatus.Repaint;
end;


{**
Download check file
}
procedure TfrmUpdateCheck.FormShow(Sender: TObject);
begin
Status('Initiating ... ');
Caption := 'Check for '+APPNAME+' updates ...';

// Init GUI controls
btnRelease.Enabled := False;
btnBuild.Enabled := False;
memoRelease.Clear;
memoBuild.Clear;

// Prepare download
CheckfileDownload := THttpDownload.Create(Self);
CheckfileDownload.URL := APPDOMAIN+'updatecheck.php?r='+IntToStr(Mainform.AppVerRevision)+'&t='+DateTimeToStr(Now);
FCheckFilename := GetTempDir + APPNAME + '_updatecheck.ini';

// Download the check file
Screen.Cursor := crHourglass;
try
Status('Downloading check file ...');
CheckfileDownload.SendRequest(FCheckFilename);
Status('Reading check file ...');
ReadCheckFile;
// Developer versions probably have "unknown" (0) as revision,
// which makes it impossible to compare the revisions.
if Mainform.AppVerRevision = 0 then
Status('Error: Cannot determine current revision. Using a developer version?')
else if Mainform.AppVerRevision = BuildRevision then
Status('Your '+APPNAME+' is up-to-date (no update available).')
else if groupRelease.Enabled or btnBuild.Enabled then
Status('Updates available.');
// Remember when we did the updatecheck to enable the automatic interval
OpenRegistry;
MainReg.WriteString(REGNAME_LAST_UPDATECHECK, DateTimeToStr(Now));
except
// Do not popup errors, just display them in the status label
on E:Exception do
Status(E.Message);
end;
if FileExists(FCheckFilename) then
DeleteFile(FCheckFilename);
FreeAndNil(CheckfileDownload);
Screen.Cursor := crDefault;

// For automatic updatechecks this dialog should close if no updates are available.
// Using PostMessage, as Self.Close or ModalResult := mrCancel does not work
// as expected in FormShow
if AutoClose
and (not groupRelease.Enabled)
and ((not CheckForBuildsInAutoMode) or (not btnBuild.Enabled)) then
PostMessage(Self.Handle, WM_CLOSE, 0, 0);
end;


{**
Parse check file for updated version + release
}
procedure TfrmUpdateCheck.ReadCheckFile;
var
Ini : TIniFile;
ReleaseVersion : String;
ReleaseRevision: Integer;
Note : String;
Compiled : TDateTime;
const
INISECT_RELEASE = 'Release';
INISECT_BUILD = 'Build';
begin
// Read [Release] section of check file
Ini := TIniFile.Create(FCheckFilename);
if Ini.SectionExists(INISECT_RELEASE) then begin
ReleaseVersion := Ini.ReadString(INISECT_RELEASE, 'Version', 'unknown');
ReleaseRevision := Ini.ReadInteger(INISECT_RELEASE, 'Revision', 0);
ReleaseURL := Ini.ReadString(INISECT_RELEASE, 'URL', '');
memoRelease.Lines.Add( 'Version ' + ReleaseVersion + ' (yours: '+Mainform.AppVersion+')' );
memoRelease.Lines.Add( 'Released: ' + Ini.ReadString(INISECT_RELEASE, 'Date', '') );
Note := Ini.ReadString(INISECT_RELEASE, 'Note', '');
if Note <> '' then
memoRelease.Lines.Add( 'Note: ' + Note );
btnRelease.Caption := 'Download version ' + ReleaseVersion;
// Enable the download button if the current version is outdated
groupRelease.Enabled := ReleaseRevision > Mainform.AppVerRevision;
btnRelease.Enabled := groupRelease.Enabled;
memoRelease.Enabled := groupRelease.Enabled;
if not memoRelease.Enabled then
memoRelease.Font.Color := cl3DDkShadow
else
memoRelease.Font.Color := clWindowText;
end;

// Read [Build] section of check file
if Ini.SectionExists(INISECT_BUILD) then begin
BuildRevision := Ini.ReadInteger(INISECT_BUILD, 'Revision', 0);
BuildURL := Ini.ReadString(INISECT_BUILD, 'URL', '');
BuildSize := Ini.ReadInteger(INISECT_BUILD, 'Size', 0);
memoBuild.Lines.Add( 'Revision ' + IntToStr(BuildRevision) + ' (yours: '+IntToStr(Mainform.AppVerRevision)+')' );
FileAge(ParamStr(0), Compiled);
memoBuild.Lines.Add( 'Compiled: ' + Ini.ReadString(INISECT_BUILD, 'Date', '') + ' (yours: '+DateToStr(Compiled)+')' );
Note := Ini.ReadString(INISECT_BUILD, 'Note', '');
if Note <> '' then
memoBuild.Lines.Add( 'Notes: * ' + StringReplace(Note, '%||%', CRLF+'* ', [rfReplaceAll] ) );
btnBuild.Caption := 'Download and install build ' + IntToStr(BuildRevision);
// A new release should have priority over a new nightly build.
// So the user should not be able to download a newer build here
// before having installed the new release.
btnBuild.Enabled := (Mainform.AppVerRevision = 0) or ((BuildRevision > Mainform.AppVerRevision) and (not btnRelease.Enabled));
end;
end;


{**
Download release installer via web browser
}
procedure TfrmUpdateCheck.btnReleaseClick(Sender: TObject);
begin
ShellExec(ReleaseURL);
end;


{**
Download latest build and replace running exe
}
procedure TfrmUpdateCheck.btnBuildClick(Sender: TObject);
var
Download: THttpDownLoad;
ExeName, DownloadFilename, UpdaterFilename: String;
ResInfoblockHandle: HRSRC;
ResHandle: THandle;
ResPointer: PChar;
Stream: TMemoryStream;
begin
Download := THttpDownload.Create(Self);
Download.URL := BuildURL;
ExeName := ExtractFileName(Application.ExeName);

// Save the file in a temp directory
DownloadFilename := GetTempDir + ExeName;
Download.OnProgress := DownloadProgress;

// Delete probably previously downloaded file
if FileExists(DownloadFilename) then
DeleteFile(DownloadFilename);

try
// Do the download
Download.SendRequest(DownloadFilename);

// Check if downloaded file exists
if not FileExists(DownloadFilename) then
Raise Exception.Create('Downloaded file not found: '+DownloadFilename);

Status('Update in progress ...');
ResInfoblockHandle := FindResource(HInstance, 'UPDATER', 'EXE');
ResHandle := LoadResource(HInstance, ResInfoblockHandle);
if ResHandle <> 0 then begin
Stream := TMemoryStream.Create;
try
ResPointer := LockResource(ResHandle);
Stream.WriteBuffer(ResPointer[0], SizeOfResource(HInstance, ResInfoblockHandle));
Stream.Position := 0;
UpdaterFilename := GetTempDir + AppName+'_updater.exe';
if FileExists(UpdaterFilename) and (Stream.Size = _GetFileSize(UpdaterFilename)) then
// Do not replace old updater if it's still valid. Avoids annoyance for cases in which
// user has whitelisted this .exe in his antivirus or whatever software.
else
Stream.SaveToFile(UpdaterFilename);
// Calling the script will now post a WM_CLOSE this running exe...
ShellExec(UpdaterFilename, '', '"'+ParamStr(0)+'" "'+DownloadFilename+'"');
finally
UnlockResource(ResHandle);
FreeResource(ResHandle);
Stream.Free;
end;
end;
except
on E:Exception do
ErrorDialog(E.Message);
end;
end;


{**
Download progress event
}
procedure TfrmUpdateCheck.DownloadProgress(Sender: TObject);
var
Download: THttpDownload;
begin
if FLastStatusUpdate > GetTickCount-200 then
Exit;
Download := Sender as THttpDownload;
Status('Downloading: '+FormatByteNumber(Download.BytesRead)+' / '+FormatByteNumber(Download.ContentLength) + ' ...');
FLastStatusUpdate := GetTickCount;
end;


end.

Change log

r4134 by ansgar.becker on Apr 28, 2012   Diff
Implement home brown "THttpDownload"
class, making use of the Internet_*
methods from WinINet unit. Replaces
"TDownloadUrl2" class. Fixes single char
in user agent.
Go to: 

Older revisions

r3919 by ansgar.becker on Aug 12, 2011   Diff
Handle build download errors in update
checker. Fixes  issue #2512 .
r3293 by ansgar.becker on Apr 24, 2010   Diff
Introduce EDatabaseError exception
class, so we're able to handle only
those and let others raise the
exception up to MadExcept. Helps
finding non-database related AVs as
...
r3215 by ansgar.becker on Mar 26, 2010   Diff
Add dummy GET parameter holding
current time, to force loading that
file, even after the VCL internals
have that file cached somewhere. Fixes
 issue #1806 .
All revisions of this file

File info

Size: 8917 bytes, 269 lines
Powered by Google Project Hosting