FileForums
Page 4 of 7 « First 23 4 56 Last »
Show 40 post(s) from this thread on one page

FileForums (https://fileforums.com/index.php)
-   Conversion Tutorials (https://fileforums.com/forumdisplay.php?f=55)
-   -   CLS-DiskSpan (UltraARC replacement) (https://fileforums.com/showthread.php?t=99627)

vollachr 14-11-2017 03:37
OK, question, does diskspan have an option to exclude files from the compression?

Because the built in exclude option of freearc doesn't seems to work with it, it crashes arc.exe.

Yes, it wasn't diskspan itself, that was my problem, the exclude option.

Razor12911 15-11-2017 08:03
Consider diskspan as a compressor, answer this question so you have answer to the question you have asked me. Does pzlib for example have an option to exclude certain files?

vollachr 16-11-2017 02:34
Quote:
Originally Posted by Razor12911 (Post 464114)
Consider diskspan as a compressor, answer this question so you have answer to the question you have asked me. Does pzlib for example have an option to exclude certain files?
So I guess that's a no... Well, but since it should be not different than any other compressors used with freearc (like srep, precomp, etc.), then why does the -x switch (exclude switch) for arc.exe causes a crash with diskspan when it doesn't with other external compressors?

felice2011 16-11-2017 03:11
Try to modify your simple Batch Codes, to reach the target, there is a solution to every problem, not persist the your job only on the external components you use.

vollachr 16-11-2017 03:25
Quote:
Originally Posted by felice2011 (Post 464130)
Try to modify your simple Batch Codes, to reach the target, there is a solution to every problem, not persist the your job only on the external components you use.
In theory you're right, but I honestly changed the command and switches so many times in so many ways that I lost count, nothing helped.

Beside, the last thing you can say about my batch code is simple, it's huge & complex, taking multiple variables from external .ini files.

So far, the only command with diskspan that actually worked was using the one from the example provided with diskspan, almost to the letter.

So, for the time being I've just created a bypass that takes files that needs to be excluded and just moves them away from the source folder before compression and back after compression.

Again, this is only with Diskspan.

vollachr 07-02-2018 02:07
Why do I get a popup message asking for the location of GameFolderName.002 during compression with CLS-Diskspan?

In my case specifically it was "Wasteland 2 Director's Cut.002"

Of course, there's no such file...

The specific compression method in said case was this:
Code:
srep+lzma:a1:mfbt4:d256m:fb128:mc1000:lc8
Diskspan sizes was DVD5 (4467mb:4474mb)

My command uses lots of information taken from variables, many of them are read from INI files, anyway, translating it to the actual command (approximately) it would look like this:

Code:
arc.exe a -ep1 -r -ed -s; -w"MyFolder\TempFiles" -msrep+lzma:a1:mfbt4:d256m:fb128:mc1000:lc8+diskspan:4467mb:4474mb "MyFolder\WL2_2xDVD5\Data.bin.001" "*" "-xUnins*" -dp"I:\Games\Wasteland 2 Director's Cut"
It compressed fine until it got to the point it need to create the .002 file, any help will be appreciated.

Of course I'm still trying to figure it out myself but if anyone could provide an explanation to the problem it'll help.

Thanks.

UPDATE:

Might have solved it by moving the exclude switch to be before the archive path (after the method), like this:
Code:
arc.exe a -ep1 -r -ed -s; -w"MyFolder\TempFiles" -msrep+lzma:a1:mfbt4:d256m:fb128:mc1000:lc8+diskspan:4467mb:4474mb "-xUnins*" "MyFolder\WL2_2xDVD5\Data.bin.001" "*" -dp"I:\Games\Wasteland 2 Director's Cut"
Still testing but it looks promising.

UPDATE 2:

Nope, it ends correctly but it doesn't exclude the files in the exclude switch.

I also have a problem with errorlevel check after using the arc.exe --sort command, from some reason it sets the errorlevel as 2 (two), which causes a problem with a following check in my batch script.

Arc.exe also shows an error unknown command when using the --sort command, it still sorts the file thought but as I said, set the errorlevel as 2 (two) which is a problem for me at the moment.

I'll update again when I know more.

UPDATE 3:

OK, I believe it finally working....

The correct command was this:

Code:
arc.exe a -ep1 -r -ed -s; -w"MyFolder\TempFiles" -dp"I:\Games\Wasteland 2 Director's Cut" "-xUnins*" -msrep+lzma:a1:mfbt4:d256m:fb128:mc1000:lc8+diskspan:4467mb:4474mb "MyFolder\WL2_2xDVD5\Data.bin.001" "*"
As for the errorlevel problem, I just changed the code the test for it a little and it now seems to work correctly.

I'll leave it all here in case someone else need to know the correct syntax to make Diskspan work with the exclude (-x & -x@) and the -dp switches.

Th3Raven 13-03-2018 02:51
First of all thank you for this great tool and second, i think i managed to integrate it into Windows Phone Installer (FMX). I will post the results after some extensive tests currently doing.

ok so implementation seems is ok, but will do more tests to make sure.

Anyway anyone can help me modify this DLL to show like "filename-*.bin" = where * is a number "filename-1.bin; filename-2.bin; etc." Total noob in Delphi here

Jiva newstone 02-04-2018 10:26
@Simorq

i think razor also added src ,so open the delphi file and add 64bit suport
and compile it

Midnights 08-10-2018 15:42
1 Attachment(s)
Hi, after trying this, in my case is more easy to use, can you please add support for DiskSpan to this script please?
I have trying but dont know where to split/add code from the exemple in the archive, many thanks if you can help...

ISFreeArcExtract v.4.2 Main.iss
Code:
var
  StatusLabel, FileNameLabel, ExtractFile, StatusInfo: TLabel;
  ProgressBar: TNewProgressBar; OutErroMsg, CurStage: String;
  UnPackError: Integer; ContinueInstall: Boolean;

Function CreateLabel(Parent: TWinControl; AutoSize, WordWrap, Transparent: Boolean; FontName: String; FontStyle: TFontStyles; FontColor: TColor; Left, Top, Width, Height: Integer; Prefs: TObject): TLabel;
Begin
  Result:=TLabel.Create(Parent); Result.parent:= Parent;
  if Prefs <> Nil then begin
    Top:= TWinControl(Prefs).Top; Left:= TWinControl(Prefs).Left; Width:= TWinControl(Prefs).Width; Height:= TWinControl(Prefs).Height;
  end;
    if Top > 0 then result.Top:=Top; if Left > 0 then result.Left:= Left; if Width > 0 then result.Width:= Width; if Height > 0 then result.Height:= Height;
    if FontName <> '' then result.Font.Name:= FontName; if FontColor > 0 then result.Font.Color:= FontColor; if FontStyle <> [] then result.Font.Style:= FontStyle;
    result.AutoSize:= AutoSize; result.WordWrap:= WordWrap; result.Transparent:=Transparent; result.ShowHint:= true;
End;

Function NumToStr(Float: Extended): String;
Begin
  Result:= Format('%.2n', [Float]); StringChange(Result, ',', '.');
  while ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) and (Pos('.', Result) > 0) do
    SetLength(Result, Length(Result)-1);
End;

Function ByteOrTB(Bytes: Extended; noMB: Boolean): String;
Begin
  if not noMB then Result:= NumToStr(Int(Bytes)) +' Mb' else
    if Bytes < 1024 then if Bytes = 0 then Result:= '0' else Result:= NumToStr(Int(Bytes)) +' Bt' else
      if Bytes/1024 < 1024 then Result:= NumToStr(round((Bytes/1024)*10)/10) +' Kb' else
        If Bytes/oneMB < 1024 then Result:= NumToStr(round(Bytes/oneMB*100)/100) +' Mb' else
          If Bytes/oneMB/1000 < 1024 then Result:= NumToStr(round(Bytes/oneMB/1024*1000)/1000) +' Gb' else
            Result:= NumToStr(round(Bytes/oneMB/oneMB*1000)/1000) +' Tb';
End;

function UpdateProgress(SText, FText, Time, errmsg: String; PosCur1, PosMax1, PosCur2, PosMax2, FileCount, CurDisk, DiskCount: Integer; ExtractedSize: Extended): Boolean;
var perc, p: extended;
begin
  if ProgressBar.Max<>PosMax2 then ProgressBar.Max:= PosMax2;
  if WizardForm.ProgressGauge.Max<>PosMax1 then WizardForm.ProgressGauge.Max:= PosMax1;
  ProgressBar.Position:=PosCur2; WizardForm.ProgressGauge.Position:= PosCur1;
  if PosMax1<>0 then perc:= Extended(PosCur1)*100/Extended(PosMax1);
  if PosMax2<>0 then p:= Extended(PosCur2)*100/Extended(PosMax2);
  StatusLabel.Caption:= SText;
  OutErroMsg:= errmsg;
  FilenameLabel.Caption:= FText; CurStage:= SText;
  StatusInfo.Caption:= FmtMessage(cm('StatusInfo'), [IntToStr(FileCount), ' ['+ ByteOrTB(ExtractedSize, true) +']', Format('%.1n', [Abs(perc)]), Time]);
  ExtractFile.Caption:= FmtMessage(cm('ArcInfo'), [IntToStr(CurDisk), IntToStr(DiskCount), IntToStr(ArcInd+1), IntToStr(GetArrayLength(Arcs)), Format('%.1n', [Abs(p)])]);
  ProgressBar.Position:= LastMb;
  Result:= ContinueInstall;
end;

procedure CurStepChanged(CurStep: TSetupStep);
var n: Integer;
begin
  if CurStep = ssPostInstall then
  begin
    ContinueInstall:= True;
    WizardForm.CancelButton.Enabled:= True;
    ProgressBar.Position:=0;
    WizardForm.ProgressGauge.Position:= 0;
    StatusLabel.Show;
    FileNameLabel.Show;
    StatusInfo.Show;
    ProgressBar.Show;
    ExtractFile.Show;
    UnPackError:= UnPackWithPrompts('{#Archives}', @UpdateProgress);
    if UnPackError <> 0 then begin
      Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n);
      WizardForm.caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak');
      SetTaskBarTitle(SetupMessage(msgErrorTitle));
    end else
      SetTaskBarTitle(SetupMessage(msgSetupAppTitle));
    StatusLabel.Hide; FileNameLabel.Hide; StatusInfo.Hide; ProgressBar.Hide; ExtractFile.Hide;
  end;
end;

Procedure CurPageChanged(CurPageID: Integer);
Begin
    if (CurPageID = wpFinished) and (UnPackError <> 0) then
    begin
        WizardForm.FinishedLabel.Font.Color:= $0000C0;
        WizardForm.FinishedLabel.Height:= WizardForm.FinishedLabel.Height * 2;
        WizardForm.FinishedLabel.Caption:= SetupMessage(msgSetupAborted) + #13#10#13#10 + OutErroMsg;
    end;
End;

procedure WizardClose(Sender: TObject; var Action: TCloseAction);
Begin
  Action:= caNone;
    if CurStage = cm('ArcTitle') then begin
        if MsgBox(SetupMessage(msgExitSetupMessage), mbInformation, MB_YESNO) = IDYES then
            ContinueInstall:= false;
    end else
        MainForm.Close;
End;

Procedure InitializeWizard();
Begin
    StatusLabel:= CreateLabel(WizardForm.InstallingPage,false,false,true,'',[],0,0,0,0,0, WizardForm.StatusLabel);
    FileNameLabel:= CreateLabel(WizardForm.InstallingPage,false,false,true,'',[],0,0,0,0,0, WizardForm.FileNameLabel);
    WizardForm.StatusLabel.Top:= WizardForm.ProgressGauge.Top; WizardForm.FileNameLabel.Top:= WizardForm.ProgressGauge.Top;    // прячем под прогрессбар, тогда все события WM_PAINT перехватываются
    with WizardForm.ProgressGauge do begin
      StatusInfo:= CreateLabel(WizardForm.InstallingPage, false, true, true, '', [], 0, 0, Top + ScaleY(32), Width, 0, Nil);
      ProgressBar := TNewProgressBar.Create(WizardForm);
      ProgressBar.SetBounds(Left, StatusInfo.Top + StatusInfo.Height + ScaleY(16), Width, Height);
      ProgressBar.Parent := WizardForm.InstallingPage;
      ProgressBar.max := 65536;
      ProgressBar.Hide;
      ExtractFile:= CreateLabel(WizardForm.InstallingPage, false, true, true, '', [], 0, 0, ProgressBar.Top + ScaleY(32), Width, 0, Nil);
      StatusLabel.Hide; FileNameLabel.Hide; StatusInfo.Hide; ProgressBar.Hide; ExtractFile.Hide;
    end;
    WizardForm.OnClose:= @WizardClose
End;

ISFreeArcExtract v.4.2.iss
Code:
#include "ISFreeArcExtract_Utils.iss"

type
#ifdef UNICODE
    #define A "W"
#else
    #define A "A"
#endif
#if Ver < 84018176
    AnsiString = String;
#endif
#if !defined(IS_ENHANCED)
  TMsg = record
    hwnd: HWND;
    message: LongWord;
    wParam: Longint;
    lParam: Longint;
    time: LongWord;
    pt: TPoint;
  end;
#endif

  TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
  TArc = record Path, SubPath, Filename, Dest, Comp, Task, Pass, List: string; allMb, Disks: Integer; UnPack, UnPacked, Delete, Packet: Boolean; ID: DWord; end;
  TSimpleArc = record Filename, Destination, Pass, Listing: String; allMb, ID: DWORD; Delete: Boolean; end;
  TFAProgressInfo = record CurStage, CurName: String; DiskSize, CurPos, LastPos, AllPos, FilesCount: Integer; Percents, LastSize, CurSize, AllSize: Extended; end;
  TFADiskStatus = record LastMaxCount, MaxCount, CurDisk, NextArc, RemainsArc: Integer; end;
  TFreeArcUpdateProcess = function(SText, FText, Time, errmsg: String; PosCur1, PosMax1, PosCur2, PosMax2, FileCount, CurDisk, DiskCount: Integer; ExtractedSize: Extended): Boolean;
   
var
  CancelCode, ArcInd, lastMb, baseMb, origsize: Integer;
  Arcs: array of TSimpleArc;
  AllArchives: array of TArc;
  msgError, CompressMethod, aTime, Arc_Path, Arc_CurPath: string;
  Progress: TFAProgressInfo; DS: TFADiskStatus;
  SuspendUpdate: Boolean;
  ReturnFunc: TFreeArcUpdateProcess;
  Remaining: Extended;
  StartInstall, LastTimerEvent, LastTimeCheck: DWORD;
   
const
  CP_ACP    = 0;
  CP_UTF8  = 65001;
  oneMB    = 1024*1024;
  VK_ESCAPE = 27;

function WrapFreeArcCallback (callback: TFreeArcCallback; paramcount: integer):longword; external 'wrapcallbackaddr@files:CallBackCtrl.dll stdcall';
function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external 'FreeArcExtract@files:unarc.dll cdecl delayload';
procedure UnloadDLL(); external 'UnloadDLL@files:unarc.dll cdecl delayload';

Function OemToChar(lpszSrc, lpszDst: AnsiString): longint; external '[email protected] stdcall';
Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpWideCharStr: PAnsiChar; cchWideChar: integer): longint; external '[email protected] stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: PAnsiChar; cchWideChar: integer; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external '[email protected] stdcall';

