Установить состояние сжатия для файла

Советы » Файлы » Установить состояние сжатия для файла

{ 
  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

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com