function WindowsCopyFileSec(FromDir, ToDir : string) : boolean;

  PSecDesc   : PSecurityDescriptor;

  SizeNeeded : DWORD;

 

  procedure CopyAR(FromDir, ToDir : string; ReqInfo: Cardinal);

  begin

    GetFileSecurity(PChar(FromDir), ReqInfo, PSecDesc, 1024, SizeNeeded);

    SetFileSecurity(PChar(ToDir), ReqInfo, PSecDesc);

  end;

 

  procedure CopyA(FromDir, ToDir: String);

  var

    Found : integer;

    SRec  : TSearchRec;

    s     : String;

    AFrom,

    ATo   : String;

  begin

    if not DirectoryExists(ToDir) then begin

      MkDir(ToDir);

      CopyAR(FromDir, ToDir, DACL_SECURITY_INFORMATION);

    end;

 

    if FindFirst(FromDir + '\*.*', faAnyFile, SRec) = 0 then begin

      repeat

 

        if (SRec.name <> '.') and (SRec.name <> '..') then begin

            AFrom := FromDir + '\' + SRec.Name;

            ATo := ToDir + '\' + SRec.Name;

 

            if (SRec.Attr and faDirectory) = faDirectory

              then CopyA(AFrom, ATo)

              else begin

                CopyFile(PChar(AFrom), PChar(ATo), False);

                CopyAR(AFrom, ATo, DACL_SECURITY_INFORMATION);

              end;

        end;

 

      until FindNext(SRec) <> 0;

      FindClose(SRec);

    end;

  end;

 

  GetMem(PSecDesc, 1024);

  try

    CopyA(FromDir, ToDir);

  finally

    FreeMem(PSecDesc);

  end;

end;

 Windows, AclAPI, AccCtrl;

 

...

 

function CopyAccessSecurity(SrcFile, DestFile: string): DWORD;

  pDACL: PACL;

  pSD: PSECURITY_DESCRIPTOR;

  result := GetNamedSecurityInfo(Pchar(SrcFile), SE_FILE_OBJECT,

    DACL_SECURITY_INFORMATION, nil, nil, PACL(@pDACL), nil, pSD);

 

  if result <> ERROR_SUCCESS then exit;

 

  result := SetNamedSecurityInfo(Pchar(DestFile), SE_FILE_OBJECT,

    DACL_SECURITY_INFORMATION, nil, nil, pDACL, nil);

end;

  CopyFile(FileSrc, FileDest, true);

  CopyAccessSecurity(FileSrc, FileDest);