function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external '[email protected] stdcall';
function TranslateMessage(const lpMsg: TMsg): BOOL; external '[email protected] stdcall';
function DispatchMessage(const lpMsg: TMsg): Longint; external '[email protected] stdcall';

function GetTickCount: DWord; external 'GetTickCount@kernel32';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';
function GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';

procedure AppProcessMessage;
var
  Msg: TMsg;
begin
  if not PeekMessage(Msg, 0, 0, 0, 1) then Exit;
  TranslateMessage(Msg); DispatchMessage(Msg);
end;

Function FreeArcCmd(callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer;
begin
  CancelCode:= 0;
  AppProcessMessage;
  try
    Result:= FreeArcExtract(callback, cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10);
    if CancelCode < 0 then Result:= CancelCode;
  except
    Result:= -63;
  end;
end;

Procedure SetTaskBarTitle(Title: String); var h: Integer;
Begin
  h:= GetWindowLong(MainForm.Handle, -8);
  if h <> 0 then SetWindowText(h, Title);
End;

Function TicksToTime(Ticks: Extended; h,m,s: String; detail: Boolean): String;
begin
  if detail then
    Result:= PADZ(IntToStr(Round(Ticks/3600000)), 2) +':'+ PADZ(IntToStr(Round((Ticks/1000 - Ticks/1000/3600*3600)/60)), 2) +':'+ PADZ(IntToStr(Round(Ticks/1000 - Ticks/1000/60*60)), 2)
  else if Ticks/3600 >= 1000 then
    Result:= IntToStr(Round(Ticks/3600000)) +h+' '+ PADZ(IntToStr(Round((Ticks/1000 - Ticks/1000/3600*3600)/60)), 2) +m
  else if Ticks/60 >= 1000 then
    Result:= IntToStr(Round(Ticks/60000)) +m+' '+ IntToStr(Round(Ticks/1000 - Ticks/1000/60*60)) +s
  else Result:= Format('%.1n', [Abs(Ticks/1000)]) +s;
end;

Function ExpandENV(S: String): String;
var
  n: UINT;
begin
  if Pos('{',S ) * Pos('}', S) = 0 then
    Result:= S
  else Result:= ExpandConstant(S);
  n:= Pos('%',result);
  if n = 0 then Exit;
    Delete(result, n,1);
  Result:= Copy(Result,1, n-1) + ExpandConstant('{%'+Copy(Result, n, Pos('%',result) -n) +'}') + Copy(Result, Pos('%',result) +1, Length(result));
end;

Function cm(Message: String): String;
begin
  Result:= ExpandConstant('{cm:'+ Message +'}')
end;

function OemToAnsiStr(strSource: AnsiString): AnsiString;
begin
  SetLength(Result, Length(strSource));
  OemToChar(strSource, Result);
end;

function AnsiToUtf8(strSource: string): string;
var
  nRet: integer;
  WideCharBuf, MultiByteBuf: AnsiString;
begin
  SetLength(WideCharBuf, Length(strSource) * 2);
  SetLength(MultiByteBuf, Length(strSource) * 2);
  MultiByteToWideChar(CP_ACP, 0, strSource, -1, WideCharBuf, Length(WideCharBuf));
  nRet:= WideCharToMultiByte(CP_UTF8, 0, WideCharBuf, -1, MultiByteBuf, Length(MultiByteBuf), 0, 0);
  Result:= Copy(MultiByteBuf, 1, nRet);
end;

Procedure UpdateStatus();
var
  i, t: string;
  TimeEnable: Boolean;
Begin
  if (SuspendUpdate)or(GetTickCount-LastTimerEvent<200) then Exit;
  Progress.CurSize := baseMb+lastMb; TimeEnable:= True;
  Progress.Allsize:= Progress.LastSize + lastMb;
  if Progress.DiskSize > 0 then begin
    Progress.CurPos:= round((100000 * Progress.CurSize)/Progress.DiskSize);
    if Progress.CurPos > Progress.LastPos then begin
      Progress.AllPos:= Progress.AllPos + ((Progress.CurPos-Progress.LastPos)/DS.MaxCount);
      Progress.LastPos:=Progress.CurPos
    end;
    Progress.Percents:= Progress.AllPos/100;
    If (Progress.AllPos > 0) then Remaining:= ((100000-Progress.AllPos)*(GetTickCount-StartInstall)/Progress.AllPos)*(DS.MaxCount+1-DS.CurDisk);
    if (Progress.Percents >= 990) then begin TimeEnable:= False; t:= cm('ending'); i:= AnsiLowerCase(t); end;
    if TimeEnable then begin
      #ifdef External
        t:= Format('%.1n',[Extended(Progress.Percents)/10])+'%';
        i:= AnsiLowercase(cm('unknown'));
      #else
        t:= FmtMessage(cm('taskbar'), [Format('%.1n',[Progress.Percents/10]), TicksToTime(Remaining, 'h', 'm', 's', false)]);
        i:= TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false);
      #endif
    end;
  end;
  SetTaskBarTitle(t);
  if GetTickCount-LastTimeCheck>=1000 then begin
    aTime:= i;
    LastTimeCheck:= GetTickCount;
  end;
  LastTimerEvent:= GetTickCount;
  if ReturnFunc<> nil then
    if not ReturnFunc(Progress.CurStage, Progress.CurName, aTime, MsgError, Progress.AllPos, 100000, LastMb, Arcs[ArcInd].allMb, Progress.FilesCount, DS.CurDisk, DS.MaxCount, Progress.Allsize*oneMB) then
      CancelCode:= -10;
