From 2f30ee2e68845ca79d9211b6433caf7cca59de4c Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Wed, 27 Feb 2008 19:31:58 +0000 Subject: [PATCH] Simplify updatecheck: Make unit updatedownload superflous by moving relevant code to updatecheck.pas. Resign from displaying a progressbar for the mostly short download time, instead use the existing status label for a textual progress information. --- packages/delphi10/heidisql.dpr | 3 +- packages/delphi11/heidisql.dpr | 3 +- packages/delphi11/heidisql.dproj | 3 - source/updatecheck.pas | 92 ++++++++++++++++- source/updatedownload.dfm | 51 ---------- source/updatedownload.pas | 165 ------------------------------- 6 files changed, 92 insertions(+), 225 deletions(-) delete mode 100644 source/updatedownload.dfm delete mode 100644 source/updatedownload.pas diff --git a/packages/delphi10/heidisql.dpr b/packages/delphi10/heidisql.dpr index e6888f04..c43edcfc 100644 --- a/packages/delphi10/heidisql.dpr +++ b/packages/delphi10/heidisql.dpr @@ -35,8 +35,7 @@ uses data_sorting in '..\..\source\data_sorting.pas' {DataSortingForm}, runsqlfile in '..\..\source\runsqlfile.pas' {RunSQLFileForm}, createdatabase in '..\..\source\createdatabase.pas' {CreateDatabaseForm}, - updatecheck in '..\..\source\updatecheck.pas' {frmUpdateCheck}, - updatedownload in '..\..\source\updatedownload.pas' {frmUpdateDownload}; + updatecheck in '..\..\source\updatecheck.pas' {frmUpdateCheck}; {$R *.RES} diff --git a/packages/delphi11/heidisql.dpr b/packages/delphi11/heidisql.dpr index e6888f04..c43edcfc 100644 --- a/packages/delphi11/heidisql.dpr +++ b/packages/delphi11/heidisql.dpr @@ -35,8 +35,7 @@ uses data_sorting in '..\..\source\data_sorting.pas' {DataSortingForm}, runsqlfile in '..\..\source\runsqlfile.pas' {RunSQLFileForm}, createdatabase in '..\..\source\createdatabase.pas' {CreateDatabaseForm}, - updatecheck in '..\..\source\updatecheck.pas' {frmUpdateCheck}, - updatedownload in '..\..\source\updatedownload.pas' {frmUpdateDownload}; + updatecheck in '..\..\source\updatecheck.pas' {frmUpdateCheck}; {$R *.RES} diff --git a/packages/delphi11/heidisql.dproj b/packages/delphi11/heidisql.dproj index ff5f7a28..f8f323f1 100644 --- a/packages/delphi11/heidisql.dproj +++ b/packages/delphi11/heidisql.dproj @@ -137,9 +137,6 @@
frmUpdateCheck
 - -
