Автор: Magellan777
Дата сообщения: 31.08.2011 09:10
Привет! Как пользоваться ISFreeArcExtract?
Например есть архив "DEHR Unpacked.arc", как его добавить в ISFreeArcExtract? Я мог бы и просто добавить в секцию [Files] (deleteafterinstal), а затем в [Run]. Но тогда Инстал будет сначала извлекать архив, а затем распаковывать его. Спасибо за помощь!
[more=ISFreeArcExtract...][ISToolPreCompile]
#ifndef Archives
#define Archives ""
#endif
#define K
#define T
#define St
#define Current AddBackslash(GetEnv("TEMP")) + GetDateTimeString('dd/mm-hh:nn', '-', '-') +'.iss'
#sub AddString
#expr St = FileRead(faAnyFile)
#if (K > T) && (Pos("[", St)>0) && (Pos("]", St)>0)
#Define E
#insert E = K
#endif
#if (K > T) && (St != "") && (Pos(";", St)!=1) && (Pos("/", St)!=1) && !defined(E)
#expr Archives != "" ? Archives = Archives+"|"+St : void, Archives == "" ? Archives = st : void
#endif
#endsub
#sub GetLastLine
#expr SaveToFile(Current)
#expr faAnyFile = FileOpen(Current)
#insert T = Find(0, "[ArcFiles]")
#for {K = 0; !FileEof(faAnyFile); K=K+1} AddString
#expr FileClose(faAnyFile)
#expr DeleteFile(Current)
#endsub
#define SourceToProgress() GetLastLine
[Code]
type
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#if Ver < 84084736
PAnsiChar = PChar;
#endif
#endif
#if Ver < 84018176
AnsiString = String;
#endif
TMessage = record hWnd: HWND; msg, wParam: Word; lParam: LongWord; Time: TFileTime; pt: TPoint; end;
TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TArc = record Path, Dest, Comp, Task, Pass, List: string; allMb, Disks: Integer; UnPack, UnPacked, Delete, Packet: Boolean; ID: DWord; end;
TFAProgressInfo = record CurStage, CurName: String; DiskSize, CurPos, LastPos, AllPos, FilesCount, Percents: Integer; LastSize, CurSize, AllSize: Extended; end;
TFADiskStatus = record LastMaxCount, MaxCount, CurDisk, NextArc, RemainsArc: Integer; end;
TTimerProc = procedure(HandleW, Msg, idEvent, TimeSys: LongWord);
TFreeArcUpdateProcess = function(SText, FText, Time, errmsg: String; PosCur1, PosMax1, PosCur2, PosMax2, FileCount, CurDisk, DiskCount: Integer; ExtractedSize: Extended): Boolean;
var
CancelCode, ArcInd, StartInstall, lastMb, baseMb, origsize: Integer;
Arcs, AllArchives: array of TArc;
msgError, CompressMethod: string;
Progress: TFAProgressInfo; DS: TFADiskStatus;
SuspendUpdate: Boolean;
ReturnFunc: TFreeArcUpdateProcess;
const
CP_ACP = 0; CP_UTF8 = 65001;
oneMB=1024*1024;
VK_ESCAPE = 27;
function WrapFreeArcCallback (callback: TFreeArcCallback; paramcount: integer):longword; external 'wrapcallback@files:innocallback.dll stdcall';
function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external 'FreeArcExtract@files:unarc.dll cdecl';
procedure UnloadDLL(); external 'UnloadDLL@files:unarc.dll cdecl';
Function OemToChar(lpszSrc, lpszDst: AnsiString): longint; external 'OemToCharA@user32.dll stdcall';
Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpWideCharStr: PAnsiChar; cchWideChar: integer): longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: PAnsiChar; cchWideChar: integer; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external 'WideCharToMultiByte@kernel32.dll stdcall';
function PeekMessage(var lpMsg: TMessage; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMessage): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMessage): Longint; external 'DispatchMessageA@user32.dll 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: TMessage;
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 StringToArray(Text, Cut: String): array of String;
var i, k: Integer;
Begin
SetArrayLength(Result, 0); if Cut = '' then Cut:= #1310;
Repeat
k:= Pos(Cut,Text);
if k = 1 then begin Delete(Text, 1, Length(Cut)); CONTINUE; end;
i:= GetArrayLength(Result); SetArrayLength(Result, i+1);
if k = 0 then
Result[i]:=Text
else begin
Result[i]:= Copy(Text, 1, k -1); Delete(Text, 1, Length(Result[i]) + Length(Cut));
end;
Until Length(Text) * k = 0;
End;
Function TicksToTime(Ticks: DWord; h,m,s: String; detail: Boolean): String;
Begin
if detail then
Result:= PADZ(IntToStr(Ticks/3600000), 2) +':'+ PADZ(IntToStr((Ticks/1000 - Ticks/1000/3600*3600)/60), 2) +':'+ PADZ(IntToStr(Ticks/1000 - Ticks/1000/60*60), 2)
else if Ticks/3600 >= 1000 then
Result:= IntToStr(Ticks/3600000) +h+' '+ PADZ(IntToStr((Ticks/1000 - Ticks/1000/3600*3600)/60), 2) +m
else if Ticks/60 >= 1000 then
Result:= IntToStr(Ticks/60000) +m+' '+ IntToStr(Ticks/1000 - Ticks/1000/60*60) +s
else Result:= Format('%.1n', [Abs(Ticks/1000)]) +s;
End;
Function ExpandENV(string: String): String; var n: UINT;
Begin
if Pos('{',string) * Pos('}',string) = 0 then Result:= String else Result:= ExpandConstant(String); 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, nRet2: integer; WideCharBuf, MultiByteBuf: AnsiString;
begin
SetLength(WideCharBuf, Length(strSource) * 2);
SetLength(MultiByteBuf, Length(strSource) * 2);
nRet:= MultiByteToWideChar(CP_ACP, 0, strSource, -1, WideCharBuf, Length(WideCharBuf));
nRet2:= WideCharToMultiByte(CP_UTF8, 0, WideCharBuf, -1, MultiByteBuf, Length(MultiByteBuf), 0, 0);
MultiByteBuf:= Copy(MultiByteBuf, 1, nRet2-1)
Result:= MultiByteBuf;
end;
procedure AbsInt(var Int: Integer); var x: integer;
begin x:= 0; if Int < 0 then x:=x-Int else x:= Int; Int:= x; end;
Procedure UpdateStatus();
var Remaining, n, AMax, APosition: Integer; i, t: string; TimeEnable: Boolean;
Begin
if SuspendUpdate then Exit;
Progress.CurSize := baseMb+lastMb; TimeEnable:= True;
Progress.Allsize:= Progress.LastSize + lastMb; AMax:= 100000;
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;
APosition:= Progress.AllPos;
n:= AMax/1000; if n > 0 then Progress.Percents:= APosition/n;
If APosition > 0 then Remaining:= ((((AMax-APosition)*100/APosition)*(GetTickCount-StartInstall))/100)*(DS.MaxCount+1-DS.CurDisk);
if (Progress.Percents > 990) then begin TimeEnable:= False; t:= cm('ending'); i:= AnsiLowerCase(t); end;
#ifdef External
TimeEnable:= False; t:= IntToStr(Progress.Percents/10)+'%'; i:= AnsiLowercase(cm('unknown'));
#endif
if TimeEnable then begin
AbsInt(Remaining);
t:= FmtMessage(cm('taskbar'), [IntToStr(Progress.Percents/10), TicksToTime(Remaining, 'h', 'm', 's', false)])
i:= TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false)
end;
end;
SetTaskBarTitle(t);
if ReturnFunc<> nil then
if not ReturnFunc(Progress.CurStage, Progress.CurName, i, 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;
'quit': if (Mb = -2) then CompressMethod:= str;
end;
UpdateStatus();
if (GetKeyState(VK_ESCAPE) < 0) then
WizardForm.Close;
AppProcessMessage;
Result:= CancelCode;
end;
Function DeleteChars(S, Char: String): String; begin if (Pos(Char, S)>0) then
begin while (Pos(Char, S)>0) do StringChange(S, Char, ''); end; Result:=S; end;
Function CutStr(var S: String; Index, Length: Integer): String;
begin Result:= Copy(S, Index, Length); Delete(S, Index, Length); end;
function ALowCase(S: String): String; begin Result:= AnsiLowercase(S); end;
Function CutStrEx(var S: String; Code: String): String;
var str: string; pos1, pos2: integer; begin pos1:= Pos(Code, S); If (pos1>0) then begin
pos2:=pos1; while S[pos2]<>';' do if pos2<>length(S) then pos2:=pos2+1; str:=cutStr(S, pos1, (pos2-pos1)+1);
StringChange(str, Code, ''); if str[Length(str)]=';' then Setlength(str, Length(str)-1); end; Result:=str; end;
function StrToBool(S: String): Boolean; var tmp: string; begin
tmp:= ALowCase(S); if (tmp = 'true')or(tmp = 'yes')or(tmp = '1') then
Result:= True else Result:= False; end;
Function ArcDecode(Line: String): array of TArc;
var tmp: array of String; cut: string; i, n: integer;
begin
SetArrayLength(Result, 0); If Line = '' then Exit;
tmp:= StringToArray(Line, '|');
for n:=0 to GetArrayLength(tmp)-1 do begin
i:= GetArrayLength(Result); SetArrayLength(Result, i+1); cut:=tmp[n]+';';
if (Pos('Source:', cut)>0) then Result[i].Path:= Trim(CutStrEx(cut, 'Source:'));
if (Pos('DestDir:', cut)>0) then Result[i].dest:= Trim(CutStrEx(cut, 'DestDir:'));
if (Pos('Disk:', cut)>0) then Result[i].disks:= StrToInt(CutStrEx(cut, 'Disk:')) else Result[i].disks:=1;
if (Pos('Components:', cut)>0) then Result[i].comp:= Trim(CutStrEx(cut, 'Components:'));
if (Pos('Tasks:', cut)>0) then Result[i].task:= Trim(CutStrEx(cut, 'Tasks:'));
if (Pos('Password:', cut)>0) then Result[i].pass:= Trim(CutStrEx(cut, 'Password:'));
if (Pos('FilesList:', cut)>0) then Result[i].list:= Trim(ExpandENV(CutStrEx(cut, 'FilesList:')));
if (Pos('Delete:', cut)>0) then Result[i].Delete:= StrToBool(CutStrEx(cut, 'Delete:')) else Result[i].Delete:= True;
if cut <> '' then cut:=DeleteChars(cut, ';');
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].Dest:= ExpandENV(result[i].Dest); Result[i].Path:= ExpandENV(result[i].Path);
end;
end;
function AddArcs(File: TArc; var ErrCode: Integer): Integer;
var i, b: integer; cmd: array [0..9] of String;
Begin
if FileExists(File.Path) then begin
Result:= 0; i:= GetArrayLength(Arcs); SetArrayLength(Arcs, i +1); Arcs[i]:=File;
cmd[0]:='l'; b:=1; if File.pass <> '' then begin cmd[1]:= '-p'+AnsiToUtf8(File.pass); b:=b+1; end;
cmd[b]:='--'; cmd[b+1]:=AnsiToUtf8(Arcs[i].Path)
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:= Arcs[i].allMb; origsize:=0; end;
end;
End;
function DispatchError(ErrorCode: Integer; Arc: TArc): String;
var ArcFile: String;
begin
ArcFile:= ExtractFilename(Arc.Path);
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: TArc): 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.Dest); cmd[3]:= '-w'+AnsiToUtf8(Archive.Dest); b:=4;
if Archive.pass <> '' then begin cmd[b]:= '-p'+AnsiToUtf8(Archive.pass); b:=b+1 end;
if Archive.list <> '' then begin cmd[b]:= AnsiToUtf8(Archive.list); b:=b+1; end;
cmd[b]:='--'; cmd[b+1]:=AnsiToUtf8(Archive.Path);
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.Dest), True, FreeMB, TotalMB);
if FreeMB < (Archive.allMb-lastMb) then Result:= -112;
MsgError:= msgError+#13#10#13+DispatchError(Result, Archive)
End;
procedure SetUnpacked(File: TArc); 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(Str.Path, FSR) then
try
Dir:= AddBackslash(ExtractFilePath(Str.Path));
repeat
AppProcessMessage;
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
i:= GetArrayLength(Result); SetArrayLength(Result, i+1);
Result[i]:= Str; Result[i].Path:= Dir+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, y: array of TArc; anil: TArc; ADelete: Boolean;
begin
for i:= 0 to GetArrayLength(Source)-1 do begin
if (Pos('*', Source[i].Path) > 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].Path<>'') then for k:=0 to GetArrayLength(zet)-1 do begin
if (i<>k)and(ALowCase(zet[i].Path)=ALowCase(zet[k].Path)) 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].Path <> '') then begin
k:= GetArrayLength(y); SetArrayLength(y, k+1); y[k]:= zet[i];
y[k].ID:=$2*(k+1);
end;
end;
Result:= y;
end;
function UpdateArcsList(): Integer;
var m: integer; begin AppProcessMessage; SetArrayLength(Arcs,0);
Progress.DiskSize:=0; Result:=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(ALowCase(ExpandConstant('{app}')), ALowCase(Arcs[ArcInd].Path)) > 0)or(Pos(ALowCase(ExpandConstant('{tmp}')), ALowCase(Arcs[ArcInd].Path)) > 0) then
if (Arcs[ArcInd].Delete = True) then DeleteFile(Arcs[ArcInd].Path);
end;
end;
Function CheckBools(Bools: array of Boolean): Integer;
var c,l: integer; begin Result:=0; for l:=0 to GetArrayLength(Bools)-1 do begin
if (Bools[l] = True) then c:=c+1; end; 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 begin
If (AllArchives[c].UnPack)and(not AllArchives[c].UnPacked)then Result:=Result+1; end; end;
Function GetNextArc(): Integer;
var c: Integer; Begin Result:=0; for c:=0 to GetArrayLength(AllArchives)-1 do begin
if (AllArchives[c].UnPack)and(not AllArchives[c].UnPacked) then begin Result:=c; Break; end; end; end;
Function GetUnpackedArcs(): Integer;
var c: Integer; Begin Result:=0; for c:=0 to GetArrayLength(AllArchives)-1 do begin
if (AllArchives[c].UnPack)and(AllArchives[c].UnPacked) then Result:=Result+1; end; Result:=Result+1; end;
Function IsComponentSelectedEx(const S: String): Boolean;
var comp: string; begin Result:= False;
if Pos('not', AnsiLowercase(S)) > 0 then begin comp:= Copy(S, Pos(' ', S), Length(S));
Result:= not ISComponentSelected(comp); end else begin Result:= IsComponentSelected(S); end; end;
Function IsTaskSelectedEx(const S: String): Boolean;
var task: string; begin Result:= False;
if Pos('not', AnsiLowercase(S)) > 0 then begin task:= Copy(S, Pos(' ', S), Length(S));
Result:= not IsTaskSelected(task); end else begin Result:= IsTaskSelected(S); end; 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 IsComponentSelectedEx(AllArchives[f].comp)) then AllArchives[f].UnPack:=False;
if (AllArchives[f].task<>'')and(not IsTaskSelectedEx(AllArchives[f].task)) then Allarchives[f].UnPack:=False;
end; end;
Function UnPackWithPrompts(Archives: string; Callback: TFreeArcUpdateProcess): Integer;
var MsBox, MaxArcs, z, f, k, x, LastDisk: Integer; FADiskMessage: string;
VArc: array of TArc; OneDisk, DiskCheck, Packet: Boolean;
begin
ExtractTemporaryFile('facompress.dll'); ReturnFunc:= Callback;
AppProcessMessage; Progress.CurStage:=cm('ArcTitle'); StartInstall:= GetTickCount;
Progress.FilesCount:=0; MsBox:=IDOK; z:=0; OneDisk:=False; DS.CurDisk:=1;
VArc:= ArcDecode(Archives); AllArchives:= FillArcList(VArc); k:=0; x:=0;
DS.LastMaxCount:=DS.MaxCount; MaxArcs:= GetArrayLength(AllArchives)-1; LastDisk:=1;
DS.MaxCount:= AllArchives[MaxArcs].disks; DiskCheck:=False; Packet:=False;
SuspendUpdate:=True; UpdateStatus();
if Archives = '' then begin Result:= -17; Exit; end;
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 IsComponentSelectedEx(AllArchives[f].comp)) then AllArchives[f].UnPack:=False;
if (AllArchives[f].task<>'')and(not IsTaskSelectedEx(AllArchives[f].task)) then Allarchives[f].UnPack:=False;
if (Pos('*', AllArchives[f].Path) > 0) then Packet:= True;
z:=z+CheckBools([FileExists(AllArchives[f].Path)]); k:=k+CheckBools([AllArchives[f].UnPack]);
x:=x+CheckBools([AllArchives[f].UnPack, FileExists(AllArchives[f].Path)]);
end;
if (z=(MaxArcs+1)) then begin DS.LastMaxCount:=DS.MaxCount; DS.MaxCount:=DS.CurDisk; OneDisk:=True; end;
if (x=k) then begin DS.LastMaxCount:=DS.MaxCount; DS.MaxCount:=DS.CurDisk; OneDisk:=True; end;
DS.NextArc:= GetNextArc; DS.RemainsArc:= GetRemainArcs;
while (Result = 0) and (DS.RemainsArc>0) do begin
if (not OneDisk) then begin x:=0;
for f:= DS.NextArc to MaxArcs do begin
x:=x+CheckBools([(AllArchives[f].UnPack), FileExists(AllArchives[f].Path)]);
if (x=((MaxArcs+1)-DS.NextArc)) then begin DS.LastMaxCount:=DS.MaxCount; DS.MaxCount:=DS.CurDisk; end; end;
end;
while (msBox=IDOK)and(not(FileExists(AllArchives[DS.NextArc].Path))and(AllArchives[DS.NextArc].UnPack)) do begin
FADiskMessage:= FmtMessage(cm('InsertDisk'),[IntToStr(DS.CurDisk), ExtractFilename(AllArchives[DS.NextArc].Path)])
MsBox:= MsgBox(FADiskMessage, mbConfirmation, MB_OKCANCEL)
end;
if MsBox = IDCANCEL then Result:= -10;
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;
if (MsBox<>IDCANCEL)and(DS.RemainsArc>0) then begin AllArchives:= FillArcList(AllArchives); UpdateArcState; Result:=UpdateArcsList; Result:= UnPack(); DS.CurDisk:= DS.CurDisk+1; DS.NextArc:= GetNextArc; DS.RemainsArc:= GetRemainArcs; end;
end;
UnloadDLL(); if CancelCode>=0 then CancelCode:= Result;
end;
[/more]