root/branches/0_1_3/InstallerServiceClass.pas

///////////////////////////////////////////////////////////
//                     GGBuildTools                      //
//    Набор утилит для сборки проектов Gipat Group       //
//             Copyright (C) 2007 Gipat Group            //
//              Распространяется на условиях             //
//    Gipat Group's opened EI-editor-utility license     //
//                      версии 1.0                       //
//                                                       //
//                  www.gipatgroup.org                   //
///////////////////////////////////////////////////////////

//К работе над данным файлом приложили руки, ноги.... короче аффтары:
// 1) Sagrer (sagrer@yandex.ru)

////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////
//          Служебный класс для Installer             //
////////////////////////////////////////////////////////

unit InstallerServiceClass;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, forms, Registry, ExtraFunctionsLcl, GGBuildToolsShared, GGConsUtilServiceClass, ExtraFileUtilsLCL;
  
const
  GGBT_InstallerAppName = 'Installer';
  
type
  TInstallerServiceClass = class (TGGConsUtilServiceClass)       //Класс с основным функционалом и данными инсталлера
  private
  protected
  public
    //Переменные
    Registr : TRegistry;               //Объект класса для работы с виндовым реестром.
    InstalledTools : RInstalledTools;  //Инфа про установленные тулсы
    
    //Конструкторы-деструкторы...
    constructor Create; override;
    destructor Destroy; override;
    
    //Другие методы...
    procedure DoWork;        override;   //Выполнить боевую задачу %).
    procedure InstallIt;                 //Выполнить инсталляцию.
    procedure ShowDescription; override; //Вывести описание утилиты.
    
  end;
  
var
  InstServClass : TInstallerServiceClass;

implementation

/////////////////////////////////////////////
//         TInstallerServiceClass          //
/////////////////////////////////////////////

//-----------------------------------------//
//        Конструкторы-деструкторы...      //
//-----------------------------------------//

constructor TInstallerServiceClass.Create;
begin
  //Проставить дефолтные значения...
  InstalledTools.IssBuilder_installed := false;
  InstalledTools.StarterModBuilder_installed := false;
  InstalledTools.StarterModSynchronizator_installed := false;
  InstalledTools.VerRevUpdater_installed := false;
  
  //Создать вложенные объекты классов...
  Registr := TRegistry.Create;
  
  //Вбить имя приложения.
  Self.GGConsAppName := GGBT_InstallerAppName;
  
  //Выполнить конструктор предка...
  inherited;
end;

destructor TInstallerServiceClass.Destroy;
begin
  //Выкидываем мусор
  Registr.Free;

  //Выполнить унаследованный деструктор
  inherited;
end;

//------------------------------------------//
//             Другие методы...             //
//------------------------------------------//

procedure TInstallerServiceClass.DoWork;
//Выполнить боевую задачу %).
begin
  //Выполнить нужно одну из задач - по её завершении ProcessFurther := false
  //и дальше нифига не выполняется.
  
  //Выполнить унаследованную функцию
  inherited;
  
  //Если ничего до сих пор не выполнилось - то выполняем боевую задачу....
  if ProcessFurther = true then begin
    //Блокировка других веток
    ProcessFurther := false;
    //Работаем....
    InstallIt;
  end;
  
end;

procedure TInstallerServiceClass.InstallIt;
var
  CurPath, CurVer, ExePath, OldPath, Answer : string;
  NeedInstall, WasOldPath, OldVersionInstalled : boolean;
