{*******************************************************}
{                                                       }
{       Tocsg.Export                                    }
{                                                       }
{       Copyright (C) 2024 kku                          }
{                                                       }
{*******************************************************}

unit Tocsg.FileInfo;

interface

uses
  System.SysUtils, Winapi.Windows, superobject, System.Classes;

const
  FmtID_SummaryInformation    : TGUID = '{F29F85E0-4FF9-1068-AB91-08002B27B3D9}';
  FMTID_DocSummaryInformation : TGUID = '{D5CDD502-2E9C-101B-9397-08002B2CF9AE}';
  FMTID_UserDefinedProperties : TGUID = '{D5CDD505-2E9C-101B-9397-08002B2CF9AE}';
  IID_IPropertySetStorage     : TGUID = '{0000013A-0000-0000-C000-000000000046}';

// Summary Information
  PID_TITLE        = 2;
  PID_SUBJECT      = 3;
  PID_AUTHOR       = 4;
  PID_KEYWORDS     = 5;
  PID_COMMENTS     = 6;
  PID_TEMPLATE     = 7;
  PID_LASTAUTHOR   = 8;
  PID_REVNUMBER    = 9;
  PID_EDITTIME     = 10;
  PID_LASTPRINTED  = 11;
  PID_CREATE_DTM   = 12;
  PID_LASTSAVE_DTM = 13;
  PID_PAGECOUNT    = 14;
  PID_WORDCOUNT    = 15;
  PID_CHARCOUNT    = 16;
  PID_THUMBNAIL    = 17;
  PID_APPNAME      = 18;
  PID_SECURITY     = 19;

// Document Summary Information
  PID_CATEGORY    = 2;
  PID_PRESFORMAT  = 3;
  PID_BYTECOUNT   = 4;
  PID_LINECOUNT   = 5;
  PID_PARCOUNT    = 6;
  PID_SLIDECOUNT  = 7;
  PID_NOTECOUNT   = 8;
  PID_HIDDENCOUNT = 9;
  PID_MMCLIPCOUNT = 10;
  PID_SCALE       = 11;
  PID_HEADINGPAIR = 12;
  PID_DOCPARTS    = 13;
  PID_MANAGER     = 14;
  PID_COMPANY     = 15;
  PID_LINKSDIRTY  = 16;
  PID_CHARCOUNT2  = 17;

type
  TTgFilePropInfo = record
    FileName,
    FilePath,
    Company,
    Description,
    Version,
    InternalName,
    LegalCopyright,
    LegalTradeMarks,
    OriginalFileName,
    ProductName,
    ProductVersion,
    Comments: String;
  end;

  TTgFileInfo = class(TObject)
  private
    FilePropInfo_: TTgFilePropInfo;
  public
    Constructor Create(const sPath: String);

    function FileProgToJsonObj: ISuperObject;

    property FileName: String read FilePropInfo_.FileName;
    property FilePath: String read FilePropInfo_.FilePath;
    property Company: String read FilePropInfo_.Company;
    property Description: String read FilePropInfo_.Description;
    property Version: String read FilePropInfo_.Version;
    property InternalName: String read FilePropInfo_.InternalName;
    property LegalCopyright: String read FilePropInfo_.LegalCopyright;
    property LegalTradeMarks: String read FilePropInfo_.LegalTradeMarks;
    property OriginalFileName: String read FilePropInfo_.OriginalFileName;
    property ProductName: String read FilePropInfo_.ProductName;
    property ProductVersion: String read FilePropInfo_.ProductVersion;
    property Comments: String read FilePropInfo_.Comments;
  end;

function FileSummaryToList(sPath: String; aList: TStrings): Integer;
function PropPidToStr(const wVal: WORD): String;
//function GetAipLabel(sPath: String): String;

implementation

uses
  Tocsg.Strings, Tocsg.Json, Tocsg.Exception, Winapi.ActiveX, System.Win.ComObj,
  Tocsg.Trace, Tocsg.DateTime;

type
  PLandCodepage = ^TLandCodepage;
  TLandCodepage = record
    wLanguage,
    wCodePage: WORD;
  end;

{ TTgFileInfo }

