Copy dir inkl progressbar

Altså i bund og grund:

Copy *.* (inkl subdirs) fra Path1 til Path2, og vise progressbar for kopieringen.

Jeg går ud fra at den også skal kontrollere om Path2 eksisterer, og hvis ikke, så oprette mappen.. Og hvad hvis der i forvejen ligger filer med samme navne - kan de overskrives med "de nye"?

Jeg er villig til at spæde godt i kassen med point, hvis en vil hjælpe mig til mål med dette :D

/jack

Hvis du vil have en bar længden af alle filer så skal du først indsamle oplysninger om alle de filer der skal kopieres for at vide hvor mange bytes der er total. Og hvis du vil have en bar for den enkelte fil så skal du lave din egen kopi funktion. Altså en bar for kopieret total og en anden bar for aktuelle fil der kopieres.
Jeg fik engang en mp3 afspiller og så lavede jeg et lille program der tog tilfældige mp3 filer fra min harddisk og lage over på afspilleren, koden kan måske give dig nogle ideer. Programmet samler alle mp3 filer fra en bestemt mappe og alle undermapper inden kopieringen starter.

unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;

type
  TMainForm = class(TForm)
    FileList: TMemo;
    BtnStart: TBitBtn;
    LabelAntal: TLabel;
    OverfortList: TMemo;
    LabelOverfort: TLabel;
    BtnStop: TBitBtn;
    procedure BtnStartClick(Sender: TObject);
    procedure BtnStopClick(Sender: TObject);
  private
    { Private declarations }
    procedure Findfiler;
    procedure KopierFiler;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  DoStop : boolean = false;

const
    Mp3Target = 'J:\';
  Mp3Source = 'D:\Mp3\Musik\';

implementation

{$R *.dfm}

procedure TMainForm.Findfiler;

procedure Start(Sti : string);
var
    Rec    : tsearchrec;
  FindResult    : integer;
begin
    FindResult:=FindFirst(Sti+'*.*',faAnyFile    ,Rec);
    while FindResult=0 do
    begin
        if (Rec.Attr=faDirectory) and (Rec.Name<>'.') and (Rec.Name<>'..') then
        Start(Sti+Rec.Name+'\')
    else
    begin
        if UpperCase(ExtractFileExt(Rec.Name))='.MP3' then
                FileList.Lines.Add(Sti+Rec.Name);
      end;
    FindResult:=FindNext(Rec);
    end;
    FindClose(Rec);
end;

begin
    FileList.Clear;
  OverfortList.Clear;

    FileList.Lines.Text:='Henter filer...';
  FileList.Update;
  FileList.Lines.BeginUpdate;
    Start(Mp3Source);
  FileList.Lines.EndUpdate;
  FileList.Lines.Delete(0);
 
  LabelAntal.Caption:='Total antal: '+Inttostr(FileList.Lines.Count);
end;

procedure TMainForm.KopierFiler;
var
    i : integer;
  Filnavn : string;
  CopyResult : boolean;
begin
    OverfortList.Lines.Add(datetimetostr(now));
    Randomize;
    repeat
      i:=Random(FileList.Lines.Count);
      Filnavn:=FileList.Lines[i];
    FileList.Lines.Delete(i);

    CopyResult:=CopyFile(PChar(Filnavn),PChar(Mp3Target+ExtractFileName(Filnavn)),true);
      OverfortList.Lines.Add(ExtractFileName(Filnavn));
        LabelOverfort.Caption:='Overført: '+Inttostr(OverfortList.Lines.Count);

    Application.ProcessMessages;
    until (DoStop) or (not CopyResult) {or (OverfortList.Lines.Count=10)};
  OverfortList.Lines.Add(datetimetostr(now));
end;

procedure TMainForm.BtnStartClick(Sender: TObject);
begin
    FindFiler;
  KopierFiler;
end;

procedure TMainForm.BtnStopClick(Sender: TObject);
begin
    DoStop:=true;
end;

end.

Nu er jeg meget lidt Delphi haj (for at sige det mildt) så jeg kan ikke lige hitte hovede og hale i det der..

Er det muligt at få et funktionelt eksempel? :)

