Mega Code Archive
Perform Some NTFS specific File Functions
<![CDATA[
Title: Perform Some NTFS-specific File Functions
This entails a description of how to do some specific NTFS file functions, and have been tested on what I have here (Windows XP). Since I do not have anything that supports the OS encryption, I didn't go down that avenue.
But I did implement a couple of things that interested me, that I hope are useful to some people here. Some descriptions and examples below, and a unit where I wrapped all the functions at the end. It's a little rough in spots and might be fixed up. As was said, it was tested on Windows XP, and hopefully it can be used on some other NT based OSes. Comments are welcome of course.
Alternate Data Streams
I know this one is to the point of being paranoid for the security types, since ADS is not implemented in most things (even Explorer) and the malware writers got to this one before most of the other softwares did. But since the cat is out of the bag anyway, and Microsoft even seems to use them regularly now in their apps (I found something like 140K worth in Live Mail files on my testing), I'll describe how you can use them in Delphi. For further reading on the general topic, Google will produce a few decent articles.
Alternate Data Streams (ADS) are a common features of NTFS formatted drives. More or less, a NTFS file or directory can have multiple data streams. The OS uses this in various ways (the compressed files discussed later is one), but you can use them too in various ways, though OS commands or Delphi as I am about to describe.
The primary raw data stream you will see is ::$DATA, which occurs for each and every file and describes what you get if you were to normally write the file. You will notice a few others if you scan a system for ADS (like with ADSSpy without the "ignore common types" option).
Now to get to Delphi: Using ADSes is really simple (almost embarrassingly simple). The standard functions and procedures support them since the underlying calls support them. This means I can assign an ADS file like "MYFILE.TXT:ADSFILE.TXT" with the AssignFile function and get away with it. In fact, I did this to create ADSes for my testing. Of course, there's a few minor little gotchas, like how the OS resolves unknown file names.
CODE
{$APPTYPE CONSOLE}
program adscreate; uses sysutils;
var
outfile: text;
i: integer;
begin
assign(outfile, 'ADSTEXT.TXT');
rewrite(outfile);
writeln(outfile, 'Test');
close(outfile);
writeln('Main file created.');
for i := 1 to 9 do
begin
assign(outfile, 'ADSTEXT.TXT:INSIDE' + IntToStr(i) + '.TXT');
rewrite(outfile);
writeln(outfile, 'Test ADS ', IntToStr(i));
close(outfile);
writeln('ADS file ', i, ' created.');
end;
readln;
end.
The only harder thing that I came across and wanted to attempt was to find the ADSes in the first place.
CODE
{$APPTYPE CONSOLE}
program adsview; uses sysutil2;
var
SR: TADSSearchRec;
begin
if ADSFindFirst('D:\BACKUP', SR) = false then
repeat
if SR.StreamName '' then
writeln(SR.StreamName, ' : ', SR.StreamSize);
until ADSFindNext(SR) = true;
if SR.StreamName '' then
writeln(SR.StreamName, ' : ', SR.StreamSize);
readln;
end.
(yes that's a path to a directory - ADSes can be attached to those as well as ordinary files)
This is the example usage for the unit below. As you notice, the process could be distilled down to a similar process of the FindFirst/FindNext. All interesting valid fields that can be returned are shown. There are other fields that function as some of the fields in TSearchRec, to keep track of the results. All resources are attached to the TADSSearchRec, so no FindClose is necessary.
Rough parts: There's really no way to tell out of this (yet) whether there are any records to return at all - this is why the name is checked. The code signals whether there are more records to return AFTER the current one, which means the current one would still need to be processed after the fact.
Individual File/Directory Compression
As you may or may not know, Windows supports single file-based compression on NTFS drives. This is one of the options in the "disk cleanup" This example shows all the
compression-oriented options that were implemented in the example unit below:
CODE
{$APPTYPE CONSOLE}
program comptest; uses sysutils, sysutil2;
{ test compression attribute on a file }
var
outfile: text;
i: integer;
fattr: Integer;
HighWord: DWord;
begin
assign(outfile, 'COMPTEST.TXT');
rewrite(outfile);
for i := 1 to 2000 do
writeln(outfile, 'Test.');
close(outfile);
if CompressFile('COMPTEST.TXT', true) then
Writeln('File is compressed.')
else
Writeln('File compress Failed.');
readln;
fattr := FileGetAttr('COMPTEST.TXT');
if (fattr and faCompressed) = faCompressed then
writeln('File shows to be compressed.');
writeln(' Compressed size is: ',
GetCompressedFileSize('COMPTEST.TXT', HighWord), ' bytes.');
readln;
if CompressFile('COMPTEST.TXT', false) then
Writeln('File is decompressed.')
else
Writeln('file deCompress Failed.');
readln;
fattr := FileGetAttr('COMPTEST.TXT');
if (fattr and faCompressed) faCompressed then
writeln('File shows to be not compressed.');
writeln('Uncompressed size is: ',
GetCompressedFileSize('COMPTEST.TXT', HighWord), ' bytes.');
readln;
end.
Compression was implemented through the CompressFile function as is shown. It can be implemented on both files and directories, but on a directory it will only compress by default the files that are subsequently created. This means that iteration through the files using FindFirst would be necessary to fully compress directories. True in the second parm means you want the file compressed, false means you want it decompressed.
NTFS drives support more file attributes than what is standardly implemented in Delphi. NTFS will tag compressed files, which means that they can be found upon inspection of the file attribute. This is demonstrated.
As well, knowing how much space a compressed file takes on the drive would interest us, too. The first parm is the file name, second parm is the high order DWord representing the file size. The return value is the low order DWord.
Sparse Files
Sparse files are another method that can be used to lower the amount of data stored to disk. NTFS notes the positions of series of zero (0) bytes and then does not store them. But if you read the file, it will return the file as originally intended. NTFS works in 64K chunks, so you will need to have a file with at least that many zeros in order for them to not be stored.
An example of writing one.
CODE
{$APPTYPE CONSOLE}
program sparse_file; uses windows, sysutils, sysutil2;
{ creation and usage of sparse file }
var
filepath: string;
fattr: integer;
fhigh: DWord;
function sparse_write(filepath: string): boolean;
{ writes the sparse range allocation array }
var
fsbuffer: array[1..1024] of TRangeBuffer;
bytesreturned, reccnt, i: DWord;
begin
bytesreturned := sparse_query_ranges(filepath, @fsbuffer, sizeof(fsbuffer));
if bytesreturned -1 then
begin
writeln('Bytes Returned: ', bytesreturned);
Result := true;
end
else
begin
writeln('Error in return.');
Result := false;
end;
writeln;
reccnt := bytesreturned div Sizeof(TRangeBuffer);
for i := 1 to reccnt do
begin
writeln(i, ' File Offset: ', fsbuffer[i].fileoffsetlow);
writeln(i, ' File Length: ', fsbuffer[i].fileLengthLow);
writeln;
end;
end;
procedure write_test(var filepath: string);
var
outfile: THandle;
i, k, bufcount, byteswritten: longint;
inbuffer: packed array[1..2] of char;
begin
{ write an eligible sparse test file }
outfile := CreateFile(PChar(filepath), GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CREATE_ALWAYS,
FILE_FLAG_BACKUP_SEMANTICS, 0);
if sparse_set_file(filepath) then
writeln('Sparse file set.')
else
writeln('Sparse file not set.');
for k := 1 to 20 do
begin
bufcount := 1;
for i := 1 to 10 do
begin
sparse_zero_file(filepath, bufcount, 640000);
// this function above does not set the file pointer, you must do that
SetFilePointer(outfile, 640000, nil, FILE_CURRENT);
bufcount := bufcount + 640000;
inbuffer[1] := #3;
inbuffer[2] := #2;
WriteFile(outfile, inbuffer, sizeof(inbuffer), byteswritten, nil);
inc(bufcount, 2);
end;
end;
CloseHandle(outfile);
end;
begin
filepath := 'SPARSE_TEST.DAT';
// write the sparse data file
write_test(filepath);
// test for the sparse file attribute
fattr := FileGetAttr(filepath);
if (fattr and faSparseFile) = faSparseFile then
writeln('File shows to be sparse file.')
else
writeln('File is not sparse file.');
// finally write the allocation spots and the storage size of the file
sparse_write(filepath);
writeln('File size is: ', GetCompressedFileSize(filepath, fhigh));
readln;
end.
sparse_query_ranges returns the ranges in the file that have actual data (i.e. non-zero).
sparse_set_file tags the file as sparse. However, it must be written by the application using the next function. It can not be undone by the OS, so the file must be rewritten to a normal file in order to undo it.
sparse_zero_file marks the sparse file with zero characters. If you use this on an un-sparse file it will write the number of zeros to the file. This does not position the file pointer, so you will have to do it yourself, as demonstrated in the example.
GetCompressedFileSize returns the total size of the sparse file as stored on disk.
Hard Links
A hard link is a directory entry to a file on a local volume. In essence it appears as a file and acts like the file in every way, but references the original file. This means I can create FILE1.TXT, and then a hard-link FILE2.TXT, edit FILE2.TXT and get the contents of FILE1.TXT and change that file.
But if I rename, copy, or delete the hard link, the original file is untouched.
CODE
{$APPTYPE CONSOLE}
program hardlink; uses ntfsfile;
var
oldfile, newlink: string;
begin
oldfile := 'ADSREAD.EXE';
newlink := 'TEST.EXE';
if CreateHardLink(newlink, oldfile) then
writeln('Hard link created.')
else
writeln('Hard link not created.');
readln;
end.
The Unit
CODE
unit sysutil2;
{
sysutils+ = try to properly access some NTFS related disk functions
can not implement and test due to not having access to it:
1) EFS Encryption
2) Symbolic links
}
interface
const
{ new file attribute constants }
faDevice = $40; // device - not used
faNormal = $80; // normal file - implied not any other attr
faTemporary = $100; // temporary file
faSparseFile = $200; // sparse file
faReparsePoint = $400; // file with reparse point or symbolic link
faCompressed = $800; // compressed file
faOffline = $1000; // file is offline
faNotContentIndexed = $2000; // file is not content indexed
faEncrypted = $4000; // encrypted file
faVirtual = $10000; // virtual file
type
DWord = Longint;
TFileInformation = array[1..16384] of byte;
TADSSearchRec = record
StreamName: string;
StreamSize: longint;
IB: TFileInformation;
IBPos: longint;
end;
TRangeBuffer = record
FileOffsetLow: DWord;
FileOffSetHigh: DWord;
FileLengthLow: DWord;
FileLengthHigh: DWord;
end;
function ADSFindFirst(filename: string; var SR: TADSSearchRec): boolean;
function ADSFindNext(var SR: TADSSearchRec): boolean;
function CompressFile(filepath: string; state: boolean): boolean;
function GetCompressedFileSize(FileName: string; var HighFileSize: DWord): DWord;
function sparse_set_file(filepath: string): boolean;
function sparse_zero_file(filepath: string; start, range: longint): boolean;
function sparse_query_ranges(filepath: string; fsbuffer: pointer; fssize: DWord): Longint;
function CreateHardLink(newlink, currfile: string): boolean;
implementation
uses windows, d3_priv, sysutils;
const
FSCTL_SET_COMPRESSION: DWord = $9C040;
FSCTL_GET_COMPRESSION: DWord = $9003C;
FSCTL_SET_SPARSE: DWord = $900C4;
FSCTL_SET_ZERO_DATA: DWord = $980C8;
FSCTL_QUERY_ALLOCATED_RANGES: DWord = $940CF;
FileStreamInformation = 22;
COMPRESSION_FORMAT_DEFAULT = 1;
COMPRESSION_FORMAT_NONE = 0;
type
TIOStatusBlock = record
Status: DWord;
Information: DWord;
end;
TFileStreamInfo = record
NextEntry: DWord;
NameLength: DWord;
StreamSizeLow: DWord;
StreamSizeHigh: DWord;
AllocLow: DWord;
AllocHigh: DWord;
cStreamName: array[1..296] of widechar;
end;
PFileStreamInfo = ^TFileStreamInfo;
NTQProc = procedure(FileHandle: THandle; var ISB: TIOStatusBlock;
InfoBlock: TFileInformation;
InfoBlockSize: DWord; FSI: Integer); stdcall;
GCSFunc = function(FileName: PChar; var HighFileSize: DWord): DWord; stdcall;
procedure GetFileInfoBlock(FHandle: THandle; var Infoblock: TfileInformation);
{ bulk of work here - get the IO block and then return first item }
var
ISB: TIOStatusBlock;
LibHandle: THandle;
funchandle: NTQProc;
begin
{ get file info block in this section }
libhandle := LoadLibrary('ntdll.dll');
if libhandle 0 then
begin
@funchandle := GetProcAddress(libhandle, 'NtQueryInformationFile');
if @funchandle nil then
begin
FillChar(ISB, Sizeof(ISB), 0);
FillChar(InfoBlock, sizeof(InfoBlock), 0);
FuncHandle(FHandle, ISB, InfoBlock,
sizeof(infoblock), FileStreamInformation);
end;
FreeLibrary(libhandle);
end;
end;
function procstring(P: PFileStreamInfo): string;
var
fname: ShortString;
i: integer;
begin
{ get string }
SetLength(fname, P.NameLength);
for i := 1 to P.NameLength do
fname[i] := Char(P.cStreamName[i]);
SetLength(fname, P.NameLength div 2);
{ now parse it apart }
fname := Copy(Fname, 2, Length(fname));
fname := Copy(Fname, 1, Pos(':$DATA', Fname)-1);
Result := fname;
end;
function ADSFindFirst(filename: string; var SR: TADSSearchRec): boolean;
var
FHandle: THandle;
begin
if not os_is_nt then
raise Exception.Create('A Windows NT based OS is required for this function.');
NTSetPrivilege('', SE_BACKUP_NAME, true);
FHandle := CreateFile(PChar(Filename), 0,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS, 0) ;
GetFileInfoBlock(FHandle, SR.IB);
CloseHandle(FHandle);
NTSetPrivilege('', SE_BACKUP_NAME, false);
SR.IBPos := 1;
Result := ADSFindNext(SR);
end;
function ADSFindNext(var SR: TADSSearchRec): boolean;
var
P: PFileStreamInfo;
begin
P := @SR.IB[SR.IBPos];
SR.StreamSize := P^.StreamSizeLow;
SR.StreamName := ProcString(P);
if P^.NextEntry = 0 then
Result := true
else
Result := false;
Inc(SR.IBPos, P^.NextEntry);
end;
function CompressFile(filepath: string; state: boolean): boolean;
var
compsetting: Word;
bytesreturned: DWord;
FHandle: THandle;
begin
if not os_is_nt then
raise Exception.Create('A Windows NT based OS is required for this function.');
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;
function GetCompressedFileSize(FileName: string; var HighFileSize: DWord): DWord;
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;
function sparse_set_file(filepath: string): boolean;
{ creates sparse file }
var
bytesreturned: DWord;
FHandle: THandle;
begin
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 DeviceIOControl(FHandle, FSCTL_SET_SPARSE, nil, 0, nil, 0,
bytesreturned, nil) then
result := true
else
result := false;
CloseHandle(FHandle);
end;
function sparse_zero_file(filepath: string; start, range: longint): boolean;
{ marks spot in file as zero length. This does not set the file pointer.
You must set the file pointer, however }
type
TZeroDataRecord = packed record
FileOffSetLow: DWord;
FileOffSetHigh: DWord;
BeyondFinalZeroLow: DWord;
BeyondFinalZeroHigh: DWord;
end;
var
ZeroData: TZeroDataRecord;
bytesreturned: DWord;
FHandle: THandle;
begin
FHandle := CreateFile(PChar(filepath), GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS, 0);
SetFilePointer(FHandle, start, nil, FILE_BEGIN);
FillChar(ZeroData, sizeof(ZeroData), 0);
ZeroData.FileOffSetLow := start;
ZeroData.BeyondFinalZeroLow := start + range;
if DeviceIOControl(FHandle, FSCTL_SET_ZERO_DATA, @ZeroData, sizeof(ZeroData),
nil, 0, bytesreturned, nil) then
result := true
else
result := false;
CloseHandle(FHandle);
end;
function sparse_query_ranges(filepath: string; fsbuffer: pointer;
fssize: DWord): Longint;
{ this returns all the spots in the file that HAVE allocation spaces -
actual storage can be found by using GetCompressedFileSize }
var
FHandle: THandle;
inbuffer: TRangeBuffer;
bytesreturned: DWord;
begin
FHandle := CreateFile(PChar(filepath), GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS, 0);
FillChar(inbuffer, Sizeof(Inbuffer), 0);
fillChar(fsbuffer^, fssize, 0);
inbuffer.FileOffsetLow := 0;
inbuffer.FileLengthLow := GetFileSize(FHandle, nil);
if DeviceIOControl(FHandle, FSCTL_QUERY_ALLOCATED_RANGES,
@inbuffer, sizeof(inbuffer),
fsbuffer, fssize,
bytesreturned, nil) then
result := bytesreturned
else
result := -1;
end;
function CreateHardLinkA(newlink, currfile: PChar; sattr: Pointer): boolean;
stdcall; external 'kernel32.dll' name 'CreateHardLinkA';
function CreateHardLink(newlink, currfile: string): boolean;
{ wrapper for function }
begin
Result := CreateHardLinkA(Pchar(Newlink), PChar(currfile), nil);
end;
end.
]]>