main

unit Main;

interface

uses
  // 0) RTL
  System.SysUtils,
  System.Types,
  System.Classes,
  System.UITypes,
  System.Variants,

  // 1) Winapi
  Winapi.Windows,
  Winapi.ShlObj,
  Winapi.ActiveX,

  // 2) FMX
  FMX.Controls,
  FMX.Controls.Presentation,
  FMX.Forms,
  FMX.Graphics,
  FMX.Layouts,
  FMX.Objects,
  FMX.StdCtrls,
  FMX.Edit,
  FMX.Dialogs,
  FMX.Types,

  // 3) Проектные
  ConfigData,
  ISArcExM_Header;

type
  TForm1 = class(TForm)
    Background: TRectangle;
    TitleBar: TLayout;
    LabelTitle: TLabel;
    ButtonClose: TButton;
    StyleBook1: TStyleBook;
    ImageContent: TImage;
    LabelInfo: TLabel;
    LabelDesc: TLabel;
    ButtonExit: TButton;
    ButtonInstall: TButton;
    LabelDisk: TLabel;
    LabelSize: TLabel;
    DirEdit: TEdit;
    ButtonBrowse: TButton;
    LabelTasks: TLabel;
    CheckBoxIcons: TCheckBox;
    CheckBoxRedists: TCheckBox;
    ProgressBarInstall: TProgressBar;
    LabelStatus: TLabel;
    LabelExtra: TLabel;
    LabelPercent: TLabel;

    procedure TitleBarMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Single);
    procedure ButtonCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ButtonBrowseClick(Sender: TObject);
    procedure ButtonInstallClick(Sender: TObject);

  private
    FTempDir: string;
    procedure CleanTempFolder;
    procedure StartUnpacking;

  public
    procedure UpdateFreeLabel(const APath: string);
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

uses
  System.IOUtils,
  FMX.Platform.Win;    // для WindowHandleToPlatform

resourcestring
  SChooseFolder   = 'Выберите диск или папку установки';
  SNotEnoughSpace = 'Недостаточно места на диске для установки.';
  SSizeFormat     = '%.0f Гб. Нужно | %.0f Гб. Есть';
  SWaitProc       = 'Ожидание...';
  SUnpackProc     = 'Установка:';

//----------------------------------------------------------------------------//
// Lowlevel расчёт свободного места (МБ)                                      //
//----------------------------------------------------------------------------//
function GetFreeSpaceMB(const APath: string): Double;
var
  freeBytes: UInt64;
  driveRoot: string;
begin
  driveRoot := IncludeTrailingPathDelimiter(ExtractFileDrive(APath));
  if not GetDiskFreeSpaceEx(PChar(driveRoot), @freeBytes, nil, nil) then
    Exit(0);
  Result := freeBytes / 1024 / 1024;
end;

//----------------------------------------------------------------------------//
// Проверка места на диске                                                    //
//----------------------------------------------------------------------------//
function CheckSpace(const APath: string; const RequiredMB: Double): Boolean;
var
  freeMB: Double;
begin
  freeMB := GetFreeSpaceMB(APath);
  if freeMB < RequiredMB then
  begin
    ShowMessage(
      Format(
        SNotEnoughSpace + sLineBreak + SSizeFormat,
        [RequiredMB / 1024, freeMB / 1024]
      )
    );
    Exit(False);
  end;
  Result := True;
end;

//----------------------------------------------------------------------------//
// Создание уникальной временной папки                                        //
//----------------------------------------------------------------------------//
function CreateTempFolder: string;
var
  guid: TGUID;
begin
  CreateGUID(guid);
  Result := TPath.Combine(TPath.GetTempPath, GUIDToString(guid));
  ForceDirectories(Result);
end;

//----------------------------------------------------------------------------//
// Удаление уникальной временной папки                                        //
//----------------------------------------------------------------------------//
procedure TForm1.CleanTempFolder;
begin
  if TDirectory.Exists(FTempDir) then
  begin
    try
      TDirectory.Delete(FTempDir, True);
      FTempDir := '';
    except
      on E: Exception do
        // здесь можно залогировать ошибку, но вы не мешаете закрытию
    end;
  end;
