Toon posts:

[Delphi] Copy Dir + File + Subdirs probleem

Pagina: 1
Acties:
  • 127 views sinds 30-01-2008
  • Reageer

Verwijderd

Topicstarter
Ik heb een probleem met het copieren. Ik kan wel files in een dir copieren maar ik wil alles kunnen copieren. Dus Dir + Files + Subdirs alles dus. Deze code had ik gevonden hier op tweakers maar dat werkt dus niet helemaal. Als tie een dir heeft gevonden zie hij dat ook als een file en ik heb geen funtie kunnen vinden om dir te copieren. Is die functie er niet?? Moet ik zelf de dirs aanmaken?? Bedankt alvast voor jullie hulp
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
procedure TForm1.Button1Click(Sender: TObject);
var
   DirAndMask : string;
   DestDir : string;
   SearchRec: TSearchRec;
   FileAttrs: Integer;

   procedure CopyTheFile(Src, Dest: String);
   begin
    if not CopyFile(PChar(Src), PChar(Dest), False) then
       ShowMessage(Format('Copy of file %s failed', [SearchRec.Name]));
   end;
   begin
    { all files... maybe exclude directories }
    FileAttrs := faAnyFile;

    {get the mask & the destination dir }
    DirAndMask := 'd:\*.*';
    { note... destdir must have \ as ending }
    DestDir := 'e:\';

    if FindFirst(DirAndMask, FileAttrs, SearchRec) = 0 then begin
       CopyTheFile(ExtractFileDir(DirAndMask) + SearchRec.Name, DestDir + SearchRec.Name);
    while FindNext(SearchRec) = 0 do
       CopyTheFile(ExtractFileDir(DirAndMask) + SearchRec.Name, DestDir + SearchRec.Name);
   end;
 end;

Verwijderd

procedure in een procedure ? Volgens mij is die code zo brak!

  • Knutselsmurf
  • Registratie: December 2000
  • Laatst online: 09-09 17:08

Knutselsmurf

LED's make things better

Op zaterdag 27 april 2002 15:09 schreef TimD het volgende:
procedure in een procedure ? Volgens mij is die code zo brak!
Daar is niets braks aan. Is een hele normale oplossing. Die procedure is alleen aanwezig binnen de scope van de andere procedure, zoals je dat ook met variabelen kan doen.

Maar om even ontopic te blijven, waarschijnlijk zul je eerst de directories aan moeten maken, als deze nog niet bestaan. Je zou eventueel de windows SHFIleOperation-functie kunnen gebruiken. Daar kan je een heleboel dingen instellen, bijvoorbeeld ook het automatisch aanmaken van directories.

- This line is intentionally left blank -


Verwijderd

Zoals het er nu staat zal het niet veel doen, maar er is verder niets mis met een procedure in een procedure.
Ik heb even geen zin om het helemaal uit te spellen, maar je kunt het als volgt doen:

Procedure CopyDir(src, dest : string)
BEGIN
Maak dest directory;
IF (FindFirst(src) is succesvol) then
Repeat
If (file gevonden) then kopieer file
else
BEGIN
CopyDir(src+found dir name, dest+found dir name)
{Recursive call}
END;
Until (Findnext(src) onsuccesvol)
END;

Als dit niet voldoende is dan roep maar, dan werkt ik 't even uit.
BTW: Waarschijnlijk is er wel een Windows API die dit voor je doet, maar dat willen we natuurlijk niet anders kun je de code niet meer in Kylix gebruiken:)
Bij dit soort functies moet je overigens nogal wat aandacht besteden aan error trapping. Zo zijn er nogal wat situaties die tot fouten kunnen leiden... ongeldige dir name... read only bestemmings directory... disk full.

SUCCES!

Verwijderd

Topicstarter
Op zaterdag 27 april 2002 15:46 schreef Iron het volgende:
Zoals het er nu staat zal het niet veel doen, maar er is verder niets mis met een procedure in een procedure.
Ik heb even geen zin om het helemaal uit te spellen, maar je kunt het als volgt doen:

Procedure CopyDir(src, dest : string)
BEGIN
Maak dest directory;
IF (FindFirst(src) is succesvol) then
Repeat
If (file gevonden) then kopieer file
else
BEGIN
CopyDir(src+found dir name, dest+found dir name)
{Recursive call}
END;
Until (Findnext(src) onsuccesvol)
END;

Als dit niet voldoende is dan roep maar, dan werkt ik 't even uit.
BTW: Waarschijnlijk is er wel een Windows API die dit voor je doet, maar dat willen we natuurlijk niet anders kun je de code niet meer in Kylix gebruiken:)
Bij dit soort functies moet je overigens nogal wat aandacht besteden aan error trapping. Zo zijn er nogal wat situaties die tot fouten kunnen leiden... ongeldige dir name... read only bestemmings directory... disk full.

