[Delphi] Kopieeren van een directory met content.

[Dryw.Filtiarn]

Ik heb dus de directorystructuur op CD:
Document
\_Doc1.txt
\_Doc2.txt
\_Doc3.txt
\_Doc4.txt

En nu is het de bedoeling dat deze naar hardeschijf worden gezet op locatie [xxxxx]. Hoe kan ik dat doen? Heb gezocht maar verder dan directory aanmaken kom ik niet...

[Creepy]

met copyfile() kan je files kopieren. En m.b.v. findfirst() en findnext() kan je alle files in een dir doorlopen, en die files m.b.v. copyfile() kopieren.

[Dryw.Filtiarn]

Op dinsdag 18 december 2001 13:00 schreef Creepy het volgende:
met copyfile() kan je files kopieren. En m.b.v. findfirst() en findnext() kan je alle files in een dir doorlopen, en die files m.b.v. copyfile() kopieren.

Op zich heel leuk maar als het nou het principe wordt van:

code:

Basedir
\_ 10 files
\_ Subdir 1
   \_ 100 files
   \_ Subdir 1.1   
    \_ 20 files
   \_ Subdir 1.2
    \_ 30 files
\_ Subdir 2
   \_ 100 files
   \_ Subdir 2.1   
    \_ 20 files
   \_ Subdir 2.2
    \_ 30 files

Oftwel een base directory met een aantal subdirectories, waar ook weer subdirectories inzitten enz...

[Dryw.Filtiarn]

Niemand kan mij helpen

[Varienaja]

Dat werd net al verteld: copyfile, findfirst en findnext.

En dat gaat dan ongeveer zo (maar werkt gegarandeerd niet) >:):

code:

procedure copydir(baselocation)
Findfirst (baselocation)
while er zijn nog files do
   findnext;
   if gevondenfile=directory then 
    copydir(gevondenfile)
   else
    copyfile(gevondenfile)
   end;
end;

Recursie heet dat

Als ik zometeen thuis ben kan ik je eventueel de complete code geven voor dit, omdat ik wel eens filemanager heb geprogd. ICQ maar even als je 't graag wilt hebben.

[Creepy]

Ik zou je ook complete code kunnen geven.. maar dat is niet leuk

Het moet inderdaad met recursie.

Maak een functie die alle bestanden uit 1 dir naar een andere dir kopieert, met als parameters, de originele dir, en de dir waar het naar toe moet.

Als die werkt, breidt je functie dan uit dat als ie een dir i.p.v. een bestand tegenkomt, zichzelf aanroept met de net gevonden dir als ene parameter en de bestemmingsdir+net gevonden dir als de andere en klaar!

Hmm.. het kan ook met behulp van een aantal loops in elkaar zonder recursie. Heb daar geen voorbeeldcode van liggen. Ik gebruik liever recursie voor dit soort dingen.

[Dryw.Filtiarn]

Op dinsdag 18 december 2001 15:30 schreef Varienaja het volgende:
Dat werd net al verteld: copyfile, findfirst en findnext.

En dat gaat dan ongeveer zo (maar werkt gegarandeerd niet) >:):

code:

procedure copydir(baselocation)
Findfirst (baselocation)
while er zijn nog files do
   findnext;
   if gevondenfile=directory then 
    copydir(gevondenfile)
   else
    copyfile(gevondenfile)
   end;
end;

Recursie heet dat

Als ik zometeen thuis ben kan ik je eventueel de complete code geven voor dit, omdat ik wel eens filemanager heb geprogd. ICQ maar even als je 't graag wilt hebben.

Als je wilt mag je wel even mailen naar [e-mail] kheb op dit moment geen ICQ

[Varienaja]

Op dinsdag 18 december 2001 15:34 schreef Dryw.Filtiarn het volgende:
Als je wilt mag je wel even mailen naar [e-mail] kheb op dit moment geen ICQ

Natuurlijk mail ik je dat niet, ik post het hier, dan heeft iemand anders er ook nog wat aan.

Deze code is van 2 februari 1999, toen ik nog NT4.0 draaide. Ik post gewoon de hele unit, waarin de thread zit voor 't kopieren. Ik weet zelf al niet exact meer hoe alles in elkaar zat. Veel plezier ermee

code:

unit ThreadSpul;

interface

uses
  StdCtrls, Classes, Forms, Gauges, Graphics, SysUtils, Windows, Settings, DKInclude;

const
   BufSize=65536;
