Add Data to any File

Unit Add2FileUtils.pas

unit Add2FileUtils;

interface

uses Windows;

type
  TQuadCharArray = array [0..3] of Char; 
  TFileAddHeader = record 
   Signature: TQuadCharArray; 
   AddLength: Longword; 
  end;

const 
  AddSignature: TQuadCharArray = ('A', 'D', 'D', 'A');

function ReadFileAdd(F: HFILE; var Buffer; var Size: Longword): Boolean;
function WriteFileAdd(F: HFILE; const Buffer; Size: Longword): Boolean;
function ClearFileAdd(F: HFILE): Boolean;

implementation

function ReadFileAdd(F: HFILE; var Buffer; var Size: Longword): Boolean; 
Var
 Header: TFileAddHeader;
 Tmp: Longword;
begin
 Result := False;
 SetFilePointer(F, -SizeOf(TFileAddHeader), nil, FILE_END);
 ReadFile(F, Header, SizeOf(Header), Tmp, nil);
 if Header.Signature <> AddSignature then Exit;
 Size := Header.AddLength;
 SetFilePointer(F, -SizeOf(TFileAddHeader) - Header.AddLength, nil, FILE_END);
 ReadFile(F, Buffer, Size, Tmp, nil);
 Result := True;
end;

function WriteFileAdd(F: HFILE; const Buffer; Size: Longword): Boolean; 
Var
 Header: TFileAddHeader;
 Tmp: Longword;
begin
 Result := False;
 ClearFileAdd(F);
 if Size = 0 then Exit;
 SetFilePointer(F, 0, nil, FILE_END);
 WriteFile(F, Buffer, Size, Tmp, nil);
 Header.Signature := AddSignature;
 Header.AddLength := Size;
 SetFilePointer(F, 0, nil, FILE_END);
 WriteFile(F, Header, SizeOf(Header), Tmp, nil);
 Result := True;
end;

function ClearFileAdd(F: HFILE): Boolean;       
Var
 Header: TFileAddHeader;
 Tmp: Longword;
begin
 Result := False;
 SetFilePointer(F, -SizeOf(TFileAddHeader), nil, FILE_END);
 ReadFile(F, Header, SizeOf(Header), Tmp, nil);
 if Header.Signature <> AddSignature then Exit;
 SetFilePointer(F, -SizeOf(TFileAddHeader) - Header.AddLength, nil, FILE_END);
 SetEndOfFile(F);
 Result := True;
end;

end.

Unit1 :

uses Add2FileUtils

type
  TLargeString = array [0..65535] of Char;
  TForm1 = class(TForm)
  
var
  Form1: TForm1;
  F: HFILE = 0;
  
//

procedure TForm1.Button1Click(Sender: TObject);
Var
 Tmp: OFSTRUCT;
 Tmp2: Longword;
 S: TLargeString;
begin
 if OpenDlg.Execute then
  begin
   Button2.Enabled := False;
   Button3.Enabled := False;
   DataMemo.Text := '';
   DataMemo.Enabled := False;
   FileLbl.Caption := '[No files selected]';
   if F <> 0 then CloseHandle(F);
   F := OpenFile(PChar(OpenDlg.FileName), Tmp, OF_READWRITE);
   if F = HFILE_ERROR then raise Exception.Create('Unable to open file !');
   FileLbl.Caption := ExtractFileName(OpenDlg.FileName);
   ReadFileAdd(F, S, Tmp2);
   DataMemo.Text := S;
   Button2.Enabled := True;
   Button3.Enabled := True;
   DataMemo.Enabled := True; 
   if DataMemo.Text = '' then
   MessageDlg('This file has no added data.' + chr(13) +
              'You can add some by typing the data in the input box, and clicking on "Add this data".' + chr(13) +
              'To remove all added data from the file, click "Delete All Data".', mtInformation, [mbOK], 0);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
Var
 S: TLargeString;
 I: Integer;
 Size: Integer;
begin
 if DataMemo.Text = '' then raise Exception.Create('You cannot add null data.');
 if Length(DataMemo.Text) > SizeOf(TLargeString) then DataMemo.Text := Copy(DataMemo.Text, 0, SizeOf(TLargeString));
 ClearFileAdd(F);
 Size := 0;
 for I := 1 to SizeOf(S) do
  begin
   if I <= Length(DataMemo.Text) then S[I - 1] := DataMemo.Text[I] else S[I - 1] := #0;
   Inc(Size); 
  end;
 if not WriteFileAdd(F, S, Size) then raise Exception.Create('Error writing added data !');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if F <> 0 then CloseHandle(F);
end;

procedure TForm1.Button3Click(Sender: TObject);
Var
 S: TLargeString;
 Tmp: Longword;
begin
 ClearFileAdd(F);
 ReadFileAdd(F, S, Tmp);
 DataMemo.Text := S;
end;