(******************************************************************************
 *                                                                            *
 *  Project: *                                                                *
 *  File   : MpuADS - Class for reading and writing of                        *
 *                    Alternate Data Streams (ADS)                            *
 *                                                                            *
 *  Copyright (c) Michael Puff  http://www.michael-puff.de                    *
 *                                                                            *
 ******************************************************************************)

     (************************************************************************
     *                                                                      *
     *                        COPYRIGHT NOTICE                              *
     *                                                                      *
     * Copyright (c) 2001-2007, Michael Puff ["copyright holder(s)"]        *
     * All rights reserved.                                                 *
     *                                                                      *
     * Redistribution and use in source and binary forms, with or without   *
     * modification, are permitted provided that the following conditions   *
     * are met:                                                             *
     *                                                                      *
     * 1. Redistributions of source code must retain the above copyright    *
     *    notice, this list of conditions and the following disclaimer.     *
     * 2. Redistributions in binary form must reproduce the above copyright *
     *    notice, this list of conditions and the following disclaimer in   *
     *    the documentation and/or other materials provided with the        *
     *    distribution.                                                     *
     * 3. The name(s) of the copyright holder(s) may not be used to endorse *
     *    or promote products derived from this software without specific   *
     *    prior written permission.                                         *
     *                                                                      *
     * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS  *
     * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT    *
     * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS    *
     * FORA PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE        *
     * REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,          *
     * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, *
     * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;     *
     * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER     *
     * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT   *
     * LIABILITY, OR TORT INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY *
     * WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE          *
     * POSSIBILITY OF SUCH DAMAGE.                                          *
     *                                                                      *
     ************************************************************************)

unit MpuADS;

interface

uses
  Windows,
  Exceptions;

type
  TADSObject = packed record
    StreamName: string[255];
    StreamSize: Int64;
  end;

  TADSObjectArray = array of TADSObject;

type
  TMpuADS = class(TObject)
  private
    FFilename: string;
    function GetFilename: string;
    procedure SetFilename(Value: string);
    function GetDataStreamNames: TADSObjectArray;
  public
    constructor Create(const Filename: string);
    property Filename: string read GetFilename write SetFilename;
    property DataStreamNames: TADSObjectArray read GetDataStreamNames;
    function ReadDataStream(const StreamName: string; StreamSize: Int64): string;
    procedure WriteDataStream(const StreamName: string; const Text: string);
    procedure WriteBinaryStream(const StreamName: string; const Source: string);
    procedure DeleteDataStream(const StreamName: string);
  end;

implementation

resourcestring
  rsExceptionTemplate = '%d: %s';

{ TMpuADS }

constructor TMpuADS.Create(const Filename: string);
begin
  inherited Create;
  FFilename := Filename;
end;

function TMpuADS.ReadDataStream(const StreamName: string; StreamSize: Int64): string;
var
  hFile             : THandle;
  ReadBuffer        : string;
  BytesRead         : DWORD;
begin
  hFile := CreateFile(PChar(FFilename + StreamName), GENERIC_READ, FILE_SHARE_READ, nil,
    OPEN_ALWAYS, 0, 0);
  if hFile <> INVALID_HANDLE_VALUE then
  begin
    Setlength(ReadBuffer, StreamSize);
    if ReadFile(hFile, ReadBuffer[1], StreamSize, BytesRead, nil) then
      SetString(Result, PChar(ReadBuffer), StreamSize)
    else
    begin
      CloseHandle(hFile);
      raise Exception.CreateFmt(rsExceptionTemplate, [GetLastError, SysErrorMessage(GetLastError)]);
    end;
    CloseHandle(hFile);
  end;
end;

function TMpuADS.GetDataStreamNames: TADSObjectArray;
var
  hFile             : THandle;
  BytesRead         : DWORD;
  Context           : Pointer;
  pBuffer           : PByte;
  iLo               : DWORD;
  iHi               : DWORD;
  wcStreamName      : array[0..MAX_PATH] of WideChar;
  StreamName        : WideString;
begin
  Context := nil;
  hFile := CreateFile(PChar(FFilename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_ALWAYS, 0, 0);
  if hFile <> INVALID_HANDLE_VALUE then
  begin
    GetMem(pBuffer, 4096);
    while BackupRead(hFile, pBuffer, 20, BytesRead, False, True, Context) do
    begin
      if BytesRead > 0 then
      begin
        if PWIN32StreamID(pBuffer)^.dwStreamNameSize > 0 then
        begin
          if BackupRead(hFile, @(wcStreamName[0]), PWIN32StreamID(pBuffer)^.dwStreamNameSize, BytesRead, False, True,
            Context) then
          begin
            if BytesRead = PWIN32StreamID(pBuffer)^.dwStreamNameSize then // go on if StreameNameSize equals BytesRead
            begin
              SetLength(Result, Length(Result) + 1);
              SetString(StreamName, wcStreamName, PWIN32StreamID(pBuffer)^.dwStreamNameSize div 2);
              StreamName := copy(StreamName, 2, length(StreamName));
              StreamName := ':' + copy(StreamName, 1, pos(':', StreamName) - 1);
              Result[Length(Result) - 1].StreamName := string(StreamName);
              Result[Length(Result) - 1].StreamSize := PWIN32StreamID(pBuffer)^.Size;
            end;
          end
          else // if BackupRead = False
            Break;
        end; // if dwStreamNameSize > 0
        //if PWIN32StreamID(pBuffer)^.Size > 0 then
        // go ahead to next stream
        BackupSeek(hFile, high(DWORD), high(DWORD), iLo, iHi, @Context);
      end
      else // if BytesRead > 0
        Break;
    end; // while BackupRead
    // Cleanup
    BackupRead(hFile, pBuffer, 0, BytesRead, True, False, Context);
    CloseHandle(hFile);
    FreeMem(pBuffer);
  end
  else
    raise Exception.CreateFmt(rsExceptionTemplate, [GetLastError, SysErrorMessage(GetLastError)]);
end;

function TMpuADS.GetFilename: string;
begin
  Result := FFilename;
end;

procedure TMpuADS.SetFilename(Value: string);
begin
  FFilename := Value;
end;

procedure TMpuADS.WriteDataStream(const StreamName, Text: string);
var
  hStream           : THandle;
  BytesWritten      : DWORD;
begin
  hStream := CreateFile(PChar(string(FFilename) + ':' + StreamName), GENERIC_WRITE, FILE_SHARE_WRITE, nil, OPEN_ALWAYS,
    0,
    0);
  if hStream <> INVALID_HANDLE_VALUE then
  begin
    if not WriteFile(hStream, Text[1], length(Text), BytesWritten, nil) then
    begin
      CloseHandle(hStream);
      raise Exception.CreateFmt(rsExceptionTemplate, [GetLastError, SysErrorMessage(GetLastError)]);
    end;
    CloseHandle(hStream);
  end
  else
    raise Exception.CreateFmt(rsExceptionTemplate, [GetLastError, SysErrorMessage(GetLastError)]);
end;

procedure TMpuADS.DeleteDataStream(const StreamName: string);
begin
  if not DeleteFile(PChar(FFilename + ':' + StreamName)) then
    raise Exception.CreateFmt(rsExceptionTemplate, [GetLastError, SysErrorMessage(GetLastError)]);
end;

procedure TMpuADS.WriteBinaryStream(const StreamName: string; const Source: string);
begin
  if not CopyFile(PChar(Source), PChar(Filename + ':' + StreamName), False) then
    raise Exception.CreateFmt(rsExceptionTemplate, [GetLastError, SysErrorMessage(GetLastError)]);
end;

end.