mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-25 02:32:19 -05:00
f8787a9e1d
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@398 3f818213-9676-44b0-a9b4-5e4c4e03d09d
203 lines
5.2 KiB
ObjectPascal
203 lines
5.2 KiB
ObjectPascal
unit updateform;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
ComCtrls, StdCtrls, updater;
|
|
|
|
type
|
|
|
|
{ TSimbaUpdateForm }
|
|
|
|
{ TSimbaVersionThread }
|
|
|
|
TSimbaVersionThread = class(TThread)
|
|
public
|
|
ResultStr : string;
|
|
InputURL : string;
|
|
Done : boolean;
|
|
procedure Execute; override;
|
|
end;
|
|
TSimbaUpdateForm = class(TForm)
|
|
UpdateLog: TMemo;
|
|
UpdateButton: TButton;
|
|
OkButton: TButton;
|
|
CancelButton: TButton;
|
|
DownloadProgress: TProgressBar;
|
|
procedure CancelButtonClick(Sender: TObject);
|
|
procedure CleanUpdateForm(Sender: TObject);
|
|
procedure OkButtonClick(Sender: TObject);
|
|
procedure UpdateButtonClick(Sender: TObject);
|
|
function CanUpdate: Boolean;
|
|
|
|
private
|
|
{ private declarations }
|
|
|
|
Updater: TMMLFileDownloader;
|
|
FCancelling: Boolean;
|
|
FSimbaVersion: Integer;
|
|
SimbaVersionThread : TSimbaVersionThread;
|
|
private
|
|
function OnUpdateBeat: Boolean;
|
|
function GetLatestSimbaVersion: Integer;
|
|
public
|
|
{ public declarations }
|
|
procedure PerformUpdate;
|
|
protected
|
|
FCancelled: Boolean;
|
|
end;
|
|
|
|
|
|
var
|
|
SimbaUpdateForm: TSimbaUpdateForm;
|
|
|
|
implementation
|
|
|
|
uses
|
|
internets, TestUnit, simbasettings;
|
|
|
|
function TSimbaUpdateForm.CanUpdate: Boolean;
|
|
begin
|
|
GetLatestSimbaVersion;
|
|
Writeln(format('Current Simba version: %d',[TestUnit.SimbaVersion]));
|
|
Writeln('Latest Simba Version: ' + IntToStr(FSimbaVersion));
|
|
Exit(testunit.SimbaVersion < FSimbaVersion);
|
|
end;
|
|
|
|
function TSimbaUpdateForm.GetLatestSimbaVersion: Integer;
|
|
|
|
begin
|
|
if SimbaVersionThread = nil then//Create thread (only if no-other one is already running)
|
|
begin
|
|
SimbaVersionThread := TSimbaVersionThread.Create(true);
|
|
|
|
SimbaVersionThread.InputURL := SettingsForm.Settings.GetSetLoadSaveDefaultKeyValueIfNotExists(
|
|
'Settings/Updater/RemoteVersionLink',
|
|
'http://old.villavu.com/merlijn/Simba'{$IFDEF WINDOWS} +
|
|
'.exe'{$ENDIF} + '.version',
|
|
SimbaSettingsFile);
|
|
|
|
SimbaVersionThread.Resume;
|
|
while SimbaVersionThread.Done = false do//Wait till thread is done
|
|
begin
|
|
Application.ProcessMessages;
|
|
Sleep(50);
|
|
end;
|
|
FSimbaVersion := StrToIntDef(Trim(SimbaVersionThread.ResultStr), -1);//Read output
|
|
FreeAndNil(SimbaVersionThread);//Free the thread
|
|
end else
|
|
begin
|
|
//Another thread is already running, lets wait for it! (When it's nil, it means that the result is written!)
|
|
while SimbaVersionThread = nil do
|
|
begin;
|
|
Application.ProcessMessages;
|
|
Sleep(50);
|
|
end;
|
|
end;
|
|
Exit(FSimbaVersion);
|
|
end;
|
|
|
|
procedure TSimbaUpdateForm.UpdateButtonClick(Sender: TObject);
|
|
begin
|
|
Self.PerformUpdate;
|
|
end;
|
|
|
|
procedure TSimbaUpdateForm.CancelButtonClick(Sender: TObject);
|
|
begin
|
|
if FCancelled then
|
|
begin
|
|
Self.ModalResult:=mrCancel;
|
|
Self.Hide;
|
|
end else
|
|
begin
|
|
FCancelling := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TSimbaUpdateForm.CleanUpdateForm(Sender: TObject);
|
|
begin
|
|
Self.DownloadProgress.Position:=0;
|
|
Self.UpdateLog.Clear;
|
|
Self.UpdateLog.Lines.Add('---------- Update Session ----------');
|
|
end;
|
|
|
|
procedure TSimbaUpdateForm.OkButtonClick(Sender: TObject);
|
|
begin
|
|
Self.ModalResult:=mrOK;
|
|
Self.Hide;
|
|
end;
|
|
|
|
{ Return true if we have to cancel }
|
|
function TSimbaUpdateForm.OnUpdateBeat: Boolean;
|
|
var
|
|
Percentage: Integer;
|
|
begin
|
|
Application.ProcessMessages;
|
|
|
|
Percentage := Updater.GetPercentage();
|
|
if Percentage <> -1 then
|
|
DownloadProgress.Position:=Percentage;
|
|
|
|
Result := FCancelling;
|
|
end;
|
|
|
|
procedure TSimbaUpdateForm.PerformUpdate;
|
|
|
|
begin
|
|
Updater := TMMLFileDownloader.Create;
|
|
|
|
FCancelling := False;
|
|
FCancelled := False;
|
|
|
|
Updater.FileURL := SettingsForm.Settings.GetSetLoadSaveDefaultKeyValueIfNotExists(
|
|
'Settings/Updater/RemoteLink',
|
|
'http://old.villavu.com/merlijn/Simba'{$IFDEF WINDOWS} +'.exe'{$ENDIF},
|
|
SimbaSettingsFile
|
|
);
|
|
|
|
//ApplicationName{$IFDEF WINDOWS} +'.exe'{$ENDIF};
|
|
|
|
// Should work on Windows as well
|
|
Updater.ReplacementFile := ExtractFileName(Application.ExeName);
|
|
Updater.OnBeat := @Self.OnUpdateBeat;
|
|
Updater.BasePath := ExtractFilePath(Application.ExeName);
|
|
|
|
Self.UpdateLog.Lines.Add('Starting download of ' + Updater.FileURL + ' ...');
|
|
try
|
|
Self.OkButton.Enabled := False; // grey out button
|
|
Updater.DownloadAndSave;
|
|
Self.UpdateLog.Lines.Add('Downloaded to ' + Updater.ReplacementFile + '_ ...');
|
|
Updater.Replace;
|
|
Self.UpdateLog.Lines.Add('Renaming ' + Updater.ReplacementFile + ' to ' + Updater.ReplacementFile + '_old_');
|
|
Self.UpdateLog.Lines.Add('Renaming ' + Updater.ReplacementFile + '_ to ' + Updater.ReplacementFile);
|
|
Self.UpdateLog.Lines.Add('Deleting ' + Updater.ReplacementFile + '_old_');
|
|
Updater.Free;
|
|
except
|
|
FCancelling := False;
|
|
FCancelled := True;
|
|
Self.UpdateLog.Lines.Add('Download stopped ...');
|
|
// more detailed info
|
|
writeln('EXCEPTION IN UPDATEFORM: We either hit Cancel, or something went wrong with files');
|
|
end;
|
|
Self.UpdateLog.Lines.Add('Done ... ');
|
|
Self.UpdateLog.Lines.Add('Please restart all currently running Simba binaries.');
|
|
Self.OkButton.Enabled := True; // un-grey out button
|
|
end;
|
|
|
|
{ TSimbaVersionThread }
|
|
|
|
procedure TSimbaVersionThread.Execute;
|
|
begin
|
|
ResultStr:= GetPage(InputURL);
|
|
done := true;
|
|
end;
|
|
|
|
initialization
|
|
{$I updateform.lrs}
|
|
|
|
end.
|
|
|