End;

function FreeArcCallback(what: PAnsiChar; Mb, int2: Integer; str: PAnsiChar): Integer;
begin
  case string(what) of
    'origsize': origsize:= Mb;
    'total_files': Null;
    'filename': begin
                  Progress.CurName:= OemToAnsiStr(str);
                  Progress.FilesCount:= Progress.FilesCount + 1;
                end;
    'read': Null;
    'write': lastMb:= Mb;
    'error': if (Mb = -2) then CompressMethod:= str;
  end;
  UpdateStatus();
  if (GetKeyState(VK_ESCAPE) < 0) then
    WizardForm.Close;
  AppProcessMessage;
  Result:= CancelCode;
end;

function GetPath(Arc: TArc; ExtrPath: String; UseSubPath: Boolean): String;
begin
  if ExtrPath='' then
    Result:= Arc.Path
  else
    Result:= ExtrPath;
  if (UseSubPath)and(Arc.SubPath<>'') then
    Result:= Result+'\'+Arc.SubPath;
  Result:= Result+'\'+Arc.Filename;
end;

function ProcessCode(var S: String; Code: String): String;
var
  p1, p2: integer;
begin
  Result:= '';
  p1:= Pos(AnsiLowercase(Code), AnsiLowercase(s));
  if p1>0 then begin
    p2:=p1; while (s[p2]<>';')and(p2<=Length(s)) do p2:=p2+1;
    Result:= Copy(s, p1, p2-p1);
    Delete(s, p1, p2-p1+1);
    Delete(Result, 1, Length(Code));
  end;
  Result:= Trim(Result);
end;

function StrToBool(S: String): Boolean;
begin
  Result:=False;
  if S='' then Exit;
  S:= Trim(AnsiLowercase(S));
  if (S = 'true')or(S = 'yes')or(S = '1') then
    Result:= True else Result:= False;
end;

Function ArcDecode(Line: String): array of TArc;
var
  cut, tmp: string;
  i, n: integer;