type
  TAction = (Move, Copy, Delete);

  ActionThread = class(TThread)
  private
    NotQuit,VerderGaanOK:boolean;
    ToDo:TAction;
    Source,Dest:string;
    StartTime:TDateTime;
    FilesLeftString:string;

    Files:TStrings;
    Form:TForm;
    Current,Overall:TGauge;
    SRCFile,DSTFile,SRCSize,BPS,OverallInfo,FilesLeft,TimeLeft:TLabel;
    StopButton:TButton;
    Box:TGroupBox;

    procedure ErrorMessage(Bericht,Error:string);
    procedure StopClick(Sender: TObject);
    function GetSize(FS:string):integer;
    function GetName(FS:string):string;
    procedure CopyFile(i:integer);
    procedure DeleteFile(i:integer);
    procedure MoveFile(i:integer);
    procedure ShowProgress;
  protected
    procedure Execute; override;
  public
    constructor Create(Bron,Doel:string; List:TStrings; Action:TAction; TermProc:TNotifyEvent);
  end;

implementation

constructor ActionThread.Create(Bron,Doel:string; List:TStrings; Action:TAction; TermProc:TNotifyEvent);
var i:integer;
    Size:integer;
begin
  Priority:=tpLowest;
  OnTerminate:=TermProc;
  VerderGaanOK:=False;
  Source:=Bron; Dest:=Doel; ToDo:=Action;

  inherited Create(True);
  Self.FreeOnTerminate:=True;
  Form:=TForm.CreateNew(Application);
  Files:=TStringList.Create;
  Box:=TGroupBox.Create(Form);  Box.Parent:=Form;
  StopButton:=TButton.Create(Form); StopButton.Parent:=Form;
  SRCFile:=TLabel.Create(Box);  SRCFile.Parent:=Box;
  SRCSize:=TLabel.Create(Box);  SRCSize.Parent:=Box;
  DSTFile:=TLabel.Create(Box);  DSTFile.Parent:=Box;
  BPS:=TLabel.Create(Box);      BPS.Parent:=Box;
  OverallInfo:=TLabel.Create(Box);  OverallInfo.Parent:=Box;
  Current:=TGauge.Create(Box);  Current.Parent:=Box;
  Overall:=TGauge.Create(Box);  Overall.Parent:=Box;
  TimeLeft:=TLabel.Create(Box);     TimeLeft.Parent:=Box;
  FilesLeft:=TLabel.Create(Box);    FilesLeft.Parent:=Box;

  with Form do begin
     case ToDo of
      Copy   : Caption:=sCopyingB;
      Delete : Caption:=sDeletingB;
      Move   : Caption:=sMovingB;
     end;
     BorderStyle:=bsDialog; Position:=poScreenCenter;
     Width:=380; Height:=205;
     BorderIcons:=[];
  end;

  with Box do begin
     Caption:=sProgressB;
     Top:=0; Left:=8; Width:=356; Height:=139;
  end;

  with StopButton do begin
     Caption:='&Stop'; Width:=74; Left:=153; Top:=146; OnClick:=StopClick;
  end;

  with SRCFile do begin
     Left:=8; Top:=24;
  end;

  with DSTFile do begin
     Top:=24; Alignment:=taRightJustify; Width:=0;
  end;

  with SRCSize do begin
    Top:=40; Left:=8;
  end;

  with OverallInfo do begin
     Left:=8; Top:=80; Caption:=sOverallProgress;
  end;

  with Current do begin
     ForeColor:=clNavy; Left:=8; Height:=18; Width:=340; Top:=56;
  end;

  with Overall do begin
     ForeColor:=clNavy; Left:=8; Height:=18; Width:=340; Top:=96;
  end;

  with FilesLeft do begin
     Left:=8; Top:=120;
  end;

  with TimeLeft do begin
     Top:=120; Alignment:=taRightJustify; Width:=0;
  end;

  with BPS do begin
     Top:=80; Alignment:=taRightJustify; Width:=0;
  end;

  //kopieer spul uit List naar Files
  Overall.MaxValue:=0;
  for i:=List.Count-1 Downto 0 do begin
     Files.Add(List.Strings[i]);
     Size:=GetSize(List.Strings[i]);
     if Size<>DirRecognize then begin
      if ToDo=Delete then
         Overall.MaxValue:=Overall.MaxValue+1
      else
         Overall.MaxValue:=Overall.MaxValue+Size;
     end;
  end;

  Form.Show;
  Resume;
end;

procedure ActionThread.Execute;
var i:integer;
    FileName:string;
    Attr:integer;
