Как я могу установить атрибут сжатия файла в Delphi? - PullRequest
Новая
       18

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

8 голосов
/ 10 августа 2011

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

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

Ответы [ 3 ]

7 голосов
/ 10 августа 2011

вы также можете использовать классы 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;
6 голосов
/ 10 августа 2011

Вот, пожалуйста.Назовите это по отношению к файлу или папке, и это должно сделать работу за вас.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;
6 голосов
/ 10 августа 2011

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