Ru-Board.club
← Вернуться в раздел «Программы»

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

Автор: Despofix
Дата сообщения: 30.08.2011 23:37
kostyamks
isdone качаешь и выравниваешь все это как тебе надо
Автор: Raf_SE
Дата сообщения: 30.08.2011 23:51
Ктонить встречался с кодом\dll'кой isProgressBar от ExpeditorR, для создания "технического" прогресс-бара? Как я понял, он создает отдельную страницу с собственным прогресс-баром. А можно ли сделать так, чтоб его прогресс-бар отображался поверх\вместо стандартного, на стандартной странице инсталляции?
Автор: Sergey_Demchuk
Дата сообщения: 31.08.2011 00:55
Есть пример как вставить на форму гиперссылку на вебстраничку? Чтобы при наведении на текст он бы подсвечивался синим и курсор мышки менялся на другой? Я так понимаю, текстурировать лейбл надо...

Raf_SE
Посмотри на библиотеку botva2.dll в шапке, отлично справляется с прогресбаром и пример есть вместе с ней
Автор: nik1967
Дата сообщения: 31.08.2011 04:06
Sergey_Demchuk
[more]
Код: [Setup]
AppName=AppName
AppVerName=AppVerName
DefaultDirName={pf}\AppName

[ Code]
var
SiteLabel: TLabel;

procedure SiteLabelOnClick(Sender: TObject);
var
ErrorCode: Integer;
begin
ShellExec('open', 'http://forum.ru-board.com', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode);
end;

procedure SiteLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
SiteLabel.Font.Color:=clRed;
SiteLabel.Font.Style:=[fsUnderline, fsBold];
end;

procedure SiteLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
SiteLabel.Font.Color:=clBlue;
SiteLabel.Font.Style:=[fsBold];
end;

procedure SiteLabelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
SiteLabel.Font.Color:=clGreen;
SiteLabel.Font.Style:=[fsUnderline, fsBold];
end;

procedure SiteLabelMouseLeave(Sender: TObject);
begin
SiteLabel.Font.Color:=clBlue;
SiteLabel.Font.Style:=[fsBold];
end;

