My favorites | Sign in
Project Home Source
Checkout   Browse   Changes  
Changes to /trunk/source/updatecheck.pas
r3919 vs. r4134 Compare: vs.  Format:
Revision r4134
Go to: 
/trunk/source/updatecheck.pas   r3919 /trunk/source/updatecheck.pas   r4134
1 unit updatecheck; 1 unit updatecheck;
2 2
3 interface 3 interface
4 4
5 uses 5 uses
6 Windows, Messages, SysUtils, Classes, Forms, StdCtrls, ExtActns, IniFiles, Controls, Graphics; 6 Windows, Messages, SysUtils, Classes, Forms, StdCtrls, IniFiles, Controls, Graphics,
7 helpers;
7 8
8 type 9 type
9 TUrlMonUrlMkSetSessionOption = function(dwOption: Cardinal; pBuffer: PChar; dwBufferLength: Cardinal; dwReserved: Cardinal): HRESULT; stdcall;
10 TDownloadUrl2 = class(TDownloadUrl)
11 public
12 procedure SetUserAgent(name: string);
13 end;
14
15 TfrmUpdateCheck = class(TForm) 10 TfrmUpdateCheck = class(TForm)
16 btnCancel: TButton; 11 btnCancel: TButton;
17 groupBuild: TGroupBox; 12 groupBuild: TGroupBox;
18 btnBuild: TButton; 13 btnBuild: TButton;
19 groupRelease: TGroupBox; 14 groupRelease: TGroupBox;
20 btnRelease: TButton; 15 btnRelease: TButton;
21 lblStatus: TLabel; 16 lblStatus: TLabel;
22 memoRelease: TMemo; 17 memoRelease: TMemo;
23 memoBuild: TMemo; 18 memoBuild: TMemo;
24 procedure FormCreate(Sender: TObject); 19 procedure FormCreate(Sender: TObject);
25 procedure btnBuildClick(Sender: TObject); 20 procedure btnBuildClick(Sender: TObject);
26 procedure btnReleaseClick(Sender: TObject); 21 procedure btnReleaseClick(Sender: TObject);
27 procedure FormShow(Sender: TObject); 22 procedure FormShow(Sender: TObject);
28 private 23 private
29 { Private declarations } 24 { Private declarations }
30 CheckfileDownload : TDownLoadURL2; 25 CheckfileDownload: THttpDownLoad;
31 ReleaseURL, BuildURL : String; 26 ReleaseURL, BuildURL : String;
32 FLastStatusUpdate: Cardinal; 27 FLastStatusUpdate: Cardinal;
28 FCheckFilename: String;
33 procedure Status(txt: String); 29 procedure Status(txt: String);
34 procedure ReadCheckFile; 30 procedure ReadCheckFile;
35 procedure URLOnDownloadProgress(Sender: TDownLoadURL; Progress, ProgressMax: Cardinal; 31 procedure DownloadProgress(Sender: TObject);
36 StatusCode: TURLDownloadStatus; StatusText: String; var Cancel: Boolean);
37 public 32 public
38 { Public declarations } 33 { Public declarations }
39 AutoClose: Boolean; // Automatically close dialog after detecting no available downloads 34 AutoClose: Boolean; // Automatically close dialog after detecting no available downloads
40 BuildRevision: Integer; 35 BuildRevision: Integer;
41 CheckForBuildsInAutoMode: Boolean; 36 CheckForBuildsInAutoMode: Boolean;
42 BuildSize: Integer; 37 BuildSize: Integer;
43 end; 38 end;
44 39
45 implementation 40 implementation
46 41
47 uses helpers, main; 42 uses main;
48 43
49 {$R *.dfm} 44 {$R *.dfm}
50 45
51 {$I const.inc} 46 {$I const.inc}
52 47
53 48
54 procedure TDownloadUrl2.SetUserAgent(name: string);
55 const
56 UrlMonLib = 'URLMON.DLL';
57 sUrlMkSetSessionOptionA = 'UrlMkSetSessionOption';
58 URLMON_OPTION_USERAGENT = $10000001;
59 var
60 UrlMonHandle: HMODULE;
61 UrlMkSetSessionOption: TUrlMonUrlMkSetSessionOption;
62 begin
63 UrlMonHandle := LoadLibrary(UrlMonLib);
64 if UrlMonHandle = 0 then raise Exception.Create('Could not get handle to urlmon.dll.');
65 UrlMkSetSessionOption := GetProcAddress(UrlMonHandle, PChar(sUrlMkSetSessionOptionA));
66 if not Assigned(UrlMkSetSessionOption) then raise Exception.Create('Could not get handle to UrlMonUrlMkSetSessionOption().');
67 // TODO: Rumoured to be broken in IE8, test when it hits the stores.
68 if UrlMkSetSessionOption(URLMON_OPTION_USERAGENT, PChar(name), Length(name), 0) <> 0 then raise Exception.Create('Could not set User-Agent via UrlMonUrlMkSetSessionOption().');
69 end;
70 49
71 {** 50 {**
72 Set defaults 51 Set defaults
73 } 52 }
74 procedure TfrmUpdateCheck.FormCreate(Sender: TObject); 53 procedure TfrmUpdateCheck.FormCreate(Sender: TObject);
75 begin 54 begin
76 // Should be false by default. Callers can set this to True after Create() 55 // Should be false by default. Callers can set this to True after Create()
77 AutoClose := False; 56 AutoClose := False;
78 InheritFont(Font); 57 InheritFont(Font);
79 end; 58 end;
80 59
81 {** 60 {**
82 Update status text 61 Update status text
83 } 62 }
84 procedure TfrmUpdateCheck.Status(txt: String); 63 procedure TfrmUpdateCheck.Status(txt: String);
85 begin 64 begin
86 lblStatus.Caption := txt; 65 lblStatus.Caption := txt;
87 lblStatus.Repaint; 66 lblStatus.Repaint;
88 end; 67 end;
89 68
90 69
91 {** 70 {**
92 Download check file 71 Download check file
93 } 72 }
94 procedure TfrmUpdateCheck.FormShow(Sender: TObject); 73 procedure TfrmUpdateCheck.FormShow(Sender: TObject);
95 begin 74 begin
96 Status('Initiating ... '); 75 Status('Initiating ... ');
97 Caption := 'Check for '+APPNAME+' updates ...'; 76 Caption := 'Check for '+APPNAME+' updates ...';
98 77
99 // Init GUI controls 78 // Init GUI controls
100 btnRelease.Enabled := False; 79 btnRelease.Enabled := False;
101 btnBuild.Enabled := False; 80 btnBuild.Enabled := False;
102 memoRelease.Clear; 81 memoRelease.Clear;
103 memoBuild.Clear; 82 memoBuild.Clear;
104 83
105 // Prepare download 84 // Prepare download
106 CheckfileDownload := TDownLoadURL2.Create(Self); 85 CheckfileDownload := THttpDownload.Create(Self);
107 CheckfileDownload.SetUserAgent(APPNAME + ' ' + Mainform.AppVersion + ' update checker tool'); 86 CheckfileDownload.URL := APPDOMAIN+'updatecheck.php?r='+IntToStr(Mainform.AppVerRevision)+'&t='+DateTimeToStr(Now);
108 CheckfileDownload.URL := APPDOMAIN + 'updatecheck.php?r='+IntToStr(Mainform.AppVerRevision)+'&t='+DateTimeToStr(Now); 87 FCheckFilename := GetTempDir + APPNAME + '_updatecheck.ini';
109 CheckfileDownload.Filename := GetTempDir + APPNAME + '_updatecheck.ini';
110 88
111 // Download the check file 89 // Download the check file
112 Screen.Cursor := crHourglass; 90 Screen.Cursor := crHourglass;
113 try 91 try
114 Status('Downloading check file ...'); 92 Status('Downloading check file ...');
115 CheckfileDownload.ExecuteTarget(nil); 93 CheckfileDownload.SendRequest(FCheckFilename);
116 Status('Reading check file ...'); 94 Status('Reading check file ...');
117 ReadCheckFile; 95 ReadCheckFile;
118 // Developer versions probably have "unknown" (0) as revision, 96 // Developer versions probably have "unknown" (0) as revision,
119 // which makes it impossible to compare the revisions. 97 // which makes it impossible to compare the revisions.
120 if Mainform.AppVerRevision = 0 then 98 if Mainform.AppVerRevision = 0 then
121 Status('Error: Cannot determine current revision. Using a developer version?') 99 Status('Error: Cannot determine current revision. Using a developer version?')
122 else if Mainform.AppVerRevision = BuildRevision then 100 else if Mainform.AppVerRevision = BuildRevision then
123 Status('Your '+APPNAME+' is up-to-date (no update available).') 101 Status('Your '+APPNAME+' is up-to-date (no update available).')
124 else if groupRelease.Enabled or btnBuild.Enabled then 102 else if groupRelease.Enabled or btnBuild.Enabled then
125 Status('Updates available.'); 103 Status('Updates available.');
126 // Remember when we did the updatecheck to enable the automatic interval 104 // Remember when we did the updatecheck to enable the automatic interval
127 OpenRegistry; 105 OpenRegistry;
128 MainReg.WriteString(REGNAME_LAST_UPDATECHECK, DateTimeToStr(Now)); 106 MainReg.WriteString(REGNAME_LAST_UPDATECHECK, DateTimeToStr(Now));
129 except 107 except
130 // Do not popup errors, just display them in the status label 108 // Do not popup errors, just display them in the status label
131 on E:Exception do 109 on E:Exception do
132 Status(E.Message); 110 Status(E.Message);
133 end; 111 end;
134 if FileExists(CheckfileDownload.Filename) then 112 if FileExists(FCheckFilename) then
135 DeleteFile(CheckfileDownload.Filename); 113 DeleteFile(FCheckFilename);
136 FreeAndNil(CheckfileDownload); 114 FreeAndNil(CheckfileDownload);
137 Screen.Cursor := crDefault; 115 Screen.Cursor := crDefault;
138 116
139 // For automatic updatechecks this dialog should close if no updates are available. 117 // For automatic updatechecks this dialog should close if no updates are available.
140 // Using PostMessage, as Self.Close or ModalResult := mrCancel does not work 118 // Using PostMessage, as Self.Close or ModalResult := mrCancel does not work
141 // as expected in FormShow 119 // as expected in FormShow
142 if AutoClose 120 if AutoClose
143 and (not groupRelease.Enabled) 121 and (not groupRelease.Enabled)
144 and ((not CheckForBuildsInAutoMode) or (not btnBuild.Enabled)) then 122 and ((not CheckForBuildsInAutoMode) or (not btnBuild.Enabled)) then
145 PostMessage(Self.Handle, WM_CLOSE, 0, 0); 123 PostMessage(Self.Handle, WM_CLOSE, 0, 0);
146 end; 124 end;
147 125
148 126
149 {** 127 {**
150 Parse check file for updated version + release 128 Parse check file for updated version + release
151 } 129 }
152 procedure TfrmUpdateCheck.ReadCheckFile; 130 procedure TfrmUpdateCheck.ReadCheckFile;
153 var 131 var
154 Ini : TIniFile; 132 Ini : TIniFile;
155 ReleaseVersion : String; 133 ReleaseVersion : String;
156 ReleaseRevision: Integer; 134 ReleaseRevision: Integer;
157 Note : String; 135 Note : String;
158 Compiled : TDateTime; 136 Compiled : TDateTime;
159 const 137 const
160 INISECT_RELEASE = 'Release'; 138 INISECT_RELEASE = 'Release';
161 INISECT_BUILD = 'Build'; 139 INISECT_BUILD = 'Build';
162 begin 140 begin
163 // Read [Release] section of check file 141 // Read [Release] section of check file
164 Ini := TIniFile.Create(CheckfileDownload.Filename); 142 Ini := TIniFile.Create(FCheckFilename);
165 if Ini.SectionExists(INISECT_RELEASE) then begin 143 if Ini.SectionExists(INISECT_RELEASE) then begin
166 ReleaseVersion := Ini.ReadString(INISECT_RELEASE, 'Version', 'unknown'); 144 ReleaseVersion := Ini.ReadString(INISECT_RELEASE, 'Version', 'unknown');
167 ReleaseRevision := Ini.ReadInteger(INISECT_RELEASE, 'Revision', 0); 145 ReleaseRevision := Ini.ReadInteger(INISECT_RELEASE, 'Revision', 0);
168 ReleaseURL := Ini.ReadString(INISECT_RELEASE, 'URL', ''); 146 ReleaseURL := Ini.ReadString(INISECT_RELEASE, 'URL', '');
169 memoRelease.Lines.Add( 'Version ' + ReleaseVersion + ' (yours: '+Mainform.AppVersion+')' ); 147 memoRelease.Lines.Add( 'Version ' + ReleaseVersion + ' (yours: '+Mainform.AppVersion+')' );
170 memoRelease.Lines.Add( 'Released: ' + Ini.ReadString(INISECT_RELEASE, 'Date', '') ); 148 memoRelease.Lines.Add( 'Released: ' + Ini.ReadString(INISECT_RELEASE, 'Date', '') );
171 Note := Ini.ReadString(INISECT_RELEASE, 'Note', ''); 149 Note := Ini.ReadString(INISECT_RELEASE, 'Note', '');
172 if Note <> '' then 150 if Note <> '' then
173 memoRelease.Lines.Add( 'Note: ' + Note ); 151 memoRelease.Lines.Add( 'Note: ' + Note );
174 btnRelease.Caption := 'Download version ' + ReleaseVersion; 152 btnRelease.Caption := 'Download version ' + ReleaseVersion;
175 // Enable the download button if the current version is outdated 153 // Enable the download button if the current version is outdated
176 groupRelease.Enabled := ReleaseRevision > Mainform.AppVerRevision; 154 groupRelease.Enabled := ReleaseRevision > Mainform.AppVerRevision;
177 btnRelease.Enabled := groupRelease.Enabled; 155 btnRelease.Enabled := groupRelease.Enabled;
178 memoRelease.Enabled := groupRelease.Enabled; 156 memoRelease.Enabled := groupRelease.Enabled;
179 if not memoRelease.Enabled then 157 if not memoRelease.Enabled then
180 memoRelease.Font.Color := cl3DDkShadow 158 memoRelease.Font.Color := cl3DDkShadow
181 else 159 else
182 memoRelease.Font.Color := clWindowText; 160 memoRelease.Font.Color := clWindowText;
183 end; 161 end;
184 162
185 // Read [Build] section of check file 163 // Read [Build] section of check file
186 if Ini.SectionExists(INISECT_BUILD) then begin 164 if Ini.SectionExists(INISECT_BUILD) then begin
187 BuildRevision := Ini.ReadInteger(INISECT_BUILD, 'Revision', 0); 165 BuildRevision := Ini.ReadInteger(INISECT_BUILD, 'Revision', 0);
188 BuildURL := Ini.ReadString(INISECT_BUILD, 'URL', ''); 166 BuildURL := Ini.ReadString(INISECT_BUILD, 'URL', '');
189 BuildSize := Ini.ReadInteger(INISECT_BUILD, 'Size', 0); 167 BuildSize := Ini.ReadInteger(INISECT_BUILD, 'Size', 0);
190 memoBuild.Lines.Add( 'Revision ' + IntToStr(BuildRevision) + ' (yours: '+IntToStr(Mainform.AppVerRevision)+')' ); 168 memoBuild.Lines.Add( 'Revision ' + IntToStr(BuildRevision) + ' (yours: '+IntToStr(Mainform.AppVerRevision)+')' );
191 FileAge(ParamStr(0), Compiled); 169 FileAge(ParamStr(0), Compiled);
192 memoBuild.Lines.Add( 'Compiled: ' + Ini.ReadString(INISECT_BUILD, 'Date', '') + ' (yours: '+DateToStr(Compiled)+')' ); 170 memoBuild.Lines.Add( 'Compiled: ' + Ini.ReadString(INISECT_BUILD, 'Date', '') + ' (yours: '+DateToStr(Compiled)+')' );
193 Note := Ini.ReadString(INISECT_BUILD, 'Note', ''); 171 Note := Ini.ReadString(INISECT_BUILD, 'Note', '');
194 if Note <> '' then 172 if Note <> '' then
195 memoBuild.Lines.Add( 'Notes: * ' + StringReplace(Note, '%||%', CRLF+'* ', [rfReplaceAll] ) ); 173 memoBuild.Lines.Add( 'Notes: * ' + StringReplace(Note, '%||%', CRLF+'* ', [rfReplaceAll] ) );
196 btnBuild.Caption := 'Download and install build ' + IntToStr(BuildRevision); 174 btnBuild.Caption := 'Download and install build ' + IntToStr(BuildRevision);
197 // A new release should have priority over a new nightly build. 175 // A new release should have priority over a new nightly build.
198 // So the user should not be able to download a newer build here 176 // So the user should not be able to download a newer build here
199 // before having installed the new release. 177 // before having installed the new release.
200 btnBuild.Enabled := (Mainform.AppVerRevision = 0) or ((BuildRevision > Mainform.AppVerRevision) and (not btnRelease.Enabled)); 178 btnBuild.Enabled := (Mainform.AppVerRevision = 0) or ((BuildRevision > Mainform.AppVerRevision) and (not btnRelease.Enabled));
201 end; 179 end;
202 end; 180 end;
203 181
204 182
205 {** 183 {**
206 Download release installer via web browser 184 Download release installer via web browser
207 } 185 }
208 procedure TfrmUpdateCheck.btnReleaseClick(Sender: TObject); 186 procedure TfrmUpdateCheck.btnReleaseClick(Sender: TObject);
209 begin 187 begin
210 ShellExec(ReleaseURL); 188 ShellExec(ReleaseURL);
211 end; 189 end;
212 190
213 191
214 {** 192 {**
215 Download latest build and replace running exe 193 Download latest build and replace running exe
216 } 194 }
217 procedure TfrmUpdateCheck.btnBuildClick(Sender: TObject); 195 procedure TfrmUpdateCheck.btnBuildClick(Sender: TObject);
218 var 196 var
219 Download: TDownLoadURL; 197 Download: THttpDownLoad;
220 ExeName, UpdaterFilename: String; 198 ExeName, DownloadFilename, UpdaterFilename: String;
221 ResInfoblockHandle: HRSRC; 199 ResInfoblockHandle: HRSRC;
222 ResHandle: THandle; 200 ResHandle: THandle;
223 ResPointer: PChar; 201 ResPointer: PChar;
224 Stream: TMemoryStream; 202 Stream: TMemoryStream;
225 begin 203 begin
226 Download := TDownLoadURL.Create(Self); 204 Download := THttpDownload.Create(Self);
227 Download.URL := BuildURL; 205 Download.URL := BuildURL;
228 ExeName := ExtractFileName(Application.ExeName); 206 ExeName := ExtractFileName(Application.ExeName);
229 207
230 // Save the file in a temp directory 208 // Save the file in a temp directory
231 Download.Filename := GetTempDir + ExeName; 209 DownloadFilename := GetTempDir + ExeName;
232 Download.OnDownloadProgress := URLOnDownloadProgress; 210 Download.OnProgress := DownloadProgress;
233 211
234 // Delete probably previously downloaded file 212 // Delete probably previously downloaded file
235 if FileExists(Download.Filename) then 213 if FileExists(DownloadFilename) then
236 DeleteFile(Download.Filename); 214 DeleteFile(DownloadFilename);
237 215
238 try 216 try
239 // Do the download 217 // Do the download
240 Download.ExecuteTarget(nil); 218 Download.SendRequest(DownloadFilename);
241 219
242 // Check if downloaded file exists 220 // Check if downloaded file exists
243 if not FileExists(Download.Filename) then 221 if not FileExists(DownloadFilename) then
244 Raise Exception.Create('Downloaded file not found: '+Download.Filename); 222 Raise Exception.Create('Downloaded file not found: '+DownloadFilename);
245 223
246 Status('Update in progress ...'); 224 Status('Update in progress ...');
247 ResInfoblockHandle := FindResource(HInstance, 'UPDATER', 'EXE'); 225 ResInfoblockHandle := FindResource(HInstance, 'UPDATER', 'EXE');
248 ResHandle := LoadResource(HInstance, ResInfoblockHandle); 226 ResHandle := LoadResource(HInstance, ResInfoblockHandle);
249 if ResHandle <> 0 then begin 227 if ResHandle <> 0 then begin
250 Stream := TMemoryStream.Create; 228 Stream := TMemoryStream.Create;
251 try 229 try
252 ResPointer := LockResource(ResHandle); 230 ResPointer := LockResource(ResHandle);
253 Stream.WriteBuffer(ResPointer[0], SizeOfResource(HInstance, ResInfoblockHandle)); 231 Stream.WriteBuffer(ResPointer[0], SizeOfResource(HInstance, ResInfoblockHandle));
254 Stream.Position := 0; 232 Stream.Position := 0;
255 UpdaterFilename := GetTempDir + AppName+'_updater.exe'; 233 UpdaterFilename := GetTempDir + AppName+'_updater.exe';
256 if FileExists(UpdaterFilename) and (Stream.Size = _GetFileSize(UpdaterFilename)) then 234 if FileExists(UpdaterFilename) and (Stream.Size = _GetFileSize(UpdaterFilename)) then
257 // Do not replace old updater if it's still valid. Avoids annoyance for cases in which 235 // Do not replace old updater if it's still valid. Avoids annoyance for cases in which
258 // user has whitelisted this .exe in his antivirus or whatever software. 236 // user has whitelisted this .exe in his antivirus or whatever software.
259 else 237 else
260 Stream.SaveToFile(UpdaterFilename); 238 Stream.SaveToFile(UpdaterFilename);
261 // Calling the script will now post a WM_CLOSE this running exe... 239 // Calling the script will now post a WM_CLOSE this running exe...
262 ShellExec(UpdaterFilename, '', '"'+ParamStr(0)+'" "'+Download.Filename+'"'); 240 ShellExec(UpdaterFilename, '', '"'+ParamStr(0)+'" "'+DownloadFilename+'"');
263 finally 241 finally
264 UnlockResource(ResHandle); 242 UnlockResource(ResHandle);
265 FreeResource(ResHandle); 243 FreeResource(ResHandle);
266 Stream.Free; 244 Stream.Free;
267 end; 245 end;
268 end; 246 end;
269 except 247 except
270 on E:Exception do 248 on E:Exception do
271 ErrorDialog(E.Message); 249 ErrorDialog(E.Message);
272 end; 250 end;
273 end; 251 end;
274 252
275 253
276 {** 254 {**
277 Download progress event 255 Download progress event
278 } 256 }
279 procedure TfrmUpdateCheck.URLOnDownloadProgress; 257 procedure TfrmUpdateCheck.DownloadProgress(Sender: TObject);
258 var
259 Download: THttpDownload;
280 begin 260 begin
281 if FLastStatusUpdate > GetTickCount-200 then 261 if FLastStatusUpdate > GetTickCount-200 then
282 Exit; 262 Exit;
283 Status('Downloading: '+FormatByteNumber(Progress)+' / '+FormatByteNumber(BuildSize) + ' ...'); 263 Download := Sender as THttpDownload;
264 Status('Downloading: '+FormatByteNumber(Download.BytesRead)+' / '+FormatByteNumber(Download.ContentLength) + ' ...');
284 FLastStatusUpdate := GetTickCount; 265 FLastStatusUpdate := GetTickCount;
285 end; 266 end;
286 267
287 268
288 end. 269 end.
Powered by Google Project Hosting