View Single Post
  #2  
Old 08-10-2018, 20:01
Razor12911's Avatar
Razor12911 Razor12911 is offline
Noob
 
Join Date: Jul 2012
Location: South Africa
Posts: 3,749
Thanks: 2,170
Thanked 11,206 Times in 2,307 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 '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?
Reply With Quote
The Following User Says Thank You to Razor12911 For This Useful Post:
ShivShubh (24-11-2019)