Показать полную графическую версию : Скрипты Inno Setup. Помощь и советы [часть 6]
По поводу прогресс бара - нужно смотреть весь скрипт, модулей не достаточно.
nik1967, могу я Вам сбросить?
лень переписывать »
Спасибо... нашел, что хотел... сделаю, мне не лень.
var
lang: String;
procedure CreateWizardImage;
begin
*******
*******
*******
end;
if lang='rus' then begin
***********
end else begin
***********
end;
***
end;
end;
Всем доброго времени суток!
Кто-нибудь знает, можно ли на странице выборка компонентов убрать выводимый "space requied". ShowComponentSizes=no отключает вывод только для самих компонентов, но не общий
И еще вопрос... как можно записать следующее... »
Вот так например:
if ActiveLanguage = 'russian' then
...
else ...
Вот так например: »
Так даже лучше!
Shkutu,
WizardForm.ComponentsDiskSpaceLabel.Hide;
Mat_y, кидай, только когда посмотрю - не знаю, дела...
function MbOrTb(Float: Extended): String;
begin
if Float < 1024 then Result:= NumToStr(Float)+ExpandConstant('{cm:Mb}') else
if Float/1024 < 1024 then Result:= NumToStr(Float/1024)+ExpandConstant('{cm:Gb}') else
Result:= NumToStr(Float/(1024*1024))+ExpandConstant('{cm:Tb}');
end;
Mat_y, кидай, только когда посмотрю - не знаю, дела... »
Хорошо, заранее спасибо... сейчас пришлю.
А с этим место я справился так:
function MbOrTb(Float: Extended): String;
begin
if Float < 1024 then Result:= NumToStr(Float)+' '+CustomMessage(lang+'Mb') else
if Float/1024 < 1024 then Result:= NumToStr(Float/1024)+' '+CustomMessage(lang+'Gb') else
Result:= NumToStr(Float/(1024*1024))+' '+CustomMessage(lang+'Tb');
end;
Shkutu, и может кому нибудь ещё. Если установлена расширенная версия от Res Tools, то при запуске Compil32Ex.exe появляется чудесная возможность посмотреть нужные параметры на вкладке "Редактор форм"("WizardForm Designer"), или на других вкладках :).
Господа!
А нет ли возможности отображать и устанавливать разные компоненты в списке в зависимости от выбранного языка? Т.е. если язык русский, то и компоненты не только по-русски написаны, но и их английские аналоги даже не отображаются для выбора. А если английский язык, то русские компоненты не отображаются.
Mat_y, есть
[Components]
Name: "component1"; Description: "component 1"; Types: full; Languages: russian
это если компонент для конкретного языка.
А если надо название компонента для конкретного языка (компонент один и тот же), то можно просто пользоваться секцией CustomMessages:
[Components]
Name: "component1"; Description: "{cm: comp}"; Types: full
[CustomMessages]
english.comp = Component 1
russian.comp = Компонент 1
Dinvin4ester
19-11-2013, 19:48
Ребята , не отображается прогресс бар , не пожете решить эту проблему - http://sendfile.su/897360 . Спасибо .
А мне не поможете ?
Johny777
20-11-2013, 07:22
Shkutu,
А вот такая проблемка. Есть код (дополняю деинсталлятор) ... Но Abort почему-то срабатывает, только если на кнопку "отмена" нажать дважды. Подскажите, плиз, можно ли с этим что-то сделать? »
я по твоему запросу игрался с кодом. всегда вылетает исключение. К слову, вовсе необязательно присваивать UninstallProgressForm.CancelButton.ModalResult := mrAbort; при нажатии. Это можно сделать и до показывания окна в модальном режиме, например так:
procedure InitializeUninstallProgressForm();
begin
...
UninstallProgressForm.CancelButton.ModalResult := mrAbort;
...
if ShowModal = mrAbort then Abort;
end;
могу посоветивать одно (считаю это действительно самым простым): вызывать своё окно вместо стандартного
вот пример. В нём возможно много для тебя ненужного кода, но думаю смысл понятен http://forum.oszone.net/post-1939326-305.html
вот упрощённая версия:
function CreateUninstallForm: Integer;
var
UninstallForm: TSetupForm;
UninstallButton, ExitButton: TButton;
begin
UninstallForm := CreateCustomForm;
with UninstallForm do
begin
BorderStyle := bsSingle;
BorderIcons := [biSystemMenu,biMinimize];
Position := poScreenCenter;
Caption := 'Uninstall';
ClientWidth := ScaleX(634);
ClientHeight := ScaleY(586);
//uninstall button
UninstallButton := TButton.Create(nil);
with UninstallButton do
begin
Parent := UninstallForm;
SetBounds(ScaleX(500), ScaleY(527), ScaleX(69), ScaleY(23));
Cursor := crHand;
Caption := SetupMessage(msgButtonYes);
ModalResult := mrOk;
end;
//exit button
ExitButton := TButton.Create(nil);
with ExitButton do
begin
Parent := UninstallForm;
SetBounds(UninstallButton.Left - UninstallButton.Width - ScaleX(16), UninstallButton.Top, UninstallButton.Width, UninstallButton.Height);
Caption := SetupMessage(msgButtonNo);
Cursor := crHand;
ModalResult := mrCancel;
end;
Result := ShowModal;
Free;
end;
end;
function Unstall(): Boolean;
begin
Result := False;
// if условия выполнены, то возвращаем True, что ведёт к полному удалению
// ...
// then Result := True;
end;
function InitializeUninstall(): Boolean;
var
ResultCode: Integer;
begin
Result := False;
if not UninstallSilent then
begin
Exec(ExpandConstant('{uninstallexe}'), '/VERYSILENT', '', SW_SHOW, ewNoWait, ResultCode);
Exit;
end;
if CreateUninstallForm = mrOk then Result := Unstall();
end;
Я смотрю опытные люди опять стали проявлять активность на форуме. Спасибо вам всем. Очень помогаете... попробую вернуться к старой проблеме, которая до сих пор не дает мне покоя.
Вот часть кода:
function MoveFile(const srcFile, destFile: PChar): Integer; external 'MoveFileA@kernel32.dll stdcall';
//////////////////////////////////////////////
RedesignWizardForm;
MyTask:=TCheckBox.Create(WizardForm);
with MyTask do
begin
Parent:=WizardForm.SelectDirPage;
Caption:='Создать резервную копию';
Left:=ScaleX(0);
Top:=ScaleY(180);
Width:=ScaleX(400);
Height:=ScaleY(15);
TabOrder:=0;
Checked:=False;
//////////////////////////////////////////////
if MyTask.Checked then begin
MyFiles:=['*']; // указать файлы или маски нужные для бакупа через запятую. при указании маски '*' бакупятся все файлы с вложенными папками
MyDir:=ExpandConstant('{app}'+'\FolderName\'); //папка откуда бакупить
BackDir:=ExpandConstant('{app}'+'\Backup\'); // папка куда бакупить
for i:=0 to GetArrayLength(MyFiles)-1 do
begin
if FindFirst(MyDir+MyFiles[i], FindFiles) then begin
repeat
if not DirExists(BackDir) then begin
CreateDir(BackDir);
end;
MoveFile(MyDir+FindFiles.Name, BackDir+FindFiles.Name);
until not FindNext(FindFiles);
FindClose(FindFiles);
end;
end;
end;
Его задача переместить все файлы и папки из одной папки №1 в папку №2.
Так вот если папка №2 уже существует и в ней есть файлы или даже пустые папки, то часть файлов он просто не перемещает, другие файлы перемещает частично... при этом никакой зависимости от присутствующих в папке №1 файлов нет.
Код брал из справки... можно ли его как-то усовершенствовать в этом вопросе? Можно ли не перемещать, а копировать файлы?
Johny777, спасибо, буду пробовать.
Кстати, исключение при Abort - это если из среды запускать. Если .ехе сам по себе - то вырубается молча вроде бы, без всяких эксепшнов.
Mat_y, чтобы не перемещать, а копировать, можно использовать CopyFile
function CopyFile(const srcFile, destFile: PChar, FailIfExists: boolean): Integer; external 'CopyFileA@kernel32.dll stdcall';
часть файлов он просто не перемещает »
А совпадающих имен точно нет?
El Sanchez
20-11-2013, 19:06
Его задача переместить все файлы и папки из одной папки №1 в папку №2 »
Mat_y, пробуйте.
#define A = (Defined UNICODE) ? "W" : "A"
const
FO_MOVE = $1;
FO_COPY = $2;
FOF_SILENT = $0004;
FOF_NOCONFIRMATION = $0010;
FOF_NOCONFIRMMKDIR = $0200;
FOF_NOERRORUI = $0400;
type
SHFILEOPSTRUCT = record
hwnd: HWND;
wFunc: UINT;
pFrom: String;
pTo: String;
fFlags: Longint;
fAnyOperationsAborted: BOOL;
hNameMappings: Longint;
lpszProgressTitle: String;
end;
function SHFileOperation(var lpFileOp: SHFILEOPSTRUCT): Integer; external 'SHFileOperation{#A}@shell32.dll stdcall';
/////////////////////////////////////////////////////////////////////
function xcopy(const pFrom, pTo: String; const wFunc: UINT): Integer;
var
shfos: SHFILEOPSTRUCT;
begin
shfos.wFunc := wFunc;
shfos.pFrom := Format('%s'#0, [pFrom]);
shfos.pTo := Format('%s'#0, [pTo]);
shfos.fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_NOERRORUI;
Result := SHFileOperation(shfos);
end;
/////////////////////////////
procedure InitializeWizard();
begin
xcopy('C:\test', 'D:\backup', FO_MOVE);
end;
А совпадающих имен точно нет? »
Есть... но он не только их не перемещает. Попадет на совпадение папки или файла и понеслась... можно как-то его заставить заменять одинаковые файлы.
Johny777
21-11-2013, 07:24
Mat_y, вот накатал копирование файлов из папки куда-нибудь, возможностью перезаписи/пропуска и перемещения файлов в одной функции с опциональным отображением прогресса:
///////////////////////////////// File Mask Works ////////////////////////
const
ALL_FILES = '*';
BACKSLASH = '\';
type
_FILE_MASK = record
Parts: array of String;
PartsCount: Integer;
end;
_FILES_MASKS_SHOBLA = record
Masks: array of _FILE_MASK;
MasksCount: Integer;
end;
procedure Inc(var Int: Integer);
begin
Int := Int + 1;
end;
procedure Dec(var Int: Integer);
begin
Int := Int - 1;
end;
procedure IncEx(var Int: Extended; const Value: Extended);
begin
Int := Int + Value;
end;
procedure DecEx(var Int: Extended; const Value: Extended);
begin
Int := Int - Value;
end;
procedure AddFragmentToFileMask(const Fragment: String; var f: _FILE_MASK);
begin
Inc(f.PartsCount);
SetArrayLength(f.Parts, f.PartsCount);
f.Parts[f.PartsCount-1] := Fragment;
//MsgBox(IntToStr(f.PartsCount-1) + #13#10 + Fragment, mbError, MB_OK); // debug
end;
procedure SplitFileMask(const FileMask: String; out f: _FILE_MASK);
var
i, Len: Integer;
Fragment: String;
begin
Len := Length(FileMask);
Fragment := '';
for i := 1 to Len do
begin
if FileMask[i] = '*' then
begin
if Fragment <> '' then
begin
AddFragmentToFileMask(Fragment, f);
Fragment := '';
end;
Continue;
end;
Fragment := Fragment + FileMask[i];
end;
if Fragment <> '' then AddFragmentToFileMask(Fragment, f);
end;
procedure SplitFilesMasks(const FilesMasks: array of String; var f: _FILES_MASKS_SHOBLA);
var
i, Len: Integer;
begin
Len := GetArrayLength(FilesMasks);
for i := 0 to Len-1 do
begin
Inc(f.MasksCount);
SetArrayLength(f.Masks, f.MasksCount);
SplitFileMask(FilesMasks[i], f.Masks[f.MasksCount-1]);
end;
end;
function ThatFile(const uFileName: String; const f: _FILES_MASKS_SHOBLA): Boolean;
var
a, i: Integer;
begin
for a := 0 to f.MasksCount-1 do
begin
Result := True;
for i := 0 to f.Masks[a].PartsCount-1 do
Result := Result and ( Pos(f.Masks[a].Parts[i], uFileName) <> 0 );
if Result then Break;
end;
end;
function AllFiles(const Masks: array of String): Boolean;
var
Len: Integer;
begin
Len := GetArrayLength(Masks);
case Len of
0: Result := True;
1: Result := Masks[0] = ALL_FILES;
else
Result := False;
end;
end;
///////////////////////////////////////
//procedure Debug();
//var
// z: Byte;
// f: _FILES_MASKS_SHOBLA;
//begin
// SplitFilesMasks(['*Soft*.exe', '*Soft*a*.exe', 'Valve*.*', '*.e*', '*.exe'], f);
// if not ThatFile('hl2.avi', f) then MsgBox('no', mbInformation, MB_OK);
// if ThatFile('hl2.exe', f) then MsgBox('yes', mbInformation, MB_OK);
//end;
////////////////////////////////////////////////////////////////////////////////////////////
const
COLLECTING_INFO = 0;
IN_PROGRESS = 1;
FINISHED = -1;
UNDEF_INT = -1;
COPY_BLOCK_SIZE = 65536;
type
_FILE_INFO = record
FilePath: String;
Size: Extended;
end;
_FILE_CALLBACK =
function
(
const Msg: Integer; //сообщение статуса копирования
const srcFilePath: String; //путь к текущему исходному файлу
const dstFilePath: String; //путь к файлу назначения
const FileBytes: Extended; //размер текущего файла в байтах
const FileBytesCopied: Extended; //сколько байт текущего файла скопировано
const OverallBytes: Extended; //размер всех файлов в байтах
const OverallBytesCopied: Extended //сколько байт всех файлов скопировано
): Boolean; //чтоб отменить копирование нужно вернуть False
function QuadPart(const HighPart: Longint; const LowPart: DWORD): Extended;
begin
Result := HighPart * $80000000{2^32} + LowPart;
end;
procedure AddFileInfo
(
const uFileInfo: TFindRec;
const uFilePath: String;
var Files: array of _FILE_INFO;
var FilesCount: Integer
);
begin
Inc(FilesCount);
SetArrayLength(Files, FilesCount);
Files[FilesCount-1].FilePath := uFilePath + uFileInfo.Name;
Files[FilesCount-1].Size := QuadPart(uFileInfo.SizeHigh, uFileInfo.SizeLow);
end;
procedure FindFiles
(
const srcFolder: String;
const f: _FILES_MASKS_SHOBLA;
const FindAll: Boolean;
var Files: array of _FILE_INFO;
var FilesCount: Integer;
var Canceled: Boolean;
const CallBack: _FILE_CALLBACK
);
var
FileInfo: TFindRec;
begin
if FindFirst(srcFolder + '*', FileInfo) then
try
repeat
if Canceled then Break;
if (FileInfo.Name <> '.') and (FileInfo.Name <> '..') then
begin
if FileInfo.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
begin
if FindAll then
AddFileInfo(
FileInfo,
srcFolder,
Files,
FilesCount
)
else if ThatFile(FileInfo.Name, f) then
AddFileInfo(
FileInfo,
srcFolder,
Files,
FilesCount
);
if CallBack <> nil then
if not CallBack
(
COLLECTING_INFO,
Files[FilesCount-1].FilePath,
'',
Files[FilesCount-1].Size,
UNDEF_INT,
UNDEF_INT,
UNDEF_INT
) then
begin
Canceled := True;
Break;
end;
end else if FileInfo.Attributes and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then
FindFiles(
srcFolder + FileInfo.Name + BACKSLASH,
f,
FindAll,
Files,
FilesCount,
Canceled,
CallBack
);
end;
until not FindNext(FileInfo);
finally
FindClose(FileInfo);
end;
end;
function CountFilesSize(const Files: array of _FILE_INFO; const FilesCount: Integer): Extended;
var
i: Integer;
begin
Result := 0;
for i := 0 to FilesCount-1 do IncEx(Result, Files[i].Size);
end;
function GetNewFilePath(
const srcFolder: String;
const dstFolder: String;
const srcFilePath: String
): String; // returns dstFilePath
var
BuffFilePath: String;
begin
BuffFilePath := srcFilePath;
StringChange(BuffFilePath, srcFolder, '');
Result := dstFolder + BuffFilePath;
//MsgBox( 'srcFolder: ' + srcFolder + #13#10 +
// 'dstFolder: ' + dstFolder + #13#10 +
// 'srcFilePath: ' + srcFilePath + #13#10 +
// 'dstFilePath: ' + Result,
//mbInformation, MB_OK); // debug
end;
function CopyFiles(
const srcFolder: String; //путь, откуда копировать
const dstFolder: String; //путь, куда откуда копировать
const Masks: array of String; //массив масок файла, например: ['*Soft*.exe', '*Soft*a*.exe', 'Valve*.*', '*.e*', '*.exe']
const Overwrite: Boolean; //перезапись существующих файлов
const Move: Boolean; //активировать перемещение (после успешного копирования исходный файл будет удалён, включая папку, где он лежал, если она пустая)
const CallBack: _FILE_CALLBACK //указатель на функцию обратного вызова _FILE_CALLBACK или nil
): Boolean;
var
Files: array of _FILE_INFO;
f: _FILES_MASKS_SHOBLA;
FilesCount: Integer;
CopyAll: Boolean;
Canceled: Boolean;
OverallBytes, OverallBytesCopied: Extended;
srcFileStream, dstFileStream: TFileStream;
dstFilePath, srcFilePath: String;
i, CopyBytes, BytesLeft: Integer;
CurrentFileDir: String;
begin
Result := False;
if not DirExists(srcFolder) then Exit;
Canceled := False;
if CallBack <> nil then
if not CallBack(COLLECTING_INFO, '', '', UNDEF_INT, UNDEF_INT, UNDEF_INT, UNDEF_INT) then Exit;
CopyAll := AllFiles(Masks);
if not CopyAll then SplitFilesMasks(Masks, f);
FilesCount := 0;
FindFiles
(
AddBackslash(RemoveBackslash(srcFolder)),
f,
CopyAll,
Files,
FilesCount,
Canceled,
CallBack
);
if (FilesCount = 0) or Canceled then Exit;
OverallBytes := CountFilesSize(Files, FilesCount);
OverallBytesCopied := 0;
for i := 0 to FilesCount-1 do
begin
if Canceled then Break;
srcFilePath := Files[i].FilePath;
dstFilePath := GetNewFilePath(srcFolder, AddBackslash(RemoveBackslash(dstFolder)), srcFilePath);
if not Overwrite then if FileExists(dstFilePath) then Continue;
ForceDirectories(ExtractFilePath(dstFilePath));
srcFileStream := TFileStream.Create(srcFilePath, fmOpenRead);
dstFileStream := TFileStream.Create(dstFilePath, fmCreate);
BytesLeft := srcFileStream.Size - srcFileStream.Position;
CopyBytes := COPY_BLOCK_SIZE;
try
while BytesLeft > 0 do
begin
if BytesLeft < COPY_BLOCK_SIZE then CopyBytes := BytesLeft;
dstFileStream.CopyFrom(srcFileStream, CopyBytes);
BytesLeft := srcFileStream.Size-srcFileStream.Position;
IncEx(OverallBytesCopied, CopyBytes);
if CallBack <> nil then
if not CallBack
(
IN_PROGRESS,
srcFilePath,
dstFilePath,
Files[i].Size,
Files[i].Size - BytesLeft,
OverallBytes,
OverallBytesCopied
) then
begin
Canceled := True;
Break;
end;
end;
finally
srcFileStream.Free;
dstFileStream.Free;
if Canceled then
DeleteFile(dstFilePath);
if Move then
begin
DeleteFile(srcFilePath);
CurrentFileDir := ExtractFilePath(srcFilePath);
if CurrentFileDir <> srcFolder then
RemoveDir(CurrentFileDir); // removes dir if it us empty
end;
end;
end;
Result := not Canceled;
end;
//////////////////////////////////////////// demo //////////////////////////////////////////////////////////////////
var
MainCopyPrgBar,FileCopyPrgBar: TNewProgressBar;
function ____________________
(
const Msg: Integer;
const srcFilePath: String;
const dstFilePath: String;
const FileBytes: Extended;
const FileBytesCopied: Extended;
const OverallBytes: Extended;
const OverallBytesCopied: Extended
): Boolean;
begin
case Msg of
COLLECTING_INFO: WizardForm.Caption := srcFilePath;
IN_PROGRESS:
begin
WizardForm.Caption := FloatToStr(FileBytes) + #32#32 + FloatToStr(FileBytesCopied);
FileCopyPrgBar.Position := Round( (100*FileBytesCopied) / FileBytes );
MainCopyPrgBar.Position := Round( (100*OverallBytesCopied) / OverallBytes );
end;
FINISHED: MsgBox('Finish! :)', mbInformation, MB_OK);
end;
Application.ProcessMessages;
Result := not Application.Terminated;
end;
procedure ButtonClick(Sender: TObject);
begin
CopyFiles('C:\Program Files (x86)\Source Engine 15\common\half-life 2\', 'C:\test',[], True, False, @____________________);
end;
procedure InitializeWizard();
begin
WizardForm.OuterNotebook.Hide;
WizardForm.Canvas.Brush.Style := bsClear;
MainCopyPrgBar := TNewProgressBar.Create(nil);
with MainCopyPrgBar do
begin
Parent:= WizardForm;
SetBounds(ScaleX(5), ScaleY(5), WizardForm.ClientWidth-10, ScaleY(20));
end;
FileCopyPrgBar := TNewProgressBar.Create(nil);
with FileCopyPrgBar do
begin
Parent:= WizardForm;
SetBounds(ScaleX(5), ScaleY(30), WizardForm.ClientWidth-10, ScaleY(20));
end;
with TButton.Create(WizardForm) do
begin
Parent:= WizardForm;
Left := ScaleX(0);
Top := ScaleY(200);
Width := ScaleY(150);
Caption:='Copy';
OnClick:=@ButtonClick;
end;
end;
справка по заголовкам:
function CopyFiles(
const srcFolder: String; //путь, откуда копировать
const dstFolder: String; //путь, куда откуда копировать
const Masks: array of String; //массив масок файла, например: ['*Soft*.exe', '*Soft*a*.exe', 'Valve*.*', '*.e*', '*.exe']
const Overwrite: Boolean; //перезапись существующих файлов
const Move: Boolean; //активировать перемещение (после успешного копирования исходный файл будет удалён, включая папку, где он лежал, если она пустая)
const CallBack: _FILE_CALLBACK //указатель на функцию обратного вызова _FILE_CALLBACK или nil
): Boolean;
type
_FILE_CALLBACK =
function
(
const Msg: Integer; //сообщение статуса копирования
const srcFilePath: String; //путь к текущему исходному файлу
const dstFilePath: String; //путь к файлу назначения
const FileBytes: Extended; //размер текущего файла в байтах
const FileBytesCopied: Extended; //сколько байт текущего файла скопировано
const OverallBytes: Extended; //размер всех файлов в байтах
const OverallBytesCopied: Extended //сколько байт всех файлов скопировано
): Boolean; //чтоб отменить копирование нужно вернуть False
El Sanchez, кажись ему надо по маске копировать (судя по коду) ;)
Mat_y, Пример переноса на новую форму (пригодится):
[Setup]
AppName=My Program
AppVersion=1.5
DefaultDirName={pf}\My Program
DefaultGroupName=My Program
OutputDir=.
[Code]
var
ISCustomPage1: TWizardPage;
///////////////////////////////// File Mask Works ////////////////////////
const
ALL_FILES = '*';
BACKSLASH = '\';
type
_FILE_MASK = record
Parts: array of String;
PartsCount: Integer;
end;
_FILES_MASKS_SHOBLA = record
Masks: array of _FILE_MASK;
MasksCount: Integer;
end;
procedure Inc(var Int: Integer);
begin
Int := Int + 1;
end;
procedure Dec(var Int: Integer);
begin
Int := Int - 1;
end;
procedure IncEx(var Int: Extended; const Value: Extended);
begin
Int := Int + Value;
end;
procedure DecEx(var Int: Extended; const Value: Extended);
begin
Int := Int - Value;
end;
procedure AddFragmentToFileMask(const Fragment: String; var f: _FILE_MASK);
begin
Inc(f.PartsCount);
SetArrayLength(f.Parts, f.PartsCount);
f.Parts[f.PartsCount-1] := Fragment;
//MsgBox(IntToStr(f.PartsCount-1) + #13#10 + Fragment, mbError, MB_OK); // debug
end;
procedure SplitFileMask(const FileMask: String; out f: _FILE_MASK);
var
i, Len: Integer;
Fragment: String;
begin
Len := Length(FileMask);
Fragment := '';
for i := 1 to Len do
begin
if FileMask[i] = '*' then
begin
if Fragment <> '' then
begin
AddFragmentToFileMask(Fragment, f);
Fragment := '';
end;
Continue;
end;
Fragment := Fragment + FileMask[i];
end;
if Fragment <> '' then AddFragmentToFileMask(Fragment, f);
end;
procedure SplitFilesMasks(const FilesMasks: array of String; var f: _FILES_MASKS_SHOBLA);
var
i, Len: Integer;
begin
Len := GetArrayLength(FilesMasks);
for i := 0 to Len-1 do
begin
Inc(f.MasksCount);
SetArrayLength(f.Masks, f.MasksCount);
SplitFileMask(FilesMasks[i], f.Masks[f.MasksCount-1]);
end;
end;
function ThatFile(const uFileName: String; const f: _FILES_MASKS_SHOBLA): Boolean;
var
a, i: Integer;
begin
for a := 0 to f.MasksCount-1 do
begin
Result := True;
for i := 0 to f.Masks[a].PartsCount-1 do
Result := Result and ( Pos(f.Masks[a].Parts[i], uFileName) <> 0 );
if Result then Break;
end;
end;
function AllFiles(const Masks: array of String): Boolean;
var
Len: Integer;
begin
Len := GetArrayLength(Masks);
case Len of
0: Result := True;
1: Result := Masks[0] = ALL_FILES;
else
Result := False;
end;
end;
///////////////////////////////////////
//procedure Debug();
//var
// z: Byte;
// f: _FILES_MASKS_SHOBLA;
//begin
// SplitFilesMasks(['*Soft*.exe', '*Soft*a*.exe', 'Valve*.*', '*.e*', '*.exe'], f);
// if not ThatFile('hl2.avi', f) then MsgBox('no', mbInformation, MB_OK);
// if ThatFile('hl2.exe', f) then MsgBox('yes', mbInformation, MB_OK);
//end;
////////////////////////////////////////////////////////////////////////////////////////////
const
COLLECTING_INFO = 0;
IN_PROGRESS = 1;
FINISHED = -1;
UNDEF_INT = -1;
COPY_BLOCK_SIZE = 65536;
type
_FILE_INFO = record
FilePath: String;
Size: Extended;
end;
_FILE_CALLBACK =
function
(
const Msg: Integer; //сообщение статуса копирования
const srcFilePath: String; //путь к текущему исходному файлу
const dstFilePath: String; //путь к файлу назначения
const FileBytes: Extended; //размер текущего файла в байтах
const FileBytesCopied: Extended; //сколько байт текущего файла скопировано
const OverallBytes: Extended; //размер всех файлов в байтах
const OverallBytesCopied: Extended //сколько байт всех файлов скопировано
): Boolean; //чтоб отменить копирование нужно вернуть False
function QuadPart(const HighPart: Longint; const LowPart: DWORD): Extended;
begin
Result := HighPart * $80000000{2^32} + LowPart;
end;
procedure AddFileInfo
(
const uFileInfo: TFindRec;
const uFilePath: String;
var Files: array of _FILE_INFO;
var FilesCount: Integer
);
begin
Inc(FilesCount);
SetArrayLength(Files, FilesCount);
Files[FilesCount-1].FilePath := uFilePath + uFileInfo.Name;
Files[FilesCount-1].Size := QuadPart(uFileInfo.SizeHigh, uFileInfo.SizeLow);
end;
procedure FindFiles
(
const srcFolder: String;
const f: _FILES_MASKS_SHOBLA;
const FindAll: Boolean;
var Files: array of _FILE_INFO;
var FilesCount: Integer;
var Canceled: Boolean;
const CallBack: _FILE_CALLBACK
);
var
FileInfo: TFindRec;
begin
if FindFirst(srcFolder + '*', FileInfo) then
try
repeat
if Canceled then Break;
if (FileInfo.Name <> '.') and (FileInfo.Name <> '..') then
begin
if FileInfo.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
begin
if FindAll then
AddFileInfo(
FileInfo,
srcFolder,
Files,
FilesCount
)
else if ThatFile(FileInfo.Name, f) then
AddFileInfo(
FileInfo,
srcFolder,
Files,
FilesCount
);
if CallBack <> nil then
if not CallBack
(
COLLECTING_INFO,
Files[FilesCount-1].FilePath,
'',
Files[FilesCount-1].Size,
UNDEF_INT,
UNDEF_INT,
UNDEF_INT
) then
begin
Canceled := True;
Break;
end;
end else if FileInfo.Attributes and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then
FindFiles(
srcFolder + FileInfo.Name + BACKSLASH,
f,
FindAll,
Files,
FilesCount,
Canceled,
CallBack
);
end;
until not FindNext(FileInfo);
finally
FindClose(FileInfo);
end;
end;
function CountFilesSize(const Files: array of _FILE_INFO; const FilesCount: Integer): Extended;
var
i: Integer;
begin
Result := 0;
for i := 0 to FilesCount-1 do IncEx(Result, Files[i].Size);
end;
function GetNewFilePath(
const srcFolder: String;
const dstFolder: String;
const srcFilePath: String
): String; // returns dstFilePath
var
BuffFilePath: String;
begin
BuffFilePath := srcFilePath;
StringChange(BuffFilePath, srcFolder, '');
Result := dstFolder + BuffFilePath;
//MsgBox( 'srcFolder: ' + srcFolder + #13#10 +
// 'dstFolder: ' + dstFolder + #13#10 +
// 'srcFilePath: ' + srcFilePath + #13#10 +
// 'dstFilePath: ' + Result,
//mbInformation, MB_OK); // debug
end;
function CopyFiles(
const srcFolder: String; //путь, откуда копировать
const dstFolder: String; //путь, куда откуда копировать
const Masks: array of String; //массив масок файла, например: ['*Soft*.exe', '*Soft*a*.exe', 'Valve*.*', '*.e*', '*.exe']
const Overwrite: Boolean; //перезапись существующих файлов
const Move: Boolean; //активировать перемещение (после успешного копирования исходный файл будет удалён, включая папку, где он лежал, если она пустая)
const CallBack: _FILE_CALLBACK //указатель на функцию обратного вызова _FILE_CALLBACK или nil
): Boolean;
var
Files: array of _FILE_INFO;
f: _FILES_MASKS_SHOBLA;
FilesCount: Integer;
CopyAll: Boolean;
Canceled: Boolean;
OverallBytes, OverallBytesCopied: Extended;
srcFileStream, dstFileStream: TFileStream;
dstFilePath, srcFilePath: String;
i, CopyBytes, BytesLeft: Integer;
CurrentFileDir: String;
begin
Result := False;
if not DirExists(srcFolder) then Exit;
Canceled := False;
if CallBack <> nil then
if not CallBack(COLLECTING_INFO, '', '', UNDEF_INT, UNDEF_INT, UNDEF_INT, UNDEF_INT) then Exit;
CopyAll := AllFiles(Masks);
if not CopyAll then SplitFilesMasks(Masks, f);
FilesCount := 0;
FindFiles
(
AddBackslash(RemoveBackslash(srcFolder)),
f,
CopyAll,
Files,
FilesCount,
Canceled,
CallBack
);
if (FilesCount = 0) or Canceled then Exit;
OverallBytes := CountFilesSize(Files, FilesCount);
OverallBytesCopied := 0;
for i := 0 to FilesCount-1 do
begin
if Canceled then Break;
srcFilePath := Files[i].FilePath;
dstFilePath := GetNewFilePath(srcFolder, AddBackslash(RemoveBackslash(dstFolder)), srcFilePath);
if not Overwrite then if FileExists(dstFilePath) then Continue;
ForceDirectories(ExtractFilePath(dstFilePath));
srcFileStream := TFileStream.Create(srcFilePath, fmOpenRead);
dstFileStream := TFileStream.Create(dstFilePath, fmCreate);
BytesLeft := srcFileStream.Size - srcFileStream.Position;
CopyBytes := COPY_BLOCK_SIZE;
try
while BytesLeft > 0 do
begin
if BytesLeft < COPY_BLOCK_SIZE then CopyBytes := BytesLeft;
dstFileStream.CopyFrom(srcFileStream, CopyBytes);
BytesLeft := srcFileStream.Size-srcFileStream.Position;
IncEx(OverallBytesCopied, CopyBytes);
if CallBack <> nil then
if not CallBack
(
IN_PROGRESS,
srcFilePath,
dstFilePath,
Files[i].Size,
Files[i].Size - BytesLeft,
OverallBytes,
OverallBytesCopied
) then
begin
Canceled := True;
Break;
end;
end;
finally
srcFileStream.Free;
dstFileStream.Free;
if Canceled then
DeleteFile(dstFilePath);
if Move then
begin
DeleteFile(srcFilePath);
CurrentFileDir := ExtractFilePath(srcFilePath);
if CurrentFileDir <> srcFolder then
RemoveDir(CurrentFileDir); // removes dir if it us empty
end;
end;
end;
Result := not Canceled;
end;
//////////////////////////////////////////// demo //////////////////////////////////////////////////////////////////
var
MainCopyPrgBar,FileCopyPrgBar: TNewProgressBar;
function ____________________
(
const Msg: Integer;
const srcFilePath: String;
const dstFilePath: String;
const FileBytes: Extended;
const FileBytesCopied: Extended;
const OverallBytes: Extended;
const OverallBytesCopied: Extended
): Boolean;
begin
case Msg of
COLLECTING_INFO: WizardForm.Caption := srcFilePath;
IN_PROGRESS:
begin
WizardForm.Caption := FloatToStr(FileBytes) + #32#32 + FloatToStr(FileBytesCopied);
FileCopyPrgBar.Position := Round( (100*FileBytesCopied) / FileBytes );
MainCopyPrgBar.Position := Round( (100*OverallBytesCopied) / OverallBytes );
end;
FINISHED: MsgBox('Finish! :)', mbInformation, MB_OK);
end;
Application.ProcessMessages;
Result := not Application.Terminated;
end;
procedure ButtonClick(Sender: TObject);
begin
CopyFiles('C:\Program Files (x86)\Source Engine 15\common\half-life 2\', 'C:\test',[], True, False, @____________________);
end;
procedure InitializeWizard();
begin
ISCustomPage1 := CreateCustomPage(wpInfoBefore, 'Копирование', 'Будем копировать?');
// WizardForm.OuterNotebook.Hide;
WizardForm.Canvas.Brush.Style := bsClear;
MainCopyPrgBar := TNewProgressBar.Create(nil);
with MainCopyPrgBar do
begin
Parent := ISCustomPage1.Surface;
SetBounds(ScaleX(5), ScaleY(5), WizardForm.ClientWidth-85, ScaleY(20));
end;
FileCopyPrgBar := TNewProgressBar.Create(nil);
with FileCopyPrgBar do
begin
Parent := ISCustomPage1.Surface;
SetBounds(ScaleX(5), ScaleY(30), WizardForm.ClientWidth-85, ScaleY(20));
end;
with TButton.Create(WizardForm) do
begin
Parent := ISCustomPage1.Surface;
Left := ScaleX(5);
Top := ScaleY(200);
Width := ScaleY(150);
Caption:='Copy';
OnClick:=@ButtonClick;
end;
end;
заменять одинаковые файлы »
Используя MoveFile(const srcFile, destFile: PChar): Integer - нет. Эта функция, если destFile файл существует, работать не будет. Из вариантов - копирование вместо перемещения
function CopyFile(const srcFile, destFile: PansiChar, FailIfExists: boolean): Integer;
external 'CopyFileA@kernel32.dll stdcall'; //если FailIfExists=false, то файл перезапишется
.
Или перемещение вот-так
function MoveFileEx(const srcFile, destFile: PansiChar, dwFlags: DWORD): Integer;
external 'MoveFileExA@kernel32.dll stdcall'; // если dwFlags=1 (MOVEFILE_REPLACE_EXISTING), то файл тоже перезапишется
Подробнее про все эти функции можно читать например на msdn http://msdn.microsoft.com/en-us/library/windows/desktop/aa365240(v=vs.85).aspx
Но по-моему эти функции могут не работать, если исходный и конечный файлы находятся на разных дисках.
Или просто используй то, что ребята насоветовали :)
FX-DENIS
21-11-2013, 13:24
El Sanchez,Johny777 здарова. У меня проблемки появились странные.Совместил фри арк и скрипт процентов и размера который мне давал Serega.Но вот беда,прогресс бар не отображается
http://x.picp2.com/allimage/666/665536-thumb.jpeg (http://picp2.com/15264/665536/)
Если изменить на ssPostInstall в скрипте if CurStep = ssInstall then begin //Если необходимо, можно поменять на ssPostInstall
то прогресс бар есть,но тогда сначала устанавливаются все ярлыки и файлы инно,а потом архивы распаковываются.
Связанно это все со строчкой
if CurStep = ssInstall then begin //Если необходимо, можно поменять на ssPostInstall
WizardForm.ProgressGauge.Hide;
WizardForm.CancelButton.Hide;
CreateControls;
WizardForm.StatusLabel.Caption:=ExpandConstant('{cm:Extracted}');
ISDoneCancel:=0;
Убираю строчку WizardForm.ProgressGauge.Hide; ,и получается что прогресс бар инно под баром фри арк вылазит,но после распаковки фри арк нормально отображается.
http://x.picp2.com/allimage/666/665537-thumb.jpeg (http://picp2.com/15264/665537/)
Я тогда пошел на хитрость и подогнал прогресс бар под бар фри арка по размерам и получилось его как бы не видно.Но это не решение,это по армянски))может есть решение проще,как отображать прогресс бар нормально при if CurStep = ssInstall?
Вторая проблемка
http://x.picp2.com/allimage/666/665538-thumb.jpeg (http://picp2.com/15264/665538/)
прогресс бар инно именно инно ,не фри арка,показывается 103% а не 100,как это исправить?
Третья проблемка инно не учитывает архивы фри арк и пишет размер только инно,как заставить писать размер места для установки правильно?Смысл тогда в строке #define NeedSize "5000000000" ?
http://x.picp2.com/allimage/666/665539-thumb.jpeg (http://picp2.com/15264/665539/)
Из вариантов - копирование вместо перемещения
Код:
function CopyFile(const srcFile, destFile: PansiChar, FailIfExists: boolean): Integer;
external 'CopyFileA@kernel32.dll stdcall'; //если FailIfExists=false, то файл перезапишется
.
Или перемещение вот-так
Код:
function MoveFileEx(const srcFile, destFile: PansiChar, dwFlags: DWORD): Integer;
external 'MoveFileExA@kernel32.dll stdcall'; // если dwFlags=1 (MOVEFILE_REPLACE_EXISTING), то файл тоже перезапишется »
Я попробовал оба варианта... все равно натыкается на существующий фаил и стопорится.
© OSzone.net 2001-2012
vBulletin v3.6.4, Copyright ©2000-2025, Jelsoft Enterprises Ltd.