type TForm1 = class(TForm) Label1: TLabel; Label2: TLabel; Label3: TLabel; ProgressBar1: TProgressBar; ProgressBar2: TProgressBar; Button1: TButton; 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; if TotalFileSize>0 then Label2.Caption:='Fil '+IntToStr(round((TotalBytesTransferred/TotalFileSize)*100)); Label2.Update; end; end;
procedure TForm1.CopyFolder(src, dest : string ); var fl : TStringList; i : integer; Path : string;
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 ((SR.Attr and faDirectory)=faDirectory) then MakeList( src + SR.Name + '\', dest + SR.Name+ '\') 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; Path:=ExtractFilePath(fl.ValueFromIndex[i]); if not DirectoryExists(Path) then ForceDirectories(Path); 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;
Du skriver koden om, retter den til og tester det. Det er en kende arrogant, men det er jo ikke et tagselv-bord af vores kunnen udi programmering.
Hvis du har tænkt dig at pakke det ind i en tråd må det være MakeList der kopieres til Execute. For-løkken ændres til en "while (i < List.Count - 1) and not Terminated do". Endelig skal al skrivning til komponenter pakkes ind i en Synchronize. På formen hvor du har din progress-bar placerer du en TButton hvori du sætter fMYCopyThread.Terminate := true;
Man bruger en tråd, og kalder terminate på den ... Lidt opsøgende arbejde skulle bringe dig på sporet ...
Prøv www.LæsEnbogOgBlivKoog.nu evt bare www.LæsEnBog.nu
Hvis du køber dig en bog omkring Delphi læserden og tænker bag efter det var s... svært jeg fattede kun 10% af det hele ja så har du fundet den rigtige bog, forid så er du parat til at læse den igen ....
I øvrigt er jeg helt på linje med hrc.. Magen til arrogant holdning skal man lede efter ...
Hvis du selv helst vil være fri for alt det grove arbejde .. Ja så er vi flere der gør det for penge .. 8 timer om dagen .. Koder Delphi altså ;o) Og mod passende betaling leverer gerne en nøgle klar løsning ...
Ikke fordi jeg er sur, men man kunne overveje at sige det på en pænere måde en anden gang har altid holdt en god tone her og har også fået hjælp af både dig (borrisholt) og hrc.
Ville bare lige tilføje at jeg godt kan forstå at man ikke bare lige overlever en færdig løsning, men skriv det på en pænere måde en anden gang, syntes at det er et fantastisk sted her på eksperten og vil ikke ligge mig ud med nogen og er heller ikke interesseret i at blive uvenner med nogen.
michael-schou>> Jeg farer i blæk huset fordi dit spørgsmål virker sådan lidt jeg gidder ikke lave noget selv .. EEndvidre ville bare en anelse recarch have bragt dig på sproet af dette spm :
Lad mig anbefale du får min tård til at virke først ...
En form en knap og et memofelt.. Så tager du min tråd og får skrevet alle de filnavne ud du finder ...
Du kan også ekespermentere med at sætte etn pause kanp på din form ...
Når så du har det til at vbirke så opretter du bare et spm her inde på eksperten så skal jeg gerne hjælpe dig gennem næste step .. Overser jeg dit spørgsmål må du gerne skrive direkte : Jens@Borrisholt.com
Men kære ven .. start selv :D
Så det korte svar start med at får ThreadSearch til at virke ...
Jeg kan sagtens se det fra din side og hrc's, men det var ikke sådan ment, jeg burde også have tilføjet at jeg har prøvet mig frem med nedenstående :
Uden for tråd :
Var pbCancel: Bool;
with Form1 do begin ProgressBar1.Max:=TotalFileSize; ProgressBar1.Position:=TotalBytesTransferred; ProgressBar1.Update; ProgressBar2.Position:=integer(lpData); ProgressBar2.Update;
if pbCancel then Result := PROGRESS_CANCEL else Result := PROGRESS_CONTINUE;
if TotalFileSize>0 then Label2.Caption:='Fil '+IntToStr(round((TotalBytesTransferred/TotalFileSize)*100)); Label2.Update; end;
begin fl:=TStringList.Create; MakeList(src, dest); ProgressBar2.Max:=fl.Count; ProgressBar2.Position:=0; if pbCancel then Break; 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; Path:=ExtractFilePath(fl.ValueFromIndex[i]); if not DirectoryExists(Path) then ForceDirectories(Path); CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(i), nil, 0); end; fl.Free; end;
procedure TForm1.btnCancelClick(Sender: TObject); begin pbCancel := True; end;
Plejer næsten altid at prøve mig frem inden jeg jeg opretter et spørgsmål her på eksperten :-)
Men nok om det - jeg ser på dit link og prøver mig frem - takker indtil videre borrisholt :-)
procedure TForm1.FormCreate(Sender: TObject); begin StartAgain; end;
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; if TotalFileSize>0 then Label2.Caption:=(IntToStr(round((TotalBytesTransferred/TotalFileSize)*100))+'%'); Label2.Update;
Application.ProcessMessages; end; end;
procedure TForm1.CopyFolder(src, dest : string ); var fl : TStringList; i : integer; Path : string;
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 ((SR.Attr and faDirectory)=faDirectory) then MakeList( src + SR.Name + '\', dest + SR.Name+ '\') 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:=(IntToStr(Round(((i+1)/fl.Count)*100))+'%'); Label3.Update; Path:=ExtractFilePath(fl.ValueFromIndex[i]); if not DirectoryExists(Path) then ForceDirectories(Path); CopyfileEx(PChar(fl.Names[i]), pchar(fl.ValueFromIndex[i]), @CopyProgressRoutine, pointer(i), nil, 0); end; fl.Free; end;
Procedure CopyThread.Execute; begin FreeOnTerminate := True; Form1.CopyFolder('C:\Temp\', 'D:\Temp\'); end;
procedure TForm1.Button1Click(Sender: TObject); begin StartAgain; CT.Resume; end;
procedure TForm1.Button2Click(Sender: TObject); label Done; begin If NOT (Form1.Label4.Caption = 'Pause aktivated') Then Begin CT.Suspended := True; Form1.Label4.Caption := 'Pause activated'; GoTo Done; end;
If (Form1.Label4.Caption = 'Pause aktivated') Then Begin Form1.Label4.Caption := 'Pause NOT aktivated'; CT.Resume; GoTo Done; end;
Done : end;
procedure TForm1.Button3Click(Sender: TObject); begin CT.Suspended := True;
If CT.Suspended Then Begin StartAgain; Form1.Label4.Caption := 'Process Stopped'; end; end;
end.
Synes godt om
Ny brugerNybegynder
Din løsning...
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.