Ветеран
Сообщения: 649
Благодарности: 444
|
Профиль
|
Отправить PM
| Цитировать
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, кажись ему надо по маске копировать (судя по коду) 
|
