Originally Posted by Midnights
(Post 476216)
Hi, after trying this, in my case is more easy to use, can you please add support for DiskSpan to this script please?
I have trying but dont know where to split/add code from the exemple in the archive, many thanks if you can help...
ISFreeArcExtract v.4.2 Main.iss
Code:
var
StatusLabel, FileNameLabel, ExtractFile, StatusInfo: TLabel;
ProgressBar: TNewProgressBar; OutErroMsg, CurStage: String;
UnPackError: Integer; ContinueInstall: Boolean;
Function CreateLabel(Parent: TWinControl; AutoSize, WordWrap, Transparent: Boolean; FontName: String; FontStyle: TFontStyles; FontColor: TColor; Left, Top, Width, Height: Integer; Prefs: TObject): TLabel;
Begin
Result:=TLabel.Create(Parent); Result.parent:= Parent;
if Prefs <> Nil then begin
Top:= TWinControl(Prefs).Top; Left:= TWinControl(Prefs).Left; Width:= TWinControl(Prefs).Width; Height:= TWinControl(Prefs).Height;
end;
if Top > 0 then result.Top:=Top; if Left > 0 then result.Left:= Left; if Width > 0 then result.Width:= Width; if Height > 0 then result.Height:= Height;
if FontName <> '' then result.Font.Name:= FontName; if FontColor > 0 then result.Font.Color:= FontColor; if FontStyle <> [] then result.Font.Style:= FontStyle;
result.AutoSize:= AutoSize; result.WordWrap:= WordWrap; result.Transparent:=Transparent; result.ShowHint:= true;
End;
Function NumToStr(Float: Extended): String;
Begin
Result:= Format('%.2n', [Float]); StringChange(Result, ',', '.');
while ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) and (Pos('.', Result) > 0) do
SetLength(Result, Length(Result)-1);
End;
Function ByteOrTB(Bytes: Extended; noMB: Boolean): String;
Begin
if not noMB then Result:= NumToStr(Int(Bytes)) +' Mb' else
if Bytes < 1024 then if Bytes = 0 then Result:= '0' else Result:= NumToStr(Int(Bytes)) +' Bt' else
if Bytes/1024 < 1024 then Result:= NumToStr(round((Bytes/1024)*10)/10) +' Kb' else
If Bytes/oneMB < 1024 then Result:= NumToStr(round(Bytes/oneMB*100)/100) +' Mb' else
If Bytes/oneMB/1000 < 1024 then Result:= NumToStr(round(Bytes/oneMB/1024*1000)/1000) +' Gb' else
Result:= NumToStr(round(Bytes/oneMB/oneMB*1000)/1000) +' Tb';
End;
function UpdateProgress(SText, FText, Time, errmsg: String; PosCur1, PosMax1, PosCur2, PosMax2, FileCount, CurDisk, DiskCount: Integer; ExtractedSize: Extended): Boolean;
var perc, p: extended;
begin
if ProgressBar.Max<>PosMax2 then ProgressBar.Max:= PosMax2;
if WizardForm.ProgressGauge.Max<>PosMax1 then WizardForm.ProgressGauge.Max:= PosMax1;
ProgressBar.Position:=PosCur2; WizardForm.ProgressGauge.Position:= PosCur1;
if PosMax1<>0 then perc:= Extended(PosCur1)*100/Extended(PosMax1);
if PosMax2<>0 then p:= Extended(PosCur2)*100/Extended(PosMax2);
StatusLabel.Caption:= SText;
OutErroMsg:= errmsg;
FilenameLabel.Caption:= FText; CurStage:= SText;
StatusInfo.Caption:= FmtMessage(cm('StatusInfo'), [IntToStr(FileCount), ' ['+ ByteOrTB(ExtractedSize, true) +']', Format('%.1n', [Abs(perc)]), Time]);
ExtractFile.Caption:= FmtMessage(cm('ArcInfo'), [IntToStr(CurDisk), IntToStr(DiskCount), IntToStr(ArcInd+1), IntToStr(GetArrayLength(Arcs)), Format('%.1n', [Abs(p)])]);
ProgressBar.Position:= LastMb;
Result:= ContinueInstall;
end;
procedure CurStepChanged(CurStep: TSetupStep);
var n: Integer;
begin
if CurStep = ssPostInstall then
begin
ContinueInstall:= True;
WizardForm.CancelButton.Enabled:= True;
ProgressBar.Position:=0;
WizardForm.ProgressGauge.Position:= 0;
StatusLabel.Show;
FileNameLabel.Show;
StatusInfo.Show;
ProgressBar.Show;
ExtractFile.Show;
UnPackError:= UnPackWithPrompts('{#Archives}', @UpdateProgress);
if UnPackError <> 0 then begin
Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n);
WizardForm.caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak');
SetTaskBarTitle(SetupMessage(msgErrorTitle));
end else
SetTaskBarTitle(SetupMessage(msgSetupAppTitle));
StatusLabel.Hide; FileNameLabel.Hide; StatusInfo.Hide; ProgressBar.Hide; ExtractFile.Hide;
end;
end;
Procedure CurPageChanged(CurPageID: Integer);
Begin
if (CurPageID = wpFinished) and (UnPackError <> 0) then
begin
WizardForm.FinishedLabel.Font.Color:= $0000C0;
WizardForm.FinishedLabel.Height:= WizardForm.FinishedLabel.Height * 2;
WizardForm.FinishedLabel.Caption:= SetupMessage(msgSetupAborted) + #13#10#13#10 + OutErroMsg;
end;
End;
procedure WizardClose(Sender: TObject; var Action: TCloseAction);
Begin
Action:= caNone;
if CurStage = cm('ArcTitle') then begin
if MsgBox(SetupMessage(msgExitSetupMessage), mbInformation, MB_YESNO) = IDYES then
ContinueInstall:= false;
end else
MainForm.Close;
End;
Procedure InitializeWizard();
Begin
StatusLabel:= CreateLabel(WizardForm.InstallingPage,false,false,true,'',[],0,0,0,0,0, WizardForm.StatusLabel);
FileNameLabel:= CreateLabel(WizardForm.InstallingPage,false,false,true,'',[],0,0,0,0,0, WizardForm.FileNameLabel);
WizardForm.StatusLabel.Top:= WizardForm.ProgressGauge.Top; WizardForm.FileNameLabel.Top:= WizardForm.ProgressGauge.Top; // прячем под прогрессбар, тогда все события WM_PAINT перехватываются
with WizardForm.ProgressGauge do begin
StatusInfo:= CreateLabel(WizardForm.InstallingPage, false, true, true, '', [], 0, 0, Top + ScaleY(32), Width, 0, Nil);
ProgressBar := TNewProgressBar.Create(WizardForm);
ProgressBar.SetBounds(Left, StatusInfo.Top + StatusInfo.Height + ScaleY(16), Width, Height);
ProgressBar.Parent := WizardForm.InstallingPage;
ProgressBar.max := 65536;
ProgressBar.Hide;
ExtractFile:= CreateLabel(WizardForm.InstallingPage, false, true, true, '', [], 0, 0, ProgressBar.Top + ScaleY(32), Width, 0, Nil);
StatusLabel.Hide; FileNameLabel.Hide; StatusInfo.Hide; ProgressBar.Hide; ExtractFile.Hide;
end;
WizardForm.OnClose:= @WizardClose
End;
ISFreeArcExtract v.4.2.iss
Code:
#include "ISFreeArcExtract_Utils.iss"
type
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
#if Ver < 84018176
AnsiString = String;
#endif
#if !defined(IS_ENHANCED)
TMsg = record
hwnd: HWND;
message: LongWord;
wParam: Longint;
lParam: Longint;
time: LongWord;
pt: TPoint;
end;
#endif
TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TArc = record Path, SubPath, Filename, Dest, Comp, Task, Pass, List: string; allMb, Disks: Integer; UnPack, UnPacked, Delete, Packet: Boolean; ID: DWord; end;
TSimpleArc = record Filename, Destination, Pass, Listing: String; allMb, ID: DWORD; Delete: Boolean; end;
TFAProgressInfo = record CurStage, CurName: String; DiskSize, CurPos, LastPos, AllPos, FilesCount: Integer; Percents, LastSize, CurSize, AllSize: Extended; end;
TFADiskStatus = record LastMaxCount, MaxCount, CurDisk, NextArc, RemainsArc: Integer; end;
TFreeArcUpdateProcess = function(SText, FText, Time, errmsg: String; PosCur1, PosMax1, PosCur2, PosMax2, FileCount, CurDisk, DiskCount: Integer; ExtractedSize: Extended): Boolean;
var
CancelCode, ArcInd, lastMb, baseMb, origsize: Integer;
Arcs: array of TSimpleArc;
AllArchives: array of TArc;
msgError, CompressMethod, aTime, Arc_Path, Arc_CurPath: string;
Progress: TFAProgressInfo; DS: TFADiskStatus;
SuspendUpdate: Boolean;
ReturnFunc: TFreeArcUpdateProcess;
Remaining: Extended;
StartInstall, LastTimerEvent, LastTimeCheck: DWORD;
const
CP_ACP = 0;
CP_UTF8 = 65001;
oneMB = 1024*1024;
VK_ESCAPE = 27;
function WrapFreeArcCallback (callback: TFreeArcCallback; paramcount: integer):longword; external 'wrapcallbackaddr@files:CallBackCtrl.dll stdcall';
function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external 'FreeArcExtract@files:unarc.dll cdecl delayload';
procedure UnloadDLL(); external 'UnloadDLL@files:unarc.dll cdecl delayload';
Function OemToChar(lpszSrc, lpszDst: AnsiString): longint; external '[email protected] stdcall';
Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpWideCharStr: PAnsiChar; cchWideChar: integer): longint; external '[email protected] stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: PAnsiChar; cchWideChar: integer; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external '[email protected] stdcall';
function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external '[email protected] stdcall';
function TranslateMessage(const lpMsg: TMsg): BOOL; external '[email protected] stdcall';
function DispatchMessage(const lpMsg: TMsg): Longint; external '[email protected] stdcall';
function GetTickCount: DWord; external 'GetTickCount@kernel32';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';
function GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';
procedure AppProcessMessage;
var
Msg: TMsg;
begin
if not PeekMessage(Msg, 0, 0, 0, 1) then Exit;
TranslateMessage(Msg); DispatchMessage(Msg);
end;
Function FreeArcCmd(callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer;
begin
CancelCode:= 0;
AppProcessMessage;
try
Result:= FreeArcExtract(callback, cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10);
if CancelCode < 0 then Result:= CancelCode;
except
Result:= -63;
end;
end;
Procedure SetTaskBarTitle(Title: String); var h: Integer;
Begin
h:= GetWindowLong(MainForm.Handle, -8);
if h <> 0 then SetWindowText(h, Title);
End;
Function TicksToTime(Ticks: Extended; h,m,s: String; detail: Boolean): String;
begin
if detail then
Result:= PADZ(IntToStr(Round(Ticks/3600000)), 2) +':'+ PADZ(IntToStr(Round((Ticks/1000 - Ticks/1000/3600*3600)/60)), 2) +':'+ PADZ(IntToStr(Round(Ticks/1000 - Ticks/1000/60*60)), 2)
else if Ticks/3600 >= 1000 then
Result:= IntToStr(Round(Ticks/3600000)) +h+' '+ PADZ(IntToStr(Round((Ticks/1000 - Ticks/1000/3600*3600)/60)), 2) +m
else if Ticks/60 >= 1000 then
Result:= IntToStr(Round(Ticks/60000)) +m+' '+ IntToStr(Round(Ticks/1000 - Ticks/1000/60*60)) +s
else Result:= Format('%.1n', [Abs(Ticks/1000)]) +s;
end;
Function ExpandENV(S: String): String;
var
n: UINT;
begin
if Pos('{',S ) * Pos('}', S) = 0 then
Result:= S
else Result:= ExpandConstant(S);
n:= Pos('%',result);
if n = 0 then Exit;
Delete(result, n,1);
Result:= Copy(Result,1, n-1) + ExpandConstant('{%'+Copy(Result, n, Pos('%',result) -n) +'}') + Copy(Result, Pos('%',result) +1, Length(result));
end;
Function cm(Message: String): String;
begin
Result:= ExpandConstant('{cm:'+ Message +'}')
end;
function OemToAnsiStr(strSource: AnsiString): AnsiString;
begin
SetLength(Result, Length(strSource));
OemToChar(strSource, Result);
end;
function AnsiToUtf8(strSource: string): string;
var
nRet: integer;
WideCharBuf, MultiByteBuf: AnsiString;
begin
SetLength(WideCharBuf, Length(strSource) * 2);
SetLength(MultiByteBuf, Length(strSource) * 2);
MultiByteToWideChar(CP_ACP, 0, strSource, -1, WideCharBuf, Length(WideCharBuf));
nRet:= WideCharToMultiByte(CP_UTF8, 0, WideCharBuf, -1, MultiByteBuf, Length(MultiByteBuf), 0, 0);
Result:= Copy(MultiByteBuf, 1, nRet);
end;
Procedure UpdateStatus();
var
i, t: string;
TimeEnable: Boolean;
Begin
if (SuspendUpdate)or(GetTickCount-LastTimerEvent<200) then Exit;
Progress.CurSize := baseMb+lastMb; TimeEnable:= True;
Progress.Allsize:= Progress.LastSize + lastMb;
if Progress.DiskSize > 0 then begin
Progress.CurPos:= round((100000 * Progress.CurSize)/Progress.DiskSize);
if Progress.CurPos > Progress.LastPos then begin
Progress.AllPos:= Progress.AllPos + ((Progress.CurPos-Progress.LastPos)/DS.MaxCount);
Progress.LastPos:=Progress.CurPos
end;
Progress.Percents:= Progress.AllPos/100;
If (Progress.AllPos > 0) then Remaining:= ((100000-Progress.AllPos)*(GetTickCount-StartInstall)/Progress.AllPos)*(DS.MaxCount+1-DS.CurDisk);
if (Progress.Percents >= 990) then begin TimeEnable:= False; t:= cm('ending'); i:= AnsiLowerCase(t); end;
if TimeEnable then begin
#ifdef External
t:= Format('%.1n',[Extended(Progress.Percents)/10])+'%';
i:= AnsiLowercase(cm('unknown'));
#else
t:= FmtMessage(cm('taskbar'), [Format('%.1n',[Progress.Percents/10]), TicksToTime(Remaining, 'h', 'm', 's', false)]);
i:= TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false);
#endif
end;
end;
SetTaskBarTitle(t);
if GetTickCount-LastTimeCheck>=1000 then begin
aTime:= i;
LastTimeCheck:= GetTickCount;
end;
LastTimerEvent:= GetTickCount;
if ReturnFunc<> nil then
if not ReturnFunc(Progress.CurStage, Progress.CurName, aTime, MsgError, Progress.AllPos, 100000, LastMb, Arcs[ArcInd].allMb, Progress.FilesCount, DS.CurDisk, DS.MaxCount, Progress.Allsize*oneMB) then
CancelCode:= -10;
End;
function FreeArcCallback(what: PAnsiChar; Mb, int2: Integer; str: PAnsiChar): Integer;
begin
case string(what) of
'origsize': origsize:= Mb;
'total_files': Null;
'filename': begin
Progress.CurName:= OemToAnsiStr(str);
Progress.FilesCount:= Progress.FilesCount + 1;
end;
'read': Null;
'write': lastMb:= Mb;
'error': if (Mb = -2) then CompressMethod:= str;
end;
UpdateStatus();
if (GetKeyState(VK_ESCAPE) < 0) then
WizardForm.Close;
AppProcessMessage;
Result:= CancelCode;
end;
function GetPath(Arc: TArc; ExtrPath: String; UseSubPath: Boolean): String;
begin
if ExtrPath='' then
Result:= Arc.Path
else
Result:= ExtrPath;
if (UseSubPath)and(Arc.SubPath<>'') then
Result:= Result+'\'+Arc.SubPath;
Result:= Result+'\'+Arc.Filename;
end;
function ProcessCode(var S: String; Code: String): String;
var
p1, p2: integer;
begin
Result:= '';
p1:= Pos(AnsiLowercase(Code), AnsiLowercase(s));
if p1>0 then begin
p2:=p1; while (s[p2]<>';')and(p2<=Length(s)) do p2:=p2+1;
Result:= Copy(s, p1, p2-p1);
Delete(s, p1, p2-p1+1);
Delete(Result, 1, Length(Code));
end;
Result:= Trim(Result);
end;
function StrToBool(S: String): Boolean;
begin
Result:=False;
if S='' then Exit;
S:= Trim(AnsiLowercase(S));
if (S = 'true')or(S = 'yes')or(S = '1') then
Result:= True else Result:= False;
end;
Function ArcDecode(Line: String): array of TArc;
var
cut, tmp: string;
i, n: integer;
begin
SetArrayLength(Result, 0);
If Line = '' then Exit;
repeat
n:= Pos('|', Line);
if (n=0) then
if(Length(Line)=0) then Break
else n:= Length(Line)+1;
cut:= Copy(Line, 1, n-1)+';'; Delete(Line, 1, n);
i:= GetArrayLength(Result); SetArrayLength(Result, i+1);
Result[i].Path:= Trim(ProcessCode(cut, 'Source:'));
Result[i].dest:= Trim(ProcessCode(cut, 'DestDir:'));
tmp:= ProcessCode(cut, 'Disk:');
if tmp='' then Result[i].disks:= 1
else Result[i].disks:= StrToInt(tmp);
Result[i].comp:= Trim(ProcessCode(cut, 'Components:'));
Result[i].task:= Trim(ProcessCode(cut, 'Tasks:'));
Result[i].pass:= Trim(ProcessCode(cut, 'Password:'));
Result[i].list:= Trim(ExpandENV(ProcessCode(cut, 'FilesList:')));
Result[i].Delete:= StrToBool(ProcessCode(cut, 'Delete:'));
while Pos(';', cut)>0 do Delete(cut, Pos(';', cut), 1);
if Result[i].Path='' then begin
if (ExtractFileDrive(ExpandEnv(cut)) = '')and(ExpandEnv(cut) = cut) then
Result[i].Path:= '{src}\'+cut else Result[i].Path:= cut;
end;
Result[i].Filename:= ExtractFileName(Result[i].Path);
Result[i].Path:= ExtractFilePath(result[i].Path);
Result[i].SubPath:= Copy(Result[i].Path, Pos('\', Result[i].Path)+1, Length(Result[i].Path));
Delete(Result[i].Path, Pos('\', Result[i].Path), Length(Result[i].Path));
Result[i].Dest:= ExpandENV(result[i].Dest);
Result[i].Path:= ExpandENV(result[i].Path);
until Line='';
end;
function AddArcs(File: TArc; var ErrCode: Integer): Integer;
var
i, b: integer;
f: String;
cmd: array [0..9] of String;
begin
Result:= 0;
f:= GetPath(File, Arc_CurPath, True);
if not FileExists(f) then
f:= GetPath(File, Arc_CurPath, False);
if FileExists(f) then begin
i:= GetArrayLength(Arcs);
SetArrayLength(Arcs, i +1);
Arcs[i].Filename:= f;
Arcs[i].Destination:= File.Dest;
Arcs[i].Pass:= File.Pass;
Arcs[i].Listing:= File.List;
Arcs[i].ID:= File.ID;
Arcs[i].Delete:= File.Delete;
cmd[0]:='l'; b:=1; if Arcs[i].Pass <> '' then begin cmd[1]:= '-p'+AnsiToUtf8(Arcs[i].Pass); b:=b+1; end;
cmd[b]:='--'; cmd[b+1]:=AnsiToUtf8(f)
ErrCode:= FreeArcCmd(WrapFreeArcCallback(@FreeArcCallback,4), cmd[0],cmd[1],cmd[2],cmd[3],cmd[4],cmd[5],cmd[6],cmd[7],cmd[8],cmd[9]);
if ErrCode >= 0 then begin
Arcs[i].allMb:= origsize;
Result:= origsize;
origsize:=0;
end;
end;
end;
function DispatchError(ErrorCode: Integer; Arc: TSimpleArc): String;
var
ArcFile: String;
begin
ArcFile:= ExtractFilename(Arc.Filename);
if (ErrorCode = -2) then StringChange(CompressMethod, 'ERROR: unsupported compression method ', '');
case ErrorCode of
-1: Result:= cm('ErrorUnknownError');
-2: Result:= FmtMessage(cm('ErrorCompressMethod'), [CompressMethod, ArcFile]);
-3: Null;
-4: Result:= FmtMessage(cm('ErrorOutBlockSize'), [ArcFile]);
-5: Result:= FmtMessage(cm('ErrorNotEnoughRAMMemory'), [ArcFile]);
-6: Result:= FmtMessage(cm('ErrorReadData'), [ArcFile]);
-7: Result:= FmtMessage(cm('ErrorBadCompressedData'), [ArcFile]);
-8: Result:= cm('ErrorNotImplement');
-9: Result:= FmtMessage(cm('ErrorDataAlreadyDecompress'), [ArcFile]);
-10: Result:= cm('ErrorUnpackTerminated');
-11: Result:= FmtMessage(cm('ErrorWriteData'), [ArcFile]);
-12: Result:= FmtMessage(cm('ErrorBadCRC'), [ArcFile]);
-13: Result:= FmtMessage(cm('ErrorBadPassword'), [ArcFile]);
-14: Result:= FmtMessage(cm('ErrorBadHeader'), [ArcFile]);
-15: Null;
-63: Result:= cm('ErrorCodeException');
-112: Result:= FmtMessage(cm('ErrorNotEnoughFreeSpace'), [ArcFile]);
end;
end;
function UnPackArchive(Archive: TSimpleArc): Integer;
var
cmd: array [0..9] of String;
b: integer;
FreeMB, TotalMB: Cardinal;
begin
cmd[0]:='x';
cmd[1]:='-o+';
cmd[2]:= '-dp'+AnsiToUtf8(Archive.Destination);
cmd[3]:= '-w'+AnsiToUtf8(Archive.Destination); b:=4;
if Archive.Pass <> '' then begin cmd[b]:= '-p'+AnsiToUtf8(Archive.Pass); b:=b+1 end;
if Archive.Listing <> '' then begin cmd[b]:= AnsiToUtf8(Archive.Listing); b:=b+1; end;
cmd[b]:='--'; cmd[b+1]:= AnsiToUtf8(Archive.Filename);
Result:= FreeArcCmd(WrapFreeArcCallback(@FreeArcCallback,4), cmd[0],cmd[1],cmd[2],cmd[3],cmd[4],cmd[5],cmd[6],cmd[7],cmd[8],cmd[9]);
if Result = 0 then Exit;
msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
GetSpaceOnDisk(ExtractFileDrive(Archive.Destination), True, FreeMB, TotalMB);
if FreeMB < (Archive.allMb-lastMb) then Result:= -112;
MsgError:= msgError+#13#10#13+DispatchError(Result, Archive)
End;
procedure SetUnpacked(File: TSimpleArc);
var
i: integer;
begin
for i:=0 to GetArrayLength(AllArchives)-1 do begin
if (File.ID=AllArchives[i].ID) then begin
AllArchives[i].UnPacked:=True;
Break;
end;
end;
end;
function FindArcs(Str: TArc): array of TArc;
var
FSR: TFindRec;
i: Integer;
Dir: String;
begin
if FindFirst(GetPath(Str, Arc_CurPath, True), FSR) then try
Dir:= ExtractFilePath(GetPath(Str, Arc_CurPath, True));
repeat
AppProcessMessage;
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
i:= GetArrayLength(Result); SetArrayLength(Result, i+1);
Result[i]:= Str;
Result[i].Filename:= FSR.Name;
Result[i].Packet:= True;
until not FindNext(FSR);
finally
FindClose(FSR);
end;
end;
function FillArcList(Source: array of TArc): array of TArc;
var i, k: integer; zet: array of TArc; anil: TArc; ADelete: Boolean;
begin
SetArrayLength(Result, 0);
for i:= 0 to GetArrayLength(Source)-1 do begin
if (Pos('*', Source[i].Filename) > 0)and(Source[i].Disks=DS.CurDisk) then
zet:= FindArcs(Source[i])
else begin
k:= GetArrayLength(zet);
SetArrayLength(zet, k+1);
zet[k]:= Source[i];
end;
end;
for i:=0 to GetArrayLength(zet)-1 do begin
if (zet[i].Filename<>'') then for k:=0 to GetArrayLength(zet)-1 do begin
if (i<>k)and(AnsiLowercase(zet[i].Filename)=AnsiLowercase(zet[k].Filename)) then begin
if (zet[i].UnPacked)and(zet[k].Packet) then ADelete:= True;
if not (zet[k].Packet)and(not zet[i].UnPacked) then begin
ADelete:= true;
if (zet[k].list<>'')and(zet[i].list<>'')and(zet[k].list<>zet[i].list) then ADelete:= False;
if ((zet[k].list<>'')and(zet[i].list=''))or((zet[k].list='')and(zet[i].list='')) then begin
if (zet[i].Packet)and(not zet[k].Packet) then zet[i].Packet:= False;
if (zet[k].dest<>'')and(zet[k].dest<>zet[i].dest) then zet[i].dest:= zet[k].dest;
if (zet[k].comp<>'')and(zet[k].comp<>zet[i].comp) then zet[i].comp:= zet[k].comp;
if (zet[k].task<>'')and(zet[k].task<>zet[i].task) then zet[i].task:= zet[k].task;
if (zet[k].pass<>'')and(zet[k].pass<>zet[i].pass) then zet[i].pass:= zet[k].pass;
if (zet[k].list<>'')and(zet[k].list<>zet[i].list) then zet[i].list:= zet[k].list;
end;
end;
if ADelete then zet[k]:= anil;
end;
end;
end;
for i:=0 to GetArrayLength(zet)-1 do begin
if (zet[i].Filename <> '') then begin
k:= GetArrayLength(Result); SetArrayLength(Result, k+1); Result[k]:= zet[i];
Result[k].ID:=$2*(k+1);
end;
end;
end;
function UpdateArcsList(): Integer;
var m: integer;
begin
Result:= 0;
SetArrayLength(Arcs,0); Progress.DiskSize:=0;
for m:=0 to (GetArrayLength(AllArchives)-1) do begin
if (AllArchives[m].UnPack)and(AllArchives[m].UnPacked=False) then
Progress.DiskSize:= Progress.DiskSize + AddArcs(AllArchives[m], Result);
if (Result < 0) then Break;
end;
end;
function UnPack(): Integer;
begin
Progress.CurPos:=0;
Progress.LastPos:=0;
baseMb:= 0;
if (DS.LastMaxCount<>DS.MaxCount)and(DS.CurDisk>1) then begin
Progress.AllPos:= (WizardForm.ProgressGauge.Max/(DS.MaxCount))*(DS.CurDisk-1);
end;
UpdateStatus();
for ArcInd:= 0 to GetArrayLength(Arcs) -1 do begin
lastMb:= 0; SuspendUpdate:=False;
Result:= UnPackArchive(Arcs[ArcInd]);
Progress.LastSize:= Progress.AllSize;
SetUnPacked(Arcs[ArcInd]);
SuspendUpdate:=True;
if Result <> 0 then Break;
baseMb:= baseMb + lastMb;
if (Pos(AnsiLowercase(ExpandConstant('{app}')), AnsiLowercase(Arcs[ArcInd].Filename)) > 0)or(Pos(AnsiLowercase(ExpandConstant('{tmp}')), AnsiLowercase(Arcs[ArcInd].Filename)) > 0) then
if (Arcs[ArcInd].Delete = True) then DeleteFile(Arcs[ArcInd].Filename);
end;
end;
function CheckBools(Bools: array of Boolean): Integer;
var
c,l: integer;
begin
Result:=0; c:= 0;
for l:=0 to GetArrayLength(Bools)-1 do
if (Bools[l] = True) then c:=c+1;
if (c=(GetArrayLength(Bools))) then Result:=1;
end;
function GetRemainArcs(): integer;
var
c: integer;
begin
Result:=0;
for c:=0 to GetArrayLength(AllArchives)-1 do
if (AllArchives[c].UnPack)and(not AllArchives[c].UnPacked) then Result:=Result+1;
end;
function GetNextArc(): Integer;
var
c: Integer;
begin
Result:=0;
for c:=0 to GetArrayLength(AllArchives)-1 do
if (AllArchives[c].UnPack)and(not AllArchives[c].UnPacked) then begin
Result:=c;
Break;
end;
end;
function IsComponentSelectedDef(const S: String): Boolean;
begin
Result:= IsComponentSelected(S);
end;
function IsTaskSelectedDef(const S: String): Boolean;
begin
Result:= IsTaskSelected(S);
end;
procedure UpdateArcState();
var
f: Integer;
begin
for f:= 0 to GetArrayLength(AllArchives)-1 do begin
if not AllArchives[f].UnPacked then AllArchives[f].UnPack:= True;
if (AllArchives[f].comp<>'')and(not ParseLine(AllArchives[f].comp, @IsComponentSelectedDef)) then AllArchives[f].UnPack:=False;
if (AllArchives[f].task<>'')and(not ParseLine(AllArchives[f].task, @IsTaskSelectedDef)) then Allarchives[f].UnPack:=False;
end;
end;
function UnPackWithPrompts(Archives: string; Callback: TFreeArcUpdateProcess): Integer;
var
MsBox, MaxArcs, z, f, k, x, LastDisk: Integer;
OneDisk, DiskCheck, Packet: Boolean;
Label
freelib;
begin
ExtractTemporaryFile('Arc.ini');
ExtractTemporaryFile('CLS.ini');
ExtractTemporaryFile('CLS-LOLZ.dll');
ExtractTemporaryFile('CLS-LOLZ_x64.exe');
ExtractTemporaryFile('CLS-LOLZ_x86.exe');
ExtractTemporaryFile('facompress_mt.dll');
ExtractTemporaryFile('facompress.dll');
#ifdef precomp
ExtractTemporaryFile('CLS-precomp.dll');
ExtractTemporaryFile('packjpg_dll.dll');
ExtractTemporaryFile('packjpg_dll1.dll');
ExtractTemporaryFile('precomp.exe');
#if precomp != "0.40"
ExtractTemporaryFile('zlib1.dll');
#endif
#endif
#ifdef srep
ExtractTemporaryFile('CLS-srep.dll');
#endif
ReturnFunc:= Callback;
Progress.CurStage:=cm('ArcTitle');
Progress.FilesCount:=0;
StartInstall:= GetTickCount;
LastTimerEvent:= StartInstall-500;
LastTimeCheck:= StartInstall-5000;
SuspendUpdate:=True;
OneDisk:=False;
DiskCheck:=False;
Packet:=False;
MsBox:=IDOK; DS.CurDisk:=1; z:=0; k:=0; x:=0; LastDisk:=1;
AllArchives:= FillArcList(ArcDecode(Archives));
DS.LastMaxCount:=DS.MaxCount; MaxArcs:= GetArrayLength(AllArchives)-1;
DS.MaxCount:= AllArchives[MaxArcs].disks;
if Archives = '' then begin
Result:= -17;
goto freelib;
end;
Arc_Path:= AllArchives[0].Path;
for f:=0 to MaxArcs do begin
AllArchives[f].UnPack:=True; AllArchives[f].UnPacked:=False; AllArchives[f].Packet:=False;
if (AllArchives[f].comp<>'')and(not ParseLine(AllArchives[f].comp, @IsComponentSelectedDef)) then AllArchives[f].UnPack:=False;
if (AllArchives[f].task<>'')and(not ParseLine(AllArchives[f].task, @IsTaskSelectedDef)) then Allarchives[f].UnPack:=False;
if (Pos('*', AllArchives[f].Filename) > 0) then Packet:= True;
z:=z+CheckBools([CheckFile(AllArchives[f].Path, AllArchives[f].SubPath, AllArchives[f].Filename)]);
k:=k+CheckBools([AllArchives[f].UnPack]);
x:=x+CheckBools([AllArchives[f].UnPack, CheckFile(AllArchives[f].Path, AllArchives[f].SubPath, AllArchives[f].Filename)]);
end;
if (z=(MaxArcs+1))or(x=k) then begin
DS.LastMaxCount:=DS.MaxCount;
DS.MaxCount:=DS.CurDisk;
OneDisk:=True;
end;
DS.NextArc:= GetNextArc;
while (Result = 0) and (GetRemainArcs>0) do begin
if GetRemainArcs<=0 then Break;
if (not OneDisk) then begin
x:=0;
for f:= DS.NextArc to MaxArcs do begin
x:=x+CheckBools([(AllArchives[f].UnPack), CheckFile(AllArchives[f].Path, AllArchives[f].SubPath, AllArchives[f].Filename)]);
if (x=((MaxArcs+1)-DS.NextArc)) then begin
DS.LastMaxCount:=DS.MaxCount;
DS.MaxCount:=DS.CurDisk;
end;
end;
end;
if (not CheckFile(AllArchives[DS.NextArc].Path, AllArchives[DS.NextArc].SubPath, AllArchives[DS.NextArc].Filename))and(not CheckFile(Arc_Path, AllArchives[DS.NextArc].SubPath, AllArchives[DS.NextArc].Filename)) then begin
if not BrowseForFiles(FmtMessage(cm('InsertDisk'),[IntToStr(DS.CurDisk), AllArchives[DS.NextArc].Filename]), Arc_Path, AllArchives[DS.NextArc].SubPath, AllArchives[DS.NextArc].Filename, Arc_Path) then begin
Result:= -10;
Break;
end;
Arc_CurPath:= Arc_Path;
end else
Arc_CurPath:= '';
if (not OneDisk) then begin
if (DS.MaxCount>1)and(DS.CurDisk<>DS.MaxCount)and(not DiskCheck) then begin
while (LastDisk<=DS.MaxCount)and(f<(MaxArcs+1)) do begin
k:=0; x:=0;
for z:=f to MaxArcs do begin
if AllArchives[z].disks=LastDisk then begin x:=x+1; if (not AllArchives[z].UnPack) then k:=k+1; end;
end;
if k=x then begin DS.LastMaxCount:= DS.MaxCount; DS.MaxCount:= DS.MaxCount-1; f:=f+k end;
LastDisk:=LastDisk+1;
end;
DiskCheck:=True;
end;
if (DS.CurDisk=DS.MaxCount)and(not Packet) then begin
k:=0; x:=0;
for z:=DS.NextArc to MaxArcs do begin
if (AllArchives[z].disks=DS.CurDisk)and(AllArchives[z].UnPack) then begin
x:=x+1; if FileExists(AllArchives[z].Path) then k:=k+1;
end;
end;
if k<x then begin DS.LastMaxCount:= DS.MaxCount; DS.MaxCount:= DS.MaxCount+1; end;
end;
end;
AllArchives:= FillArcList(AllArchives);
UpdateArcState;
Result:= UpdateArcsList;
if Result<0 then Break;
Result:= UnPack();
DS.CurDisk:= DS.CurDisk+1;
DS.NextArc:= GetNextArc;
end;
freelib:
UnloadDLL();
end;
|
