Glenn9999 Posted April 20, 2009 Share Posted April 20, 2009 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. Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now