unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ExtCtrls, ActiveX, ComObj;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    FileExit1: TMenuItem;
    OpenDialog1: TOpenDialog;
    tree: TTreeView;
    FileOpen1: TMenuItem;
    N1: TMenuItem;
    pnlHeader: TPanel;
    Bevel1: TBevel;
    Compress1: TMenuItem;
    procedure FileExit1Click(Sender: TObject);
    procedure FileOpen1Click(Sender: TObject);
    procedure Compress1Click(Sender: TObject);
  private
    { Private declarations }
    FFileName: WideString;
    procedure DisplayFileStructure;
    procedure RecurseStorage(ParentNode: TTreeNode; stg: IStorage);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FileExit1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.RecurseStorage(ParentNode: TTreeNode; stg: IStorage);
var
  EnumStatStg: IEnumStatStg;
  StatStg: TStatStg;
  NodeName: string;
  ChildNode: TTreeNode;
  stgChild: IStorage;
begin
  OleCheck(stg.EnumElements(0, nil, 0, EnumStatStg));

  while EnumStatStg.Next(1, StatStg, nil) = S_OK do begin
    NodeName := StatStg.pwcsName;
    if Ord(NodeName[1]) < 32 then
      NodeName := '#' + IntToStr(Ord(NodeName[1])) +
        Copy(NodeName, 2, Length(NodeName) - 1);

{$IFDEF VER100}
    ChildNode := tree.Items.AddChild(ParentNode, NodeName +
      ' (' + FloatToStr(StatStg.cbSize) + ' bytes)');
{$ELSE}
    ChildNode := tree.Items.AddChild(ParentNode, NodeName +
      ' (' + IntToStr(StatStg.cbSize) + ' bytes)');
{$ENDIF}

    if StatStg.dwType = STGTY_STORAGE then begin
      // See if we can open the child storage
      OleCheck(stg.OpenStorage(StatStg.pwcsName, nil, STGM_READ or
        STGM_SHARE_EXCLUSIVE, nil, 0, stgChild));

      // Process the sub-storage
      RecurseStorage(ChildNode, stgChild);
    end;
  end;
end;

procedure TForm1.DisplayFileStructure;
var
  stgRoot: IStorage;
  Node: TTreeNode;
begin
  // First, check to see if it's a structured storage file
  if StgIsStorageFile(PWideChar(FFileName)) <> S_OK then begin
    ShowMessage(FFileName + ' is not a structured storage file.');
    exit;
  end;

  pnlHeader.Caption := FFileName;

  // Open the file
  OleCheck(StgOpenStorage(PWideChar(FFileName), nil, STGM_READ or
    STGM_SHARE_EXCLUSIVE, nil, 0, stgRoot));

  tree.Items.BeginUpdate;
  try
    tree.Items.Clear;
    Node := tree.Items.Add(nil, '<Root>');
    RecurseStorage(Node, stgRoot);
    Node.Expand(True);
  finally
    tree.Items.EndUpdate;
  end;

  Compress1.Enabled := True;
end;

procedure TForm1.FileOpen1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then begin
    FFileName := OpenDialog1.FileName;
    DisplayFileStructure;
  end;
end;

procedure TForm1.Compress1Click(Sender: TObject);
var
  stgOriginal: IStorage;
  stgTemp: IStorage;
  TempFileName: WideString;
begin
  // Step 1 - Open the original file
  OleCheck(StgOpenStorage(PWideChar(FFileName), nil, STGM_READ or
    STGM_SHARE_EXCLUSIVE, nil, 0, stgOriginal));

  // Step 2 - Create a new, temporary file
  TempFileName := ChangeFileExt(FFileName, '.$$$');
  OleCheck(StgCreateDocFile(PWideChar(TempFileName),
    STGM_WRITE or STGM_SHARE_EXCLUSIVE, 0, stgTemp));
  
  // Step 3 - Copy the old file to the new one
  stgOriginal.CopyTo(0, nil, nil, stgTemp);

  // Step 4 - Close the temporary file
  stgTemp := nil;

  // Step 5 - Close the original file
  stgOriginal := nil;

  // Step 6 - Delete the original file
  DeleteFile(FFileName);

  // Step 7 - Rename the temporary file
  RenameFile(TempFileName, FFileName);
end;

end.