begin
  //Выполнить инсталляцию.
  
  //Все очень просто. Проверяем ключ реестра проги, если он есть - смотрим тот ли там путь,
  //если не тот - спрашиваем регистрировать ли путь, затем смотрим PATH, если там
  //есть старый путь - удаляем. Затем добавляем новый путь в переменную и ключег в реестр.
  
  NeedInstall := false;   //По умолчанию - ниче трогать не надо %).
  WasOldPath := false;   //И считаем что по другим путям ниче не установлено.
  ExePath := DelLastSlash(ExtractFilePath(Application.ExeName))+'\bin';   //Сразу получим путь к GGBuildTools.
  OldVersionInstalled := false;   //Считаем что более старой версии не установлено.
  
  //Выводим сначала версию...
  ShowVersion();
  //Отделяющая строка.
  Writeln();
  
  //Пишем что собираем инфу...
  Writeln('Gathering infirmation...');
  Writeln('');
  
  //Итак, проверям ключ реестра...
  Registr.RootKey := HKEY_CURRENT_USER;
  if Registr.OpenKey('\Software\Gipat Group\'+AllProjectName,false) = true then begin
  //if Registr.KeyExists('\Software\Gipat Group\'+AllProjectName,false) = true then begin    //#LCL-BUG
    //Registr.OpenKey('\Software\Gipat Group\'+AllProjectName,false);                        //#LCL-BUG
    
    //Есть такой ключег... смотрим чего там внутрях %).
    CurPath := Registr.ReadString('path');
    CurVer := Registr.ReadString('ver');
    Registr.CloseKey;
    
    //Ок. Теперь - проверяем, правильный ли там путь...
    if UpperCase(DelLastSlash(ExtractFilePath(Application.ExeName))) <> UpperCase(DelLastSlash(CurPath)) then begin
      //Не, не совпало.
      WasOldPath := true;
      OldPath := DelLastSlash(CurPath);
    end;
    
    //Теперь смотрим на номер версии...
    if IsNewVersion(CurVer,Self.AppVersion.GenerateDotsVersionString()) = true then begin
      //Если стоит старая версия...
      OldVersionInstalled := true;
    end;
    
    //Если эта версия уже установлена, по этому же пути - то нет смысла еще раз
    //устанавливаться, о чем и сообщаем %).
    if (WasOldPath = false) and (OldVersionInstalled = false) then begin
      Writeln('This version is already installed into this directory.');
      Writeln('So, we no need to reinstall now.');
      Writeln('Installation aborted %)');
    end;
    
    //Теперь выясняем вопрос о необходимости переустановки...
    
    //Если был прописан другой путь.
    If WasOldPath = true then begin
      //Спрашиваем если нужно.
      if DoSilent <> true then begin
        Writeln('Another version is installed with path:');
        Writeln(OldPath);
        Write('Continue installing this version, deinstalling this another? (y/n) > ');
        Readln(Answer);
      end
      else begin
        Writeln('Another version is installed with path:');
        Writeln(OldPath);
        Writeln('I''ll deinstall this another!');
        Answer := 'y';
      end;
      
      if UpperCase(Answer) = 'Y' then begin
        NeedInstall := true;  //Отмечаем необходимость переустановки.
      end;
    end;

    //Если была прописана другая версия, но с путем все было ок.
    If (WasOldPath = false) and (OldVersionInstalled = true) then begin
      //Нужно спросить (если нужно %) ) обновлять ли на новую версию.
      if DoSilent <> true then begin
        Writeln('Older version ( '+CurVer+' ) is installed.');
        Write('Update (y) or cancel (n) ? (y/n) > ');
        Readln(Answer);
      end
      else begin
        Writeln('Older version ( '+CurVer+' ) is installed.');
        Writeln('Updating!');
        Answer := 'y';
      end;
      
      if UpperCase(Answer) = 'Y' then begin
        NeedInstall := true;  //Отмечаем необходимость переустановки.
      end;
    end;
    
  end
  else begin
    //Нету нифига в реестре. Просто переустанавливаем...
    NeedInstall := true;
  end;
  
  //Запрос на собсно установку %)
  if NeedInstall = true then begin
    if DoSilent = false then begin
      Write('All is ready. Really want to install? (y/n) > ');
      Readln(Answer);
      if UpperCase(Answer) <> 'Y' then begin
        NeedInstall := false;  //Облом, отмена установки.
        Writeln('Ok, canceled.');
      end
      else begin
        Writeln('Ok, installing is confirmed.');
      end;
    end
    else begin
      Writeln('All is ready. Installing is confirmed automatically.');
    end;
  end;
  
  //Теперь собсно установка.
  if NeedInstall = true then begin
  
    Writeln('');
    Writeln('');
    Writeln('');
    Writeln('Installing started!');
    Writeln('');
    Writeln('');

///////////////////////////

    //Проверяем наличие тулсов...
    Writeln('Checking tools: ');

    Write('IssBuilder                              ');
    if FileExists(DelLastSlash(ExePath)+'\IssBuilder.exe') = true then begin
      //Экзешнег присутствует...
      InstalledTools.IssBuilder_installed := true;
      Writeln('[  OK  ]');
    end
    else begin
      //Нету нифигга.
      InstalledTools.IssBuilder_installed := false;
      Writeln('[ FAIL ]');
    end;
    
    Write('VerRevUpdater                           ');
    if FileExists(DelLastSlash(ExePath)+'\VerRevUpdater.exe') = true then begin
      //Экзешнег присутствует...
      InstalledTools.VerRevUpdater_installed := true;
      Writeln('[  OK  ]');
    end
    else begin
      //Нету нифигга.
      InstalledTools.VerRevUpdater_installed := false;
      Writeln('[ FAIL ]');
    end;
    
    Write('StarterModBuilder                       ');
    if FileExists(DelLastSlash(ExePath)+'\StarterModBuilder.exe') = true then begin
      //Экзешнег присутствует...
      InstalledTools.StarterModBuilder_installed := true;
      Writeln('[  OK  ]');
    end
    else begin
      //Нету нифигга.
      InstalledTools.StarterModBuilder_installed := false;
      Writeln('[ FAIL ]');
    end;
    
    Write('StarterModSynchtonizator                ');
    if FileExists(DelLastSlash(ExePath)+'\StarterModSynchronizator.exe') = true then begin
      //Экзешнег присутствует...
      InstalledTools.StarterModSynchronizator_installed := true;
      Writeln('[  OK  ]');
    end
    else begin
      //Нету нифигга.
      InstalledTools.StarterModSynchronizator_installed := false;
      Writeln('[ FAIL ]');
    end;
    
    Write('SourcePackBuilder                       ');
    if FileExists(DelLastSlash(ExePath)+'\SourcePackBuilder.exe') = true then begin
      //Экзешнег присутствует...
      InstalledTools.SourcePackBuilder_installed := true;
      Writeln('[  OK  ]');
    end
    else begin
      //Нету нифигга.
      InstalledTools.SourcePackBuilder_installed := false;
      Writeln('[ FAIL ]');
    end;
    
    Writeln('');
    
/////////////////////////////

    //Если что-то было зарегистрировано по старому пути...
    if WasOldPath = true then begin
      //Просто удаляем старый путь.
      if EnvPathRemove(OldPath,true,true) = true then begin
        Writeln('Deleted old path from environment.');
      end;
    end;
    
    //Теперь - если нужно - удаляем старый раздел реестра...
    if Registr.OpenKey('\Software\Gipat Group\'+AllProjectName,false) = true then begin
      Registr.CloseKey();
      Registr.DeleteKey('\Software\Gipat Group\'+AllProjectName);
      Writeln('Deleted old registry key.');
    end;
    
    //Дальше - типо стандартный инсталл.
    Writeln('');
    Writeln('Standard installation started.');
    Writeln('');
    //Добавляем переменную в User path-а.
    Write('Adding into PATH wariable: ');
    if not ( (OldVersionInstalled = true) and (WasOldPath = false) ) then begin
      //Новый путь нужно вбить во всех случаях, кроме как когда поменялась только версия но не путь.
      EnvPathAdd(DelLastSlash(ExePath),EnvPathAdd_User);
    end;
    Writeln(DelLastSlash(ExePath));
    Writeln('done.');
    Writeln('');
    //Создаем ключег в реестре.
    Writeln('Registering in a registry...');
    Registr.RootKey := HKEY_CURRENT_USER;
    Registr.OpenKey('\Software\Gipat Group\'+AllProjectName, true);
    //И вбиваем в него содержимое...
    Registr.WriteString('path',DelLastSlash(ExtractFilePath(Application.ExeName)));
    Registr.WriteString('ver',Self.AppVersion.GenerateDotsVersionString());
    Registr.WriteBool('IssBuilder_installed',InstalledTools.IssBuilder_installed);
    Registr.WriteBool('VerRevUpdater_installed',InstalledTools.VerRevUpdater_installed);
    Registr.WriteBool('StarterModBuilder_installed',InstalledTools.StarterModBuilder_installed);
    Registr.WriteBool('StarterModSynchronizator_installed',InstalledTools.StarterModSynchronizator_installed);
    Registr.WriteBool('SourcePackBuilder_installed',InstalledTools.SourcePackBuilder_installed);
    //Закрываем ключег...
    Registr.CloseKey;
    Writeln('done.');
    Writeln('');
    //Сообсчаем об успешном завершении инсталляции.
    Writeln('Installation completed succesfully!');
    Writeln('');
  end;
  
end;

procedure TInstallerServiceClass.ShowDescription;
//Вывести описание утилиты.
begin
  inherited;
  Writeln('Description:');
  Writeln('             Installs '+AllProjectName+' to your system. No files copying, only');
  Writeln('             registering in windows registry and environment variables.');
end;


/////////////////////////////////
initialization

//Инициализация %). Выделим память, создадим всякую херню... как обычно в общем %)
begin
  InstServClass := TInstallerServiceClass.Create;
end;

finalization
//Мочим все лишнее...
begin
  InstServClass.Free;
end;

end.