نمایش نتایج 1 تا 5 از 5

نام تاپیک: بک آپ گرفتن از زیر شاخه ها

  1. #1
    کاربر دائمی آواتار mbshareat
    تاریخ عضویت
    آبان 1387
    محل زندگی
    شهر مقدس قم-چهارمردان-کوچه 37
    پست
    962

    بک آپ گرفتن از زیر شاخه ها

    سلام
    میخوام یه بک آپ از شاخه های موجود در پوشه جاری در myDocument بگیرم.
    چند تا کد دارم که کمی دستکاریش کردم.
    نمی دونم چرا بار اول که برنامه رو اجرا می کنم،درست کار می کنه ولی بار دوم و سوم عجیب کار می کنه.
    مثلا یه پوشه داخلی دارم به نام A.بار اول که برنامه رو اجرا می کنم درست کپی می کنه(BackUp\A).اما بار دوم یه زیر شاخه هم داخل A میسازه(BackUp\A\A).
    ممکنه کد رو یه نگاه کنید برام اصلاح کنید؟
    unit EasyBackupUnit;

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, FileCtrl, StdCtrls,ShellApi,ShlObj,ActiveX,StrUtils;

    type
    TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    var
    Form1: TForm1;
    Dirs:Array[1..32000] of String;
    DirsNo:Word=0;


    implementation

    {$R *.dfm}
    function CopyDir(const fromDir, toDir: string): Boolean;
    var
    fos: TSHFileOpStruct;
    begin
    ZeroMemory(@fos, SizeOf(fos));
    with fos do
    begin
    wFunc := FO_COPY;
    fFlags := FOF_FILESONLY;
    pFrom := PChar(fromDir + #0);
    pTo := PChar(toDir)
    end;
    Result := (0 = ShFileOperation(fos));
    end;
    procedure GetDirs(const sRootDir:string;OnlyMainDir:Boolean);
    var
    srSearch: TSearchRec;
    sSearchPath: string;
    sltSub: TStrings;
    i: Integer;
    begin
    sltSub := TStringList.Create;
    try
    sSearchPath := IncludeTrailingBackslash(sRootDir);
    if FindFirst(sSearchPath + '*', faDirectory, srSearch) = 0 then
    repeat
    if (srSearch.Name <> '.') and
    (srSearch.Name <> '..') then
    begin
    if ((srSearch.Attr and faDirectory) =faDirectory) then
    Begin
    Inc(DirsNo);
    Dirs[DirsNo]:=sSearchPath + srSearch.Name;
    End;
    sltSub.Add(sSearchPath + srSearch.Name);
    end;
    until (FindNext(srSearch) <> 0);

    FindClose(srSearch);
    if OnlyMainDir=false then
    Begin
    for i := 0 to sltSub.Count - 1 do
    GetDirs(sltSub.Strings[i],OnlyMainDir);
    End;
    finally
    FreeAndNil(sltSub);
    end;
    end;
    function MyDocumentPath: string;
    var
    Allocator: IMalloc;
    SpecialDir: PItemIdList;
    FBuf: array[0..MAX_PATH] of Char;
    PerDir: string;
    begin
    if SHGetMalloc(Allocator) = NOERROR then
    begin
    SHGetSpecialFolderLocation(Form1.Handle, CSIDL_PERSONAL, SpecialDir);
    SHGetPathFromIDList(SpecialDir, @FBuf[0]);
    Allocator.Free(SpecialDir);
    Result:=string(FBuf);
    end;
    end;
    procedure TForm1.FormCreate(Sender: TObject);
    Var
    I,J:SmallInt;
    F1,F2:String;
    begin
    GetDirs(ExtractFileDir(Application.ExeName),true);
    ForceDirectories(MyDocumentPath+'\Backup');
    For I:=1 to DirsNo do
    Begin
    //ShowMessage(Dirs[I]+#13+MyDocumentPath+'\Backup\'+ExtractFileName(Dir s[I]));
    CopyDir(Dirs[I],MyDocumentPath+'\Backup\'+ExtractFileName(Dirs[I]));
    End;
    Application.Terminate;
    end;

    end.

  2. #2
    کاربر دائمی آواتار mbshareat
    تاریخ عضویت
    آبان 1387
    محل زندگی
    شهر مقدس قم-چهارمردان-کوچه 37
    پست
    962

    نقل قول: بک آپ گرفتن از زیر شاخه ها

    چند تا کد کپی شاخه رو امتحان کردم بعضیها کار نکردند وچند تاشون همینطوری کار کردند.مجبور شدم کد حذف شاخه قبل از کپی بذارم.

  3. #3
    کاربر دائمی آواتار hp1361
    تاریخ عضویت
    دی 1384
    محل زندگی
    تهران
    پست
    750

    نقل قول: بک آپ گرفتن از زیر شاخه ها

    نقل قول نوشته شده توسط mbshareat مشاهده تاپیک
    سلام
    میخوام یه بک آپ از شاخه های موجود در پوشه جاری در myDocument بگیرم.
    end.[/PASCAL]
    سلام

    منظورت فقط پوشه های موجود در مسیر جاریه یا شامل فایل هم میشه؟

  4. #4
    کاربر دائمی آواتار mbshareat
    تاریخ عضویت
    آبان 1387
    محل زندگی
    شهر مقدس قم-چهارمردان-کوچه 37
    پست
    962

    نقل قول: بک آپ گرفتن از زیر شاخه ها

    زیر شاخه ها رو هم میخواستم کپی بگیرم.چون در واقع نتیجه نهایی دستکاری فایلها رو میخوام.

  5. #5

    نقل قول: بک آپ گرفتن از زیر شاخه ها

    نیازی به این کد پیچیده نیست و میتوانید این کار را با روتینهای موجود در یونتی IOUtils انجام دهید.

تاپیک های مشابه

  1. پاسخ: 70
    آخرین پست: شنبه 30 آبان 1394, 20:13 عصر
  2. سوال: چرا زیر سطح های منوی بازشو، زیر بقیه Divها قرار می گیره؟(مثل این تصویر)
    نوشته شده توسط fa_karoon در بخش طراحی وب (Web Design)
    پاسخ: 4
    آخرین پست: جمعه 08 شهریور 1392, 21:13 عصر
  3. سوال: آیا راهی هست که بدون اینکه فرم بالایی پایین فرم زیرش بره فوکوس رو به فرم زیرش منتقل کنه؟
    نوشته شده توسط mbshareat در بخش مباحث عمومی دلفی و پاسکال
    پاسخ: 1
    آخرین پست: سه شنبه 29 فروردین 1391, 09:56 صبح
  4. سوال: زیر آیتمهای منو در Google chrome زیر banner سایت قرار میگیره
    نوشته شده توسط majid784 در بخش طراحی وب (Web Design)
    پاسخ: 5
    آخرین پست: سه شنبه 08 آذر 1390, 18:07 عصر

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •