Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Аватара для Johny777

Ветеран


Сообщения: 649
Благодарности: 444

Профиль | Отправить PM | Цитировать


cliff99, вот тебе пример простой распаковки архива FreeArc в зависимости от выбранных компонентов на этапе ssPostInstall с отображением прогресса распаковки
я просто упростил и немного изменил код из шапки. Надеюсь это то что тебе нужно

пример без кнопки отмены
читать дальше »
Код: Выделить весь код
[Setup]
AppName=FreeArc Example
AppVerName=FreeArc Example 3.3
DefaultDirName={pf}\FreeArc Example
OutputDir=.

[Components]
Name: "main"; Description: "Main Files";
Name: "help"; Description: "Help Files"; 

[Files]
Source: unarc.dll; DestDir: {tmp}; Flags: dontcopy

[code]
const
  CP_ACP    = 0;           
  CP_UTF8   = 65001;         

function FreeArcExtract (callback: Longword; cmd1, cmd2, cmd3, cmd4, cmd5, cmd6, cmd7, cmd8, cmd9, cmd10: String): integer; external 'FreeArcExtract@files:unarc.dll cdecl';
function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: PAnsiChar; cbMultiByte: Integer; lpWideCharStr: PAnsiChar; cchWideChar: Integer): Longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: PAnsiChar; cchWideChar: Integer; lpMultiByteStr: PAnsiChar; cbMultiByte: Integer; lpDefaultChar: Integer; lpUsedDefaultChar: Integer): Longint; external 'WideCharToMultiByte@kernel32.dll stdcall';

function AnsiToUtf8(const strSource: String): String;
var
  WideCharBuf: String;
begin
  SetLength( WideCharBuf, Length( strSource + chr(0) ) * 2 );
  SetLength( Result, Length( strSource + chr(0) ) * 2 );
  MultiByteToWideChar( CP_ACP, 0, strSource + chr(0), -1, WideCharBuf, Length(WideCharBuf) );
  WideCharToMultiByte( CP_UTF8, 0, WideCharBuf, -1, Result, Length(Result), 0, 0);
end;


function ArcCallBack(what: PAnsiChar; WriteSize, FileSize: Integer; str: PAnsiChar): Integer;
begin
  if (WriteSize <> 0) and (FileSize <> 0) then with WizardForm do
  begin
    ProgressGauge.Max := FileSize;
    ProgressGauge.Position := WriteSize;
    StatusLabel.Caption := 'Filesize:' + #32 + IntToStr(FileSize) + #32 + 'MB,' + #32 + 'Extracted:' + #32 + IntToStr(WriteSize) + #32 + 'MB';
  end;
  Application.ProcessMessages;
end;


procedure CurStepChanged(CurStep: TSetupStep);
begin
  if CurStep = ssPostInstall then
  begin
    WizardForm.ProgressGauge.Position := 0;
    if IsComponentSelected('main') then FreeArcExtract (CallbackAddr('ArcCallBack'), 'x', '-o+', '-dp' + AnsiToUtf8('C:\setup'), '--', AnsiToUtf8('C:\Users\FreeArc\FaT-170.mp4.arc'), '', '', '', '', '');
    if IsComponentSelected('help') then FreeArcExtract (CallbackAddr('ArcCallBack'), 'x', '-o+', '-dp' + AnsiToUtf8('C:\setup'), '--', AnsiToUtf8('другой архив'), '', '', '', '', '');
  end;
end;


с кнопкой отмены:
читать дальше »
Код: Выделить весь код
[Setup]
AppName=FreeArc Example
AppVerName=FreeArc Example 3.3
DefaultDirName={pf}\FreeArc Example
OutputDir=.

[Components]
Name: "main"; Description: "Main Files";
Name: "help"; Description: "Help Files"; 

[Files]
Source: unarc.dll; DestDir: {tmp}; Flags: dontcopy

[code]
const
  CP_ACP    = 0;           
  CP_UTF8   = 65001;

var
  CancelCode: Integer;

function FreeArcExtract (callback: Longword; cmd1, cmd2, cmd3, cmd4, cmd5, cmd6, cmd7, cmd8, cmd9, cmd10: String): integer; external 'FreeArcExtract@files:unarc.dll cdecl';
function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: PAnsiChar; cbMultiByte: Integer; lpWideCharStr: PAnsiChar; cchWideChar: Integer): Longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: PAnsiChar; cchWideChar: Integer; lpMultiByteStr: PAnsiChar; cbMultiByte: Integer; lpDefaultChar: Integer; lpUsedDefaultChar: Integer): Longint; external 'WideCharToMultiByte@kernel32.dll stdcall';

function AnsiToUtf8(const strSource: String): String;
var
  WideCharBuf: String;
begin
  SetLength( WideCharBuf, Length( strSource + chr(0) ) * 2 );
  SetLength( Result, Length( strSource + chr(0) ) * 2 );
  MultiByteToWideChar( CP_ACP, 0, strSource + chr(0), -1, WideCharBuf, Length(WideCharBuf) );
  WideCharToMultiByte( CP_UTF8, 0, WideCharBuf, -1, Result, Length(Result), 0, 0);
end;


function ArcCallBack(what: PAnsiChar; WriteSize, FileSize: Integer; str: PAnsiChar): Integer;
begin
  if (WriteSize <> 0) and (FileSize <> 0) then with WizardForm do
  begin
    ProgressGauge.Max := FileSize;
    ProgressGauge.Position := WriteSize;
    StatusLabel.Caption := 'Filesize:' + #32 + IntToStr(FileSize) + #32 + 'MB,' + #32 + 'Extracted:' + #32 + IntToStr(WriteSize) + #32 + 'MB';
  end;
  Application.ProcessMessages;
  Result:= CancelCode;
end;

procedure CancelFreeArcextracting(Sedner: TObject);
begin
  CancelCode := -127;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
  if CurStep = ssPostInstall then
  begin
    WizardForm.ProgressGauge.Position := 0;
    with TButton.Create(nil) do
    begin
      Parent := WizardForm.InstallingPage;
      Caption := SetupMessage(msgButtonCancel);
      SetBounds(ScaleX(100), ScaleY(100), ScaleX(75), ScaleY(25));
      OnClick := @CancelFreeArcextracting;
    end;
    if IsComponentSelected('main') and (CancelCode <> -127) then FreeArcExtract (CallbackAddr('ArcCallBack'), 'x', '-o+', '-dp' + AnsiToUtf8('C:\setup'), '--', AnsiToUtf8('C:\Users\Âîâà\Desktop\FreeArc\FaT-170.mp4.arc'), '', '', '', '', '');
    if IsComponentSelected('help') and (CancelCode <> -127) then FreeArcExtract (CallbackAddr('ArcCallBack'), 'x', '-o+', '-dp' + AnsiToUtf8('C:\setup'), '--', AnsiToUtf8('äðóãîé àðõèâ'), '', '', '', '', '');
  end;
end;

теперь из-за тебя я знаю немного фриарк модуль. Спасибо!
библиотеку найдёшь тут http://freearc.org/download/InnoSetu...noSetup3_5.zip
Это сообщение посчитали полезным следующие участники:

Отправлено: 19:42, 27-02-2013 | #1748