8

How can I compact files (set the 'c' attribute) from Delphi? I am speaking about the "compress contents to save disk space" function available under NTFS.

It seems that FileSetAttr does not allow me to set the 'c' attribute for a file.

Rob Kennedy
  • 161,384
  • 21
  • 275
  • 467
Gabriel
  • 20,797
  • 27
  • 159
  • 293

3 Answers3

7

you can also use the CIM_DataFile and CIM_Directory WMI classes, both had two methods called Compress and UnCompress which can be used to set the NTFS compression in a file or folder.

Check these samples (if the )

Compress (NTFS) or UnCompress a File

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;

Compress (NTFS) or UnCompress a Folder

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
  • 134,889
  • 20
  • 356
  • 483
  • 1
    I'm curious, is there anything to be gained from using WMI rather than native Win32? – David Heffernan Aug 09 '11 at 23:23
  • 2
    @David, exist some situations when can be very usefull example 1) using a Object pascal scripting engine which not support WinApi functions 2) use from a Installer like Inno Setup 3) when you need to compress a folder or file in a remote machine ... and finally is only to show "There is always more than one way to skin a cat" :) – RRUZ Aug 09 '11 at 23:45
  • @RRUZ: Though I prefer not to skin any cats :-), I always like alternate solutions to a problem. – Marjan Venema Aug 10 '11 at 06:48
6

The documentation for SetFileAttributes() explains that the FILE_ATTRIBUTE_COMPRESSED flag is not accepted by that function (although it is for GetFileAttributes). Instead it states:

To set a file's compression state, use the DeviceIoControl function with the FSCTL_SET_COMPRESSION operation.

The FSCTL_SET_COMPRESSION link in particular explains precisely how to do it. It goes something like this:

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
  • 601,492
  • 42
  • 1,072
  • 1,490
6

Here you go. Call this against a file or a folder and it should do the job for you. State=true makes it compressed, State=false undoes the compression. Remember, though, that if you run it against a folder it only changes the attribute and makes it so future files created in that folder are compressed. To compress the ones already in there, you have to iterate and call this on each file (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;
Glenn1234
  • 2,542
  • 1
  • 16
  • 21
  • 1
    Why do you specify `FILE_SHARE_READ or FILE_SHARE_WRITE`? Why do you specify `FILE_FLAG_BACKUP_SEMANTICS`? Why don't you write `result := DeviceIOControl`? You should also check for `FHandle=0`. And also for file not existing. In short, this could do with a good tidy up. – David Heffernan Aug 09 '11 at 21:24
  • 1&2. Does it matter? It was copied. 3. Again does it matter as long as it works? 4. The function is used in a program which provides reliable file names/paths so it doesn't matter. But yes on a stand-alone FHandle should be checked for 0 or not 5. File not existing is irrelevant to this function because the function FileExists doesn't work on folders. Checking for that renders it partly non-functional since this function can be validly called against folders. – Glenn1234 Aug 10 '11 at 02:45
  • and on 2, FILE_FLAG_BACKUP_SEMANTICS is required to compress folders. – Glenn1234 Aug 10 '11 at 03:15
  • The sharing flags seem odd. Why do you want to let other process open the file while it is being compresed? It sounds like that might not be a good idea. Does it work? – David Heffernan Aug 10 '11 at 06:31
  • OK, I've found the documentation for `FILE_FLAG_BACKUP_SEMANTICS`. In `CreateFile` docs it says "You must set this flag to obtain a handle to a directory." I didn't know that. I'm still interested in how the system can compress a file at the same time as allowing other processes to write to it. – David Heffernan Aug 10 '11 at 07:08
  • 5
    "Again does it matter as long as it works?" Sounds an awful lot like programming by coincidence to me. – johnny Aug 10 '11 at 07:40
  • Note I'm not asserting that I think you are wrong, I'd just like to understand why you've done it this way. – David Heffernan Aug 10 '11 at 10:41
  • 1
    Fair enough. For a while I thought I was on Usenet with the responses this got. The sharing flags don't make sense, I agree. I usually don't like overdoing code (like was said, that was copied out of a program where valid path/file was already checked elsewhere). That said, wouldn't checking for GetLastError = 2 after CreateFile be sufficient for path/file checking? – Glenn1234 Aug 10 '11 at 18:27
  • @Glenn1234 - Yeah Usenet can be an "interesting" place to say the least. – TWA Aug 10 '11 at 18:41
  • @Glenn Plenty of ways to check for existence, that's not really important as you said. Was the sharing that seemed most odd and I see that you've edited it. – David Heffernan Aug 10 '11 at 19:30
  • @johnny More like reacting to someone who cares about whether there is one or two spaces after the := . Does it matter if I say "if Function_That_Returns_Condition then Result := true else Result := false" or "Result := Function_That_Returns_Condition? The second is cleaner looking, but both equally work, right? – Glenn1234 Aug 11 '11 at 00:44
  • @Glenn1234, You're right, point 3 isn't that important. Although when it was combined with "Does it matter? It was copied." I got a little bit concerned. – johnny Aug 11 '11 at 05:18