NOVINKA: Kurz kybernetické bezpečnosti s akreditací MŠMT, nyní již od 0 Kč. Staň se žádaným profesionálem. Zjisti více:
Avatar
28tomino
Člen
Avatar
28tomino:15.8.2016 16:00

Zdravim, vie mi niekto poradit, ked kopirujem subory z priecinka v ktorom sa nachadza dalsi priecinok, tak mi skopiruje vsetky subory aj subory z toho priecinka ale nevytvori mi ten priecinok.

 
Odpovědět
15.8.2016 16:00
Avatar
28tomino
Člen
Avatar
28tomino:15.8.2016 16:32

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;
 
Nahoru Odpovědět
15.8.2016 16:32
Avatar
Martin Dráb
Tvůrce
Avatar
Odpovídá na 28tomino
Martin Dráb:15.8.2016 17:20

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 CopyFileWithPro­gress 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.Pro­cessMessages 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.

Nahoru Odpovědět
15.8.2016 17:20
2 + 2 = 5 for extremely large values of 2
Avatar
28tomino
Člen
Avatar
28tomino:15.8.2016 18:42

Dakujem za odpoved, ale aj tak mi to nevytvori tie "vnorene priecinky", co sa tyka toho kodu, je to tak trochu prasacina.

 
Nahoru Odpovědět
15.8.2016 18:42
Děláme co je v našich silách, aby byly zdejší diskuze co nejkvalitnější. Proto do nich také mohou přispívat pouze registrovaní členové. Pro zapojení do diskuze se přihlas. Pokud ještě nemáš účet, zaregistruj se, je to zdarma.

Zobrazeno 4 zpráv z 4.