end;

//----------------------------------------------------------------------------//
// Извлечение только нужных RCDATA-ресурсов (имена в MyFiles[])               //
//----------------------------------------------------------------------------//
function EnumResNamesProc(hModule: HMODULE; lpszType, lpszName: PChar;
  lParam: NativeInt): BOOL; stdcall;
var
  rs: TResourceStream;
  outDir, resName, fileName: string;
  i: Integer;
begin
  Result := True;
  outDir  := PChar(lParam);
  resName := string(lpszName);
  for i := Low(MyFiles) to High(MyFiles) do
    if SameText(MyFiles[i], resName) then
    begin
      try
        rs := TResourceStream.Create(hModule, lpszName, RT_RCDATA);
        try
          fileName := TPath.Combine(outDir, resName);
          rs.SaveToFile(fileName);
        finally
          rs.Free;
        end;
      except
        // TODO: логировать ошибку
      end;
      Break;
    end;
end;

procedure ExtractAllRCDATA(const OutputDir: string);
begin
  if not DirectoryExists(OutputDir) then
    ForceDirectories(OutputDir);
  EnumResourceNames(
    HInstance,
    RT_RCDATA,
    @EnumResNamesProc,
    NativeInt(PChar(OutputDir))
  );
end;

//----------------------------------------------------------------------------//
// Колбэк, вызываемый ISArcExM.dll при распаковке                             //
//----------------------------------------------------------------------------//
function ProgressStub(
  OverallPct, CurrentPct, DiskTotalMB, DiskExtractedMB,
  TotalFiles, CurFiles: Integer;
  DiskName, CurrentFile, RemainsTime,
  ElapsedTime, CurSpeed, AvgSpeed: WideString
): LongWord; stdcall;
begin
  // Обновляем UI
  Form1.ProgressBarInstall.Value := OverallPct;
  Form1.LabelPercent.Text := Format('%d%%', [OverallPct div 10]);
  Form1.LabelExtra.Text := CurrentFile;

  // Возвращаем 0, чтобы процесс не прервался
  Result := 0;
end;

// ----------------------------------------------------------------------------
// Реализация метода StartUnpacking
// ----------------------------------------------------------------------------

procedure TForm1.StartUnpacking;
var
  ISArc        : TISArcExM;
  exeFolder    : string;
  arcPath      : string;
  i, diskCount : Integer;
  hWnd: Winapi.Windows.HWND;
begin
  hWnd := WindowHandleToPlatform(Self.Handle).Wnd;

  exeFolder := ExtractFilePath(ParamStr(0));
  diskCount := 0;

  // 1. Инициализируем объект, указывая, где лежат DLL
  ISArc := TISArcExM.Create(FTempDir);
  try
    // 2. Добавляем все диски (архивы) в список
    for i := Low(Archives) to High(Archives) do
    begin
      arcPath := TPath.Combine(exeFolder, Archives[i]);
      if not FileExists(arcPath) then
        raise Exception.CreateFmt('Архив не найден: %s', [arcPath]);

      if not ISArc.AddDisksEx(arcPath, ArcPass, '', DirEdit.Text) then
        raise Exception.CreateFmt('AddDisksEx failed for "%s"', [Archives[i]]);

      Inc(diskCount);
    end;

    if diskCount = 0 then
      raise Exception.Create('Нет ни одного диска для распаковки.');

    // 3. Инициализируем движок (InitEx)
    //    1-й параметр — HWND приёма сообщений (0 = не нужен)
    //    2-й параметр — номер сообщения (любое ваше, напр. WM_USER+1 или 2)
    //    3-й параметр — функция обратного вызова
    if not ISArc.InitEx(hWnd, 2, ProgressStub) then
      raise Exception.Create('Не удалось инициализировать ISArcExM.dll');

    ISArc.ChangeLanguage('Russian');

    // 4. Цикл извлечения каждого диска
    for i := 1 to diskCount do
      if not ISArc.Extract(i, '', DirEdit.Text) then
        raise Exception.CreateFmt('Ошибка Extract на диске %d', [i]);

    // 5. Завершаем работу
    ISArc.Stop;      // либо ISArc.CleanUp;
  finally
    ISArc.Free;
  end;

  ShowMessage('Установка успешно завершена!');