frmUpdateDownload
-
UserManagerForm
 diff --git a/source/updatecheck.pas b/source/updatecheck.pas index 997f903c..3e730d17 100644 --- a/source/updatecheck.pas +++ b/source/updatecheck.pas @@ -26,6 +26,8 @@ type ReleaseURL, BuildURL : String; procedure Status(txt: String); procedure ReadCheckFile; + procedure URLOnDownloadProgress(Sender: TDownLoadURL; Progress, ProgressMax: Cardinal; + StatusCode: TURLDownloadStatus; StatusText: String; var Cancel: Boolean); public { Public declarations } AutoClose: Boolean; // Automatically close dialog after detecting no available downloads @@ -34,7 +36,7 @@ type implementation -uses helpers, main, UpdateDownload; +uses helpers, main; {$R *.dfm} @@ -196,8 +198,94 @@ end; Download latest build and replace running exe } procedure TfrmUpdateCheck.btnBuildClick(Sender: TObject); +var + Download: TDownLoadURL; + ScriptFile: Textfile; + ExeName, ScriptFilename, ScriptContent: String; begin - DoUpdateDownload(Self, BuildURL, Application.ExeName); + Download := TDownLoadURL.Create(Self); + Download.URL := BuildURL; + ExeName := ExtractFileName(Application.ExeName); + + // Save the file in a temp directory + Download.Filename := GetTempDir + ExeName; + Download.OnDownloadProgress := URLOnDownloadProgress; + + // Delete probably previously downloaded file + if FileExists(Download.Filename) then + DeleteFile(Download.Filename); + + // Do the download + Download.ExecuteTarget(nil); + + // Check if downloaded file exists + if not FileExists(Download.Filename) then + Raise Exception.Create('Downloaded file not found: '+Download.Filename); + + // The Visual Basic Script code which kills this exe and moves the + // downloaded file to the application directory. + // This file moving can fail due to several reasons. Especially in Vista + // where users are normally not admins, they'll get a "Permission denied". + // However, the script does several write attempts and quits with a clear + // error message if it couldn't move the file. + // TODO: move this code to a seperate file for easier debugging + Status('Update in progress ...'); + ScriptContent := ''' This is a temporary script which shall update your ' + APPNAME + CRLF + + ''' with a nightly build.' + CRLF + + CRLF + + 'ExeName = "'+ExeName+'"' + CRLF + + 'DownloadFileName = "'+Download.Filename+'"' + CRLF + + 'TargetFileName = "'+Application.ExeName+'"' + CRLF + + CRLF + + 'WScript.Echo "Terminating """&ExeName&""" ..."' + CRLF + + 'Set Shell = WScript.CreateObject("WScript.Shell")' + CRLF + + 'Shell.Run("taskkill /im """&ExeName&""" /f")' + CRLF + + CRLF + + 'Set FileSystem = CreateObject("Scripting.FileSystemObject")' + CRLF + + 'Set DownloadFile = FileSystem.GetFile(DownloadFileName)' + CRLF + + 'Set TargetFile = FileSystem.GetFile(TargetFileName)' + CRLF + + 'On Error Resume Next' + CRLF + + 'MaxAttempts = 10' + CRLF + + 'for x = 1 to MaxAttempts' + CRLF + + ' WScript.Echo "Deleting "&ExeName&" (attempt "&x&" of "&MaxAttempts&") ..."' + CRLF + + ' TargetFile.Delete' + CRLF + + ' If Err.Number = 0 Then' + CRLF + + ' Err.Clear' + CRLF + + ' Exit For' + CRLF + + ' End If' + CRLF + + ' Err.Clear' + CRLF + + ' WScript.Sleep(2000)' + CRLF + + 'Next' + CRLF + + 'If Err.Number <> 0 Then' + CRLF + + ' WScript.Echo "Error: Cannot delete file "&TargetFileName' + CRLF + + ' WScript.Sleep(10000)' + CRLF + + ' Wscript.Quit' + CRLF + + 'End If' + CRLF + + 'Err.Clear' + CRLF + + CRLF + + 'WScript.Echo "Installing new build ..."' + CRLF + + 'DownloadFile.Move TargetFileName' + CRLF + + CRLF + + 'WScript.Echo "Restarting ..."' + CRLF + + 'Shell.Run(""""&TargetFileName&"""")'; + // Write script file to disk + ScriptFilename := GetTempDir + APPNAME + '_Update.vbs'; + AssignFile(ScriptFile, ScriptFilename); + Rewrite(ScriptFile); + Write(Scriptfile, ScriptContent); + CloseFile(ScriptFile); + // Calling the script will now terminate the running exe... + WinExec(PAnsiChar('cscript.exe "'+ScriptFilename+'"'), 1); end; + +{** + Download progress event +} +procedure TfrmUpdateCheck.URLOnDownloadProgress; +begin + Status('Downloading: '+FormatByteNumber(Progress)+' / '+FormatByteNumber(ProgressMax) + ' ...'); +end; + + end. diff --git a/source/updatedownload.dfm b/source/updatedownload.dfm deleted file mode 100644 index 1c58e679..00000000 --- a/source/updatedownload.dfm +++ /dev/null @@ -1,51 +0,0 @@ -object frmUpdateDownload: TfrmUpdateDownload - Left = 0 - Top = 0 - BorderStyle = bsDialog - Caption = 'Downloading update file ...' - ClientHeight = 95 - ClientWidth = 286 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OldCreateOrder = False - Position = poOwnerFormCenter - DesignSize = ( - 286 - 95) - PixelsPerInch = 96 - TextHeight = 13 - object lblStatus: TLabel - Left = 8 - Top = 31 - Width = 270 - Height = 28 - Anchors = [akLeft, akTop, akRight] - AutoSize = False - Caption = 'lblStatus' - WordWrap = True - end - object progressDownload: TProgressBar - Left = 8 - Top = 8 - Width = 270 - Height = 17 - Anchors = [akLeft, akTop, akRight] - TabOrder = 0 - end - object btnCancel: TButton - Left = 104 - Top = 62 - Width = 68 - Height = 25 - Anchors = [akLeft, akTop, akRight] - Cancel = True - Caption = 'Cancel' - ModalResult = 2 - TabOrder = 1 - OnClick = btnCancelClick - end -end diff --git a/source/updatedownload.pas b/source/updatedownload.pas deleted file mode 100644 index 6884fbcf..00000000 --- a/source/updatedownload.pas +++ /dev/null @@ -1,165 +0,0 @@ -unit updatedownload; - -interface - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, ComCtrls, ExtActns, Helpers; - -type - TfrmUpdateDownload = class(TForm) - progressDownload: TProgressBar; - lblStatus: TLabel; - btnCancel: TButton; - procedure btnCancelClick(Sender: TObject); - private - { Private declarations } - Download: TDownLoadURL; - DoCancel: Boolean; - FilePath: String; - procedure DoDownload; - procedure URLOnDownloadProgress(Sender: TDownLoadURL; Progress, ProgressMax: Cardinal; - StatusCode: TURLDownloadStatus; StatusText: String; var Cancel: Boolean); - public - { Public declarations } - end; - -function DoUpdateDownload(AOwner: TComponent; URL, FilePath: String): Boolean; - -implementation - -{$R *.dfm} - - -{** - Initiate the download + update process -} -function DoUpdateDownload(AOwner: TComponent; URL, FilePath: String): Boolean; -var - frm: TfrmUpdateDownload; -begin - Result := False; - frm := TfrmUpdateDownload.Create(AOwner); - frm.Download := TDownLoadURL.Create(frm); - frm.Download.URL := URL; - frm.FilePath := FilePath; - frm.DoDownload; -end; - - -{** - Cancel clicked -} -procedure TfrmUpdateDownload.btnCancelClick(Sender: TObject); -begin - DoCancel := True; -end; - - -{** - Start the download + update process -} -procedure TfrmUpdateDownload.DoDownload; -var - ScriptFile: Textfile; - ScriptFilename, ScriptContent: String; -begin - Show; - - // Save the file in a temp directory - Download.Filename := GetTempDir + ExtractFileName(Filepath); - Download.OnDownloadProgress := URLOnDownloadProgress; - - // Delete probably previously downloaded file - if FileExists(Download.Filename) then - DeleteFile(Download.Filename); - - // Do the download - Download.ExecuteTarget(nil); - - // Check if downloaded file exists - if not FileExists(Download.Filename) then - Raise Exception.Create('Downloaded file not found: '+Download.Filename); - - if FilePath = Application.ExeName then begin - // The Visual Basic Script code which kills this exe and moves the - // downloaded file to the application directory. - // This file moving can fail due to several reasons. Especially in Vista - // where users are normally not admins, they'll get a "Permission denied". - // However, the script does several write attempts and quits with a clear - // error message if it couldn't move the file. - // TODO: move this code to a seperate file for easier debugging - ScriptContent := ''' This is a temporary script which shall update your ' + APPNAME + CRLF + - ''' with a nightly build.' + CRLF + - CRLF + - 'ExeName = "'+ExtractFilename(FilePath)+'"' + CRLF + - 'DownloadFileName = "'+Download.Filename+'"' + CRLF + - 'TargetFileName = "'+FilePath+'"' + CRLF + - CRLF + - 'WScript.Echo "Terminating """&ExeName&""" ..."' + CRLF + - 'Set Shell = WScript.CreateObject("WScript.Shell")' + CRLF + - 'Shell.Run("taskkill /im """&ExeName&""" /f")' + CRLF + - CRLF + - 'Set FileSystem = CreateObject("Scripting.FileSystemObject")' + CRLF + - 'Set DownloadFile = FileSystem.GetFile(DownloadFileName)' + CRLF + - 'Set TargetFile = FileSystem.GetFile(TargetFileName)' + CRLF + - 'On Error Resume Next' + CRLF + - 'MaxAttempts = 10' + CRLF + - 'for x = 1 to MaxAttempts' + CRLF + - ' WScript.Echo "Deleting "&ExeName&" (attempt "&x&" of "&MaxAttempts&") ..."' + CRLF + - ' TargetFile.Delete' + CRLF + - ' If Err.Number = 0 Then' + CRLF + - ' Err.Clear' + CRLF + - ' Exit For' + CRLF + - ' End If' + CRLF + - ' Err.Clear' + CRLF + - ' WScript.Sleep(2000)' + CRLF + - 'Next' + CRLF + - 'If Err.Number <> 0 Then' + CRLF + - ' WScript.Echo "Error: Cannot delete file "&TargetFileName' + CRLF + - ' WScript.Sleep(10000)' + CRLF + - ' Wscript.Quit' + CRLF + - 'End If' + CRLF + - 'Err.Clear' + CRLF + - CRLF + - 'WScript.Echo "Installing new build ..."' + CRLF + - 'DownloadFile.Move TargetFileName' + CRLF + - CRLF + - 'WScript.Echo "Restarting ..."' + CRLF + - 'Shell.Run(""""&TargetFileName&"""")'; - // Write script file to disk - ScriptFilename := GetTempDir + APPNAME + '_Update.vbs'; - AssignFile(ScriptFile, ScriptFilename); - Rewrite(ScriptFile); - Write(Scriptfile, ScriptContent); - CloseFile(ScriptFile); - // Calling the script will now terminate the running exe... - WinExec(PAnsiChar('cscript.exe "'+ScriptFilename+'"'), 1); - end else begin - // We're not replacing the running exe, so just move file to destination - MoveFile(PChar(Download.Filename), PChar(FilePath)); - end; - - // Close form - ModalResult := mrOK; -end; - - -{** - Download progress event -} -procedure TfrmUpdateDownload.URLOnDownloadProgress(Sender: TDownLoadURL; Progress, ProgressMax: Cardinal; - StatusCode: TURLDownloadStatus; StatusText: String; var Cancel: Boolean); -begin - progressDownload.Max := ProgressMax; - progressDownload.Position := Progress; - lblStatus.Caption := StatusText; - // Notification if cancel button was pressed - Cancel := DoCancel; - Application.ProcessMessages; -end; - - - - -end.