NTFS file compression

[Glenn9999]

Since I saw a topic on compression, and I happen to have this code handy, I thought I might share this - hopefully it's useful to someone. What this does is enable you to compress or decompress a file on an NTFS volume. This works on a directory, as well, but it will only signal that future files created in that directory should be compressed and will not compress the files that are already present. As I'm sure most know on this forum, compressed files on NTFS volumes typically show up in Explorer in blue shade. Of course, you will need the Windows unit for this stuff.

The actual compression/decompression function:

function CompressFile(filepath: string; state: boolean): boolean;
       const
         FSCTL_SET_COMPRESSION: DWord = $9C040;
         COMPRESSION_FORMAT_DEFAULT = 1;
         COMPRESSION_FORMAT_NONE = 0;
       var
         compsetting: Word;
         bytesreturned: DWord;
         FHandle: THandle;
       begin
     // an OS check, replace this with whatever is good to you
         if not os_is_nt then
           raise Exception.Create('A Windows NT based OS is required for this function.');
    // the actual code
         FHandle := CreateFile(PChar(filepath), GENERIC_READ or GENERIC_WRITE,
                    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
                    FILE_FLAG_BACKUP_SEMANTICS, 0);
         if state = true then
            compsetting := COMPRESSION_FORMAT_DEFAULT
         else
            compsetting := COMPRESSION_FORMAT_NONE;
         if DeviceIOControl(FHandle, FSCTL_SET_COMPRESSION, @compsetting, sizeof(compsetting),
                    nil, 0, bytesreturned, nil) then
            result := true
         else
            result := false;
         CloseHandle(FHandle);
       end;

This will be useful to find the compressed size of the file.

   function GetCompressedFileSize(FileName: string; var HighFileSize: DWord): DWord;
       type
          GCSFunc = function(FileName: PChar; var HighFileSize: DWord): DWord; stdcall;
       var
         libhandle: THandle;
         funchandle: GCSFunc;
         fresult: DWord;
       begin
         fresult := 0;
         libhandle := LoadLibrary('KERNEL32.DLL');
         if libhandle <> 0 then
            begin
              @funchandle := GetProcAddress(libhandle, 'GetCompressedFileSizeA');
              if @funchandle <> nil then
                fresult := funchandle(PChar(Filename), HighFileSize);
              FreeLibrary(libhandle);
            end;
         result := fresult;
       end;

NTFS marks these files with standard file attributes that can be used with FindFirst/FindNext.

 const
   faCompressed = $800;

This definition will enable you to test for a compressed file.

HTH someone.