Ветеран
Сообщения: 649
Благодарности: 444
|
Профиль
|
Отправить PM
| Цитировать
Mat_y,
Цитата Mat_y:
|
Я попробовал оба варианта... все равно натыкается на существующий фаил и стопорится. »
|
Цитата Mat_y:
|
Сломался на всем этом... пытался, но не осилил. »
|
Кошмар! 
Давай по порядку.
Функция вчера почти весь вечер, а ночью дописывалась, хотя это я мог бы и быстрее, но, тк цель одна - максимальная скорость, функциональность и качество,
в ней собственная система определения нужного файла для копирования - это вспомогательные функции из раздела "File Mask Works",
из которых непосредственно во время копирования работает только "ThatFile", для того чтобы найти и в последствии копировать в один цикл прохода по выбранной папке, чтоб
не насиловать ж. диск в количестве длиной с массив масок, как в коде у тебя из сообщения:
for i:=0 to GetArrayLength(MyFiles)-1 do ..., где MyFiles - массив строк (масок поиска)
Перед тем как выложить функцию я её протестировал, хотя составные её части тестировались ещё по мере написания, там где приписано "debug"
Но замечу: я её не перегружал (далее опишу чем), тк не знал насколько это может быть необходимо, тк думал, что тот код которым ты пользуешься не особо хорошо работает.
(не люблю я исправлять, мне проще переписать и потому код твой не брал. Только глянул в чём его назначение)
Те целью было рабочее копирование/перемещение!
"натыкается на существующий фаил и стопорится" может по двум известным мне причинам, если ты конечно папку винды не переносишь
1. у файла (который заменяем в папке назначения) свойство "Только чтение"
2. файл держит какой-то процесс
3. хз
эти 3 возможности в коде не учтены, как сказано выше
вывод: дело не в том коде, каким ты пользовался, а в тех самых файлах, которые есть только у тебя, так что нужно максимальное кол-во информации с твоей стороны!
UPD:
вот местами исправленный, улучшенный и дополненный код:
добавлена работа с файлами защиты от изменений ( Read only )
изменён прототип функции. Теперь туда отправляем флаги
SET_OVERWRITE_EXISTING_FILES = 2;
SET_MOVE_FILES = 4;
SET_PROCESS_READONLY_FILES = 8;
читать дальше »
Код:  [Code]
///////////////////////////////// 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;
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;
////////////////////////////////////////////////////////////////////////////////////////////
const
COPY_COLLECTING_INFO = 0;
COPY_IN_PROGRESS = 1;
COPY_FINISHED = -1;
SET_OVERWRITE_EXISTING_FILES = 2;
SET_MOVE_FILES = 4;
SET_PROCESS_READONLY_FILES = 8;
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 + ALL_FILES, 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
begin
AddFileInfo(FileInfo, srcFolder, Files, FilesCount);
if CallBack <> nil then
if not CallBack
(
COPY_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 ThatFile(FileInfo.Name, f) then
begin
AddFileInfo(FileInfo, srcFolder, Files, FilesCount);
if CallBack <> nil then
if not CallBack
(
COPY_COLLECTING_INFO,
Files[FilesCount-1].FilePath,
'',
Files[FilesCount-1].Size,
UNDEF_INT,
UNDEF_INT,
UNDEF_INT
) then
begin
Canceled := True;
Break;
end;
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;
end;
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
function SetFileAttributes(lpFileName: String; dwFileAttributes: DWORD): BOOL; external 'SetFileAttributes{#A}@kernel32.dll stdcall';
function GetFileAttributes(lpFileName: PAnsiChar): DWORD; external 'GetFileAttributes{#A}@kernel32.dll stdcall';
function CopyFiles(
const srcFolder: String; //путь, откуда копировать
const dstFolder: String; //путь, куда откуда копировать
const Masks: array of String; //массив масок файла, например: ['*Soft*.exe', '*Soft*a*.exe', 'Valve*.*', '*.e*', '*.exe']
const dwOptions: DWORD;
const CallBack: _FILE_CALLBACK //указатель на функцию обратного вызова _FILE_CALLBACK или nil
): Boolean;
var
Files: array of _FILE_INFO;
f: _FILES_MASKS_SHOBLA;
FilesCount: Integer;
CopyAll: Boolean;
Canceled: Boolean;
ReadOnlyOff, ReadOnlyFile: 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;
ReadOnlyFile := False;
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;
if CallBack <> nil then
begin
OverallBytes := CountFilesSize(Files, FilesCount);
OverallBytesCopied := 0;
end;
for i := 0 to FilesCount-1 do
begin
if Canceled then Break;
srcFilePath := Files[i].FilePath;
dstFilePath := GetNewFilePath(srcFolder, AddBackslash(RemoveBackslash(dstFolder)), srcFilePath);
if dwOptions and SET_OVERWRITE_EXISTING_FILES = 0 then
if FileExists(dstFilePath) then Continue;
if dwOptions and SET_PROCESS_READONLY_FILES = SET_PROCESS_READONLY_FILES then
if FileExists(dstFilePath) then
if (GetFileAttributes(dstFilePath) and FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY then
begin
ReadOnlyFile := True;
ReadOnlyOff := SetFileAttributes(dstFilePath, FILE_ATTRIBUTE_NORMAL);
if not ReadOnlyOff then
begin
Canceled := True;
Break;
end;
end;
if not ForceDirectories(ExtractFilePath(dstFilePath)) then
begin
Canceled := True;
Break;
end;
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
(
COPY_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 ReadOnlyFile then
begin
ReadOnlyOff := not SetFileAttributes(dstFilePath, FILE_ATTRIBUTE_READONLY);
if ReadOnlyOff then
Canceled := True
else
ReadOnlyFile := False;
end;
if Canceled then
DeleteFile(dstFilePath);
if dwOptions and SET_MOVE_FILES = SET_MOVE_FILES then
begin
DeleteFile(srcFilePath);
CurrentFileDir := ExtractFilePath(srcFilePath);
if CurrentFileDir <> srcFolder then
RemoveDir(CurrentFileDir); // removes dir if it is empty
end;
end;
end;
Result := not Canceled;
if Result then
if CallBack <> nil then
CallBack(COPY_FINISHED, '', '', UNDEF_INT, UNDEF_INT, UNDEF_INT, UNDEF_INT);
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
COPY_IN_PROGRESS:
begin
WizardForm.Caption := FloatToStr(FileBytes) + #32#32 + FloatToStr(FileBytesCopied);
FileCopyPrgBar.Position := Round( (100*FileBytesCopied) / FileBytes );
MainCopyPrgBar.Position := Round( (100*OverallBytesCopied) / OverallBytes );
end;
COPY_FINISHED: MsgBox('Finish! :)', mbInformation, MB_OK);
end;
Application.ProcessMessages;
Result := not Application.Terminated;
end;
procedure ButtonClick(Sender: TObject);
begin
CopyFiles('C:\src\', 'C:\test',['*'], SET_PROCESS_READONLY_FILES or SET_OVERWRITE_EXISTING_FILES, @____________________);
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;
пробуй!
|
