Autor Beitrag
Tino
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Veteran
Beiträge: 9839
Erhaltene Danke: 45

Windows 8.1
Delphi XE4
BeitragVerfasst: Mi 02.04.03 17:19 
Benötigt Windows NT/2000/XP und funktioniert nur auf NTFS Laufwerken.

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
const 
  COMPRESSION_FORMAT_NONE = 0; 
  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 CompressFile(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 or 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

function UnCompressFile(FileName: PChar): Boolean; 
var 
  hnd:  Integer; 
  Comp: SHORT; 
  res:  DWORD; 
begin 
  Result := False; 
  if (GetFileAttributes(FileName) and FILE_ATTRIBUTE_COMPRESSED) <> 0 then 
  begin 
    hnd := CreateFile(FileName, GENERIC_READ or GENERIC_WRITE, 0,nil, OPEN_EXISTING, 0,0); 
    try 
      Comp := COMPRESSION_FORMAT_NONE; 
      if not DeviceIoControl(hnd, FSCTL_SET_COMPRESSION, @Comp, 
        SizeOf(SHORT), nil, 0, res, nil) then Exit; 
    finally 
      CloseHandle(hnd); 
    end; 
    Result := True; 
  end 
  else 
    Result := True; 
end;

Aufgerufen können die Funktionen wie folgt:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if CompressFile(PChar('C:\test.txt'), True) then 
    ShowMessage('Vorgang erfolgreich'); 
end

procedure TForm1.Button2Click(Sender: TObject); 
begin 
  if UnCompressFile(PChar('C:\test.txt')) then 
    ShowMessage('Vorgang erfolgreich'); 
end;