opensource/HeidiSQL
1
0
Fork 0
mirror of https://github.com/HeidiSQL/HeidiSQL.git synced 2025-08-06 18:24:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

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.

Browse Source
This commit is contained in:
Ansgar Becker
2008-02-27 19:31:58 +00:00
parent d6d8f88417
commit 2f30ee2e68
6 changed files with 92 additions and 225 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
packages/delphi10/heidisql.dpr
View File

@ -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}

3
packages/delphi11/heidisql.dpr
View File

@ -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}

3
packages/delphi11/heidisql.dproj
View File

@ -137,9 +137,6 @@
<DCCReference Include="..\..\source\updatecheck.pas">
<Form>frmUpdateCheck</Form>
</DCCReference>
<DCCReference Include="..\..\source\updatedownload.pas">
<Form>frmUpdateDownload</Form>
</DCCReference>
<DCCReference Include="..\..\source\usermanager.pas">
<Form>UserManagerForm</Form>
</DCCReference>

92
source/updatecheck.pas
View File

@ -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.

51
source/updatedownload.dfm
View File

@ -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

165
source/updatedownload.pas
View File

@ -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.