end;

//----------------------------------------------------------------------------//
// Обработчики формы                                                          //
//----------------------------------------------------------------------------//
procedure TForm1.FormCreate(Sender: TObject);
var
  defaultDir: string;
begin
  LabelTitle.Text  := AppName;
  LabelInfo.Text   := AppInfo;
  LabelDesc.Text   := AppDesc;
  LabelStatus.Text := SWaitProc;

  CheckBoxIcons.Enabled   := Length(Shortcuts) > 0;
  CheckBoxIcons.IsChecked := CheckBoxIcons.Enabled;
  CheckBoxRedists.Enabled   := Length(Redists) > 0;
  CheckBoxRedists.IsChecked := CheckBoxRedists.Enabled;

  defaultDir := TPath.Combine(
    IncludeTrailingPathDelimiter(GetEnvironmentVariable('SystemDrive')),
    AppPath
  );
  DirEdit.Text := defaultDir;
  UpdateFreeLabel(defaultDir);
end;

//----------------------------------------------------------------------------//
// Объявление функции выбора папки/диска                                      //
//----------------------------------------------------------------------------//

function BrowseForDrivesOnly(const OwnerWnd: HWND; const Title: string;
  var Folder: string): Boolean;
var
  bi: TBrowseInfo;
  pidlRoot, pidlSel: PItemIDList;
  buf: array[0..MAX_PATH] of Char;
begin
  Result   := False;
  pidlRoot := nil;
  pidlSel  := nil;
  ZeroMemory(@bi, SizeOf(bi));
  bi.hwndOwner := OwnerWnd;
  bi.lpszTitle := PChar(Title);
  bi.ulFlags   := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
  if Succeeded(SHGetSpecialFolderLocation(OwnerWnd, CSIDL_DRIVES, pidlRoot)) then
  try
    bi.pidlRoot := pidlRoot;
    pidlSel := SHBrowseForFolder(bi);
    if (pidlSel <> nil) and SHGetPathFromIDList(pidlSel, buf) then
    begin
      Folder := buf;
      Result := True;
    end;
  finally
    if pidlSel  <> nil then CoTaskMemFree(pidlSel);
    if pidlRoot <> nil then CoTaskMemFree(pidlRoot);
  end;
end;

procedure TForm1.ButtonBrowseClick(Sender: TObject);
var
  sel, fullPath: string;
begin
  sel := DirEdit.Text;
  if BrowseForDrivesOnly(
       WindowHandleToPlatform(Self.Handle).Wnd,
       SChooseFolder,
       sel
     )
  then
  begin
    fullPath := TPath.Combine(sel, AppPath);
    DirEdit.Text := fullPath;
    UpdateFreeLabel(fullPath);
  end;
end;

procedure TForm1.ButtonInstallClick(Sender: TObject);
//var
//  tempDir: string;
begin
  // Проверяем свободное место
  if not CheckSpace(DirEdit.Text, AppSizeMB) then
    Exit;

  // Распаковываем ресурсы в TEMP
  FTempDir := CreateTempFolder;
  ExtractAllRCDATA(FTempDir);

  // Обновляем статус и запускаем фактическую распаковку
  LabelStatus.Text := SUnpackProc;
  StartUnpacking;
end;

procedure TForm1.ButtonCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.TitleBarMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  if Button = TMouseButton.mbLeft then
  begin
    ReleaseCapture;
    SendMessage(
      FmxHandleToHWND(Self.Handle),
      $0112, $F012, 0
    );
  end;
end;

procedure TForm1.UpdateFreeLabel(const APath: string);
var
  needMB: Double;
begin
  needMB := AppSizeMB;
  LabelSize.Text := Format(
    SSizeFormat,
    [needMB / 1024, GetFreeSpaceMB(APath) / 1024]
  );
end;

end.