Скрипты Inno Setup. Помощь и советы [часть 4]

El Sanchez · Конфигурация компьютера

Цитата Лександер:

El Sanchez, одна беда - шрифт остается во временной папке »

Лександер, мерси, поправил. Не удалялся, потому что форма, его использующая, еще существовала.

Цитата Лександер:

Причина, как объяснили, какая-то программа ловит это сообщение и не пересылает его дальше »

Попахивает грязным хуком. Антивирь как всегда спит при работе таких "обслуживающих утилиток"?

Gnom_aka_Lexander · Отправлено: **13:41, 10-03-2012** | #**1012**

Цитата El Sanchez:

Антивирь как всегда спит при работе таких "обслуживающих утилиток"? »

В том-то и дело, что ничего не говорит. Стоит лицензионный доктор веб на параноидальных настройках. Лично ничего такого не ставил, софт стараюсь с официальных сайтов качать. Но есть товарищь, у которого на чистой лицензионной семерке такая-же беда была. Что говорит о косяке мелких. видимо срабатывает комплекс железо+ос+драйвера.

by_gangster · Отправлено: **13:44, 10-03-2012** | #**1013**

Люди да помогите чайнику

исправить хоть и тупой но скрипт, нодо что бы он распаковывал arc архив, и всё что внём. Я сделал что бы он расспаковывал сам .arc архив но он не распаковывает всё что внём,помогите поправить

Вот скриншот

Код:

[Setup]
AppName=Sigerous Mod для COP
AppVerName=Sigerous Mod v2.2
DefaultDirName=stalker
InfoBeforeFile=embedded\InfoBefore.rtf
WizardImageFile=embedded\WizardImage.bmp
WizardSmallImageFile=embedded\WizardSmallImage.bmp


[Languages]
;Name: rus; MessagesFile: compiler:Languages\Russian.isl

[Files]
Source: *.arc; DestDir: {app}; Flags: ignoreversion
Source: unarc.dll; DestDir: {tmp}; Flags: dontcopy
Source: InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy

[Icons]
Name: {group}\Uninstall; IconFilename: {app}\unins000.exe; Filename: {app}\unins000.exe

[_Code]


const
  PM_REMOVE      = 1;

function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMsg): Longint; external 'DispatchMessageA@user32.dll stdcall';

procedure AppProcessMessage;
var
  Msg: TMsg;
begin
  while PeekMessage(Msg, WizardForm.Handle, 0, 0, PM_REMOVE) do begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end;



type
  
  TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;

function WrapFreeArcCallback (callback: TFreeArcCallback; paramcount: integer):longword;
  external 'wrapcallback@files:innocallback.dll stdcall';

function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external 'FreeArcExtract@files:unarc.dll cdecl';



var
 ProgressBar: TNewProgressBar;
 ExtractFile: TNewStaticText;
 Button1:     TButton;
 Cancel:      Integer;

procedure InitializeWizard();
begin
  ProgressBar := TNewProgressBar.Create(WizardForm);
  ExtractFile:=TNewStaticText.Create(WizardForm);
  with WizardForm.ProgressGauge do
    begin
      ProgressBar.Left := Left;
      ProgressBar.Top := Top + ScaleX(55);
      ProgressBar.Width := Width;
      ProgressBar.Height := Height;
      ProgressBar.Parent := WizardForm.InstallingPage;
      ProgressBar.max := 1000;
      ProgressBar.Position := 0;
      ExtractFile.parent:=WizardForm.InstallingPage;
      ExtractFile.autosize:=false;
      ExtractFile.Width := Width;
      ExtractFile.top:=Top + ScaleX(35);
      ExtractFile.caption:='Распаковка архива FreeArc';
    end;
end;

procedure Button1OnClick(Sender: TObject);
begin
  Cancel := -1;
end;

function FreeArcCallback (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
var percents: Integer;
begin
  if string(what)='filename' then
      //ExtractFile.Caption:=str
  else if (string(what)='progress') and (int2>0) then begin
      percents := (int1*1000) div int2;
      ProgressBar.Position := percents;
      ExtractFile.Caption:='Распаковано '+IntToStr(int1)+' из '+IntToStr(int2)+' мб ('+FloatToStr(percents/10)+'%)';
  end;
  AppProcessMessage;
  Result := Cancel;
end;

procedure ExtractFreeArcArchive(arcname: String; destpath: String);
var callback: longword;
    res: Integer;
begin
  AppProcessMessage;
  callback:=WrapFreeArcCallback(@FreeArcCallback,4);   //FreeArcCallback has 4 arguments
  Cancel := 0;
  try
   res := FreeArcExtract (callback, 'x', '-o+', '-dp'+destpath, '--', arcname, '', '', '', '', '');
   if cancel<0 then
     MsgBox('Installation cancelled', mbInformation, MB_OK);
   if res<0 then
     MsgBox('Decompression failed with error code '+IntToStr(res)+'!', mbError, MB_OK);
   Button1.visible:=false;
  except
   MsgBox('Decompression failed!', mbError, MB_OK);
   Button1.visible:=false;
  end;
  DeleteFile(arcname);
end;

procedure CurStepChanged(CurStep: TSetupStep);
var app: String;
begin
  If CurStep=ssPostInstall then
   begin
    Button1:=TButton.create(WizardForm);
    Button1.parent:=WizardForm;
    Button1.width:=135;
    Button1.caption:='Cancel installation';
    Button1.left:=260;
    Button1.top:=WizardForm.cancelbutton.top;
    Button1.OnClick:=@Button1OnClick;

    app := ExpandConstant('{app}');
    ExtractFreeArcArchive(app+'\data.arc', app);
   end;
end;