» Inno Setup (создание инсталяционных пакетов)

VASYAKRN
для каждого лейбла пропиши параметр

Код: Transparent:=true;

с работой ISPP под unicode-версией никаких нюансов нет?

компилю:

Код: [Setup]
AppName=My Program
AppVersion=1.0
DefaultDirName={pf}\My Program

#if FileExists (AddBackslash (SourcePath) + "Icons\*.dll")
    #error It's alive!!!
#endif

Скрипт изменения прозрачности окна трекбаром.

Ссылка.

Привет народ! Сегодня а выложу обновленную справку и сорцы. На этот раз исправил битые локальные ссылки (спасибо проге xenu's link sleuth) и еще некоторые другие ошибки. Еще раз прошу прошения за причиняемое неудобство. Ссылка на СПРАВКУ и на СОРЦЫ. YURSHAT, должен попросить вас исправить ссылку в шапке.

bugron

Цитата:

должен попросить вас исправить ссылку в шапке.

Исправил

Как пользоваться 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]

Текстурируйте кнопки http://inno.at.ua/TMP/Assassins_Creed_Revelations.7z

Подскажите как лучше сделать.
С помощью функции
SetWindowLong(WizardForm.Handle, GWL_STYLE, GetWindowLong(WizardForm.Handle, GWL_STYLE) and not WS_CAPTION);
убрал заголовок окна и боковые и нижние полосы. Но потерялась возможность "возить" окно по рабочему столу. Можно как то это исправить?
И еще такой вопрос. Если нажимаю кнопку Отмена, то заголовок окна, который убрал с помощью данной функции, появляется опять и уже не пропадает

подскажите код на подобие этих инсталов http://s002.youpic.su/pictures/1314475200/11f7d48273db1adc5adbb9869a5639c3.png http://img828.imageshack.us/img828/7882/34932166.jpg

GDDR7
Тебе его никто не даст, качай закос от репачека и допиливай.

vistaw
а где можно его скачать?

GDDR7
http://rghost.ru/17917091

Подскажите, юзаю скрипт Xenus2 спотыкается, когда попадаются файлы с иегорлифами (китай, корея), как испрвить это, не прибегая к ренейму? Переименовал бы, да там несколько сотен папок и сотни тысяч файлов, просто не найду их все..

Sergey_Demchuk а BorderStyle := bsNone; не подходит?

Перетаскивать окно можно с помощью такого кода:

[more=код]
Код: function ReleaseCapture: Longint; external 'ReleaseCapture@user32.dll stdcall'; // объявляем функцию

procedure WizardFormOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(WizardForm.Handle,$0112,$F012,0);
end;

procedure InitializeWizard();
begin
with WizardForm do
begin
BorderStyle := bsNone; // удаляем бордюр у окна
Outernotebook.Hide;
end;
with TLabel.Create(WizardForm) do begin
AutoSize:=False;
Parent:=WizardForm;
SetBounds(ScaleX(0), ScaleY(0), WizardForm.Width, WizardForm.Height); // размеры поля, за которое можно перетаскивать окно.
OnMouseDown:=@WizardFormOnMouseDown;
Transparent:=True;
end;
end;

Sergey_Demchuk вот другой вариант но там надо скрывать может просто пригодится хотя примеры разные но что лайбал создается на все форму и засчет него двигается все одинаковое
InnerNotebook.Hide;
OuterNotebook.Hide;
[more][Setup]
AppName=My Program
AppVerName=My Program
DefaultDirName={pf}\My Program
OutputDir=.

[Languages]
Name: rus; MessagesFile: compiler:Languages\Russian.isl

[Code]
function ReleaseCapture(): Longint; external 'ReleaseCapture@user32.dll stdcall';

procedure LabelOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
SendMessage(WizardForm.Handle,$0112,$F012,0)
end;

procedure InitializeWizard;
begin
with WizardForm do begin
BorderStyle:=bsNone;
Bevel.Hide;
InnerNotebook.Hide;
OuterNotebook.Hide;
Center;
end;

with TLabel.Create(WizardForm) do begin
Parent:=WizardForm;
AutoSize:=False;
Top:=7;
Left:=0;
Width:=WizardForm.Width;
Alignment:=taCenter;
Transparent:=True;
Font.Color:=$000000;
Font.Size:= 9;
Font.Style:=[fsBold];
Caption:=WizardForm.Caption; //это что текст у нас по середине
OnMouseDown:=@LabelOnMouseDown;
end;

//Создаем лейбл на всю форму, чтоб ее можно было двигать
with TLabel.Create(WizardForm) do begin
Parent:=WizardForm;
AutoSize:=False;
Top:=0;
Left:=0;
Width:=WizardForm.Width;
Height:= WizardForm.Height
Transparent:=True;
OnMouseDown:=@LabelOnMouseDown;
end;
end;[/more]

подскажите, как сделать что-бы при нажатии на крестик не выводилось сообщение с подтверждением

Добавлено:
vint56, Gnom3