begin
  { Place thread code here }
{  while not VerderGaanOK do begin
     Sleep(50);
  end;}
  StartTime:=Time;

  NotQuit:=True;
  i:=Files.Count;
  while (NotQuit) and (i>0) do begin
     //doe Source+Files.Items[i] actie >> Dest
     Current.Progress:=0;
     Current.MaxValue:=GetSize(Files.Strings[i-1]);
     case ToDo of
      Copy   : begin
              if i>1 then
                 FilesLeftString:=' bytes left in '+IntToStr(i)+sSpace+sFiles
              else
                 FilesLeftString:=' bytes left in '+IntToStr(i)+sSpace+sFile;

              if (Settings.Frm.AskOverwrite.Checked or Settings.Frm.AskAlways.Checked) and (FileExists(Dest+GetName(Files.Strings[i-1]))) then begin
                 if Application.MessageBox(sFilePresent_Overwrite,sConfirmOverwrite,MB_ICONQUESTION+MB_YESNO)=IDYes then begin
                  CopyFile(i-1);
                 end;
              end else begin
                 CopyFile(i-1);
              end;
             end;
      Delete : begin
              if i>1 then
                 FilesLeft.Caption:=IntToStr(i)+sSpace+sFiles+sSpace+sLeft
              else
                 FilesLeft.Caption:=IntToStr(i)+sSpace+sFile+sSpace+sLeft;

              Attr:=FileGetAttr(Source+GetName(Files.Strings[i-1]));
              if (Settings.Frm.DelAll.Checked or Settings.Frm.AskAlways.Checked) and ((Attr and faHidden>0) or (Attr and faSysFile>0) or (Attr and faReadOnly>0)) then begin
                 if Application.MessageBox(sSureDelete,sConfirmDelete,MB_ICONQUESTION+MB_YESNO)=IDYes then begin
                  FileSetAttr(Source+GetName(Files.Strings[i-1]),0);
                  DeleteFile(i-1);
                 end;
              end else begin
                 FileSetAttr(Source+GetName(Files.Strings[i-1]),0);
                 DeleteFile(i-1);
              end;
             end;
      Move   : MoveFile(i-1);
     end;
     ShowProgress;
     dec(i);
  end;
  Form.Close;
end;

procedure ActionThread.StopClick(Sender: TObject);
begin
   NotQuit:=False;
   StopButton.Enabled:=False;
end;

function ActionThread.GetSize(FS:string):integer;
var Size:string;
    i:integer;
begin
   i:=Length(FS); Size:=sEmpty;
   while (i>0) and (FS[i]<>sKomma) do begin
    Size:=FS[i]+Size;
    dec(i);
   end;
   GetSize:=StrToInt(Size);
end;

function ActionThread.GetName(FS:string):string;
var i:integer;
begin
   i:=1; Result:=sEmpty;
   while FS[i]<>sKomma do begin
    Result:=Result+FS[i];
    inc(i);
   end;
end;

procedure ActionThread.CopyFile(i:integer);
var SourceFile,DestFile,j,BytesRead:integer;
    Buffer:array[1..BufSize] of char;
    SourceFilename,DestFileName:string;
    CopyError:boolean;
    H,M,S,MS:WORD;
    FSize:integer;
begin
FSize:=GetSize(Files.Strings[i]);
 if FSize=DirRecognize then begin
    CreateDir(Dest+GetName(Files.Strings[i]));
 end else begin
   if DiskFree(Ord(Dest[1])-64)<FSize then begin
    Application.MessageBox(sDiskFull,sErrorCopyingFile,mb_Ok+mb_IconStop);
    CopyError:=True;
   end else begin
    BytesRead:=1;
    SourceFilename:=Source+GetName(Files.Strings[i]);
    DestFilename:=Dest+GetName(Files.Strings[i]);

    SRCFile.Caption:=SourceFilename;
    DSTFile.Caption:=DestFilename; DSTFile.Left:=346-DSTFile.Width;
    SRCSize.Caption:=AJVIntToStr(FSize)+sSpace+'bytes';
    SourceFile:=FileOpen(SourceFilename,fmShareDenyNone);
    DestFile:=FileCreate(DestFilename);
    if SourceFile<0 then begin
       ErrorMessage(sCouldNotOpenSrcFile+sSpace+sQuote+SourceFilename+sQuote,sErrorCopyingFile);
       Overall.Progress:=Overall.Progress+FSize;
    end else begin
       if DestFile<0 then begin
        ErrorMessage(sCouldNotOpenDestFile+sSpace+sQuote+DestFilename+sQuote,sErrorCopyingFile);
        Overall.Progress:=Overall.Progress+FSize;
       end else begin
        while (BytesRead<>0) and (not CopyError) do begin
           BytesRead:=FileRead(SourceFile,Buffer,BufSize);
           FileWrite(DestFile,Buffer,BytesRead);
           Current.Progress:=Current.Progress+BytesRead;
           Overall.Progress:=Overall.Progress+BytesRead;
           FilesLeft.Caption:=AJVIntToStr(Overall.MaxValue-Overall.Progress)+FilesLeftString;
           DecodeTime(Time-StartTime,H,M,S,MS); inc(S);
           BPS.Caption:=AJVIntToStr(Overall.Progress div (H*3600+M*60+S))+' bytes/sec';
           BPS.Left:=346-BPS.Width;
           ShowProgress;
        end;
       end;
    end;
    FileClose(DestFile);
    FileClose(SourceFile);
    FileSetAttr(DestFilename,FileGetAttr(SourceFilename));
   end;
 end;
