[ MatezYU @ 10.12.2004. 12:27 ] @
Kako mogu u delphiju da kopiram jedan direktorijum koji je pun poddirektorijuma na neko drugo mesto, radi backup-a podataka? |
[ MatezYU @ 10.12.2004. 12:27 ] @
[ sasas @ 10.12.2004. 12:59 ] @
Ovo bi ti uradilo posao:
Code: procedure TMyForm.GetFiles(dir:string); var F: TSearchRec; begin if FindFirst(dir + '*.*', faAnyFile, F) = 0 then begin repeat application.ProcessMessages; //da program ne ostane 'zaledjen' if (F.Attr = faDirectory) and (f.Name[1] <> '.') then GetFiles(dir + F.Name + '\'); ListBox1.Items.Add(dir + F.Name); // ovde mozes ubaciti CopyFile until FindNext(F) <> 0; FindClose(F); end; end; Sad, da li postoji nesto elegantnije... ss. [ bancika @ 10.12.2004. 13:51 ] @
mislim da ima...preko API-ja, dobijes i onaj windowsov Copy dijalog :)
Code: uses ShellAPI; ... function WinCopy(Owner: Integer; FromFile, ToFile: String; RenameOnCollision: boolean = False; Confirm: boolean = False): Boolean; var Struct : TSHFileOpStructA; MultDest: boolean; begin FillChar(Struct, SizeOf(Struct), 0); MultDest:=pos(';',ToFile)>0; While pos(';',FromFile)>0 do FromFile[pos(';',FromFile)]:=#0; While pos(';',ToFile)>0 do ToFile[pos(';',ToFile)]:=#0; FromFile:=FromFile+#0#0; ToFile:=ToFile+#0#0; with Struct do begin wnd :=Owner; wFunc :=FO_Copy; pFrom :=PChar(FromFile); pTo :=PChar(ToFile); fFlags:=FOF_ALLOWUNDO or FOF_FILESONLY; If MultDest then fFLags:=fFlags or FOF_MULTIDESTFILES; If RenameOnCollision then fFLags:=fFlags or FOF_RENAMEONCOLLISION; If not Confirm then begin fFLags:=fFlags or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR; end; hNameMappings:=nil; lpszProgressTitle:=nil; end; Result:=(SHFileOperationA(Struct)=0) and (not Struct.fAnyOperationsAborted); end; upotreba ide ovako: Code: WinCopy(Application.Handle, 'c:\folder1', 'c:\folder2'); //ovo confirm je za potvrdu overwrite-a pozdravi [ sasas @ 10.12.2004. 14:12 ] @
U smislu elegancije, malo preradjeno ShellAPI resenje (danas sam bas zaludan, a?
![]() ![]() ss. Code: function DirCopy(FromPath, ToPath: string; Overwrite: Boolean): Boolean; var fos: TSHFileOpStruct; begin FillChar(fos, SizeOf(fos), #0); fos.Wnd := 0; fos.wFunc := FO_COPY; fos.pFrom := PChar(FromPath + #0); fos.pTo := PChar(ToPath + #0); if Overwrite then fos.fFlags := FOF_SILENT // ako zelimo prikaz progresa, FOF_SIMPLEPROGRESS else fos.fFlags := FOF_RENAMEONCOLLISION or FOF_SIMPLEPROGRESS; fos.fAnyOperationsAborted := False; fos.hNameMappings := nil; Result := (ShFileOperation(fos) = 0); end; [ Srki_82 @ 10.12.2004. 15:23 ] @
Ako ti stvarno treba ova funkcija za backup bilo bi jos bolje resenje da ne kopiras nego da zapakujes direktorijum, zar ne? :)
[ bancika @ 10.12.2004. 16:16 ] @
a ako hoces za cele drajvove mozes da pravis image fajlove ovako:
Code: procedure ImageDisk; var InF, OutF: THandle; Buffer: array [1..(1024 * 64)] of Byte; // 64kb buffer BufRead, BufWrote: DWORD; begin InF := CreateFile('\\.\A:',GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); OutF := CreateFile('DISK.IMG',GENERIC_WRITE,FILE_SHARE_READ,nil,CREATE_ALWAYS,0,0); BufRead := 1; while (ReadFile(InF,Buffer,SizeOf(Buffer),BufRead,nil) = True) and (BufRead <> 0) do begin WriteFile(OutF,Buffer,BufRead,BufWrote,nil); end; CloseHandle(OutF); CloseHandle(InF); end; procedure RestoreImage; var InF, OutF: THandle; Buffer: array [1..(1024 * 64)] of Byte; // 64kb buffer BufRead, BufWrote: DWORD; begin InF := CreateFile('DISK.IMG',GENERIC_READ,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); OutF := CreateFile('\\.\A:',GENERIC_WRITE,FILE_SHARE_READ,nil,OPEN_EXISTING,0,0); if GetFileSize(OutF,nil) < GetFileSize(InF,nil) then begin CloseHandle(InF); CloseHandle(OutF); Exit; end; BufRead := 1; while (ReadFile(InF,Buffer,SizeOf(Buffer),BufRead,nil) = True) and (BufRead <> 0) do begin WriteFile(OutF,Buffer,BufRead,BufWrote,nil); end; CloseHandle(OutF); CloseHandle(InF); end; [ morlic @ 12.12.2004. 11:22 ] @
Ono prvo resenje sa sistemskom funkcijom je najbolje. Funkcije FindFirst i ostale ne podrzavaju unicode nazive foldera i fajlova (sto danas nije nikakvo cudo), tako da kada budu naleteli na takve fajlove bice tesno. Mislim da se meni cak desilo od ranije da sam imao problem sa fajlom koji ima znak pitanja u nazivu. Total Commander je tek od verzije 6 dobio podrsku za takve nazive.
[ Riste Pejov @ 14.12.2004. 11:42 ] @
Pitanje:
'\\.\A:' je direktan pristup A: drajvu ? to mu je kao pandan /dev/fd0 ? Ima negde na netu kako su imena C: drajva ili celog harddiska ? Copyright (C) 2001-2025 by www.elitesecurity.org. All rights reserved.
|