begin
  SetArrayLength(Result, 0);
  If Line = '' then Exit;
  repeat
    n:= Pos('|', Line);
    if (n=0) then
      if(Length(Line)=0) then Break
      else n:= Length(Line)+1;
    cut:= Copy(Line, 1, n-1)+';'; Delete(Line, 1, n);
    i:= GetArrayLength(Result); SetArrayLength(Result, i+1);
    Result[i].Path:= Trim(ProcessCode(cut, 'Source:'));
    Result[i].dest:= Trim(ProcessCode(cut, 'DestDir:'));
    tmp:= ProcessCode(cut, 'Disk:');
    if tmp='' then Result[i].disks:= 1
    else Result[i].disks:= StrToInt(tmp);
    Result[i].comp:= Trim(ProcessCode(cut, 'Components:'));
    Result[i].task:= Trim(ProcessCode(cut, 'Tasks:'));
    Result[i].pass:= Trim(ProcessCode(cut, 'Password:'));
    Result[i].list:= Trim(ExpandENV(ProcessCode(cut, 'FilesList:')));
    Result[i].Delete:= StrToBool(ProcessCode(cut, 'Delete:'));
    while Pos(';', cut)>0 do Delete(cut, Pos(';', cut), 1);
    if Result[i].Path='' then begin
      if (ExtractFileDrive(ExpandEnv(cut)) = '')and(ExpandEnv(cut) = cut) then
      Result[i].Path:= '{src}\'+cut else Result[i].Path:= cut;
    end;
    Result[i].Filename:= ExtractFileName(Result[i].Path);
    Result[i].Path:= ExtractFilePath(result[i].Path);
    Result[i].SubPath:= Copy(Result[i].Path, Pos('\', Result[i].Path)+1, Length(Result[i].Path));
    Delete(Result[i].Path, Pos('\', Result[i].Path), Length(Result[i].Path));
    Result[i].Dest:= ExpandENV(result[i].Dest);
    Result[i].Path:= ExpandENV(result[i].Path);
  until Line='';
end;

function AddArcs(File: TArc; var ErrCode: Integer): Integer;
var
  i, b: integer;
  f: String;
  cmd: array [0..9] of String;
begin
  Result:= 0;
  f:= GetPath(File, Arc_CurPath, True);
  if not FileExists(f) then
    f:= GetPath(File, Arc_CurPath, False);
  if FileExists(f) then begin
    i:= GetArrayLength(Arcs);
    SetArrayLength(Arcs, i +1);
    Arcs[i].Filename:= f;
    Arcs[i].Destination:= File.Dest;
    Arcs[i].Pass:= File.Pass;
    Arcs[i].Listing:= File.List;
    Arcs[i].ID:= File.ID;
    Arcs[i].Delete:= File.Delete;
    cmd[0]:='l'; b:=1; if Arcs[i].Pass <> '' then begin cmd[1]:= '-p'+AnsiToUtf8(Arcs[i].Pass); b:=b+1; end;
    cmd[b]:='--'; cmd[b+1]:=AnsiToUtf8(f)
    ErrCode:= FreeArcCmd(WrapFreeArcCallback(@FreeArcCallback,4), cmd[0],cmd[1],cmd[2],cmd[3],cmd[4],cmd[5],cmd[6],cmd[7],cmd[8],cmd[9]);
    if ErrCode >= 0 then begin
      Arcs[i].allMb:= origsize;
      Result:= origsize;
      origsize:=0;
    end;
  end;
end;

function DispatchError(ErrorCode: Integer; Arc: TSimpleArc): String;
var
  ArcFile: String;
begin
  ArcFile:= ExtractFilename(Arc.Filename);
  if (ErrorCode = -2) then StringChange(CompressMethod, 'ERROR: unsupported compression method ', '');
  case ErrorCode of
    -1:  Result:= cm('ErrorUnknownError');
    -2:  Result:= FmtMessage(cm('ErrorCompressMethod'), [CompressMethod, ArcFile]);
    -3:  Null;
    -4:  Result:= FmtMessage(cm('ErrorOutBlockSize'), [ArcFile]);
    -5:  Result:= FmtMessage(cm('ErrorNotEnoughRAMMemory'), [ArcFile]);
    -6:  Result:= FmtMessage(cm('ErrorReadData'), [ArcFile]);
    -7:  Result:= FmtMessage(cm('ErrorBadCompressedData'), [ArcFile]);
    -8:  Result:= cm('ErrorNotImplement');
    -9:  Result:= FmtMessage(cm('ErrorDataAlreadyDecompress'), [ArcFile]);
    -10:  Result:= cm('ErrorUnpackTerminated');
    -11:  Result:= FmtMessage(cm('ErrorWriteData'), [ArcFile]);
    -12:  Result:= FmtMessage(cm('ErrorBadCRC'), [ArcFile]);
    -13:  Result:= FmtMessage(cm('ErrorBadPassword'), [ArcFile]);
    -14:  Result:= FmtMessage(cm('ErrorBadHeader'), [ArcFile]);
    -15:  Null;
    -63:  Result:= cm('ErrorCodeException');
    -112: Result:= FmtMessage(cm('ErrorNotEnoughFreeSpace'), [ArcFile]);
  end;
end;

function UnPackArchive(Archive: TSimpleArc): Integer;
var
  cmd: array [0..9] of String;
  b: integer;
  FreeMB, TotalMB: Cardinal;
begin
  cmd[0]:='x';
  cmd[1]:='-o+';
  cmd[2]:= '-dp'+AnsiToUtf8(Archive.Destination);
  cmd[3]:= '-w'+AnsiToUtf8(Archive.Destination); b:=4;
  if Archive.Pass <> '' then begin cmd[b]:= '-p'+AnsiToUtf8(Archive.Pass); b:=b+1 end;
  if Archive.Listing <> '' then begin cmd[b]:= AnsiToUtf8(Archive.Listing); b:=b+1; end;
  cmd[b]:='--'; cmd[b+1]:= AnsiToUtf8(Archive.Filename);
  Result:= FreeArcCmd(WrapFreeArcCallback(@FreeArcCallback,4), cmd[0],cmd[1],cmd[2],cmd[3],cmd[4],cmd[5],cmd[6],cmd[7],cmd[8],cmd[9]);
  if Result = 0 then Exit;
  msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
  GetSpaceOnDisk(ExtractFileDrive(Archive.Destination), True, FreeMB, TotalMB);
  if FreeMB < (Archive.allMb-lastMb) then Result:= -112;
  MsgError:= msgError+#13#10#13+DispatchError(Result, Archive)
End;

procedure SetUnpacked(File: TSimpleArc);
var
  i: integer;
begin
  for i:=0 to GetArrayLength(AllArchives)-1 do begin
    if (File.ID=AllArchives[i].ID) then begin
      AllArchives[i].UnPacked:=True;
      Break;
    end;
  end;
end;

function FindArcs(Str: TArc): array of TArc;
var
  FSR: TFindRec;
  i: Integer;
  Dir: String;
begin
  if FindFirst(GetPath(Str, Arc_CurPath, True), FSR) then try
    Dir:= ExtractFilePath(GetPath(Str, Arc_CurPath, True));
    repeat
      AppProcessMessage;
      if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
      i:= GetArrayLength(Result); SetArrayLength(Result, i+1);
      Result[i]:= Str;
      Result[i].Filename:= FSR.Name;
      Result[i].Packet:= True;
    until not FindNext(FSR);
  finally
    FindClose(FSR);
  end;
end;

function FillArcList(Source: array of TArc): array of TArc;
var i, k: integer; zet: array of TArc; anil: TArc; ADelete: Boolean;
begin
  SetArrayLength(Result, 0);
  for i:= 0 to GetArrayLength(Source)-1 do begin
    if (Pos('*', Source[i].Filename) > 0)and(Source[i].Disks=DS.CurDisk) then
      zet:= FindArcs(Source[i])
    else begin
      k:= GetArrayLength(zet);
      SetArrayLength(zet, k+1);
      zet[k]:= Source[i];
    end;
  end;
  for i:=0 to GetArrayLength(zet)-1 do begin
    if (zet[i].Filename<>'') then for k:=0 to GetArrayLength(zet)-1 do begin
      if (i<>k)and(AnsiLowercase(zet[i].Filename)=AnsiLowercase(zet[k].Filename)) then begin
        if (zet[i].UnPacked)and(zet[k].Packet) then ADelete:= True;
        if not (zet[k].Packet)and(not zet[i].UnPacked) then begin
          ADelete:= true;
          if (zet[k].list<>'')and(zet[i].list<>'')and(zet[k].list<>zet[i].list) then ADelete:= False;
          if ((zet[k].list<>'')and(zet[i].list=''))or((zet[k].list='')and(zet[i].list='')) then begin
            if (zet[i].Packet)and(not zet[k].Packet) then zet[i].Packet:= False;
            if (zet[k].dest<>'')and(zet[k].dest<>zet[i].dest) then zet[i].dest:= zet[k].dest;
            if (zet[k].comp<>'')and(zet[k].comp<>zet[i].comp) then zet[i].comp:= zet[k].comp;
            if (zet[k].task<>'')and(zet[k].task<>zet[i].task) then zet[i].task:= zet[k].task;
            if (zet[k].pass<>'')and(zet[k].pass<>zet[i].pass) then zet[i].pass:= zet[k].pass;
            if (zet[k].list<>'')and(zet[k].list<>zet[i].list) then zet[i].list:= zet[k].list;
          end;
        end;
        if ADelete then zet[k]:= anil;
      end;
    end;
  end;
  for i:=0 to GetArrayLength(zet)-1 do begin
    if (zet[i].Filename <> '') then begin
      k:= GetArrayLength(Result); SetArrayLength(Result, k+1); Result[k]:= zet[i];
      Result[k].ID:=$2*(k+1);
    end;
  end;
end;

function UpdateArcsList(): Integer;
var m: integer;
begin
  Result:= 0;
  SetArrayLength(Arcs,0); Progress.DiskSize:=0;
  for m:=0 to (GetArrayLength(AllArchives)-1) do begin
    if (AllArchives[m].UnPack)and(AllArchives[m].UnPacked=False) then
      Progress.DiskSize:= Progress.DiskSize + AddArcs(AllArchives[m], Result);
    if (Result < 0) then Break;
  end;
end;

function UnPack(): Integer;
begin
  Progress.CurPos:=0;
  Progress.LastPos:=0;
  baseMb:= 0;
  if (DS.LastMaxCount<>DS.MaxCount)and(DS.CurDisk>1) then begin
    Progress.AllPos:= (WizardForm.ProgressGauge.Max/(DS.MaxCount))*(DS.CurDisk-1);
  end;
  UpdateStatus();
  for ArcInd:= 0 to GetArrayLength(Arcs) -1 do begin
    lastMb:= 0; SuspendUpdate:=False;
    Result:= UnPackArchive(Arcs[ArcInd]);
    Progress.LastSize:= Progress.AllSize;
    SetUnPacked(Arcs[ArcInd]);
    SuspendUpdate:=True;
    if Result <> 0 then Break;
    baseMb:= baseMb + lastMb;
    if (Pos(AnsiLowercase(ExpandConstant('{app}')), AnsiLowercase(Arcs[ArcInd].Filename)) > 0)or(Pos(AnsiLowercase(ExpandConstant('{tmp}')), AnsiLowercase(Arcs[ArcInd].Filename)) > 0) then
      if (Arcs[ArcInd].Delete = True) then DeleteFile(Arcs[ArcInd].Filename);
  end;
end;

function CheckBools(Bools: array of Boolean): Integer;
var
  c,l: integer;
begin
  Result:=0; c:= 0;
  for l:=0 to GetArrayLength(Bools)-1 do
    if (Bools[l] = True) then c:=c+1;
  if (c=(GetArrayLength(Bools))) then Result:=1;
end;

function GetRemainArcs(): integer;
var
  c: integer;
begin
  Result:=0;
  for c:=0 to GetArrayLength(AllArchives)-1 do
    if (AllArchives[c].UnPack)and(not AllArchives[c].UnPacked) then Result:=Result+1;
end;

function GetNextArc(): Integer;
var
  c: Integer;
begin
  Result:=0;
  for c:=0 to GetArrayLength(AllArchives)-1 do
    if (AllArchives[c].UnPack)and(not AllArchives[c].UnPacked) then begin
      Result:=c;
      Break;
    end;
end;

function IsComponentSelectedDef(const S: String): Boolean;
begin
  Result:= IsComponentSelected(S);
end;

function IsTaskSelectedDef(const S: String): Boolean;
begin
  Result:= IsTaskSelected(S);
end;

procedure UpdateArcState();
var
  f: Integer;
begin
  for f:= 0 to GetArrayLength(AllArchives)-1 do begin
    if not AllArchives[f].UnPacked then AllArchives[f].UnPack:= True;
    if (AllArchives[f].comp<>'')and(not ParseLine(AllArchives[f].comp, @IsComponentSelectedDef)) then AllArchives[f].UnPack:=False;
    if (AllArchives[f].task<>'')and(not ParseLine(AllArchives[f].task, @IsTaskSelectedDef)) then Allarchives[f].UnPack:=False;
  end;
end;

function UnPackWithPrompts(Archives: string; Callback: TFreeArcUpdateProcess): Integer;
var
  MsBox, MaxArcs, z, f, k, x, LastDisk: Integer;
  OneDisk, DiskCheck, Packet: Boolean;
Label
  freelib;
begin
  ExtractTemporaryFile('Arc.ini');
  ExtractTemporaryFile('CLS.ini');
  ExtractTemporaryFile('CLS-LOLZ.dll');
  ExtractTemporaryFile('CLS-LOLZ_x64.exe');
  ExtractTemporaryFile('CLS-LOLZ_x86.exe');
  ExtractTemporaryFile('facompress_mt.dll');

  ExtractTemporaryFile('facompress.dll');
  #ifdef precomp
    ExtractTemporaryFile('CLS-precomp.dll');
    ExtractTemporaryFile('packjpg_dll.dll');
    ExtractTemporaryFile('packjpg_dll1.dll');
    ExtractTemporaryFile('precomp.exe');
    #if precomp != "0.40"
      ExtractTemporaryFile('zlib1.dll');
    #endif
  #endif
  #ifdef srep
    ExtractTemporaryFile('CLS-srep.dll');
  #endif
  ReturnFunc:= Callback;
  Progress.CurStage:=cm('ArcTitle');
  Progress.FilesCount:=0;
  StartInstall:= GetTickCount;
  LastTimerEvent:= StartInstall-500;
  LastTimeCheck:= StartInstall-5000;
  SuspendUpdate:=True;
  OneDisk:=False;
  DiskCheck:=False;
  Packet:=False;
  MsBox:=IDOK; DS.CurDisk:=1; z:=0; k:=0; x:=0; LastDisk:=1;
  AllArchives:= FillArcList(ArcDecode(Archives));
  DS.LastMaxCount:=DS.MaxCount; MaxArcs:= GetArrayLength(AllArchives)-1;
  DS.MaxCount:= AllArchives[MaxArcs].disks;
  if Archives = '' then begin
    Result:= -17;
    goto freelib;
  end;
  Arc_Path:= AllArchives[0].Path;
  for f:=0 to MaxArcs do begin
    AllArchives[f].UnPack:=True; AllArchives[f].UnPacked:=False; AllArchives[f].Packet:=False;
    if (AllArchives[f].comp<>'')and(not ParseLine(AllArchives[f].comp, @IsComponentSelectedDef)) then AllArchives[f].UnPack:=False;
    if (AllArchives[f].task<>'')and(not ParseLine(AllArchives[f].task, @IsTaskSelectedDef)) then Allarchives[f].UnPack:=False;
    if (Pos('*', AllArchives[f].Filename) > 0) then Packet:= True;
    z:=z+CheckBools([CheckFile(AllArchives[f].Path, AllArchives[f].SubPath, AllArchives[f].Filename)]);
    k:=k+CheckBools([AllArchives[f].UnPack]);
    x:=x+CheckBools([AllArchives[f].UnPack, CheckFile(AllArchives[f].Path, AllArchives[f].SubPath, AllArchives[f].Filename)]);
  end;
  if (z=(MaxArcs+1))or(x=k) then begin
    DS.LastMaxCount:=DS.MaxCount;
    DS.MaxCount:=DS.CurDisk;
    OneDisk:=True;
  end;
  DS.NextArc:= GetNextArc;
  while (Result = 0) and (GetRemainArcs>0) do begin
    if GetRemainArcs<=0 then Break;
   
    if (not OneDisk) then begin
      x:=0;
      for f:= DS.NextArc to MaxArcs do begin
        x:=x+CheckBools([(AllArchives[f].UnPack), CheckFile(AllArchives[f].Path, AllArchives[f].SubPath, AllArchives[f].Filename)]);
        if (x=((MaxArcs+1)-DS.NextArc)) then begin
          DS.LastMaxCount:=DS.MaxCount;
          DS.MaxCount:=DS.CurDisk;
        end;
      end;
    end;
   
    if (not CheckFile(AllArchives[DS.NextArc].Path, AllArchives[DS.NextArc].SubPath, AllArchives[DS.NextArc].Filename))and(not CheckFile(Arc_Path, AllArchives[DS.NextArc].SubPath, AllArchives[DS.NextArc].Filename)) then begin
      if not BrowseForFiles(FmtMessage(cm('InsertDisk'),[IntToStr(DS.CurDisk), AllArchives[DS.NextArc].Filename]), Arc_Path, AllArchives[DS.NextArc].SubPath, AllArchives[DS.NextArc].Filename, Arc_Path) then begin
        Result:= -10;
        Break;
      end;
      Arc_CurPath:= Arc_Path;
    end else
      Arc_CurPath:= '';

    if (not OneDisk) then begin
      if (DS.MaxCount>1)and(DS.CurDisk<>DS.MaxCount)and(not DiskCheck) then begin
        while (LastDisk<=DS.MaxCount)and(f<(MaxArcs+1)) do begin
          k:=0; x:=0;
          for z:=f to MaxArcs do begin
            if AllArchives[z].disks=LastDisk then begin x:=x+1; if (not AllArchives[z].UnPack) then k:=k+1; end;
          end;
          if k=x then begin DS.LastMaxCount:= DS.MaxCount; DS.MaxCount:= DS.MaxCount-1; f:=f+k end;
          LastDisk:=LastDisk+1;
        end;
        DiskCheck:=True;
      end;
      if (DS.CurDisk=DS.MaxCount)and(not Packet) then begin
        k:=0; x:=0;
        for z:=DS.NextArc to MaxArcs do begin
          if (AllArchives[z].disks=DS.CurDisk)and(AllArchives[z].UnPack) then begin
            x:=x+1; if FileExists(AllArchives[z].Path) then k:=k+1;
          end;
        end;
        if k<x then begin DS.LastMaxCount:= DS.MaxCount; DS.MaxCount:= DS.MaxCount+1; end;
      end;
    end;

    AllArchives:= FillArcList(AllArchives);
    UpdateArcState;
    Result:= UpdateArcsList;
    if Result<0 then Break;
    Result:= UnPack();
    DS.CurDisk:= DS.CurDisk+1;
    DS.NextArc:= GetNextArc;
  end;
 
freelib:
  UnloadDLL();
end;

Razor12911 08-10-2018 20:01
Quote:
Originally Posted by Midnights (Post 476216)
Hi, after trying this, in my case is more easy to use, can you please add support for DiskSpan to this script please?
I have trying but dont know where to split/add code from the exemple in the archive, many thanks if you can help...

ISFreeArcExtract v.4.2 Main.iss
Code:
var
  StatusLabel, FileNameLabel, ExtractFile, StatusInfo: TLabel;
  ProgressBar: TNewProgressBar; OutErroMsg, CurStage: String;
  UnPackError: Integer; ContinueInstall: Boolean;

Function CreateLabel(Parent: TWinControl; AutoSize, WordWrap, Transparent: Boolean; FontName: String; FontStyle: TFontStyles; FontColor: TColor; Left, Top, Width, Height: Integer; Prefs: TObject): TLabel;
Begin
  Result:=TLabel.Create(Parent); Result.parent:= Parent;
  if Prefs <> Nil then begin
    Top:= TWinControl(Prefs).Top; Left:= TWinControl(Prefs).Left; Width:= TWinControl(Prefs).Width; Height:= TWinControl(Prefs).Height;
  end;
    if Top > 0 then result.Top:=Top; if Left > 0 then result.Left:= Left; if Width > 0 then result.Width:= Width; if Height > 0 then result.Height:= Height;
    if FontName <> '' then result.Font.Name:= FontName; if FontColor > 0 then result.Font.Color:= FontColor; if FontStyle <> [] then result.Font.Style:= FontStyle;
    result.AutoSize:= AutoSize; result.WordWrap:= WordWrap; result.Transparent:=Transparent; result.ShowHint:= true;
End;

Function NumToStr(Float: Extended): String;
Begin
  Result:= Format('%.2n', [Float]); StringChange(Result, ',', '.');
  while ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) and (Pos('.', Result) > 0) do
    SetLength(Result, Length(Result)-1);
End;

Function ByteOrTB(Bytes: Extended; noMB: Boolean): String;
Begin
  if not noMB then Result:= NumToStr(Int(Bytes)) +' Mb' else
    if Bytes < 1024 then if Bytes = 0 then Result:= '0' else Result:= NumToStr(Int(Bytes)) +' Bt' else
      if Bytes/1024 < 1024 then Result:= NumToStr(round((Bytes/1024)*10)/10) +' Kb' else
        If Bytes/oneMB < 1024 then Result:= NumToStr(round(Bytes/oneMB*100)/100) +' Mb' else
          If Bytes/oneMB/1000 < 1024 then Result:= NumToStr(round(Bytes/oneMB/1024*1000)/1000) +' Gb' else
            Result:= NumToStr(round(Bytes/oneMB/oneMB*1000)/1000) +' Tb';
End;

function UpdateProgress(SText, FText, Time, errmsg: String; PosCur1, PosMax1, PosCur2, PosMax2, FileCount, CurDisk, DiskCount: Integer; ExtractedSize: Extended): Boolean;
var perc, p: extended;
begin
  if ProgressBar.Max<>PosMax2 then ProgressBar.Max:= PosMax2;
  if WizardForm.ProgressGauge.Max<>PosMax1 then WizardForm.ProgressGauge.Max:= PosMax1;
  ProgressBar.Position:=PosCur2; WizardForm.ProgressGauge.Position:= PosCur1;
  if PosMax1<>0 then perc:= Extended(PosCur1)*100/Extended(PosMax1);
  if PosMax2<>0 then p:= Extended(PosCur2)*100/Extended(PosMax2);
  StatusLabel.Caption:= SText;
  OutErroMsg:= errmsg;
  FilenameLabel.Caption:= FText; CurStage:= SText;
  StatusInfo.Caption:= FmtMessage(cm('StatusInfo'), [IntToStr(FileCount), ' ['+ ByteOrTB(ExtractedSize, true) +']', Format('%.1n', [Abs(perc)]), Time]);
  ExtractFile.Caption:= FmtMessage(cm('ArcInfo'), [IntToStr(CurDisk), IntToStr(DiskCount), IntToStr(ArcInd+1), IntToStr(GetArrayLength(Arcs)), Format('%.1n', [Abs(p)])]);
  ProgressBar.Position:= LastMb;
  Result:= ContinueInstall;
end;

procedure CurStepChanged(CurStep: TSetupStep);
var n: Integer;
begin
  if CurStep = ssPostInstall then
  begin
    ContinueInstall:= True;
    WizardForm.CancelButton.Enabled:= True;
    ProgressBar.Position:=0;
    WizardForm.ProgressGauge.Position:= 0;
    StatusLabel.Show;
    FileNameLabel.Show;
    StatusInfo.Show;
    ProgressBar.Show;
    ExtractFile.Show;
    UnPackError:= UnPackWithPrompts('{#Archives}', @UpdateProgress);
    if UnPackError <> 0 then begin
      Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n);
      WizardForm.caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak');
      SetTaskBarTitle(SetupMessage(msgErrorTitle));
    end else
      SetTaskBarTitle(SetupMessage(msgSetupAppTitle));
    StatusLabel.Hide; FileNameLabel.Hide; StatusInfo.Hide; ProgressBar.Hide; ExtractFile.Hide;
  end;
end;

Procedure CurPageChanged(CurPageID: Integer);
Begin
    if (CurPageID = wpFinished) and (UnPackError <> 0) then
    begin
        WizardForm.FinishedLabel.Font.Color:= $0000C0;
        WizardForm.FinishedLabel.Height:= WizardForm.FinishedLabel.Height * 2;
        WizardForm.FinishedLabel.Caption:= SetupMessage(msgSetupAborted) + #13#10#13#10 + OutErroMsg;
    end;
End;

procedure WizardClose(Sender: TObject; var Action: TCloseAction);
Begin
  Action:= caNone;
    if CurStage = cm('ArcTitle') then begin
        if MsgBox(SetupMessage(msgExitSetupMessage), mbInformation, MB_YESNO) = IDYES then
            ContinueInstall:= false;
    end else
        MainForm.Close;
End;

Procedure InitializeWizard();
Begin
    StatusLabel:= CreateLabel(WizardForm.InstallingPage,false,false,true,'',[],0,0,0,0,0, WizardForm.StatusLabel);
    FileNameLabel:= CreateLabel(WizardForm.InstallingPage,false,false,true,'',[],0,0,0,0,0, WizardForm.FileNameLabel);
    WizardForm.StatusLabel.Top:= WizardForm.ProgressGauge.Top; WizardForm.FileNameLabel.Top:= WizardForm.ProgressGauge.Top;    // прячем под прогрессбар, тогда все события WM_PAINT перехватываются
    with WizardForm.ProgressGauge do begin
      StatusInfo:= CreateLabel(WizardForm.InstallingPage, false, true, true, '', [], 0, 0, Top + ScaleY(32), Width, 0, Nil);
      ProgressBar := TNewProgressBar.Create(WizardForm);
      ProgressBar.SetBounds(Left, StatusInfo.Top + StatusInfo.Height + ScaleY(16), Width, Height);
      ProgressBar.Parent := WizardForm.InstallingPage;
      ProgressBar.max := 65536;
      ProgressBar.Hide;
      ExtractFile:= CreateLabel(WizardForm.InstallingPage, false, true, true, '', [], 0, 0, ProgressBar.Top + ScaleY(32), Width, 0, Nil);
      StatusLabel.Hide; FileNameLabel.Hide; StatusInfo.Hide; ProgressBar.Hide; ExtractFile.Hide;
    end;
    WizardForm.OnClose:= @WizardClose
End;

ISFreeArcExtract v.4.2.iss
Code:
#include "ISFreeArcExtract_Utils.iss"

type
#ifdef UNICODE
    #define A "W"
#else
    #define A "A"
#endif
#if Ver < 84018176
    AnsiString = String;
#endif
#if !defined(IS_ENHANCED)
  TMsg = record
    hwnd: HWND;
    message: LongWord;
    wParam: Longint;
    lParam: Longint;
    time: LongWord;
    pt: TPoint;
  end;
#endif

  TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
  TArc = record Path, SubPath, Filename, Dest, Comp, Task, Pass, List: string; allMb, Disks: Integer; UnPack, UnPacked, Delete, Packet: Boolean; ID: DWord; end;
  TSimpleArc = record Filename, Destination, Pass, Listing: String; allMb, ID: DWORD; Delete: Boolean; end;
  TFAProgressInfo = record CurStage, CurName: String; DiskSize, CurPos, LastPos, AllPos, FilesCount: Integer; Percents, LastSize, CurSize, AllSize: Extended; end;
  TFADiskStatus = record LastMaxCount, MaxCount, CurDisk, NextArc, RemainsArc: Integer; end;
  TFreeArcUpdateProcess = function(SText, FText, Time, errmsg: String; PosCur1, PosMax1, PosCur2, PosMax2, FileCount, CurDisk, DiskCount: Integer; ExtractedSize: Extended): Boolean;
   
var
  CancelCode, ArcInd, lastMb, baseMb, origsize: Integer;
  Arcs: array of TSimpleArc;
  AllArchives: array of TArc;
  msgError, CompressMethod, aTime, Arc_Path, Arc_CurPath: string;
  Progress: TFAProgressInfo; DS: TFADiskStatus;
  SuspendUpdate: Boolean;
  ReturnFunc: TFreeArcUpdateProcess;
  Remaining: Extended;
  StartInstall, LastTimerEvent, LastTimeCheck: DWORD;
   
const
  CP_ACP    = 0;
  CP_UTF8  = 65001;
  oneMB    = 1024*1024;
  VK_ESCAPE = 27;

function WrapFreeArcCallback (callback: TFreeArcCallback; paramcount: integer):longword; external 'wrapcallbackaddr@files:CallBackCtrl.dll stdcall';
function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external 'FreeArcExtract@files:unarc.dll cdecl delayload';
procedure UnloadDLL(); external 'UnloadDLL@files:unarc.dll cdecl delayload';

Function OemToChar(lpszSrc, lpszDst: AnsiString): longint; external '[email protected] stdcall';
Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpWideCharStr: PAnsiChar; cchWideChar: integer): longint; external '[email protected] stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: PAnsiChar; cchWideChar: integer; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external '[email protected] stdcall';

function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external '[email protected] stdcall';
function TranslateMessage(const lpMsg: TMsg): BOOL; external '[email protected] stdcall';
function DispatchMessage(const lpMsg: TMsg): Longint; external '[email protected] stdcall';

function GetTickCount: DWord; external 'GetTickCount@kernel32';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';
function GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';

procedure AppProcessMessage;
var
  Msg: TMsg;
begin
  if not PeekMessage(Msg, 0, 0, 0, 1) then Exit;
  TranslateMessage(Msg); DispatchMessage(Msg);
end;

Function FreeArcCmd(callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer;
begin
  CancelCode:= 0;
  AppProcessMessage;
  try
    Result:= FreeArcExtract(callback, cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10);
    if CancelCode < 0 then Result:= CancelCode;
  except
    Result:= -63;
  end;
end;

Procedure SetTaskBarTitle(Title: String); var h: Integer;
Begin
  h:= GetWindowLong(MainForm.Handle, -8);
  if h <> 0 then SetWindowText(h, Title);
End;

Function TicksToTime(Ticks: Extended; h,m,s: String; detail: Boolean): String;
begin
  if detail then
    Result:= PADZ(IntToStr(Round(Ticks/3600000)), 2) +':'+ PADZ(IntToStr(Round((Ticks/1000 - Ticks/1000/3600*3600)/60)), 2) +':'+ PADZ(IntToStr(Round(Ticks/1000 - Ticks/1000/60*60)), 2)
  else if Ticks/3600 >= 1000 then
    Result:= IntToStr(Round(Ticks/3600000)) +h+' '+ PADZ(IntToStr(Round((Ticks/1000 - Ticks/1000/3600*3600)/60)), 2) +m
  else if Ticks/60 >= 1000 then
    Result:= IntToStr(Round(Ticks/60000)) +m+' '+ IntToStr(Round(Ticks/1000 - Ticks/1000/60*60)) +s
  else Result:= Format('%.1n', [Abs(Ticks/1000)]) +s;
end;

Function ExpandENV(S: String): String;
var
  n: UINT;
begin
  if Pos('{',S ) * Pos('}', S) = 0 then
    Result:= S
  else Result:= ExpandConstant(S);
  n:= Pos('%',result);
  if n = 0 then Exit;
    Delete(result, n,1);
  Result:= Copy(Result,1, n-1) + ExpandConstant('{%'+Copy(Result, n, Pos('%',result) -n) +'}') + Copy(Result, Pos('%',result) +1, Length(result));
end;

Function cm(Message: String): String;
begin
  Result:= ExpandConstant('{cm:'+ Message +'}')
end;

function OemToAnsiStr(strSource: AnsiString): AnsiString;
begin
  SetLength(Result, Length(strSource));
  OemToChar(strSource, Result);
end;

function AnsiToUtf8(strSource: string): string;
var
  nRet: integer;
  WideCharBuf, MultiByteBuf: AnsiString;
begin
  SetLength(WideCharBuf, Length(strSource) * 2);
  SetLength(MultiByteBuf, Length(strSource) * 2);
  MultiByteToWideChar(CP_ACP, 0, strSource, -1, WideCharBuf, Length(WideCharBuf));
  nRet:= WideCharToMultiByte(CP_UTF8, 0, WideCharBuf, -1, MultiByteBuf, Length(MultiByteBuf), 0, 0);
  Result:= Copy(MultiByteBuf, 1, nRet);
end;

Procedure UpdateStatus();
var
  i, t: string;
  TimeEnable: Boolean;
Begin
  if (SuspendUpdate)or(GetTickCount-LastTimerEvent<200) then Exit;
  Progress.CurSize := baseMb+lastMb; TimeEnable:= True;
  Progress.Allsize:= Progress.LastSize + lastMb;
  if Progress.DiskSize > 0 then begin
    Progress.CurPos:= round((100000 * Progress.CurSize)/Progress.DiskSize);
    if Progress.CurPos > Progress.LastPos then begin
      Progress.AllPos:= Progress.AllPos + ((Progress.CurPos-Progress.LastPos)/DS.MaxCount);
      Progress.LastPos:=Progress.CurPos
    end;
    Progress.Percents:= Progress.AllPos/100;
    If (Progress.AllPos > 0) then Remaining:= ((100000-Progress.AllPos)*(GetTickCount-StartInstall)/Progress.AllPos)*(DS.MaxCount+1-DS.CurDisk);
    if (Progress.Percents >= 990) then begin TimeEnable:= False; t:= cm('ending'); i:= AnsiLowerCase(t); end;
    if TimeEnable then begin
      #ifdef External
        t:= Format('%.1n',[Extended(Progress.Percents)/10])+'%';
        i:= AnsiLowercase(cm('unknown'));
      #else
        t:= FmtMessage(cm('taskbar'), [Format('%.1n',[Progress.Percents/10]), TicksToTime(Remaining, 'h', 'm', 's', false)]);
        i:= TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false);
      #endif
    end;
  end;
  SetTaskBarTitle(t);
  if GetTickCount-LastTimeCheck>=1000 then begin
    aTime:= i;
    LastTimeCheck:= GetTickCount;
  end;
  LastTimerEvent:= GetTickCount;
  if ReturnFunc<> nil then
    if not ReturnFunc(Progress.CurStage, Progress.CurName, aTime, MsgError, Progress.AllPos, 100000, LastMb, Arcs[ArcInd].allMb, Progress.FilesCount, DS.CurDisk, DS.MaxCount, Progress.Allsize*oneMB) then
      CancelCode:= -10;
End;

function FreeArcCallback(what: PAnsiChar; Mb, int2: Integer; str: PAnsiChar): Integer;
begin
  case string(what) of
    'origsize': origsize:= Mb;
    'total_files': Null;
    'filename': begin
                  Progress.CurName:= OemToAnsiStr(str);
                  Progress.FilesCount:= Progress.FilesCount + 1;
                end;
    'read': Null;
    'write': lastMb:= Mb;
    'error': if (Mb = -2) then CompressMethod:= str;
  end;
  UpdateStatus();
  if (GetKeyState(VK_ESCAPE) < 0) then
    WizardForm.Close;
  AppProcessMessage;
  Result:= CancelCode;
end;

function GetPath(Arc: TArc; ExtrPath: String; UseSubPath: Boolean): String;
begin
  if ExtrPath='' then
    Result:= Arc.Path
  else
    Result:= ExtrPath;
  if (UseSubPath)and(Arc.SubPath<>'') then
    Result:= Result+'\'+Arc.SubPath;
  Result:= Result+'\'+Arc.Filename;
end;

function ProcessCode(var S: String; Code: String): String;
var
  p1, p2: integer;
begin
  Result:= '';
  p1:= Pos(AnsiLowercase(Code), AnsiLowercase(s));
  if p1>0 then begin
    p2:=p1; while (s[p2]<>';')and(p2<=Length(s)) do p2:=p2+1;
    Result:= Copy(s, p1, p2-p1);
    Delete(s, p1, p2-p1+1);
    Delete(Result, 1, Length(Code));
  end;
  Result:= Trim(Result);
end;

function StrToBool(S: String): Boolean;
begin
  Result:=False;
  if S='' then Exit;
  S:= Trim(AnsiLowercase(S));
  if (S = 'true')or(S = 'yes')or(S = '1') then
    Result:= True else Result:= False;
end;

Function ArcDecode(Line: String): array of TArc;
var
  cut, tmp: string;
  i, n: integer;
begin
  SetArrayLength(Result, 0);
  If Line = '' then Exit;
  repeat
    n:= Pos('|', Line);
    if (n=0) then
      if(Length(Line)=0) then Break
      else n:= Length(Line)+1;
    cut:= Copy(Line, 1, n-1)+';'; Delete(Line, 1, n);
    i:= GetArrayLength(Result); SetArrayLength(Result, i+1);
    Result[i].Path:= Trim(ProcessCode(cut, 'Source:'));
    Result[i].dest:= Trim(ProcessCode(cut, 'DestDir:'));
    tmp:= ProcessCode(cut, 'Disk:');
    if tmp='' then Result[i].disks:= 1
    else Result[i].disks:= StrToInt(tmp);
    Result[i].comp:= Trim(ProcessCode(cut, 'Components:'));
    Result[i].task:= Trim(ProcessCode(cut, 'Tasks:'));
    Result[i].pass:= Trim(ProcessCode(cut, 'Password:'));
    Result[i].list:= Trim(ExpandENV(ProcessCode(cut, 'FilesList:')));
    Result[i].Delete:= StrToBool(ProcessCode(cut, 'Delete:'));
    while Pos(';', cut)>0 do Delete(cut, Pos(';', cut), 1);
    if Result[i].Path='' then begin
      if (ExtractFileDrive(ExpandEnv(cut)) = '')and(ExpandEnv(cut) = cut) then
      Result[i].Path:= '{src}\'+cut else Result[i].Path:= cut;
    end;
    Result[i].Filename:= ExtractFileName(Result[i].Path);
    Result[i].Path:= ExtractFilePath(result[i].Path);
    Result[i].SubPath:= Copy(Result[i].Path, Pos('\', Result[i].Path)+1, Length(Result[i].Path));
    Delete(Result[i].Path, Pos('\', Result[i].Path), Length(Result[i].Path));
    Result[i].Dest:= ExpandENV(result[i].Dest);
    Result[i].Path:= ExpandENV(result[i].Path);
  until Line='';
end;

function AddArcs(File: TArc; var ErrCode: Integer): Integer;
var
  i, b: integer;
  f: String;
  cmd: array [0..9] of String;
begin
  Result:= 0;
  f:= GetPath(File, Arc_CurPath, True);
  if not FileExists(f) then
    f:= GetPath(File, Arc_CurPath, False);
  if FileExists(f) then begin
    i:= GetArrayLength(Arcs);
    SetArrayLength(Arcs, i +1);
    Arcs[i].Filename:= f;
    Arcs[i].Destination:= File.Dest;
    Arcs[i].Pass:= File.Pass;
    Arcs[i].Listing:= File.List;
    Arcs[i].ID:= File.ID;
    Arcs[i].Delete:= File.Delete;
    cmd[0]:='l'; b:=1; if Arcs[i].Pass <> '' then begin cmd[1]:= '-p'+AnsiToUtf8(Arcs[i].Pass); b:=b+1; end;
    cmd[b]:='--'; cmd[b+1]:=AnsiToUtf8(f)
    ErrCode:= FreeArcCmd(WrapFreeArcCallback(@FreeArcCallback,4), cmd[0],cmd[1],cmd[2],cmd[3],cmd[4],cmd[5],cmd[6],cmd[7],cmd[8],cmd[9]);
    if ErrCode >= 0 then begin
      Arcs[i].allMb:= origsize;
      Result:= origsize;
      origsize:=0;
    end;
  end;
end;

function DispatchError(ErrorCode: Integer; Arc: TSimpleArc): String;
var
  ArcFile: String;
begin
  ArcFile:= ExtractFilename(Arc.Filename);
  if (ErrorCode = -2) then StringChange(CompressMethod, 'ERROR: unsupported compression method ', '');
  case ErrorCode of
    -1:  Result:= cm('ErrorUnknownError');
    -2:  Result:= FmtMessage(cm('ErrorCompressMethod'), [CompressMethod, ArcFile]);
    -3:  Null;
    -4:  Result:= FmtMessage(cm('ErrorOutBlockSize'), [ArcFile]);
    -5:  Result:= FmtMessage(cm('ErrorNotEnoughRAMMemory'), [ArcFile]);
    -6:  Result:= FmtMessage(cm('ErrorReadData'), [ArcFile]);
    -7:  Result:= FmtMessage(cm('ErrorBadCompressedData'), [ArcFile]);
    -8:  Result:= cm('ErrorNotImplement');
    -9:  Result:= FmtMessage(cm('ErrorDataAlreadyDecompress'), [ArcFile]);
    -10:  Result:= cm('ErrorUnpackTerminated');
    -11:  Result:= FmtMessage(cm('ErrorWriteData'), [ArcFile]);
    -12:  Result:= FmtMessage(cm('ErrorBadCRC'), [ArcFile]);
    -13:  Result:= FmtMessage(cm('ErrorBadPassword'), [ArcFile]);
    -14:  Result:= FmtMessage(cm('ErrorBadHeader'), [ArcFile]);
    -15:  Null;
    -63:  Result:= cm('ErrorCodeException');
    -112: Result:= FmtMessage(cm('ErrorNotEnoughFreeSpace'), [ArcFile]);
  end;
end;

function UnPackArchive(Archive: TSimpleArc): Integer;
var
  cmd: array [0..9] of String;
  b: integer;
  FreeMB, TotalMB: Cardinal;
begin
  cmd[0]:='x';
  cmd[1]:='-o+';
  cmd[2]:= '-dp'+AnsiToUtf8(Archive.Destination);
  cmd[3]:= '-w'+AnsiToUtf8(Archive.Destination); b:=4;
  if Archive.Pass <> '' then begin cmd[b]:= '-p'+AnsiToUtf8(Archive.Pass); b:=b+1 end;
  if Archive.Listing <> '' then begin cmd[b]:= AnsiToUtf8(Archive.Listing); b:=b+1; end;
  cmd[b]:='--'; cmd[b+1]:= AnsiToUtf8(Archive.Filename);
  Result:= FreeArcCmd(WrapFreeArcCallback(@FreeArcCallback,4), cmd[0],cmd[1],cmd[2],cmd[3],cmd[4],cmd[5],cmd[6],cmd[7],cmd[8],cmd[9]);
  if Result = 0 then Exit;
  msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
  GetSpaceOnDisk(ExtractFileDrive(Archive.Destination), True, FreeMB, TotalMB);
  if FreeMB < (Archive.allMb-lastMb) then Result:= -112;
  MsgError:= msgError+#13#10#13+DispatchError(Result, Archive)
End;

procedure SetUnpacked(File: TSimpleArc);
var
  i: integer;
begin
  for i:=0 to GetArrayLength(AllArchives)-1 do begin
    if (File.ID=AllArchives[i].ID) then begin
      AllArchives[i].UnPacked:=True;
      Break;
    end;
  end;
end;

function FindArcs(Str: TArc): array of TArc;
var
  FSR: TFindRec;
  i: Integer;
  Dir: String;
begin
  if FindFirst(GetPath(Str, Arc_CurPath, True), FSR) then try
    Dir:= ExtractFilePath(GetPath(Str, Arc_CurPath, True));
    repeat
      AppProcessMessage;
      if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
      i:= GetArrayLength(Result); SetArrayLength(Result, i+1);
      Result[i]:= Str;
      Result[i].Filename:= FSR.Name;
      Result[i].Packet:= True;
    until not FindNext(FSR);
  finally
    FindClose(FSR);
  end;
end;

function FillArcList(Source: array of TArc): array of TArc;
var i, k: integer; zet: array of TArc; anil: TArc; ADelete: Boolean;
begin
  SetArrayLength(Result, 0);
  for i:= 0 to GetArrayLength(Source)-1 do begin
    if (Pos('*', Source[i].Filename) > 0)and(Source[i].Disks=DS.CurDisk) then
      zet:= FindArcs(Source[i])
    else begin
      k:= GetArrayLength(zet);
      SetArrayLength(zet, k+1);
      zet[k]:= Source[i];
    end;
  end;
  for i:=0 to GetArrayLength(zet)-1 do begin
    if (zet[i].Filename<>'') then for k:=0 to GetArrayLength(zet)-1 do begin
      if (i<>k)and(AnsiLowercase(zet[i].Filename)=AnsiLowercase(zet[k].Filename)) then begin
        if (zet[i].UnPacked)and(zet[k].Packet) then ADelete:= True;
        if not (zet[k].Packet)and(not zet[i].UnPacked) then begin
          ADelete:= true;
          if (zet[k].list<>'')and(zet[i].list<>'')and(zet[k].list<>zet[i].list) then ADelete:= False;
          if ((zet[k].list<>'')and(zet[i].list=''))or((zet[k].list='')and(zet[i].list='')) then begin
            if (zet[i].Packet)and(not zet[k].Packet) then zet[i].Packet:= False;
            if (zet[k].dest<>'')and(zet[k].dest<>zet[i].dest) then zet[i].dest:= zet[k].dest;
            if (zet[k].comp<>'')and(zet[k].comp<>zet[i].comp) then zet[i].comp:= zet[k].comp;
            if (zet[k].task<>'')and(zet[k].task<>zet[i].task) then zet[i].task:= zet[k].task;
            if (zet[k].pass<>'')and(zet[k].pass<>zet[i].pass) then zet[i].pass:= zet[k].pass;
            if (zet[k].list<>'')and(zet[k].list<>zet[i].list) then zet[i].list:= zet[k].list;
          end;
        end;
        if ADelete then zet[k]:= anil;
      end;
    end;
  end;
  for i:=0 to GetArrayLength(zet)-1 do begin
    if (zet[i].Filename <> '') then begin
      k:= GetArrayLength(Result); SetArrayLength(Result, k+1); Result[k]:= zet[i];
      Result[k].ID:=$2*(k+1);
    end;
  end;
end;

function UpdateArcsList(): Integer;
var m: integer;
begin
  Result:= 0;
  SetArrayLength(Arcs,0); Progress.DiskSize:=0;
  for m:=0 to (GetArrayLength(AllArchives)-1) do begin
    if (AllArchives[m].UnPack)and(AllArchives[m].UnPacked=False) then
      Progress.DiskSize:= Progress.DiskSize + AddArcs(AllArchives[m], Result);
    if (Result < 0) then Break;
  end;
end;

function UnPack(): Integer;
begin
  Progress.CurPos:=0;
  Progress.LastPos:=0;
  baseMb:= 0;
  if (DS.LastMaxCount<>DS.MaxCount)and(DS.CurDisk>1) then begin
    Progress.AllPos:= (WizardForm.ProgressGauge.Max/(DS.MaxCount))*(DS.CurDisk-1);
  end;
  UpdateStatus();
  for ArcInd:= 0 to GetArrayLength(Arcs) -1 do begin
    lastMb:= 0; SuspendUpdate:=False;
    Result:= UnPackArchive(Arcs[ArcInd]);
    Progress.LastSize:= Progress.AllSize;
    SetUnPacked(Arcs[ArcInd]);
    SuspendUpdate:=True;
    if Result <> 0 then Break;
    baseMb:= baseMb + lastMb;
    if (Pos(AnsiLowercase(ExpandConstant('{app}')), AnsiLowercase(Arcs[ArcInd].Filename)) > 0)or(Pos(AnsiLowercase(ExpandConstant('{tmp}')), AnsiLowercase(Arcs[ArcInd].Filename)) > 0) then
      if (Arcs[ArcInd].Delete = True) then DeleteFile(Arcs[ArcInd].Filename);
  end;
end;

function CheckBools(Bools: array of Boolean): Integer;
var
  c,l: integer;
begin
  Result:=0; c:= 0;
  for l:=0 to GetArrayLength(Bools)-1 do
    if (Bools[l] = True) then c:=c+1;
  if (c=(GetArrayLength(Bools))) then Result:=1;
end;

function GetRemainArcs(): integer;
var
  c: integer;
begin
  Result:=0;
  for c:=0 to GetArrayLength(AllArchives)-1 do
    if (AllArchives[c].UnPack)and(not AllArchives[c].UnPacked) then Result:=Result+1;
end;

function GetNextArc(): Integer;
var
  c: Integer;
begin
  Result:=0;
  for c:=0 to GetArrayLength(AllArchives)-1 do
    if (AllArchives[c].UnPack)and(not AllArchives[c].UnPacked) then begin
      Result:=c;
      Break;
    end;
end;

function IsComponentSelectedDef(const S: String): Boolean;
begin
  Result:= IsComponentSelected(S);
end;

function IsTaskSelectedDef(const S: String): Boolean;
begin
  Result:= IsTaskSelected(S);
end;

procedure UpdateArcState();
var
  f: Integer;
begin
  for f:= 0 to GetArrayLength(AllArchives)-1 do begin
    if not AllArchives[f].UnPacked then AllArchives[f].UnPack:= True;
    if (AllArchives[f].comp<>'')and(not ParseLine(AllArchives[f].comp, @IsComponentSelectedDef)) then AllArchives[f].UnPack:=False;
    if (AllArchives[f].task<>'')and(not ParseLine(AllArchives[f].task, @IsTaskSelectedDef)) then Allarchives[f].UnPack:=False;
  end;
end;

function UnPackWithPrompts(Archives: string; Callback: TFreeArcUpdateProcess): Integer;
var
  MsBox, MaxArcs, z, f, k, x, LastDisk: Integer;
  OneDisk, DiskCheck, Packet: Boolean;
Label
  freelib;
begin
  ExtractTemporaryFile('Arc.ini');
  ExtractTemporaryFile('CLS.ini');
  ExtractTemporaryFile('CLS-LOLZ.dll');
  ExtractTemporaryFile('CLS-LOLZ_x64.exe');
  ExtractTemporaryFile('CLS-LOLZ_x86.exe');
  ExtractTemporaryFile('facompress_mt.dll');

  ExtractTemporaryFile('facompress.dll');
  #ifdef precomp
    ExtractTemporaryFile('CLS-precomp.dll');
    ExtractTemporaryFile('packjpg_dll.dll');
    ExtractTemporaryFile('packjpg_dll1.dll');
    ExtractTemporaryFile('precomp.exe');
    #if precomp != "0.40"
      ExtractTemporaryFile('zlib1.dll');
    #endif
  #endif
  #ifdef srep
    ExtractTemporaryFile('CLS-srep.dll');
  #endif
  ReturnFunc:= Callback;
  Progress.CurStage:=cm('ArcTitle');
  Progress.FilesCount:=0;
  StartInstall:= GetTickCount;
  LastTimerEvent:= StartInstall-500;
  LastTimeCheck:= StartInstall-5000;
  SuspendUpdate:=True;
  OneDisk:=False;
  DiskCheck:=False;
  Packet:=False;
  MsBox:=IDOK; DS.CurDisk:=1; z:=0; k:=0; x:=0; LastDisk:=1;
  AllArchives:= FillArcList(ArcDecode(Archives));
  DS.LastMaxCount:=DS.MaxCount; MaxArcs:= GetArrayLength(AllArchives)-1;
  DS.MaxCount:= AllArchives[MaxArcs].disks;
  if Archives = '' then begin
    Result:= -17;
    goto freelib;
  end;
  Arc_Path:= AllArchives[0].Path;
  for f:=0 to MaxArcs do begin
    AllArchives[f].UnPack:=True; AllArchives[f].UnPacked:=False; AllArchives[f].Packet:=False;
    if (AllArchives[f].comp<>'')and(not ParseLine(AllArchives[f].comp, @IsComponentSelectedDef)) then AllArchives[f].UnPack:=False;
    if (AllArchives[f].task<>'')and(not ParseLine(AllArchives[f].task, @IsTaskSelectedDef)) then Allarchives[f].UnPack:=False;
    if (Pos('*', AllArchives[f].Filename) > 0) then Packet:= True;
    z:=z+CheckBools([CheckFile(AllArchives[f].Path, AllArchives[f].SubPath, AllArchives[f].Filename)]);
    k:=k+CheckBools([AllArchives[f].UnPack]);
    x:=x+CheckBools([AllArchives[f].UnPack, CheckFile(AllArchives[f].Path, AllArchives[f].SubPath, AllArchives[f].Filename)]);
  end;
  if (z=(MaxArcs+1))or(x=k) then begin
    DS.LastMaxCount:=DS.MaxCount;
    DS.MaxCount:=DS.CurDisk;
    OneDisk:=True;
  end;
  DS.NextArc:= GetNextArc;
  while (Result = 0) and (GetRemainArcs>0) do begin
    if GetRemainArcs<=0 then Break;
   
    if (not OneDisk) then begin
      x:=0;
      for f:= DS.NextArc to MaxArcs do begin
        x:=x+CheckBools([(AllArchives[f].UnPack), CheckFile(AllArchives[f].Path, AllArchives[f].SubPath, AllArchives[f].Filename)]);
        if (x=((MaxArcs+1)-DS.NextArc)) then begin
          DS.LastMaxCount:=DS.MaxCount;
          DS.MaxCount:=DS.CurDisk;
        end;
      end;
    end;
   
    if (not CheckFile(AllArchives[DS.NextArc].Path, AllArchives[DS.NextArc].SubPath, AllArchives[DS.NextArc].Filename))and(not CheckFile(Arc_Path, AllArchives[DS.NextArc].SubPath, AllArchives[DS.NextArc].Filename)) then begin
      if not BrowseForFiles(FmtMessage(cm('InsertDisk'),[IntToStr(DS.CurDisk), AllArchives[DS.NextArc].Filename]), Arc_Path, AllArchives[DS.NextArc].SubPath, AllArchives[DS.NextArc].Filename, Arc_Path) then begin
        Result:= -10;
        Break;
      end;
      Arc_CurPath:= Arc_Path;
    end else
      Arc_CurPath:= '';

    if (not OneDisk) then begin
      if (DS.MaxCount>1)and(DS.CurDisk<>DS.MaxCount)and(not DiskCheck) then begin
        while (LastDisk<=DS.MaxCount)and(f<(MaxArcs+1)) do begin
          k:=0; x:=0;
          for z:=f to MaxArcs do begin
            if AllArchives[z].disks=LastDisk then begin x:=x+1; if (not AllArchives[z].UnPack) then k:=k+1; end;
          end;
          if k=x then begin DS.LastMaxCount:= DS.MaxCount; DS.MaxCount:= DS.MaxCount-1; f:=f+k end;
          LastDisk:=LastDisk+1;
        end;
        DiskCheck:=True;
      end;
      if (DS.CurDisk=DS.MaxCount)and(not Packet) then begin
        k:=0; x:=0;
        for z:=DS.NextArc to MaxArcs do begin
          if (AllArchives[z].disks=DS.CurDisk)and(AllArchives[z].UnPack) then begin
            x:=x+1; if FileExists(AllArchives[z].Path) then k:=k+1;
          end;
        end;
        if k<x then begin DS.LastMaxCount:= DS.MaxCount; DS.MaxCount:= DS.MaxCount+1; end;
      end;
    end;

    AllArchives:= FillArcList(AllArchives);
    UpdateArcState;
    Result:= UpdateArcsList;
    if Result<0 then Break;
    Result:= UnPack();
    DS.CurDisk:= DS.CurDisk+1;
    DS.NextArc:= GetNextArc;
  end;
 
freelib:
  UnloadDLL();
end;
What's the issue with the script that comes with DiskSpan?

Midnights 08-10-2018 20:28
Quote:
Originally Posted by Razor12911 (Post 476220)
What's the issue with the script that comes with DiskSpan?
This script is the only one i have find able to select archives as a components, so you can add the game and extra stuff as optionnal, all that in arc format...

But for now, all the scripts i find for UltraArc dont have this option, so we need to use all the bin/arc... i need to use as a component...
I have try to add UltraArc R5 support to this script with no succes, so i look for DiskSpan now.

I not able to do something with big code like that is too much for me... i you can help me with that is gonna be awsome, UltraArc is very nice, user friendly...

DiskSpan is another option... :o

zirkhaki 15-10-2018 08:08
I have one question, as I know diskspan does not support something like Mask method (different compression method for different file types). But is it possible to categorize all file into different folders (e.g. movies, zlib supported file, srep+lzma supprting files) and use Diskspan on these folders separately and finally put the *.bin files beside each other and edit record.ini so that the installer could extract them?

KaktoR 15-10-2018 08:12
Yes, that's what I do for some conversions lately :)

zirkhaki 15-10-2018 10:38
Do you mean you are doing the conversion separately or you've changed the script and it does all the things for you? If you're changing the Diskspan script for each game is it possible to tell me how I can do that? is it complicated? or is there a tutorial for that?

KaktoR 15-10-2018 11:10
I use my own script which works with list files in which you have to write files by names or extensions and what method is used for a list file.

Unfortunatelly there is no real tutorial about that. But if you know a bit about batch it's very easy if you understand it once.


All times are GMT -7. The time now is 17:23.
Page 4 of 7 « First 23 4 56 Last »
Show 40 post(s) from this thread on one page

Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2026, vBulletin Solutions Inc.
FileForums @ https://fileforums.com