السلام عليكم ورحمة الله وبركاته من لا يشكر الناس لا يشكر الله .
فكرتي هي نسخ مجلد خاص بـ ق ب برادوكس بكل محتوياته موجود في نفس مسار البرنامج
أنسخه في مجلد أخر احتياطي في نفس مسار البرنامج
يقوم البرنامج بفحص في المجلد الاحتياطي أن لم يكن هناك مجلد يحمل اسم تاريخ اليوم يقوم بإنشائه ناسخا فيه مجلد ملفات قاعدة البيانات.
بعد البحث وجدت هذا الكود لكن لم أعرف كيف أستعمله
أرجو من الإخوة الكرام مساعدتي في فهم هذا الكود.
function CheckSlashDir(prstrDir: String): String;
begin
if Length(prstrDir) = 0 then Exit;
if prstrDir[Length(prstrDir)] <> '\' then Result := prstrDir + '\'
else Result := prstrDir;
end;
Procedure TMainfrm.GetTotalFilesToCopy(SrcFolder: String; var aTotalFolder, aTotalFiles: LongInt);
var
OverrightAll: Boolean;
SR: TSearchRec;
begin
{Make sure that trailing slash exists}
SrcFolder := CheckSlashDir(SrcFolder);
{Check if Src Folder & Dest Folder are valid}
if not DirectoryExists(SrcFolder) then begin
ShowMessage('Source folder is not valid, Please select a valid source folder');
abort;
end;
try
if FindFirst(SrcFolder + '*.*' , faAnyFile, SR) = 0 then begin
repeat
if (SR.Attr and faDirectory) = faDirectory then begin
if (SR.Name <> '.') and (SR.Name <> '..') then begin
Inc(TotalFolder);
GetTotalFilesToCopy(SrcFolder + SR.Name, aTotalFolder, aTotalFiles);
end;
end else begin
Inc(TotalFiles);
end;
until FindNext(sr) <> 0;
end;
finally
FindClose(SR);
end;
end;
Procedure TMainfrm.CopyFolders(SrcFolder, DestFolder: String);
var
SR: TSearchRec;
begin
{Make sure that trailing slash exists}
SrcFolder := CheckSlashDir(SrcFolder);
DestFolder := CheckSlashDir(DestFolder);
{Check if Src Folder & Dest Folder are valid}
if not DirectoryExists(SrcFolder) then begin
ShowMessage('Source folder is not valid, Please select a valid source folder');
abort;
end;
if not DirectoryExists(DestFolder) then begin
ShowMessage('Destination folder is not valid, Please select a valid destination folder');
abort;
end;
try
if FindFirst(SrcFolder + '*.*' , faAnyFile, SR) = 0 then begin
repeat
if (SR.Attr and faDirectory) = faDirectory then begin
if (SR.Name <> '.') and (SR.Name <> '..') then begin
{here you can handle existing folders if needed}
ForceDirectories(DestFolder + SR.Name);
CopyFolders(SrcFolder + SR.Name, DestFolder + SR.Name);
end;
end else begin
{here you can handle existing files if needed}
CopyFile(pChar(SrcFolder + SR.Name), pChar(DestFolder + SR.Name), false);
lblInfo.Caption := Format('Copying File %s to ', [SrcFolder + SR.Name, DestFolder + SR.Name]);
end;
Inc(CurrFileCount);
ProgressBar.Position := Round((CurrFileCount * 100) / TotalFiles);
until FindNext(sr) <> 0;
end;
finally
FindClose(SR);
end;
end;
procedure TMainfrm.btnSrcClick(Sender: TObject);
var
Directory: string;
begin
if not SelectDirectory('Please Select Source Directory', '', Directory) then exit;
txtSource.text := Directory;
{Get Total files and folder to copy, so we can make use of progressbar}
TotalFolder := 0;
TotalFiles := 0;
GetTotalFilesToCopy(txtSource.text, TotalFolder, TotalFiles);
lblFIleCount.Caption := Format('Contains %d File(s), %d folder(s)', [TotalFiles, TotalFolder]);
end;
procedure TMainfrm.btnDestClick(Sender: TObject);
var
Directory: string;
begin
if not SelectDirectory('Please Select Destination Directory', '', Directory) then exit;
txtDest.text := Directory;
end;
procedure TMainfrm.BitBtn1Click(Sender: TObject);
begin
CurrFileCount := 0;
CopyFolders(txtSource.text, txtDest.text);
ShowMessage('Done');
end;وأقدم شكري للجميع وبارك الله فيكم وحفظكم ورعاكم .