Go Back   FileForums > Game Backup > PC Games > PC Games - CD/DVD Conversions > Conversion Tutorials

Reply
 
Thread Tools Display Modes
  #46  
Old 14-11-2017, 04:37
vollachr's Avatar
vollachr vollachr is offline
Conversions & UCC Creator
 
Join Date: Sep 2009
Location: Israel
Posts: 243
Thanks: 57
Thanked 485 Times in 179 Posts
vollachr is on a distinguished road
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.
Reply With Quote
Sponsored Links
  #47  
Old 15-11-2017, 09:03
Razor12911's Avatar
Razor12911 Razor12911 is offline
Coder
 
Join Date: Jul 2012
Location: South Africa
Posts: 3,190
Thanks: 1,722
Thanked 7,666 Times in 1,762 Posts
Razor12911 is on a distinguished road
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?
__________________
Looking for something?
Visit the
Tutorial Index

Reply With Quote
  #48  
Old 16-11-2017, 03:34
vollachr's Avatar
vollachr vollachr is offline
Conversions & UCC Creator
 
Join Date: Sep 2009
Location: Israel
Posts: 243
Thanks: 57
Thanked 485 Times in 179 Posts
vollachr is on a distinguished road
Quote:
Originally Posted by Razor12911 View Post
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?
Reply With Quote
  #49  
Old 16-11-2017, 04:11
felice2011's Avatar
felice2011 felice2011 is offline
Registered User
 
Join Date: Feb 2011
Location: italy
Posts: 760
Thanks: 314
Thanked 964 Times in 334 Posts
felice2011 is on a distinguished road
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.
__________________
≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈ ≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈
« I Mediocri Imitano, I Geni Copiano, Dio Crea & Distrugge » (Io Ridefinisco & Perfeziono le Loro Opere Rendendole Uniche)
≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈ ≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈≈
« The Mediocre Man Imitate, The Genius Man Copy, God Creates & Destroys » (I Redefines And I Perfect Their Works Making It Them Unique)
Reply With Quote
  #50  
Old 16-11-2017, 04:25
vollachr's Avatar
vollachr vollachr is offline
Conversions & UCC Creator
 
Join Date: Sep 2009
Location: Israel
Posts: 243
Thanks: 57
Thanked 485 Times in 179 Posts
vollachr is on a distinguished road
Quote:
Originally Posted by felice2011 View Post
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.
Reply With Quote
  #51  
Old 07-02-2018, 03:07
vollachr's Avatar
vollachr vollachr is offline
Conversions & UCC Creator
 
Join Date: Sep 2009
Location: Israel
Posts: 243
Thanks: 57
Thanked 485 Times in 179 Posts
vollachr is on a distinguished road
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 & [email protected]) and the -dp switches.

Last edited by vollachr; 08-02-2018 at 07:04.
Reply With Quote
  #52  
Old 13-03-2018, 03:51
Th3Raven's Avatar
Th3Raven Th3Raven is offline
Registered User
 
Join Date: Mar 2012
Location: Romania
Posts: 91
Thanks: 55
Thanked 51 Times in 33 Posts
Th3Raven is on a distinguished road
Send a message via Yahoo to Th3Raven
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

Last edited by Th3Raven; 13-03-2018 at 06:05.
Reply With Quote
The Following User Says Thank You to Th3Raven For This Useful Post:
pakrat2k2 (13-03-2018)
  #53  
Old 02-04-2018, 11:26
Jiva newstone's Avatar
Jiva newstone Jiva newstone is offline
Registered User
 
Join Date: Nov 2016
Location: India
Posts: 152
Thanks: 167
Thanked 219 Times in 68 Posts
Jiva newstone is on a distinguished road
@Simorq

i think razor also added src ,so open the delphi file and add 64bit suport
and compile it
Reply With Quote
The Following 2 Users Say Thank You to Jiva newstone For This Useful Post:
EzzEldin16 (02-04-2018), Simorq (02-04-2018)
  #54  
Old 08-10-2018, 16:42
Midnights Midnights is offline
Registered User
 
Join Date: Aug 2015
Location: Canada
Posts: 23
Thanks: 2
Thanked 0 Times in 0 Posts
Midnights is on a distinguished road
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 '[email protected]:CallBackCtrl.dll stdcall';
function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external '[email protected]:unarc.dll cdecl delayload';
procedure UnloadDLL(); external '[email protected]: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 '[email protected]';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external '[email protected] stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';
function GetKeyState(nVirtKey: Integer): ShortInt; external 'Get[email protected] 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;
Attached Files
File Type: 7z ISFreeArcExtract v.4.2b with lolz support.7z (4.19 MB, 1 views)

Last edited by Midnights; 08-10-2018 at 16:47.
Reply With Quote
  #55  
Old 08-10-2018, 21:01
Razor12911's Avatar
Razor12911 Razor12911 is offline
Coder
 
Join Date: Jul 2012
Location: South Africa
Posts: 3,190
Thanks: 1,722
Thanked 7,666 Times in 1,762 Posts
Razor12911 is on a distinguished road
Quote:
Originally Posted by Midnights View Post
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 '[email protected]:CallBackCtrl.dll stdcall';
function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external '[email protected]:unarc.dll cdecl delayload';
procedure UnloadDLL(); external '[email protected]: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 '[email protected]';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external '[email protected] stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';
function GetKeyState(nVirtKey: Integer): ShortInt; external '[email protected] 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?
__________________
Looking for something?
Visit the
Tutorial Index

Reply With Quote
  #56  
Old 08-10-2018, 21:28
Midnights Midnights is offline
Registered User
 
Join Date: Aug 2015
Location: Canada
Posts: 23
Thanks: 2
Thanked 0 Times in 0 Posts
Midnights is on a distinguished road
Red face

Quote:
Originally Posted by Razor12911 View Post
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...
Reply With Quote
  #57  
Old 15-10-2018, 09:08
zirkhaki's Avatar
zirkhaki zirkhaki is offline
Registered User
 
Join Date: Jul 2009
Location: Iran
Posts: 270
Thanks: 1,268
Thanked 132 Times in 86 Posts
zirkhaki is on a distinguished road
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?
Reply With Quote
  #58  
Old 15-10-2018, 09:12
KaktoR KaktoR is offline
Lame User
 
Join Date: Jan 2012
Location: From outer space
Posts: 2,286
Thanks: 564
Thanked 3,286 Times in 1,173 Posts
KaktoR is on a distinguished road
Yes, that's what I do for some conversions lately
__________________
Haters gonna hate
RIP GOD
Reply With Quote
The Following User Says Thank You to KaktoR For This Useful Post:
zirkhaki (15-10-2018)
  #59  
Old 15-10-2018, 11:38
zirkhaki's Avatar
zirkhaki zirkhaki is offline
Registered User
 
Join Date: Jul 2009
Location: Iran
Posts: 270
Thanks: 1,268
Thanked 132 Times in 86 Posts
zirkhaki is on a distinguished road
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?
Reply With Quote
  #60  
Old 15-10-2018, 12:10
KaktoR KaktoR is offline
Lame User
 
Join Date: Jan 2012
Location: From outer space
Posts: 2,286
Thanks: 564
Thanked 3,286 Times in 1,173 Posts
KaktoR is on a distinguished road
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.
__________________
Haters gonna hate
RIP GOD
Reply With Quote
The Following User Says Thank You to KaktoR For This Useful Post:
zirkhaki (15-10-2018)
Reply

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Quantum Break (9xDVD5) GTX590 PC Games - CD/DVD Conversions 103 31-07-2018 19:49
Bioshock Infinite Complete Edition (7xDVD5) UltraArc + CIU v2.0.3 By *Yener90* GTX590 PC Games - CD/DVD Conversions 13 17-06-2017 11:55
Call of Duty Black OPS 3 + DLC Awakening (11xDVD5) GTX590 PC Games - CD/DVD Conversions 22 30-12-2016 08:46
Mortal Kombat XL (7xDVD5) UltraArc + CIU v2.0.3 By *Yener90* GTX590 PC Games - CD/DVD Conversions 1 13-10-2016 17:03
UltraARC Tutorials, Hints and Examples Razor12911 Conversion Tutorials 33 14-12-2015 08:26



All times are GMT -7. The time now is 08:48.


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