SUCCES!
Ik begin het wel een klein beetje te snappen. Maar als je het wilt uitwerken graag. Bedankt alvast voor je hulp

Verwijderd

Topicstarter
Kan iemand mij hier misschien mee verder helpen

  • Creepy
  • Registratie: Juni 2001
  • Laatst online: 21:25

Creepy

Tactical Espionage Splatterer

Wat is je probleem precies? Wat lukt er niet?

"I had a problem, I solved it with regular expressions. Now I have two problems". That's shows a lack of appreciation for regular expressions: "I know have _star_ problems" --Kevlin Henney


  • WildernessChild
  • Registratie: Februari 2002
  • Niet online

WildernessChild

Voor al uw hersenspinsels

Is hier niet gewoon een Windows API function - o sorry procedure, ben meer van C++ - voor?

Maker van Taekwindow; verplaats en resize je vensters met de Alt-toets!


  • Creepy
  • Registratie: Juni 2001
  • Laatst online: 21:25

Creepy

Tactical Espionage Splatterer

Op zondag 28 april 2002 19:25 schreef WildernessChild het volgende:
Is hier niet gewoon een Windows API function - o sorry procedure, ben meer van C++ - voor?
CopyFile IS een API call. CopyDir bestaat naar mijn weten niet. Maar met bovenstaande uitleg is deze toch wel zelf te schrijven?

Je hoeft je trouwens niet te verontschuldigen voor het C++ hoor, in Delphi kan je ook net zo goed API calls gebruiken.

"I had a problem, I solved it with regular expressions. Now I have two problems". That's shows a lack of appreciation for regular expressions: "I know have _star_ problems" --Kevlin Henney


Verwijderd

sorry ik poste hem per ongeluk als een nieuwe topic , dawas dus niet de bedoeling

maar hier is hij dus nog een keer

deze copiert gewijzigde bestanden , nieuwe bestanden en nieuwe directories van een locatie naar een locatie.

