installprocesswindow.pas

{
    InstallProcessWindow используется для создания окна, в котором пользователь
    наблюдает процесс установки новой программы на Малик Эмулятор и ошибки,
    которые могли возникнуть в процессе установки.
    Этот исходный текст является частью Малик Эмулятора.

    Следующие файлы используются этим исходным текстом:
        installprocesswindow.lfm
    На них так же распространяются те же права, как и на этот исходный текст.

    Copyright © 2016–2017, 2019–2023 Малик Разработчик

    Малик Эмулятор – свободная программа: вы можете перераспространять её и/или
    изменять её на условиях Стандартной общественной лицензии GNU в том виде,
    в каком она была опубликована Фондом свободного программного обеспечения;
    либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.

    Малик Эмулятор распространяется в надежде, что он может быть полезен,
    но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
    или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Стандартной
    общественной лицензии GNU.

    Вы должны были получить копию Стандартной общественной лицензии GNU
    вместе с этой программой. Если это не так, см.
    <http://www.gnu.org/licenses/>.
}

unit InstallProcessWindow;

{$MODE DELPHI}

interface

uses
    Classes,
    SysUtils,
    Forms,
    StdCtrls,
    ComCtrls,
    ExtCtrls,
    LMessages,
    LCLIntf,
    Lang,
    Manifests,
    EmulConstants,
    EmulProgrammes,
    StaticRecompilers;

{%region public }
type
    TInstallProcessForm = class(TForm, _Interface, Runnable)
        processStatusLabel: TLabel;
        processStatus: TProgressBar;
        dialogInformation: TImage;
        dialogError: TImage;
        installResult: TMemo;
        closeButton: TButton;
        procedure formShow(sender: TObject);
        procedure formClose(sender: TObject; var action: TCloseAction);
    private
        installed: boolean;
        recompiler: StaticRecompiler;
        archive: AnsiString;
        destinationDirectory: AnsiString;
        programmeDirectory: AnsiString;
    protected
        message: AnsiString;
        procedure lmInstallEnd(var theMessage: TLMessage); message LM_USER + 1;
        procedure lmInstallError(var theMessage: TLMessage); message LM_USER + 2;
    public
        { _Interface }
        function getClass(): _Class;
        function asObject(): TObject;
        { Runnable }
        procedure run();
        { Собственные методы }
        procedure setInstallParameters(recompiler: StaticRecompiler; const archive, destinationDirectory: AnsiString);
        function getProgrammeDirectory(): AnsiString;
    end;
{%endregion}

implementation

{$R *.LFM}

{%region TInstallProcessForm }
    procedure TInstallProcessForm.formShow(sender: TObject);
    begin
        if not installed then begin
            installed := true;
            startThread(self);
        end;
    end;

    procedure TInstallProcessForm.formClose(sender: TObject; var action: TCloseAction);
    begin
        if closeButton.enabled then begin
            action := caHide;
        end else begin
            action := caNone;
        end;
    end;

    procedure TInstallProcessForm.lmInstallEnd(var theMessage: TLMessage);
    begin
        processStatusLabel.caption := 'Установка завершена';
        processStatus.style := pbstNormal;
        processStatus.position := processStatus.max;
        dialogInformation.visible := true;
        installResult.visible := true;
        installResult.text := message;
        closeButton.enabled := true;
    end;

    procedure TInstallProcessForm.lmInstallError(var theMessage: TLMessage);
    begin
        processStatusLabel.caption := 'Установка прервана';
        processStatus.style := pbstNormal;
        processStatus.position := 0;
        dialogError.visible := true;
        installResult.visible := true;
        installResult.text := message;
        closeButton.enabled := true;
    end;

    function TInstallProcessForm.getClass(): _Class;
    begin
        result := ClassData.create(classType());
    end;

    function TInstallProcessForm.asObject(): TObject;
    begin
        result := self;
    end;

    procedure TInstallProcessForm.run();
    var
        dir: AnsiString;
        msg: AnsiString;
        man: ProgrammeManifest;
    begin
        try
            dir := recompiler.createInstance().install(archive, destinationDirectory);
            man := ProgrammeManifest.create();
            try
                man.loadFromFile(dir + DIRECTORY_SEPARATOR + ProgrammeInfo.MANIFEST_FILE_NAME);
                message :=
                    'Новая программа установлена на Малик Эмулятор.' + (LINE_ENDING +
                    'Название: ') + man.getValue(MANIFEST_PROPERTY_PROGRAMME_NAME) + (LINE_ENDING +
                    'Папка: ') + dir + LINE_ENDING
                ;
                msg := man.getValue(MANIFEST_PROPERTY_PROGRAMME_INSTALL_NOTIFY);
                if length(msg) > 0 then begin
                    message := message + (LINE_ENDING + 'Сообщение от разработчиков установленной программы:' + LINE_ENDING) + msg;
                end;
            finally
                man.free();
            end;
            programmeDirectory := dir;
            postMessage(handle, LM_USER + 1, 0, 0);
        except
            on e: SysUtils.Exception do begin
                message :=
                    'Во время установки программы возникла ошибка.' + (LINE_ENDING +
                    'Класс: ') + (e.unitName() + '.' + e.className()) + (LINE_ENDING +
                    'Сообщение: ') + e.message
                ;
                postMessage(handle, LM_USER + 2, 0, 0);
            end;
            on e: Lang.Exception do begin
                message :=
                    'Во время установки программы возникла ошибка.' + (LINE_ENDING +
                    'Класс: ') + e.getClass().getName() + (LINE_ENDING +
                    'Сообщение: ') + e.getMessage()
                ;
                postMessage(handle, LM_USER + 2, 0, 0);
            end;
        end;
    end;

    procedure TInstallProcessForm.setInstallParameters(recompiler: StaticRecompiler; const archive, destinationDirectory: AnsiString);
    begin
        self.installed := false;
        self.recompiler := recompiler;
        self.archive := archive;
        self.destinationDirectory := destinationDirectory;
        self.programmeDirectory := '';
    end;

    function TInstallProcessForm.getProgrammeDirectory(): AnsiString;
    begin
        result := programmeDirectory;
    end;
{%endregion}

end.