Jeg kan lave et eks. i morgen hvis ikke andre kommer først.

Se evt. her: http://www.delphicorner.f9.co.uk/articles/misc4.htm

Hvis du er tilfreds med Windows progressbar kan du bruge denne

Uses shellApi;

function KopierMappe(Kilde, Destination: string): LongInt;
var
  F: TShFileOpStruct;
  //sKilde, sDestination: string;
begin
  Result := 0;
  Kilde := Kilde + #0;
  Destination := Destination + #0;

  with F do
  begin
    Application.ProcessMessages;
    Wnd := Application.Handle;
    wFunc := FO_COPY;
    pFrom := @Kilde[1];
    pTo := @Destination[1];
    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
  end;

  Result := ShFileOperation(F);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
KopierMappe('c:\en mappe','d:\kopi af mappen');
end;

kroning: jeg ville blive _meget_ glad for et eksempel :)

For lige at opsummere..:

Jeg har et SourceDir (fx "c:\documents and settings\mig\", alt i denne mappe inkl. subdirs m.v. vil jeg gerne kopiere til DestDir (fx "e:\backup\"), samtidig med kopieringen gøres synlig med en progressbar (eller gauge).

Hvis der i forvejen er nogen filer i e:\backup\, skal de bare overskrives..

Mvh
/jack :)

Du kan hente eks. her:
http://www.kroning.dk/Kopi.zip

Jeg har brugt kopi funktionen fra siden:
http://www.delphicorner.f9.co.uk/articles/misc4.htm

Det er verdensklasse kroning.. præcis det jeg eftersøgte!! :D

Men.. Jeg får denne fejl når kopieringen når til en fil som er i brug:

First chance exception at $7C81EB33. Exception class EFOpenError with message 'Cannot open file "C:\Documents and Settings\John Doe\Cookies\index.dat". The process cannot access the file because it is being used by another process'. Process FetchIT.exe (192)

..hvilket er pga denne linie:

sStream := TFileStream.Create(SrcFile, fmOpenRead or fmShareDenyWrite);

Så jeg skal vel på en eller anden måde kontrollere, om den pågældende fil som der forsøges at create en filestream på, overhovedet er læsbar, ellers hoppe videre til næste fil?

/jack

Ja jeg har ikke puttet nogen try except ind, men hvis du smider en ind f.eks. omkring DoCopyFile funktionen så vil kopieringen fortsætte:

try
  DoCopyFile(Sti+Rec.Name,EditTil.Text+SubDir+Rec.Name);
except
  on E: Exception do begin
  Application.MessageBox(PChar('Kan ikke kopiere filen: '+Rec.Name+' Fejl: '+E.Message),'Fejl',MB_OK or MB_ICONERROR);
  end;
end;

istedet for Application.MessageBox kan du så f.eks. skrive en besked i en log memo så brugeren ikke skal trykke på OK.

Ja, men problemet er jo at:

sStream := TFileStream.Create(SrcFile, fmOpenRead or fmShareDenyWrite);

..fejler. Den kan ikke create den filestream. Så fejlen opstår ikke nede CopyFiles() (eller rettere Start()) proceduren, men derimod i DoCopyFile() hvor jeg ikke kan bruge den try/except du skriver, fordi den ikke kender Rec og SubDir.

Har du et alternativ? :)

/jack

Har du prøvet?

Ja, og jeg får samme fejl som i kommentaren 22/12-2005 13:44:25 .. altså i den linie der :)

Hvis jeg bruger den try except du skrev før, virker det fint hvis filen bare ikke kan kopieres - men jeg får stadig fejl når filestream skal creates

Er du sikker på det for det virker fint her, kommer fejlen ikke kun i Delphi IDE?

Du har sq ret.. det er kun i Delphi IDE :)

Tusind tak for hjælpen.. Smider du et svar?

jep.