Имя пользователя:
Пароль:
 

Показать сообщение отдельно

Аватара для R3Pa4eK

Новый участник


Сообщения: 18
Благодарности: 3

Профиль | Отправить PM | Цитировать


Привет всем! Мне нужна ваша помощь

Скрипт переменной для отмены:
читать дальше »

function ISCreateProcessCallback(): boolean;
begin
Result := isexec_cancel;
begin
if not(isexec_cancel) then
begin
DelTree(ExpandConstant('{app}'), True, True, True);
end;
end;
end;


Это код для отмены, но он не работает. Если поставить Result :=true;, то все распаковывается на ура, но кнопка отмены не работает. А если оставить Result := isexec_cancel; , то кнопка отмены работает, но архивы не распаковываются. Вот весь скрипт:
читать дальше »

#define MyAppName "Fallout New Vegas"
#define MyAppVersion "1.0"
#define MyAppPublisher "Microsoft Game Studios"
#define vers1 "1.0.0.0"
#define MAX "2"


[Setup]
AppName={#MyAppName}
AppverName={#MyAppVersion}
AppVersion={#MyAppVersion}
VersionInfoVersion={#vers1}
VersionInfoTextVersion={#vers1}
AppPublisher={#MyAppPublisher}
DefaultDirName={pf}\{#MyAppName}
DefaultGroupName={#MyAppName}
OutputBaseFilename=setup
Compression=lzma
SolidCompression=yes
ShowTasksTreeLines=yes
OutputDir=.

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


[Files]
Source: "ISExec.dll"; DestDir: {tmp}; Flags: dontcopy
Source: "srep.dll"; DestDir: "{tmp}"; Flags: dontcopy
Source: "arc.dll"; DestDir: "{tmp}"; Flags: dontcopy
Source: "precomp.exe"; DestDir: "{tmp}"; Flags: dontcopy
Source: "packjpg_dll.dll"; DestDir: "{tmp}"; Flags: dontcopy
Source: "zlib1.dll"; DestDir: "{tmp}"; Flags: dontcopy
Source: "oggdec.exe"; DestDir: "{tmp}"; Flags: dontcopy

[UninstallDelete]
Type: filesandordirs; Name: {app};

[code]
var
FLabel1, FLabel2, WLabel1, WLabel2, PageNameLabel, PageDescriptionLabel,NeedSpaceLabel,FreeSpaceLabel: TLabel;
NeedSize:Integer;
FreeMB, TotalMB: Cardinal;
LogoImage: TBitmapImage;

ProgressBar1:TNewProgressBar;

const SmallWidth = 497;


procedure InitializeWizard();
begin

ProgressBar1:=TNewProgressBar.Create(WizardForm);
with WizardForm.ProgressGauge do
begin
ProgressBar1.Left := WizardForm.ProgressGauge.Left;
ProgressBar1.Top := WizardForm.ProgressGauge.Top;
ProgressBar1.min:=0;
ProgressBar1.Width :=WizardForm.ProgressGauge.Width;
ProgressBar1.Height := WizardForm.ProgressGauge.Height;
ProgressBar1.Parent := WizardForm.InstallingPage;
ProgressBar1.Max:= {#MAX};
end;
end;

var
isexec_cancel: boolean;
Cancel:integer;
type
TISCreateProcessCallback = function(): boolean;

function CreateProcess(callback: TISCreateProcessCallback; EXEName: PAnsiChar; DIRName: PAnsiChar; Show: boolean; Comfort: boolean; hWnd: HWND): BOOL; external 'isexec_cp@files:isexec.dll stdcall';

function ISCreateProcessCallback(): boolean;
begin
Result := true;
begin
if not(isexec_cancel) then
begin
DelTree(ExpandConstant('{app}'), True, True, True);
end;
end;
end;

var
Files: Array of String;
S: String;
n: Integer;

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;
SetArrayLength(Result, GetArrayLength(Result) +1); i:= GetArrayLength(Result) -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;

procedure FindFiles(FromDir: String; Mask: String);
var FSR, DSR: TFindRec; FindResult: Boolean;
begin
FindResult:= FindFirst(AddBackslash(FromDir)+Mask, FSR)
while FindResult do begin
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
S:= S + AddBackslash(fromDir) + FSR.Name +'|';
end;
FindResult:= FindNext(FSR);
end;
FindResult:= FindFirst(AddBackslash(FromDir)+ '*.*', DSR)
while FindResult do begin
if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and not ((DSR.Name = '.') or (DSR.Name = '..')) then begin
FindFiles(AddBackSlash(FromDir)+DSR.Name, Mask)
end;
FindResult:= FindNext(DSR);
end;
FindClose(FSR); FindClose(DSR)
end;

procedure FindAllFiles(_Dir: string; var _i: integer);
var
SearchRec: TFindRec;
begin
_Dir := AddBackslash(_Dir);
if FindFirst(_Dir + '*.*', SearchRec) then
begin
try
repeat
if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
Continue;
if (SearchRec.Attributes and FILE_ATTRIBUTE_DIRECTORY) <> 0 then
FindAllFiles(_Dir + SearchRec.Name, _i)
else
_i := _i + 1;
until
not FindNext(SearchRec);
finally
FindClose(SearchRec);
end;
end;
end;

procedure Extract_ogg;
var ResultCode: integer; CurFile: String;
begin

FindFiles(ExpandConstant('{app}'), '*.ogg')
Files:= StringToArray(S, '|')

for n:=(GetArrayLength(Files)-1) downto 0 do begin

CurFile:= Files[n]
StringChange(CurFile, AddBackslash(ExtractFilePath(Files[n])), '')

if not(CreateProcess(@ISCreateProcessCallback, ExpandConstant('{tmp}\oggdec.exe') + ' ' + ' -Q '+ CurFile, AddBackslash(ExtractFilePath(Files[n])), FALSE, FALSE, WizardForm.Handle)) then exit;

DeleteFile(Files[n])
ProgressBar1.Position:= ProgressBar1.Position +1;
end;end;

procedure Extract_pcf;
var ResultCode: integer; CurFile: String;
begin

FindFiles(ExpandConstant('{app}'), '*.pcf')
Files:= StringToArray(S, '|')

for n:=(GetArrayLength(Files)-1) downto 0 do begin

CurFile:= Files[n]
StringChange(CurFile, AddBackslash(ExtractFilePath(Files[n])), '')

if not(CreateProcess(@ISCreateProcessCallback, ExpandConstant('{tmp}\precomp.exe') + ' ' + ' -r '+ CurFile, AddBackslash(ExtractFilePath(Files[n])), FALSE, FALSE, WizardForm.Handle)) then exit;

DeleteFile(Files[n])
ProgressBar1.Position:= ProgressBar1.Position +1;
end;end;

procedure Extract_Arc(arcArchName,arcDestDir: string);
begin

if not(CreateProcess(@ISCreateProcessCallback, ExpandConstant('{tmp}\Arc.dll') + ' ' + 'x '+AddQuotes(ExpandConstant(arcArchName))+' -y -dp'+AddQuotes(ExpandConstant(arcDestDir)), '', FALSE, FALSE, WizardForm.Handle)) then exit;
ProgressBar1.Position:= ProgressBar1.Position +10;
end;

procedure Extract_srep(srepArchName,srepDestDir: string);//srep
begin
if not(CreateProcess(@ISCreateProcessCallback, ExpandConstant('{tmp}\Srep.dll') + ' ' + '-d '+AddQuotes(ExpandConstant(srepArchName))+' '+AddQuotes(ExpandConstant(srepDestDir)),'', FALSE, FALSE, WizardForm.Handle)) then exit;
ProgressBar1.Position := ProgressBar1.Position+10;
end;

function PlsInsertNextDisk(num: integer; CheckedFile: string): string;
var Capt:string;
CheckedDir:string;
begin
if not(isexec_cancel) then exit;
CheckedFile:=ExpandConstant(CheckedFile);
if not FileExists(CheckedFile) then begin
Capt:=ExpandConstant('{cm:disk}')+' ¹%n'+ExpandConstant('{cm:disk2}');
StringChange(Capt, '%n', inttostr(num));
StringChange(Capt, '%f', ExtractFileName(CheckedFile));
MsgBox(Capt, mbInformation, MB_OK);
PlsInsertNextDisk(num, CheckedFile);
end;
Result := CheckedFile;
end;

procedure CurStepChanged(CurStep: TSetupStep);
var
i: integer;
tmp:integer;
begin

if CurStep = ssInstall then
begin
WizardForm.StatusLabel.Caption:=SetupMessage(msgStatusExtractFiles);
ExtractTemporaryFile('arc.dll');
ExtractTemporaryFile('precomp.exe');
ExtractTemporaryFile('packjpg_dll.dll');
ExtractTemporaryFile('Srep.dll');
ExtractTemporaryFile('oggdec.exe');
ProgressBar1.Position := ProgressBar1.Position+1;
end;

if CurStep = ssInstall then
begin
Extract_Arc('{src}\data.bin', '{app}');

//Extract_ogg

WizardForm.StatusLabel.Caption:=SetupMessage(msgStatusRunProgram);
end;
end;

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

if CurPageID = wpInstalling then
begin
isexec_cancel := true;
end;
end;

Последний раз редактировалось R3Pa4eK, 29-03-2011 в 17:47. Причина: Плохо написал


Отправлено: 17:44, 29-03-2011 | #1169