end;

procedure ActionThread.DeleteFile(i:integer);
var FileNaam:string;
    Size:integer;
begin
   FileNaam:=Source+GetName(Files.Strings[i]);
   Size:=GetSize(Files.Strings[i]);
   SRCFile.Caption:=FileNaam;
   SRCSize.Caption:=AJVIntToStr(GetSize(Files.Strings[i]))+sSpace+'bytes';

   if Size=DirRecognize then begin
    if not SysUtils.RemoveDir(FileNaam) then begin
       ErrorMessage(sCouldNotDeleteDir+sSpace+sQuote+Filenaam+sQuote,sErrorDeletingFile);
    end;
   end else begin
    if SysUtils.DeleteFile(FileNaam) then begin
       Current.Progress:=Size;
       Overall.Progress:=Overall.Progress+1;
    end else begin
       ErrorMessage(sCouldNotDeleteFile+sSpace+sQuote+Filenaam+sQuote,sErrorDeletingFile);
    end;
   end;
end;

procedure ActionThread.MoveFile(i:integer);
begin
   Current.MaxValue:=GetSize(Files.Strings[i]);
   Overall.Progress:=Overall.Progress+Current.MaxValue;
end;

procedure ActionThread.ErrorMessage(Bericht,Error:string);
var Msg:array[0..355] of char;
    Err:array[0..355] of char;
begin
   StrPCopy(Msg,Bericht);
   StrPCopy(Err,Error);
   Application.MessageBox(Msg,Err,mb_Ok+mb_IconWarning);
end;

procedure ActionThread.ShowProgress;
begin
  if Overall.Progress>0 then begin
     TimeLeft.Caption:=sEstim+sSpace+FormatDateTime('n:ss',(Time-StartTime)*((Overall.MaxValue-Overall.Progress)/Overall.Progress));
     TimeLeft.Left:=346-TimeLeft.Width;
  end;
end;

end.

(edit) Oja.. dit hoort er nog bij:

code:

procedure TFileList.CopyFiles(Dest:string; Func:TNotifyEvent);
var
   FilesToDo:TStrings;

   procedure AddSub(Dr:string);
   var FRec:TSearchRec;
   begin
    FilesToDo.Add(Dr+sKomma+IntToStr(DirRecognize));
    FindFirst(CurrentDir+Dr+sExtAll,faAnyFile,FRec);
    repeat
       if (FRec.Attr and faDirectory>0) then begin
        if ((FRec.Name<>sPoint) and (FRec.Name<>sDirUp)) then begin
           AddSub(Dr+FRec.Name+sBackSlash);
        end;
       end else begin
        FilesToDo.Add(Dr+FRec.Name+sKomma+IntToStr(Frec.Size));
       end;
    until FindNext(FRec)<>0;
    SysUtils.FindClose(FRec);
   end;

var i:integer;
    FileNaam:array[0..256] of char;
begin
   Screen.Cursor:=crHourGlass;
   FilesToDo:=TStringList.Create;
   i:=Files.Items.Count-1;
   while i>=0 do begin
    if Files.Items[i].Selected then begin
       if Files.Items[i].SubItems[0]=sDirStr then begin
       // voeg subdir toe
        AddSub(Files.Items[i].Caption+sBackSlash);
       end else begin
        FilesToDo.Add(Files.Items[i].Caption+sKomma+Files.Items[i].Subitems[0]);
       end;
    end;
    dec(i);
   end;
   ActionThread.Create(CurrentDir,Dest,FilesToDo,Copy,Func);
   FilesToDo.Free;
   Screen.Cursor:=crDefault;
end;

En het is de bedoeling dat je dit als leidraad gebruikt natuurlijk he.. niet letterlijk overnemen!

[Dryw.Filtiarn]

Op dinsdag 18 december 2001 22:05 schreef Varienaja het volgende:

[..]

Natuurlijk mail ik je dat niet, ik post het hier, dan heeft iemand anders er ook nog wat aan.

Deze code is van 2 februari 1999, toen ik nog NT4.0 draaide. Ik post gewoon de hele unit, waarin de thread zit voor 't kopieren. Ik weet zelf al niet exact meer hoe alles in elkaar zat. Veel plezier ermee

code:

unit ThreadSpul;

[knipmode]Heel veel Delphi-code[/knipmode]

En het is de bedoeling dat je dit als leidraad gebruikt natuurlijk he.. niet letterlijk overnemen!

Thanks, was helaas al niet echt meer nodig omdat ik al iets anders had gevonden, maar toch goed te weten dat er GoTters zijn die anderen willen helpen...