Как установить атрибут сжатия файла в Delphi?

Как я могу сжать файлы (установить атрибут 'c') из Delphi? Я говорю о функции "сжимать содержимое для экономии места на диске", доступной в NTFS.

Похоже, что FileSetAttr не позволяет мне установить атрибут 'c' для файла.

3 8
compression delphi ntfs

3 ответа:

Документация для 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;
6

Вы также можете использовать 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;
7

Вот, пожалуйста. Вызовите это против файла или папки, и это должно сделать работу за вас. Состояние = true делает его сжатым, состояние=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;
6