tak jak w temacie jaka funkcja odpowiada za kopiowanie folderu z jego zawartoscią??
Z tego co mi wiadomo, taka w Delphi nie istnieje. (ofkoz możesz skorzystać z dosowej komendy copy...). Wydaje mi się, że niedawno ktoś (chyba nawet ty :>) zadawał na forum podobne pytanie, tylko o usuwaniu. Tu będzie podobnie, tylko zamiast usuwać pliki, trzeba je będzie kopiować.
Czyli: FindFirst+FindNext+Copy+rekurencja.
ok moze uda mi sie cos zrobic ale kody mile widziane :)
uses shellapi
type
EInvalidDest = class(EStreamError);
EFCantMove = class(EStreamError);
const
SInvalidDest = 'Destination %s does not exist';
SFCantMove = 'Cannot move file %s';
function HasAttr(const FileName: string; Attr: Word): Boolean;
var
FileAttr: Integer;
begin
FileAttr := FileGetAttr(FileName);
if FileAttr = -1 then FileAttr := 0;
Result := (FileAttr and Attr) = Attr;
end;
procedure CopyFile(const FileName, DestName: string);
var
CopyBuffer: Pointer; { buffer for copying }
BytesCopied: Longint;
Source, Dest: Integer; { handles }
Len: Integer;
Destination: TFileName; { holder for expanded destination name }
const
ChunkSize: Longint = 8192; { copy in 8K chunks }
begin
Destination := ExpandFileName(DestName); { expand the destination path }
if HasAttr(Destination, faDirectory) then { if destination is a directory... }
begin
Len := Length(Destination);
if Destination[Len] = '\' then
Destination := Destination + ExtractFileName(FileName) { ...clone file name }
else
Destination := Destination + '\' + ExtractFileName(FileName); { ...clone file name }
end;
GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
try
Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
if Source < 0 then raise EFOpenError.CreateFmt(SFOpenError, [FileName]);
try
Dest := FileCreate(Destination); { create output file; overwrite existing }
if Dest < 0 then raise EFCreateError.CreateFmt(SFCreateError, [Destination]);
try
repeat
BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk }
if BytesCopied > 0 then { if we read anything... }
FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
until BytesCopied < ChunkSize; { until we run out of chunks }
finally
FileClose(Dest); { close the destination file }
end;
finally
FileClose(Source); { close the source file }
end;
finally
FreeMem(CopyBuffer, ChunkSize); { free the buffer }
end;
end;
uses ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
var FOS:TSHFileOpStructA;
begin
with FOS do
begin
Wnd:=Handle;
wFunc:=FO_COPY;
pFrom:='c:\Katalog\From\*.*';
pTo:='c:\Katalog\To\';
fFlags:=FOF_ALLOWUNDO or FOF_NOCONFIRMMKDIR;
lpszProgressTitle:='Kopiowanie...';
fAnyOperationsAborted:=False;
end;
if SHFileOperation(FOS)<>0 then
ShowMessage('Wystąpił błąd podczas kopiowania')
else
if FOS.fAnyOperationsAborted then
ShowMessage('Kopiowanie zostało przerwane');
end;
dzieki za kody ale :
co do pirwszego jak go uzyc?
co do drugiego - zrobilem folder o nazwie katalog i do niego dalem dwa katalogi jeden 'from' a drugi 'to' do from dalem pare plikow i daje na przycisk i sie wyswietla ze nie mozna czytac z okreslonego dysku ??
Edit : Juz wiem jak uzywac pierwszego kody ale przy kompilacji wyskakuja 2 bledy przy tworzeniu wyjatkow
Edit : Juz wiem jak uzywac pierwszego kody ale przy kompilacji wyskakuja 2 bledy przy tworzeniu wyjatkow
demos>doc>file**>fmxutils.pas
zagladajcie do demosow!
co do kodu Pinola... proponuje rpzestudiowac m.in:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/structures/shfileopstruct.asp
Wesoledi - ta procedura kopiuje tylko pliki a nie foldery :(
a wiec szukam dalej [glowa]
EDIT JEST JUZ GIT KOD PINIOLA DZIALA MI JUZ TERAZ :)