uses filectrl , plus er staat nog wat bagger in sinds ik hem gewoon copied pasted uit een applicatie van me.
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
procedure Tform1.zoekdir(pad, topad : string ) ;
var
sr : tsearchrec ;
r :  integer ;
Attributes : Word;
begin
panel1.caption := 'Synchroniseren van bestanden';
panel1.update ;
r := findfirst(pad + '\*.*', faanyfile, sr);
 while r = 0 do
 begin
 statusbar1.Panels.Items[0].Text := sr.name;
 statusbar1.Update;
     if (sr.name <> '.') and (sr.name <> '..')  then
    begin
     if (sr.attr <> 0) and (fadirectory <> 0) then
     begin
    if not DirectoryExists (topad ) then
    begin
    ForceDirectories(topad );
    memo1.lines.Append('directory gemaakt : ' + topad) ;
    application.processmessages ;
    end;
     zoekdir(pad +'\'+sr.name, topad + '\'+ sr.name) ;
     end;
    end;
     if FileAge(topad + '\'+ sr.name) <> fileage(pad +'\' + sr.name) then
    begin
    CopyFile(pchar(pad + '\' + sr.name),pchar(topad+ '\' + sr.name),FALSE);
    Attributes := FileGetAttr(pchar(topad + '\' +sr.name));
    FileSetAttr(pchar(topad + '\' +sr.name),attributes and not fareadonly);
    memo1.lines.append('Bestand gemaakt : ' + topad + '\' + sr.name) ;
    application.processmessages;
    end;
   r := findnext(Sr)
 end;
findclose(sr);
end;

Verwijderd

Topicstarter
Op maandag 29 april 2002 11:11 schreef The_milkman het volgende:
sorry ik poste hem per ongeluk als een nieuwe topic , dawas dus niet de bedoeling

maar hier is hij dus nog een keer

deze copiert gewijzigde bestanden , nieuwe bestanden en nieuwe directories van een locatie naar een locatie.

uses filectrl , plus er staat nog wat bagger in sinds ik hem gewoon copied pasted uit een applicatie van me.
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
procedure Tform1.zoekdir(pad, topad : string ) ;
var
sr : tsearchrec ;
r :  integer ;
Attributes : Word;
begin
panel1.caption := 'Synchroniseren van bestanden';
panel1.update ;
r := findfirst(pad + '\*.*', faanyfile, sr);
 while r = 0 do
 begin
 statusbar1.Panels.Items[0].Text := sr.name;
 statusbar1.Update;
     if (sr.name <> '.') and (sr.name <> '..')  then
    begin
     if (sr.attr <> 0) and (fadirectory <> 0) then
     begin
    if not DirectoryExists (topad ) then
    begin
    ForceDirectories(topad );
    memo1.lines.Append('directory gemaakt : ' + topad) ;
    application.processmessages ;
    end;
     zoekdir(pad +'\'+sr.name, topad + '\'+ sr.name) ;
     end;
    end;
     if FileAge(topad + '\'+ sr.name) <> fileage(pad +'\' + sr.name) then
    begin
    CopyFile(pchar(pad + '\' + sr.name),pchar(topad+ '\' + sr.name),FALSE);
    Attributes := FileGetAttr(pchar(topad + '\' +sr.name));
    FileSetAttr(pchar(topad + '\' +sr.name),attributes and not fareadonly);
    memo1.lines.append('Bestand gemaakt : ' + topad + '\' + sr.name) ;
    application.processmessages;
    end;
   r := findnext(Sr)
 end;
findclose(sr);
end;
Thx ik ga meteen even kijken hoe ik dit in mijn proggie kan gebruiken.

Verwijderd

Phalcon, dat lijkt er al aardig op, wel zie ik wat vreemde zaken.....
1) FaDirectory is een constante(16)
2) De force directory doe je nu voor ELKE file
3) Waarom verander je de attributes van de gekopieerde files?

Hier is een alternative oplossing. Bij maakt een recht toe recht aan kopie maken van een directory. Er zit geen error trapping in.

procedure Copydir(SourceDir, destinationDir : string);
Var sr : TSearchRec ;
Begin
ForceDirectories(destinationDir);
if (findfirst(sourceDir + '\*.*', FaAnyfile, sr) = 0) then
Repeat
if ((sr.name = '.') or (sr.name = '..')) then Continue;

if ((sr.attr and fadirectory) <> 0) then { Directory }
CopyDir(sourceDir + '\' + sr.name, destinationDir + '\'+ sr.name)
else { File }
CopyFile(pchar(sourceDir + '\' + sr.name), pchar(destinationDir + '\' + sr.name), FALSE);
Until (findNext(sr) <> 0);
Findclose(sr);
End;

Verwijderd

Topicstarter
Op maandag 29 april 2002 18:54 schreef Iron het volgende:
Phalcon, dat lijkt er al aardig op, wel zie ik wat vreemde zaken.....
1) FaDirectory is een constante(16)
2) De force directory doe je nu voor ELKE file
3) Waarom verander je de attributes van de gekopieerde files?

Hier is een alternative oplossing. Bij maakt een recht toe recht aan kopie maken van een directory. Er zit geen error trapping in.

procedure Copydir(SourceDir, destinationDir : string);
Var sr : TSearchRec ;
Begin
ForceDirectories(destinationDir);
if (findfirst(sourceDir + '\*.*', FaAnyfile, sr) = 0) then
Repeat
if ((sr.name = '.') or (sr.name = '..')) then Continue;

if ((sr.attr and fadirectory) <> 0) then { Directory }
CopyDir(sourceDir + '\' + sr.name, destinationDir + '\'+ sr.name)
else { File }
CopyFile(pchar(sourceDir + '\' + sr.name), pchar(destinationDir + '\' + sr.name), FALSE);
Until (findNext(sr) <> 0);
Findclose(sr);
End;
Ok bedankt. Ik ga het meteen zo proberen

Verwijderd

Topicstarter
Thx Iron het werkt perfect. :)

Verwijderd

Creepy Wrote : Is hier niet gewoon een Windows API function - o sorry procedure, ben meer van C++ - voor?

Natuurlijk,

[Uses shellapi]

function CopyTo(FromDir,ToDir : string ) : boolean;
var
lpFileOpStruct : TSHFileOpStruct;
begin
lpFileOpStruct.wFunc := FO_COPY;
lpFileOpStruct.pFrom := Pchar(FromDir);
lpFileOpStruct.pTo := Pchar(ToDir);
lpFileOpStruct.fFlags := FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SILENT;
Result := not Boolean(SHFileOperation(lpFileOpStruct));
end;

  • Creepy
  • Registratie: Juni 2001
  • Laatst online: 21:25

Creepy

Tactical Espionage Splatterer

Op dinsdag 30 april 2002 22:56 schreef Pender het volgende:
Creepy Wrote : Is hier niet gewoon een Windows API function - o sorry procedure, ben meer van C++ - voor?

Natuurlijk,

[Uses shellapi]

function CopyTo(FromDir,ToDir : string ) : boolean;
var
lpFileOpStruct : TSHFileOpStruct;
begin
lpFileOpStruct.wFunc := FO_COPY;
lpFileOpStruct.pFrom := Pchar(FromDir);
lpFileOpStruct.pTo := Pchar(ToDir);
lpFileOpStruct.fFlags := FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_SILENT;
Result := not Boolean(SHFileOperation(lpFileOpStruct));
end;
Ik was niet diegene die dat zei hoor :)
Ik zei dat ik er geen API call voor wist. Maar die is er dus wel! Dat is mooi.. kan ik weer een recurieve functie uit m'n code weghalen ;)

"I had a problem, I solved it with regular expressions. Now I have two problems". That's shows a lack of appreciation for regular expressions: "I know have _star_ problems" --Kevlin Henney

Pagina: 1