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

Question

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

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

- Gabriel Moraru

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;

- RRUZ

---

我很好奇，使用 WMI 而不是本机 Win32 是否有任何收益？ - David Heffernan

@David，有一些情况非常有用，例如：1）使用不支持WinApi函数的Object Pascal脚本引擎 2）像Inno Setup这样的安装程序中使用 3）当需要在远程机器上压缩文件夹或文件时...最后只是为了展示“有多种方法可以做同一件事” :) - RRUZ

尽管我不喜欢剥光任何猫 :-)，但我总是喜欢问题的替代解决方案。 - Marjan Venema

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);
  Win32Check(Handle <> INVALID_HANDLE_VALUE);
  try
    if not DeviceIoControl(Handle, FSCTL_SET_COMPRESSION, @CompressionFormat, SizeOf(Comp), nil, 0, BytesReturned, nil) then
      RaiseLastOSError;
  finally
    CloseHandle(Handle);
  end;
end;

- David Heffernan

---

我假设在*GetFileAttributes()*函数中这是有效的? 如果不是，这个部分可以从源代码中删除。 - Rudy Velthuis

没错，@Rudy。有几个属性可以通过GetFileAttributes读取，但不能通过SetFileAttributes设置；它们在MSDN的SFA页面中列出。 - Rob Kennedy

@Altar 为什么接受更改？我的回答有问题吗？ - David Heffernan

我不确定 if Handle=0 部分是否正确。难道你不应该检查 INVALID_HANDLE_VALUE 吗？请参见 https://dev59.com/Nl3Va4cB1Zd3GeqPBYzk#8241115 - Günther the Beautiful

@GünthertheBeautiful 谢谢，你说得对，我已经更新了答案。 - David Heffernan

Answer 3

这里是代码，可以用于对文件或文件夹进行压缩和解压缩。当State=true时，会进行压缩；当State=false时，会进行解压缩。需要记住的是，如果您将其应用于文件夹，则只会更改属性并使以后在该文件夹中创建的文件被压缩。要压缩已经存在于其中的文件，您需要迭代并对每个文件调用此代码（使用FindFirst/FindNext/FindClose）。祝您好运。

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;

- Glenn1234

---

为什么要指定 FILE_SHARE_READ 或 FILE_SHARE_WRITE？为什么要指定 FILE_FLAG_BACKUP_SEMANTICS？为什么不写成 result := DeviceIOControl？你还应该检查 FHandle=0，以及文件是否存在。简而言之，这段代码需要好好整理一下。 - David Heffernan

共享标志似乎很奇怪。为什么你想在文件正在压缩时让其他进程打开它？这听起来可能不是一个好主意。它能工作吗？ - David Heffernan

只要它有效，那还有关系吗？这听起来很像凭运气编程。 - johnny

很好。有一段时间我以为这是Usenet，因为得到的回复太多了。共享标志毫无意义，我同意这一点。通常我不喜欢过度编写代码（就像已经在其他地方检查了有效路径/文件的程序中所说的那样）。话虽如此，在CreateFile之后检查GetLastError = 2是否足以进行路径/文件检查吗？ - Glenn1234

@johnny 更像是对关心“:=”后是否有一个或两个空格的人做出反应。如果我说“if Function_That_Returns_Condition then Result := true else Result := false”或“Result := Function_That_Returns_Condition”，这有什么区别吗？第二种看起来更简洁，但两种写法同样有效，对吧？ - Glenn1234