Constructor TTgFileInfo.Create(const sPath: String);

  function GetVerQueryValue(pInfo: Pointer; const sLang, sField: String): String;
  var
    dwVerSize: DWORD;
    pVer: Pointer;
  begin
    Result := '';
    VerQueryValue(pInfo, PChar(Format('\StringFileInfo\%s\%s', [sLang, sField])), pVer, dwVerSize);
    if dwVerSize > 0 then
    begin
      SetLength(Result, dwVerSize);
      StrLCopy(PChar(Result), pVer, dwVerSize);
      Result := DeleteNullTail(Result);
      Result := StringReplace(Result, #13, ' ', [rfReplaceAll]);
      Result := StringReplace(Result, #10, '', [rfReplaceAll]);
    end;
  end;

  procedure GetFileInfo;
  var
    dwLen,
    dwInfoSize: DWORD;
    pInfo, pLang: Pointer;
    sLang: String;
  begin
    if FileExists(sPath) then
    begin
      dwInfoSize := GetFileVersionInfoSize(PChar(sPath), dwInfoSize);
      if dwInfoSize = 0 then
        exit;

      pInfo := AllocMem(dwInfoSize);
      try
        if GetFileVersionInfo(PChar(sPath), 0, dwInfoSize, pInfo) then
          if VerQueryValue(pInfo, '\VarFileInfo\Translation\', pLang, dwLen) then
          begin
            sLang := Format('%.4x%.4x', [PLandCodepage(pLang).wLanguage, PLandCodepage(pLang).wCodePage]);

            with FilePropInfo_ do
            begin
              Company          := GetVerQueryValue(pInfo, sLang, 'CompanyName');
              Description      := GetVerQueryValue(pInfo, sLang, 'FileDescription');
              Version          := GetVerQueryValue(pInfo, sLang, 'FileVersion');
              InternalName     := GetVerQueryValue(pInfo, sLang, 'InternalName');
              LegalCopyright   := GetVerQueryValue(pInfo, sLang, 'LegalCopyright');
              LegalTradeMarks  := GetVerQueryValue(pInfo, sLang, 'LegalTradeMarks');
              OriginalFileName := GetVerQueryValue(pInfo, sLang, 'OriginalFilename');
              ProductName      := GetVerQueryValue(pInfo, sLang, 'ProductName');
              ProductVersion   := GetVerQueryValue(pInfo, sLang, 'ProductVersion');
              Comments         := GetVerQueryValue(pInfo, sLang, 'Comments');
            end;
          end;
      finally
        FreeMem(pInfo, dwInfoSize);
      end;
    end;
  end;

begin
  Inherited Create;

  ZeroMemory(@FilePropInfo_, SizeOf(FilePropInfo_));

  FilePropInfo_.FilePath := sPath;
  FilePropInfo_.FileName := ExtractFileName(FilePropInfo_.FilePath);

  GetFileInfo;

  if FilePropInfo_.Description = '' then
    FilePropInfo_.Description := FilePropInfo_.FileName;
end;

function TTgFileInfo.FileProgToJsonObj: ISuperObject;
begin
  Result := TTgJson.ValueToJsonObject<TTgFilePropInfo>(FilePropInfo_);
end;

function FileSummaryToList(sPath: String; aList: TStrings): Integer;
var
  Stg: IStorage;
  PropSetStg: IPropertySetStorage;
  PropStg: IPropertyStorage;
  PropEnum: IEnumSTATPROPSTG;
  HR : HResult;
  PropStat: STATPROPSTG;
  nCnt, i: Integer;
  PropSpec: array of TPropSpec;
  PropVariant: array of TPropVariant;
  sTemp: String;
begin
  Result := 0;
  try
    aList.Clear;

    if not Succeeded(StgOpenStorage(PChar(sPath), nil, STGM_READ or
              STGM_SHARE_DENY_WRITE,
              nil, 0, Stg)) then
    begin
      TTgTrace.T('Fail .. StgOpenStorage() .. Path=%s', [sPath], 1);
      exit;
    end;

    PropSetStg := Stg as IPropertySetStorage;
    if not Succeeded(PropSetStg.Open(FmtID_SummaryInformation,
              STGM_READ or STGM_SHARE_EXCLUSIVE, PropStg)) then
    begin
      TTgTrace.T('Fail .. PropSetStg.Open() .. Path=%s', [sPath], 1);
      exit;
    end;

    if not Succeeded(PropStg.Enum(PropEnum)) then
    begin
      TTgTrace.T('Fail .. PropStg.Enum() .. Path=%s', [sPath], 1);
      exit;
    end;

    nCnt := 0;
    HR := PropEnum.Next(1, PropStat, nil);
    while HR = S_OK do
    begin
      SetLength(PropSpec, nCnt + 1);
      PropSpec[nCnt].ulKind := PRSPEC_PROPID;
      PropSpec[nCnt].propid := PropStat.propid;
      HR := PropEnum.Next(1, PropStat, nil);
      Inc(nCnt);
    end;

    if nCnt = 0 then
    begin
      TTgTrace.T('Fail .. Not found PropSpec .. Path=%s', [sPath], 1);
      exit;
    end;

    SetLength(PropVariant, nCnt);
    if PropStg.ReadMultiple(nCnt, @PropSpec[0], @PropVariant[0]) <> S_OK then
    begin
      TTgTrace.T('Fail .. PropStg.ReadMultiple() .. Path=%s', [sPath], 1);
      exit;
    end;

    for i := 0 to nCnt - 1 do
    begin
      case PropVariant[i].vt of
        VT_LPSTR :
          if Assigned(PropVariant[i].pszVal) then
          begin
            if IsUTF8_AnsiChar(PropVariant[i].pszVal) then
              sTemp := UTF8String(PropVariant[i].pszVal)
            else
              sTemp := AnsiString(PropVariant[i].pszVal);
            aList.AddObject(sTemp, TObject(PropSpec[i].propid));
          end;
        VT_FILETIME :
          if PropSpec[i].propid = PID_EDITTIME then
            aList.AddObject(Format('%g', [Comp(PropVariant[I].filetime) / 1.0E9]), TObject(PropSpec[i].propid))
          else
            aList.AddObject(DateTimeToStr(ConvFileTimeToDateTime_Local(PropVariant[i].filetime)), TObject(PropSpec[i].propid));
        VT_I4 :
          aList.AddObject(IntToStr(PropVariant[i].lVal), TObject(PropSpec[i].propid));
      end;
    end;

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

function PropPidToStr(const wVal: WORD): String;
begin
  case wVal of
    PID_TITLE        : Result := 'Title';
    PID_SUBJECT      : Result := 'Subject';
    PID_AUTHOR       : Result := 'Author';
    PID_KEYWORDS     : Result := 'Keywords';
    PID_COMMENTS     : Result := 'Comments';
    PID_TEMPLATE     : Result := 'Template';
    PID_LASTAUTHOR   : Result := 'Last Saved By';
    PID_REVNUMBER    : Result := 'Revision Number';
    PID_EDITTIME     : Result := 'Total Editing Time';
    PID_LASTPRINTED  : Result := 'Last Printed';
    PID_CREATE_DTM   : Result := 'Create Time/Date';
    PID_LASTSAVE_DTM : Result := 'Last Saved Time/Date';
    PID_PAGECOUNT    : Result := 'Number of Pages';
    PID_WORDCOUNT    : Result := 'Number of Words';
    PID_CHARCOUNT    : Result := 'Number of Characters';
    PID_THUMBNAIL    : Result := 'Thumbnail';
    PID_APPNAME      : Result := 'Creating Application';
    PID_SECURITY     : Result := 'Security';
    else Result := '$' + IntToHex(wVal, 8);
  end
end;

// "사용자 지정"을 통한 AIP 적용 유무는 정확도가 떨어져서 사용하지 않기로 함 24_0905 09:35:30 kku
//function GetAipLabel(sPath: String): String;
//var
//  Stg: IStorage;
//  PropSetStg: IPropertySetStorage;
//  PropStg: IPropertyStorage;
//  PropEnum: IEnumSTATPROPSTG;
//  HR : HResult;
//  PropStat: STATPROPSTG;
//  nCnt: Integer;
//  PropSpec: array of TPropSpec;
//  PropVariant: array of TPropVariant;
//  sSpecName: String;
//begin
//  Result := '';
//  try
//    if not Succeeded(StgOpenStorage(PChar(sPath), nil, STGM_READ or
//              STGM_SHARE_DENY_WRITE,
//              nil, 0, Stg)) then
//    begin
//    // 일반파일 대상으로 하면 로그가 너무 많이 떠서 비활성 24_0221 14:28:23 kku
////      TTgTrace.T('Fail .. StgOpenStorage() .. Path=%s', [sPath], 1);
//      exit;
//    end;
//
//    PropSetStg := Stg as IPropertySetStorage;
//    if not Succeeded(PropSetStg.Open(FMTID_UserDefinedProperties,
//              STGM_READ or STGM_SHARE_EXCLUSIVE, PropStg)) then
//    begin
//      TTgTrace.T('Fail .. PropSetStg.Open() .. Path=%s', [sPath], 1);
//      exit;
//    end;
//
//    if not Succeeded(PropStg.Enum(PropEnum)) then
//    begin
//      TTgTrace.T('Fail .. PropStg.Enum() .. Path=%s', [sPath], 1);
//      exit;
//    end;
//
//    nCnt := 0;
//    HR := PropEnum.Next(1, PropStat, nil);
//    while HR = S_OK do
//    begin
//      sSpecName := UpperCase(PropStat.lpwstrName);
//      if sSpecName.StartsWith('MSIP_LABEL_') and sSpecName.EndsWith('_NAME') then
//      begin
//        SetLength(PropSpec, nCnt + 1);
//        PropSpec[nCnt].ulKind := PRSPEC_PROPID;
//        PropSpec[nCnt].propid := PropStat.propid;
//        Inc(nCnt);
//        break;
//      end;
//      HR := PropEnum.Next(1, PropStat, nil);
//    end;
//
//    if nCnt = 0 then
//    begin
//      TTgTrace.T('Fail .. Not found PropSpec .. Path=%s', [sPath], 1);
//      exit;
//    end;
//
//    SetLength(PropVariant, nCnt);
//    if PropStg.ReadMultiple(nCnt, @PropSpec[0], @PropVariant[0]) <> S_OK then
//    begin
//      TTgTrace.T('Fail .. PropStg.ReadMultiple() .. Path=%s', [sPath], 1);
//      exit;
//    end;
//
//    if PropVariant[0].vt = VT_LPSTR then
//      if Assigned(PropVariant[0].pszVal) then
//      begin
//        if IsUTF8(PropVariant[0].pszVal) then
//          Result := UTF8String(PropVariant[0].pszVal)
//        else
//          Result := AnsiString(PropVariant[0].pszVal);
//      end;
//  except
//    on E: Exception do
//      ETgException.TraceException(E, 'Fail .. FileDetailToList()');
//  end;
//end;

end.