Diskuze: Kopirovanie suborov aj z priecinkami
Zobrazeno 4 zpráv z 4.
kod vyzera asi takto neako
procedure GatherFilesFromDirectory(const ADirectory: String;
var AFileList: TStringList; out ATotalSize: Int64);
var
SR: TSearchRec;
begin
if FindFirst(ADirectory + '\*.*', faDirectory, SR) = 0 then
begin
repeat
if ((SR.Attr and faDirectory) = SR.Attr) and (SR.Name <> '.') and
(SR.Name <> '..') then
GatherFilesFromDirectory(ADirectory + '\' + SR.Name, AFileList,
ATotalSize);
until FindNext(SR) <> 0;
FindClose(SR);
end;
if FindFirst(ADirectory + '\*.*', 0, SR) = 0 then
begin
repeat
AFileList.Add(ADirectory + '\' + SR.Name);
Inc(ATotalSize, SR.Size);
until FindNext(SR) <> 0;
FindClose(SR);
end;
end;
procedure CopyFileWithProgress(const AFrom, ATo: String;
var AProgress: TProgressBar);
var
FromF, ToF: file;
NumRead, NumWritten, DataSize: integer;
Buf: array [1 .. 2048] of Char;
begin
try
DataSize := SizeOf(Buf);
AssignFile(FromF, AFrom);
Reset(FromF, 1);
AssignFile(ToF, ATo);
Rewrite(ToF, 1);
repeat
BlockRead(FromF, Buf, DataSize, NumRead);
BlockWrite(ToF, Buf, NumRead, NumWritten);
if Assigned(AProgress) then
begin
AProgress.Position := AProgress.Position + DataSize;
Application.ProcessMessages;
end;
until (NumRead = 0) or (NumWritten <> NumRead);
finally
CloseFile(FromF);
CloseFile(ToF);
end;
end;
procedure TForm2.btnCopyClick(Sender: TObject);
var
Filelist: TStringList;
TotalSize: Int64;
i: integer;
begin
TotalSize := 0;
Filelist := TStringList.Create;
Timer1.Enabled := True;
Timer1.Interval := i_Spolu;
Timer2.Enabled := True;
if directoryexists(Edit2.Text) then
else
CreateDir(Edit2.Text);
try
GatherFilesFromDirectory(Edit1.Text, Filelist, TotalSize);
ProgressBar1.Position := 0;
ProgressBar1.Max := TotalSize;
Label1.Caption := Hodin + ':' + Minut + ':' + Sekund;
for i := 0 to Filelist.Count - 1 do
begin
CopyFileWithProgress(Filelist[i], Edit2.Text + '\' +
ExtractFileName(Filelist[i]), ProgressBar1);
end;
finally
Filelist.Free;
end;
end;
ale nevytvori mi ten priecinok
Protože nedáš příkaz k vytvoření toho adresáře. Pro tebe asi nejjednodušší řešení (tzn. nejmenší úprava kódu) bude přidat na začátek CopyFileWithProgress přidat pár řádek
If Not DirectoryExists(ATo) Then
ForceDirectories(ExtractFileDir(ATo));Obvykle ale nemá smysl si nejprve vytvářet seznam souborů a následně je až pak kopírovat... protože jich může být opravdu hodně. Pokud chceš mít kopírování se signalizací průběhu, můžeš nejprve celou strukturu souborů projít a spočítat velikost, následně ji pak procházet znovu a postupně kopírovat. Znát seznam souborů dopředu obecně nepotřebuješ.
A Application.ProcessMessages je poměrně ošklivý způsob, jak předstírat, že GUI nezamrzlo... ale to už s kopírováním nemá vůbec nic společného.
Zobrazeno 4 zpráv z 4.