BSOne.SFC/Tocsg.Lib/VCL/Tocsg.OLE.Stg.pas

unit Tocsg.OLE.Stg;

interface

uses
  System.Classes, Winapi.ActiveX, System.SysUtils;

function IsStgStorageFile(const sPath: string): Boolean;
function StgStorageFileOpen(sPath: WideString; out stOpen: IStorage; nMode: Integer = STGM_READ or STGM_SHARE_EXCLUSIVE): Boolean;
function StgOpenSubStorage(stOpen: IStorage; const SubStgName: WideString; nMode: Integer; out stg: IStorage): Boolean;
function StgGetStream(stOpen: IStorage; sName: WideString; ms: TMemoryStream): Boolean;
function StgGetStreamToText(stOpen: IStorage; sName: WideString; var sText: WideString): Boolean;
function StgGetEnumElements(stOpen: IStorage; out enum: IEnumStatStg): Boolean;
function StgNextStatStg(enum: IEnumStatStg; out elStat: TStatStg): Boolean;
function StgGetStatStg(enum: IEnumStatStg; const sName: WideString; out elStat: TStatStg; bReset: Boolean = true): Boolean;
function StgGetStatStgLike(enum: IEnumStatStg; const sName: WideString; out elStat: TStatStg; bReset: Boolean = true): Boolean;
function StgGetStatStgList(enum: IEnumStatStg; const sName: WideString; aList: TStringList; bReset: Boolean = true): Boolean;

implementation

uses
  Winapi.Windows, Tocsg.Exception;

function IsStgStorageFile(const sPath: string): Boolean;
var
  pvStg: IStorage;
begin
  Result := StgStorageFileOpen(PChar(sPath), pvStg);
  pvStg := nil;
end;

function StgStorageFileOpen(sPath: WideString; out stOpen: IStorage; nMode: Integer = STGM_READ or STGM_SHARE_EXCLUSIVE): Boolean;
begin
  try
    Result := Winapi.ActiveX.StgOpenStorage(PWideChar(sPath), nil, nMode, nil, 0, stOpen) = S_OK;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. StgStorageOpen()');
  end;
end;

function StgOpenSubStorage(stOpen: IStorage; const SubStgName: WideString; nMode: Integer; out stg: IStorage): Boolean;
begin
  try
    Result := stOpen.OpenStorage(PWideChar(SubStgName), nil, nMode, 0, 0, stg) = S_OK;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. StgOpenSubStorage()');
  end;
end;

function StgGetStream(stOpen: IStorage; sName: WideString; ms: TMemoryStream): Boolean;
var
  s: IStream;
  Stat: TStatStg;
  dwSize: Integer;
begin
  Result := false;
  try
    if stOpen.OpenStream(PWideChar(sName), nil,
      STGM_READ or STGM_SHARE_EXCLUSIVE, 0, s) = S_OK then
    begin
      if (s.Stat(Stat, STATFLAG_NONAME) = S_OK) then
      begin
        ms.Clear;
        ms.Size := Stat.cbSize;
        Result := s.Read(ms.Memory, Stat.cbSize, @dwSize) = S_OK;
      end;
      s := nil;
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. StgGetStream()');
  end;
end;

function StgGetStreamToText(stOpen: IStorage; sName: WideString; var sText: WideString): Boolean;
var
  ms: TMemoryStream;
begin
  Result := false;
  try
    ms := TMemoryStream.Create;
    try
      if StgGetStream(stOpen, sName, ms) then
      begin
        SetLength(sText, ms.Size div 2);
        CopyMemory(PByte(sText), ms.Memory, ms.Size);
        Result := true;
      end else exit;
    finally
      ms.Free;
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. StgGetStreamTextContents()');
  end;
end;

function StgGetEnumElements(stOpen: IStorage; out enum: IEnumStatStg): Boolean;
begin
  try
    Result := stOpen.EnumElements(0, nil, 0, enum) = S_OK;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. StgEnumElements()');
  end;
end;

function StgNextStatStg(enum: IEnumStatStg; out elStat: TStatStg): Boolean;
begin
  try
    Result := enum.Next(1, elStat, nil) = S_OK;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. StgNextStatStg()');
  end;
end;

function StgGetStatStg(enum: IEnumStatStg; const sName: WideString; out elStat: TStatStg; bReset: Boolean = true): Boolean;
begin
  Result := false;
  try
    if bReset then
    begin
      if enum.Reset <> S_OK then
       exit;
    end;

    while StgNextStatStg(enum, elStat) do
    begin
      if Pos(sName, elStat.pwcsName) = 1 then
      begin
        Result := true;
        Break;
      end;
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. StgGetStatStg()');
  end;
end;

// sName가 elStat.pwcsName 문자열에 포함되면 true
function StgGetStatStgLike(enum: IEnumStatStg; const sName: WideString; out elStat: TStatStg; bReset: Boolean = true): Boolean;
begin
  Result := false;
  try
    if bReset then
    begin
     if enum.Reset <> S_OK then
      exit;
    end;

    while StgNextStatStg(enum, elStat) do
    begin
      if Pos(sName, elStat.pwcsName) <> 0 then
      begin
        Result := true;
        exit;
      end;
    end;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. StgGetStatStgLike()');
  end;
end;

function StgGetStatStgList(enum: IEnumStatStg; const sName: WideString; aList: TStringList; bReset: Boolean = true): Boolean;
var
  I: Integer;
  list_length: Integer;
  elStat: TStatStg;
begin
  Result := false;
  try
    if bReset then
    begin
      if enum.Reset <> S_OK then
        exit;
    end;

    aList.Clear;
    while StgNextStatStg(enum, elStat) do
    begin
      if Pos(sName, elStat.pwcsName) = 1 then
      begin
        aList.AddObject(elStat.pwcsName, TObject(elStat.dwType));
        continue;
      end;

    end;

    Result := aList.Count > 0;
  except
    on E: Exception do
      ETgException.TraceException(E, 'Fail .. StgGetStatStgList()');
  end;
end;


end.