...set a file's compression state ?

Author: Primoz Gabrijelcic 

0 Comments to this tip [Write new comment]

[ Print tip ]    

 

Tip Rating (2):  

Skill:  

Useful:  

Overall:  

 

 

 

{

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

  FSCTL_SET_COMPRESSION operation.

 

  Call the following function with the name of the file to compress and

  boolean parameter 'forceCompress'. If that one is true, file will be compressed.

  If it is false, the file will be compressed only if its parent folder is

  compressed (reason for that parameter: if you MoveFile uncompressed file from

  uncompressed folder to compressed folder, file will not become automatically

  compressed - at least under some NT 4 service packs).

 

  Ein "compressed" Attribut kann man nicht mit der FileSetAttr Funktion setzen

  sondern muss DeviceIoControl Funktion mit dem flag FSCTL_SET_COMPRESSION verwenden:

}

 

 

const

  COMPRESSION_FORMAT_NONE = 0

  COMPRESSION_FORMAT_LZNT1 = 2

  COMPRESSION_FORMAT_DEFAULT = 1;

  FILE_DEVICE_FILE_SYSTEM = 9;

  METHOD_BUFFERED = 0;

  FILE_READ_DATA = 1;

  FILE_WRITE_DATA = 2;

  FSCTL_SET_COMPRESSION = (FILE_DEVICE_FILE_SYSTEM shl 16) or

    ((FILE_READ_DATA or FILE_WRITE_DATA) shl 14) or (16 shl 2) or METHOD_BUFFERED;

 

function SetCompressedAttribut(FileName: PChar; forceCompress: Boolean): Boolean;

var

  hnd: Integer;

  Comp: SHORT;

  res: DWORD;

begin

  if forceCompress or ((GetFileAttributes(PChar(ExtractFilePath(FileName))) and

    FILE_ATTRIBUTE_COMPRESSED) <> 0) then

  begin

    Result := False;

    if (GetFileAttributes(FileName) and FILE_ATTRIBUTE_COMPRESSED) = 0 then

    begin

      hnd := CreateFile(FileName, GENERIC_READ + GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0);

      try

        Comp := COMPRESSION_FORMAT_DEFAULT;

        if not DeviceIoControl(hnd, FSCTL_SET_COMPRESSION, @Comp,

          SizeOf(SHORT), nil, 0, res, nil) then Exit;

      finally

        CloseHandle(hnd);

      end;

    end;

    Result := True;

  end

  else

    Result := True;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

  if OpenDialog1.Execute then

  begin

    SetCompressedAttribut(PChar(OpenDialog1.FileName), True);

  end;

end;