подскажите, почему если брать ниже полоски(см. скрин http://s57.radikal.ru/i157/1108/20/689e434d0213.jpg) окно не передвигается

alex0413

Цитата:

подскажите, как сделать что-бы при нажатии на крестик не выводилось сообщение с подтверждением

procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
Confirm:=False;
end;

Sten23

Цитата:

REALYAROHA
Вот, сделал: http://rghost.ru/11683931
Скрин: Подробнее...
Если что не понравится шрифт, размер, положение, я там всё подписал! Что за что отвечает.....

Если можно и мне такой скрипт подкинь, по твоей ссылки фаил удален.

Всем привет, такой вопрос, может кто нибудь сталкивался, после создания и установки репака в "Установка и удаление программ" появляется два названия игры, как сделать чтобы было одно, вот пример:

Название игры Chaos Legion, а получается Chaos LegionChaos Legion, кто знает как исправить помогите!

Добавлено:
Вот если картинка не отображается
http://i26.fastpic.ru/big/2011/0828/c8/83256f9093b2c1ecf9f3861b735a4bc8.png

vint56
сделал так

procedure CancelButtonOnClick(Sender: TObject);
var Cancel, Confirm: Boolean;
begin
if MsgBox(SetupMessage(msgExitSetupMessage), mbConfirmation, MB_YESNO) = IDYES then ISDoneCancel:=1;
Confirm:=False;
end;
но не работает. Я пытаюсь прикрепить к скрипту GOG_Catalyst_iswn7
Цитата:

http://rghost.ru/17917091

, а там ISDone прикреплен, и уже использует эту процедуру, а слепить вместе не получается.

Gnom3
vint56
Спасибо, то что надо.
Вот еще ерундовый вроде вопросец.
Не могу вывести текстом знак &
Пробую через Chr(38), тоже его нету, вместо него тире нижнее.
Label.Caption:=Chr(38).

alex0413 cделай так
procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
Confirm:=False;
end;
procedure CancelButtonOnClick1(Sender: TObject);
begin
SuspendProc;
if MsgBox(SetupMessage(msgExitSetupMessage), mbConfirmation, MB_YESNO) = IDYES then ISDoneCancel:=1;
ResumeProc;
end;

MyCancelButton:=TButton.Create(WizardForm);
with MyCancelButton do begin
OnClick:=@CancelButtonOnClick1;// поменяй
end;
end;

Ссылка на скрипт с изменением темы оформляния по кнопкам. Оцените. Работает только в анси.

Привет)
У кого есть 3D инсталлятор, очень хочу на него посмотреть)

Nukloud
http://rghost.ru/19677101

log1stable

Цитата:

Скрипт изменения прозрачности окна трекбаром.

Похвальное желание быть нужным людям.
Только вот так будет и короче, и работает плавно и красиво.
[more=Код]
Код: [Setup]
AppName=Alpha+Trackbar
AppVerName=Alpha+Trackbar
DefaultDirName={pf}\Alpha+Trackbar


Код:
var
AlphaTrackBar: TTrackBar;

function SetLayeredWindowAttributes(hwnd: HWND; crKey: TColor; bAlpha: BYTE; dwFlags: DWORD): Boolean; external 'SetLayeredWindowAttributes@user32.dll stdcall';
function GetWindowLong(Wnd: HWnd; Index: Integer): Longint; external 'GetWindowLongA@user32.dll stdcall';
function SetWindowLong(Wnd: HWnd; Index: Integer; NewLong: Longint): Longint;external 'SetWindowLongA@user32.dll stdcall';

procedure AlphaTrackBarChange(Sender: TObject);
begin
SetWindowLong(WizardForm.Handle, (-20), GetWindowLong(WizardForm.Handle, (-20)) or $80000);
SetLayeredWindowAttributes(WizardForm.Handle, 0, AlphaTrackBar.Position, 2);
end;

Procedure InitializeWizard();
begin
AlphaTrackBar:=TTrackBar.Create(WizardForm);
AlphaTrackBar.Name:='AlphaTrackBar';
AlphaTrackBar.Parent:=WizardForm;
AlphaTrackBar.SetBounds(ScaleX(0),ScaleY(327),ScaleX(238),ScaleY(29));
AlphaTrackBar.Max:=255;
AlphaTrackBar.Position:=255;
AlphaTrackBar.OnChange:=@AlphaTrackBarChange;
end;

riperoc1
спс

Цитата:

Подскажите, юзаю скрипт Xenus2 спотыкается, когда попадаются файлы с иегорлифами (китай, корея), как испрвить это, не прибегая к ренейму? Переименовал бы, да там несколько сотен папок и сотни тысяч файлов, просто не найду их все..

Gnom3, спасибо за совет. Буду стараться А что скажешь насчет слайд-шоу по таймеру? Страницы две тому постил. Этот скрипт можно оптимизировать?

Цитата:

Sergey_Demchuk
А вот так
Код: procedure InitializeWizard();
begin
WizardForm.WelcomeLabel2.Caption := '&';
end;

не выходит?

Если бы....уже как хочешь пробовал
И еще, к прошлому вопросу, насчет запуска приложения на последней странице

function NextButtonClick(CurPageID: Integer): Boolean;
Var
ErrorCode: integer;
begin
Result:=True;
If CurPageID=wpFinished then
Exec(ExpandConstant('{app}') + '\Archicad.exe',' ', ExpandConstant('{app}'), SW_HIDE, ewNoWait, ErrorCode);
end;

Вот на этой странице у меня 2 кнопки, одна "Завершить" (стандартная NextButton), а другая "Старт"
Одна кнопа должна просто завершить инсталлятор стандартно, а другая завершить и запустить приложение. Можно как то на эту мою кнопу на онклик повесить дополнительно еще одно событие?
Или может есть возможность вызвать событие NextButtonClick вручную, повесив свое событие на созданную кнопку?