View Full Version : سوال: کپی فولدر و محتویات
delphibaz
سه شنبه 03 اسفند 1389, 09:13 صبح
دوستان یه برنامه بک آپ کوچولو میخوام بنویسم که روزانه بر اساس تاریخ فولدری بسازه و محتویات رو به سیستم دیگری در شبکه منتقل کنه.
در دلفی چجوری میتونم یک فولدر (با هزاران File , و Subfolder) را به مسیر دیگری کپی کنم؟
سرچ کردم تنها دستورات کپی فایل را پیدا کردم و نه ساب فولدر ممنون میشم راهنماییم کنید.
delphibaz
سه شنبه 03 اسفند 1389, 09:28 صبح
مشکلم با این کد حل شد: (برای استفاده دوستان اینجا قرار میدم)
function CopyFolder(const SrcFolder
, DestFolder: String
; iFileOp: Integer
; OverWrite: Boolean
; ShowDialog: Boolean): Boolean;
{
Copies or moves ...\SrcFolder to ...\DestFolder\SrcFolder\*.*
Example:
Copy C:\AFolder\SubFolder and it's contents to
C:\AnotherFolder\SubFolder
and prompt to replace existing files.
CopyFolder('C:\AFolder\SubFolder', 'C:\AnotherFolder', FOF_COPY,
true);
}
var
// declare structure
MyFOStruct: TSHFileOpStruct;
Src,
Dest: String;
ResultVal: Integer;
begin
result := false;
Src := SrcFolder;
Dest := DestFolder;
if (Src = '') or
( (iFileOp <> FO_DELETE) and (Dest = '') ) or
(CompareText(Src, Dest) = 0) then
exit;
if Src[Length(Src)] = '\' then
SetLength( Src, Length(Src) -1 );
Src := Src +#0#0;
if (Dest <> '') and (Dest[Length(Dest)] = '\') then
SetLength( Dest, Length(Dest) -1 );
Dest := Dest + #0#0;
// zero structure
// ! Mandatory in XP
FillChar( MyFOStruct, SizeOf(MyFOStruct), 0 );
// Fill in structure
with MyFOStruct do begin
Wnd := 0;
// specify a copy operation
wFunc := iFileOp;
pFrom := @Src[1];
pTo := @Dest[1];
// set the flags
fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMMKDIR;
if not OverWrite then fFlags := fFlags or FOF_RENAMEONCOLLISION;
if not ShowDialog then fFlags := fFlags or FOF_SILENT;
end;
Screen.Cursor := crHourGlass;
try
MyFOStruct.fAnyOperationsAborted := False;
MyFOStruct.hNameMappings := nil;
Resultval := ShFileOperation(MyFOStruct);
Result := (ResultVal = 0);
finally
Screen.Cursor := crDefault;
end;
AmirKalan
سه شنبه 20 دی 1390, 12:05 عصر
چه میشه پنجره Yes To All رو نشون نداد و سیستم خودش بدون پرسش کپی و جایگزین کنه
ممنون
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.