06. august 2008 - 14:09Der er
23 kommentarer og 1 løsning
Kopier en mappe (incl. filer og undermapper) incl progressbar.
Hejsa.
Jeg har læst om alle de progressbar spørgsmål og svar der har været her på Eksperten, men kan stadig ikke få noget af det til at virke.
Det eneste eksempel jeg har fået til at virke er nedenstående eksempel, det kopiere alle Mapper og filer fra C:\Temp til D:\Temp, men uden progress bar.
Spørgsmål : Kan man integrere en progressbar ala. Windows Commander(Viser 2 progressbar 1 til den fil den kopiere og en til hvor langt den er nået i alt.), i nedenstående eksempel og hvis ja hvordan?
Ellers, vil jeg meget gerne have hjælp til at få det til at virker og meget gerne se et funktionsdygtigt eksempel.
EKS:
---------------------------------------------------------------- unit Unit1;
procedure TForm1.CopyFolder(src, dest : string ); var sts : Integer ; SR: TSearchRec;
begin sts := FindFirst(src + '*.*' , faAnyFile , SR ); if sts = 0 then begin if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then begin //Put User Feedback here if desired Application.ProcessMessages; if pos('.', SR.Name) = 0 then begin {$I-}MkDir( dest + SR.Name ) ;{$I+} CopyFolder( src + SR.Name + '\', dest + SR.Name + '\' ) ; end else Copyfile( pchar(src + SR.Name), pchar(dest + sr.name), true ); end; while FindNext( SR ) = 0 do begin if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then begin //Put User Feedback here if desired Application.ProcessMessages; if Pos('.', SR.Name) = 0 then begin {$I-}MkDir( dest + SR.Name );{$I+} CopyFolder( src + SR.Name + '\', dest + SR.Name + '\' ) ; end else Copyfile( pchar(src + SR.Name), pchar(dest + sr.name), true ); end; end; FindClose( SR ) ; end ; end;
procedure TForm1.Button1Click(Sender: TObject); begin CopyFolder('C:\Temp\', 'D:\Temp\'); end;
Princippet i det vil være først, at lave en filliste, hvor du så kan se hvor mange der er, og bagefter løbe listen igennem, og kopiere en efter en, mens antal procent regnes ud, udfra nummeret i listen. Dette kunne være en TStringList.
Men vil lade en anden om eksemplet for at se hvor langt man er med den aktive fil. //mbs
Det med hvor langt man er med den aktuelle fil afhænger helt og aldeles af at ens kopieringsfunktion enten ved hvordan man skal opdatere det der nu skal opdateres, eller at man har mulighed for at give den en callback som bliver kaldt når den har noget at rapportere.
Da du bruger Windows API til at kopiere (det er der intet galt i), skal du derfor i stedet bruge CopyFileEx, der lader dig medsende en callback-funktion som du kan bruge til at opdatere din "denne fil" progressbar.
Da Windows API bruger en anden calling convention (hvordan parametre m.v. overføres mellem funktionerne) end Delphi, skal du huske at markere din callbackfunktion som stdcall.
Der er et eksempel på http://delphicikk.atw.hu/index.php?oldal=5 - som nævnt kan du bruge Int64 i stedet for COMP (hvilket du bør med mindre du har behov for understøttelse i Delphi 3 eller derunder - hvilket er tvivlsomt).
Kan se at i den kommende Delphi kan progressbar'en lege løbelys (altså starte forfra).
Hvad mbsnets forslag angår så kan man klare sig med bare at tælle filerne. Det er det simpleste men bliver lidt misvisende hvis der er meget store og meget små filer i samme "batch". Så ville jeg nok lave en liste (TObjectList) og nogle dataklasser der hver indeholdt navn og størrelse på hver fil, men som også var i stand til at kopiere/flytte sig selv til et andet sted - og i processen derved sende data, enten ved callback eller ved en message
Skal man gå helt amok kan man nedarve TFileData fra TThread og så lade ProgressBar.Max være AntalOprettede og ProgrssBar.Position være (AntalOprettede - LevendeTråde).
Ideen er nok for speget, men det vil være en sjov opgave med load balancing, synkronisering m.v.
uses ShellAPI, Windows, SysUtils; Function DeleteFiles( Files : String) : Boolean; Function CopyFiles( From, Dest : String) : Boolean; Function MoveFiles( From, Dest : String) : Boolean; Function RenameFiles( From, Dest : String) : Boolean; Function GetFileSize(FileName : TFileName) : Integer;
implementation
Function ExecuteOp(From : String; Dest : String; IdOp : Integer) : Boolean; var SHFileOpStruct : TSHFileOpStruct; zFrom, zDest : array [0..MAX_PATH+2] of Char; begin From := ExpandFileName(From); Dest := ExpandFileName(Dest); ZeroMemory(@zFrom, SizeOf(zFrom)); ZeroMemory(@zDest, SizeOf(zDest));
if IdOp <> FO_DELETE then SHFileOpStruct.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR else SHFileOpStruct.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;
Result := Boolean(SHFileOperation(SHFileOpStruct)); Result := Result and (SHFileOpStruct.fAnyOperationsAborted); end;
Function CopyFiles( From, Dest : String) : Boolean; begin result := ExecuteOp(From,Dest, FO_COPY); end;
Function DeleteFiles( Files : String) : Boolean; begin Result := ExecuteOp(Files,'', FO_DELETE); end;
Function MoveFiles( From, Dest : String) : Boolean; begin Result := ExecuteOp(From,Dest, FO_MOVE); end;
Function RenameFiles( From, Dest : String) : Boolean; begin if (ExtractFilePath(From) <> '') and (ExtractFilePath(Dest) = '') then Dest := ExtractFilePath(From) + Dest; Result := ExecuteOp(From,Dest, FO_RENAME); end;
Function GetFileSize(FileName : TFileName) : Integer; var SearchRec : TSearchRec; begin if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then Result := SearchRec.Size else Result := -1; FindClose (SearchRec); end;
Nu har jeg fået det til at virke med windows progressbar ved at indsætte :
FOF_MULTIDESTFILES i følgende linjer :
if IdOp <> FO_DELETE then SHFileOpStruct.fFlags := FOF_ALLOWUNDO Or FOF_MULTIDESTFILES or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR else SHFileOpStruct.fFlags := FOF_ALLOWUNDO or FOF_MULTIDESTFILES or FOF_NOCONFIRMATION;
Men den viser jo så kun 1 progressbar, der findes ikke en progressbar ala. Total Commander, hvor den viser en progressbar for filen den kopiere og hvorlangt den er nået ialt?
Nu har jeg set lidt på dit eksempel og det virker jo fint, men kan simpelthen ikke få en extra progresbar til at virke (ProgressBar2), det er den progressBar der skal vise overall progress, hvor ProgressBar1 skal vise hver enkelt fil, hvad den også gør :-)
type TForm1 = class(TForm) Button1: TButton; ProgressBar1: TProgressBar; ProgressBar2: TProgressBar; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } procedure CopyFolder(src, dest : string ); end;
var Form1: TForm1;
implementation
{$R *.dfm}
function CopyProgressRoutine( TotalFileSize : Int64; // total file size, in bytes TotalBytesTransferred : Int64; // total number of bytes transferred StreamSize : Int64; // total number of bytes for this stream StreamBytesTransferred : Int64; // total number of bytes transferred for this stream dwStreamNumber : DWORD; // the current stream dwCallbackReason : DWORD; // reason for callback hSourceFile : THandle; // handle to the source file hDestinationFile : THandle; // handle to the destination file lpData : pointer) : DWORD; stdcall; // passed by CopyFileEx begin with Form1 do begin ProgressBar1.Max:=TotalFileSize; ProgressBar1.Position:=TotalBytesTransferred; ProgressBar1.Update; ProgressBar2.Position:=ProgressBar2.Max-integer(lpData); ProgressBar2.Update; end; end;
procedure TForm1.CopyFolder(src, dest : string ); var fl : TStringList; i : integer;
procedure MakeList(src, dest : string); var sts : Integer ; SR: TSearchRec; begin sts := FindFirst(src + '*.*' , faAnyFile , SR ); while sts = 0 do begin if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then begin if Pos('.', SR.Name) = 0 then begin {$I-}MkDir( dest + SR.Name );{$I+} MakeList( src + SR.Name + '\', dest + SR.Name+ '\' ) ; end else fl.Add(src + SR.Name+'='+dest + sr.name); end; sts:=FindNext( SR ); end; FindClose( SR ) ; end;
begin fl:=TStringList.Create; MakeList(src, dest); ProgressBar2.Max:=fl.Count; ProgressBar2.Position:=0; for i:=0 to fl.Count-1 do CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(fl.count-i-1), nil, 0); fl.Free; end;
procedure TForm1.Button1Click(Sender: TObject); begin CopyFolder('C:\Temp\', 'D:\Temp\'); end;
Hov, har lavet noget vrøvl, ret disse 2 linier: ProgressBar2.Position:=ProgressBar2.Max-integer(lpData); CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(fl.count-i-1), nil, 0);
til dette: ProgressBar2.Position:=integer(lpData); CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(i), nil, 0);
begge løsninger virker men det første er bare noget vrøvl.
Nu har jeg lige læst tråden igennem og som hrc nævner så bliver ProgressBar2 misvisende hvis der er meget store og små filer blandet, men det kan dog let rettes til så ProgressBar2 kører på samlet antal byte i stedet.
kroning, det virker som det skal nu fantastisk :-) og har rettet de 2 linjer.
En lille ting mere .. hehe ... Vill gerne have en label på også der viser hvilken fil der bliver kopiret som du har i dit først eksempel du linkede til :-)
for i:=0 to fl.Count-1 do begin Label1.Caption:='Kopierer '+fl.Names[i]+' til '+fl.ValueFromIndex[i]; CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(fl.count-i-1), nil, 0); end;
Du skal nok have en Label1.Update; ind efter Caption er sat. Altså:
for i:=0 to fl.Count-1 do begin Label1.Caption:='Kopierer '+fl.Names[i]+' til '+fl.ValueFromIndex[i]; Label1.Update; CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(fl.count-i-1), nil, 0); end;
type TForm1 = class(TForm) Button1: TButton; ProgressBar1: TProgressBar; ProgressBar2: TProgressBar; Label1: TLabel; Label2: TLabel; Label3: TLabel; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } procedure CopyFolder(src, dest : string ); end;
var Form1: TForm1;
implementation
{$R *.dfm}
function CopyProgressRoutine( TotalFileSize : Int64; // total file size, in bytes TotalBytesTransferred : Int64; // total number of bytes transferred StreamSize : Int64; // total number of bytes for this stream StreamBytesTransferred : Int64; // total number of bytes transferred for this stream dwStreamNumber : DWORD; // the current stream dwCallbackReason : DWORD; // reason for callback hSourceFile : THandle; // handle to the source file hDestinationFile : THandle; // handle to the destination file lpData : pointer) : DWORD; stdcall; // passed by CopyFileEx begin with Form1 do begin ProgressBar1.Max:=TotalFileSize; ProgressBar1.Position:=TotalBytesTransferred; ProgressBar1.Update; ProgressBar2.Position:=ProgressBar2.Max-integer(lpData); ProgressBar2.Update; Label2.Caption:='Fil '+IntToStr(round((TotalBytesTransferred/TotalFileSize)*100)); Label2.Update; end; end;
procedure TForm1.CopyFolder(src, dest : string ); var fl : TStringList; i : integer;
procedure MakeList(src, dest : string); var sts : Integer ; SR: TSearchRec; begin sts := FindFirst(src + '*.*' , faAnyFile , SR ); while sts = 0 do begin if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then begin if Pos('.', SR.Name) = 0 then begin {$I-}MkDir( dest + SR.Name );{$I+} MakeList( src + SR.Name + '\', dest + SR.Name+ '\' ) ; end else fl.Add(src + SR.Name+'='+dest + sr.name); end; sts:=FindNext( SR ); end; FindClose( SR ) ; end;
begin fl:=TStringList.Create; MakeList(src, dest); ProgressBar2.Max:=fl.Count; ProgressBar2.Position:=0; for i:=0 to fl.Count-1 do begin Label1.Caption:='Kopierer '+fl.Names[i]+' til '+fl.ValueFromIndex[i]; Label1.Update; Label3.Caption:='Samlet '+IntToStr(Round(((i+1)/fl.Count)*100)); Label3.Update; CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(fl.count-i-1), nil, 0); end; fl.Free; end;
procedure TForm1.Button1Click(Sender: TObject); begin CopyFolder('C:\Temp\', 'D:\Temp\'); end;
type TForm1 = class(TForm) Button1: TButton; ProgressBar1: TProgressBar; ProgressBar2: TProgressBar; Label1: TLabel; Label2: TLabel; Label3: TLabel; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } procedure CopyFolder(src, dest : string ); end;
var Form1: TForm1;
implementation
{$R *.dfm}
function CopyProgressRoutine( TotalFileSize : Int64; // total file size, in bytes TotalBytesTransferred : Int64; // total number of bytes transferred StreamSize : Int64; // total number of bytes for this stream StreamBytesTransferred : Int64; // total number of bytes transferred for this stream dwStreamNumber : DWORD; // the current stream dwCallbackReason : DWORD; // reason for callback hSourceFile : THandle; // handle to the source file hDestinationFile : THandle; // handle to the destination file lpData : pointer) : DWORD; stdcall; // passed by CopyFileEx begin with Form1 do begin ProgressBar1.Max:=TotalFileSize; ProgressBar1.Position:=TotalBytesTransferred; ProgressBar1.Update; ProgressBar2.Position:=integer(lpData); ProgressBar2.Update; Label2.Caption:='Fil '+IntToStr(round((TotalBytesTransferred/TotalFileSize)*100)); Label2.Update; end; end;
procedure TForm1.CopyFolder(src, dest : string ); var fl : TStringList; i : integer;
procedure MakeList(src, dest : string); var sts : Integer ; SR: TSearchRec; begin sts := FindFirst(src + '*.*' , faAnyFile , SR ); while sts = 0 do begin if ( SR.Name <> '.' ) and ( SR.Name <> '..' ) then begin if Pos('.', SR.Name) = 0 then begin {$I-}MkDir( dest + SR.Name );{$I+} MakeList( src + SR.Name + '\', dest + SR.Name+ '\' ) ; end else fl.Add(src + SR.Name+'='+dest + sr.name); end; sts:=FindNext( SR ); end; FindClose( SR ) ; end;
begin fl:=TStringList.Create; MakeList(src, dest); ProgressBar2.Max:=fl.Count; ProgressBar2.Position:=0; for i:=0 to fl.Count-1 do begin Label1.Caption:='Kopierer '+fl.Names[i]+' til '+fl.ValueFromIndex[i]; Label1.Update; Label3.Caption:='Samlet '+IntToStr(Round(((i+1)/fl.Count)*100)); Label3.Update; CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(i), nil, 0); end; fl.Free; end;
procedure TForm1.Button1Click(Sender: TObject); begin CopyFolder('C:\Temp\', 'D:\Temp\'); end;
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
