Question

如何从Delphi压缩文件（设置'c'属性）？我说的是NTFS下可用的“压缩内容以节省磁盘空间”功能。

似乎FileSetAttr不允许我为文件设置'c'属性。

Answer 1

您还可以使用CIM_DataFile和CIM_Directory WMI类，它们都有两个名为Compress和UnCompress的方法，可用于在文件中设置NTFS压缩或文件夹。

检查这些样本（如果是）

压缩（NTFS）或解压缩文件

function  CompressFile(const FileName:string;Compress:Boolean):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_DataFile.Name="%s"',[StringReplace(FileName,'\','\\',[rfReplaceAll])]));
  if Compress then
    Result:=FWbemObject.Compress()
  else
    Result:=FWbemObject.UnCompress();
end;

压缩（NTFS）或解压缩文件夹

function  CompressFolder(const FolderName:string;Recursive, Compress:Boolean):integer;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObject   : OLEVariant;
  StopFileName  : OLEVariant;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
  FWbemObject   := FWMIService.Get(Format('CIM_Directory.Name="%s"',[StringReplace(FolderName,'\','\\',[rfReplaceAll])]));
  if Compress then
    if Recursive then
     Result:=FWbemObject.CompressEx(StopFileName, Null, Recursive)
    else
     Result:=FWbemObject.Compress()
  else
    if Recursive then
     Result:=FWbemObject.UnCompressEx(StopFileName, Null, Recursive)
    else
     Result:=FWbemObject.UnCompress();
end;

Answer 2

SetFileAttributes()的文档解释了该函数不接受FILE_ATTRIBUTE_COMPRESSED标志（尽管它是GetFileAttributes)。而是声明：

要设置文件的压缩状态，请使用带有DeviceIoControl操作的FSCTL_SET_COMPRESSION功能。

FSCTL_SET_COMPRESSION链接特别解释了如何做到这一点。它是这样的：

const
  COMPRESSION_FORMAT_NONE = 0;
  COMPRESSION_FORMAT_DEFAULT = 1;
  COMPRESSION_FORMAT_LZNT1 = 2;

procedure SetCompressionAttribute(const FileName: string; const CompressionFormat: USHORT);
const
  FSCTL_SET_COMPRESSION = $9C040;
var
  Handle: THandle;
  Flags: DWORD;
  BytesReturned: DWORD;
begin
  if DirectoryExists(FileName) then
    Flags := FILE_FLAG_BACKUP_SEMANTICS
  else if FileExists(FileName) then
    Flags := 0
  else
    raise Exception.CreateFmt('%s does not exist', [FileName]);

  Handle := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, Flags, 0);
  if Handle=0 then
    RaiseLastOSError;
  if not DeviceIoControl(Handle, FSCTL_SET_COMPRESSION, @CompressionFormat, SizeOf(Comp), nil, 0, BytesReturned, nil) then
  begin
    CloseHandle(Handle);
    RaiseLastOSError;
  end;
  CloseHandle(Handle);
end;

Answer 3

你走了。对文件或文件夹进行调用，它应该为您完成工作。 State = true使其压缩，State = false撤消压缩。但请记住，如果您针对某个文件夹运行它，它只会更改该属性并使其生成，以便压缩在该文件夹中创建的未来文件。要压缩那里已经存在的那些，你必须在每个文件上迭代并调用它（FindFirst / FindNext / FindClose）。 HTH。

function CompressFile(filepath: string; state: boolean): boolean;
  const
    COMPRESSION_FORMAT_DEFAULT = 1;
    COMPRESSION_FORMAT_NONE = 0;
    FSCTL_SET_COMPRESSION: DWord = $9C040;
  var
    compsetting: Word;
    bytesreturned: DWord;
    FHandle: THandle;
  begin
   //if not os_is_nt then
   //  raise Exception.Create('A Windows NT based OS is required for this function.');
    FHandle := CreateFile(PChar(filepath), GENERIC_READ or GENERIC_WRITE,
              0, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
    if FHandle = INVALID_HANDLE_VALUE then
      raise Exception.Create('CompressFile Message: ' + SysErrorMessage(GetLastError));
    if state = true then
      compsetting := COMPRESSION_FORMAT_DEFAULT
    else
      compsetting := COMPRESSION_FORMAT_NONE;
    try
      Result := DeviceIOControl(FHandle, FSCTL_SET_COMPRESSION, @compsetting,
         sizeof(compsetting), nil, 0, bytesreturned, nil);
    finally
      CloseHandle(FHandle);
    end;
  end;

如何在Delphi中设置文件的压缩属性？

3 个答案: