Smart questions
Smart answers
Smart people
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Member Login




Remember Me
Forgot Password?
Join Us!

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips now!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

Join Tek-Tips
*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.
Jobs from Indeed

Link To This Forum!

Partner Button
Add Stickiness To Your Site By Linking To This Professionally Managed Technical Forum.
Just copy and paste the
code below into your site.

How To

Perform Some NTFS-specific File Functions
Posted: 18 Apr 09 (Edited 25 Apr 09)

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.

Back to Embarcadero: Delphi FAQ Index
Back to Embarcadero: Delphi Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close