395 lines
12 KiB
Plaintext
395 lines
12 KiB
Plaintext
{*******************************************************}
|
|
{ }
|
|
{ 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.
|