procedure InitializeWizard();
begin
SiteLabel:=TLabel.Create(WizardForm);
SiteLabel.Left:=10;
SiteLabel.Top:=330;
SiteLabel.Cursor:=crHand;
SiteLabel.Font.Color:=clBlue;
SiteLabel.Font.Style:=[fsBold];
SiteLabel.Caption:='Forum Ru-Board';
SiteLabel.OnClick:=@SiteLabelOnClick;
SiteLabel.OnMouseDown:=@SiteLabelMouseDown;
SiteLabel.OnMouseUp:=@SiteLabelMouseUp;
SiteLabel.OnMouseMove:=@SiteLabelMouseMove;
SiteLabel.OnMouseLeave:=@SiteLabelMouseLeave;
SiteLabel.Parent:=WizardForm;
end;
Автор: 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]
Автор: vint56
Дата сообщения: 31.08.2011 11:34
Magellan777 тебе придется поменять расширение либо в скрипте либо в файле
[ArcFiles]
Source: {src}\*.bin; DestDir: {app}; Disk: 1;
Source: {src}\Data2.bin; DestDir: {app}\data; Disk: 1; Components: Russian;
Source: {src}\Data3.bin; DestDir: {app}\data2; Disk: 1; Components: English;
//Source: {src}\Data4.bin; DestDir: {app}\data3; Disk: 2;
//Source: {src}\Data5.bin; DestDir: {app}\data4; Disk: 2; Components: Russian;
//Source: {src}\Data6.bin; DestDir: {app}\data5; Disk: 2; Components: Russian;
{#SourceToProgress}
Автор: Raf_SE
Дата сообщения: 31.08.2011 12:49
nik1967 (04:06 31-08-2011)
Цитата:
Скачай Xenus2+botva2+ISDone0.5 - я там в своё время так делал.

Слишком много функций там намучено.

Sergey_Demchuk (00:55 31-08-2011)
Цитата:
Посмотри на библиотеку botva2.dll в шапке, отлично справляется с прогресбаром и пример есть вместе с ней

Мне нужен прогресс-бар который ничего отображать не будет, т.е. исключительно для красоты, с отображением не прогресса, а какой-то анимации. Разве через botva2 можно такое сделать?
Автор: Magellan777
Дата сообщения: 31.08.2011 13:07
То есть? Я не использовал компоненты! Вы имеете в виду изменить расширение файла на *. bin?
Автор: vint56
Дата сообщения: 31.08.2011 13:12
Magellan777 запрос на диск по маске там стоит с расширением bin у тебя файл arc
Source: {src}\*.bin; DestDir: {app}; Disk: 1;
Автор: Despofix
Дата сообщения: 31.08.2011 16:16
iswin7 работает только при использовании aero тем? ботва + iswin 7 могут нормально вместе работать? а то при добавлении на стекло кнопок текстуринованных с помощью ботвы, все окно закрашивается черным, кроме кнопок и стекла.
Автор: Gnom3
Дата сообщения: 31.08.2011 18:50
Despofix

Цитата:
то при добавлении на стекло кнопок текстуринованных с помощью ботвы, все окно закрашивается черным, кроме кнопок и стекла.

Все окно в любом случае закрашивается черным, это необходимо для нормального отображениея стекла. Просто ты скрыл WizardForm.OuterNotebook , вот у тебя и получилось, что все черное. Смело лепи поверх картинки, нормально они живут вместе. Только на стекле картинок видно не будет.
Автор: TNR
Дата сообщения: 01.09.2011 06:56
Подскажите как через isxdl.dll сделать загрузку файла например update.ini c последующей загрузкой всех файлов указанных с нём ?
Автор: nik1967
Дата сообщения: 01.09.2011 08:01
Raf_SE
Я, например, делаю так:

Код: [Run]
Filename: {src}\Redist\dxwebsetup.exe; Parameters: /q; Flags: skipifdoesntexist; Components: Redist\DirectXCheck; BeforeInstall: DirectXProgress;

[ code]
procedure DirectXProgress;
begin
WizardForm.ProgressGauge.Style:= npbstMarquee;
end;
Автор: Sergey_Demchuk
Дата сообщения: 01.09.2011 09:40
Можно ли в стандартном списке компонентов изменить цвет шрифта отдельного компонента? Стиль поменять можно на жирный или подчеркнутый, а вот цвет не нашел как....
Автор: Sergey_Demchuk
Дата сообщения: 01.09.2011 11:44
И есть ли возможность у стандартного списка компонентов сворачивать дочерные компоненты?
Автор: Gnom3
Дата сообщения: 01.09.2011 19:36
Sergey_Demchuk

Цитата:
Можно ли в стандартном списке компонентов изменить цвет шрифта отдельного компонента?

Нельзя, самому хотелось

Цитата:
И есть ли возможность у стандартного списка компонентов сворачивать дочерные компоненты?

Можно - Flags: collapsed

Код: [Components]
Name: ansi; Description: Компилятор Ansi; Types: custom compact full; Flags: exclusive collapsed
Name: ansi\r; Description: Расширенный Ansi; Flags: exclusive; Types: custom compact full
Name: ansi\s; Description: Стандартный Ansi; Flags: exclusive; Types: custom compact
Автор: Sergey_Demchuk
Дата сообщения: 01.09.2011 21:48
Gnom3
А можно в списке компонентов сделать отступ текста от правого края больше чем по умолчанию? Границу я убрал в оке, она не надо.
Автор: Gnom3
Дата сообщения: 01.09.2011 22:24

Цитата:
А можно в списке компонентов сделать отступ текста от правого края больше чем по умолчанию?

тут не уверен. По крайней мере не нашел ничего похожего в свойствах. А так, все свойства для объекта можно найти в расширенной версии на второй вкладке - забиваеш в поиск имя объекта - определяеш тип, потом забиваеш тип объекта, и смотриш его свойства.
Автор: Sergey_Demchuk
Дата сообщения: 01.09.2011 23:45
Ладно, с этим понял, еще вопрос если можно.
На странице компонентов при развертывании списка компонентов появляется линия прокрутки. Можно как то отследить, есть она на экране в данный момент или нет?
Автор: NumberI
Дата сообщения: 02.09.2011 08:22
можно ли в зависимых задачах присваивать разные groupdescription, естественно чтобы они отображались при выборе?
Автор: Gnom3
Дата сообщения: 02.09.2011 09:32

Цитата:
можно ли в зависимых задачах присваивать разные groupdescription, естественно чтобы они отображались при выборе?

Нет. Именно groupdescription создает группы зависимых задач.

Цитата:
На странице компонентов при развертывании списка компонентов появляется линия прокрутки. Можно как то отследить, есть она на экране в данный момент или нет?


Можно попробовать. Нужно WizardForm.ComponentsList.MinItemHeight умножить на WizardForm.ComponentsList.ItemCount и сравнить WizardForm.ComponentsList.Height - если больше, то скроллбар однозначно есть. ТОлько проводить эту проверку нужно гдето, где происходит какоето действие постоянно. Например в OnItemMouseMove.
Автор: NumberI
Дата сообщения: 02.09.2011 11:38
Gnom3
каким образом, тогда можно сделать пункт "все" с несколькими групп декскрипшинами?
Автор: Gnom3
Дата сообщения: 02.09.2011 11:57
NumberI никак, специально сейчас попробовал - при создании зависимых задач, GroupDescription зависимых задач просто игнорируется.

Код: [Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application
[Tasks]
Name: a; Description: &#226;&#241;&#229;; GroupDescription: all
Name: a/a1; Description: a; GroupDescription: a
Name: a/a2; Description: b; GroupDescription: a
Name: a/b1; Description: c; GroupDescription: b
Name: a/b2; Description: d; GroupDescription: b
Автор: NumberI
Дата сообщения: 02.09.2011 13:54
а возможно ли на странице выбора задач между самими задачами вставить custom message?
Автор: troyan90
Дата сообщения: 02.09.2011 14:45
TNR
вот пример написал. думаю подойдет
http://rghost.ru/20210301

update
http://rghost.ru/20230561
более удобный вариант
Автор: Mataes
Дата сообщения: 02.09.2011 14:55
Подскажите, пожалуйста, как сделать: есть 2 текстовых файла. Надо один скопировать в другой, на стирая его содержимого, а дописав в конец.
Автор: troyan90
Дата сообщения: 02.09.2011 18:46
Mataes
[more]
Код:
[_code]
procedure NewButtonClick(Sender: TObject);
var
TextFile, Str: TStringList;
begin
TextFile := TStringList.Create;
Str := TStringList.Create;
try
with TextFile do begin
Str.LoadFromFile(ExpandConstant('{sd}\text1.txt'));
AddStrings(Str);
Str.LoadFromFile(ExpandConstant('{sd}\text2.txt'));
AddStrings(Str);
SaveToFile(ExpandConstant('{sd}\text1.txt'));
end;
finally
TextFile.free;
Str.Free;
end;
end;

procedure InitializeWizard();
var
NewButton: TNewButton;
begin
NewButton := TNewButton.Create(WizardForm);
with NewButton do begin
Parent := WizardForm;
Left := ScaleX(8);
Top := ScaleY(325);
OnClick := @NewButtonClick;
end;
end;
Автор: Mataes
Дата сообщения: 02.09.2011 20:46
troyan90
спасибо!
Автор: Sergey_Demchuk
Дата сообщения: 03.09.2011 00:02

Цитата:
Можно попробовать. Нужно WizardForm.ComponentsList.MinItemHeight умножить на WizardForm.ComponentsList.ItemCount и сравнить WizardForm.ComponentsList.Height - если больше, то скроллбар однозначно есть. ТОлько проводить эту проверку нужно гдето, где происходит какоето действие постоянно. Например в OnItemMouseMove.

Идея хороша, попробовал, но ничего не вышло, ибо
WizardForm.ComponentsList.MinItemHeight * WizardForm.ComponentsList.ItemCount
постоянное число, что свернутый список что развернутый.

procedure ClickCheck(Sender: TObject; X, Y: Integer; Index: Integer; Area: TItemArea);
var
CompH: integer;
begin
CompH:=WizardForm.ComponentsList.MinItemHeight * WizardForm.ComponentsList.ItemCount;
if CompH > WizardForm.ComponentsList.Height then Line1.Hide else Line1.Show;
if index=10 then MsgBox(inttostr(WizardForm.ComponentsList.Height), mbInformation, MB_OK);
end;
Автор: VicF1
Дата сообщения: 03.09.2011 16:24
Привет.
Есть такая проблема в инсталляторе (база от Need for Speed Undercover 2):
Если в процессе установки инсталлятор не сворачивать, то на "финише", как положено, пишет что установка "успешна".
Но если его свернуть, то по завершении установки он развернется и на финишной странице будет написано, что установка успешна и "мусор", типа внесение данных в реестр и осталось до завершения столько-то...
А если после этого инсталлятор свернуть, а потом развернуть, то будет уже написано всё как положено, т.е. только "установка успешно завершена".
В чем загвоздка?
Большое спасибо.

Страницы: 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177

Предыдущая тема: поиск


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.