BSOne.SFC/Tocsg.Lib/VCL/Tocsg.FileInfo.pas

500 lines
16 KiB
Plaintext

{*******************************************************}
{ }
{ Tocsg.Export }
{ }
{ Copyright (C) 2024 kku }
{ }
{*******************************************************}
unit Tocsg.FileInfo;
interface
uses
System.SysUtils, Winapi.Windows, superobject, System.Classes, System.Generics.Collections;
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;
procedure GetFileProp_all(const sPath: String; aList: TStringList; bFieldEng: Boolean = false);
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, System.Variants, Tocsg.Safe, Tocsg.Path;
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;
procedure GetFileProp_all(const sPath: String; aList: TStringList; bFieldEng: Boolean = false);
var
vShell, vFolder, vFolderItem: Variant;
oDir, oFName: OleVariant; // OleVariant 사용
i, nFieldIdx: Integer;
sPropValue, sPropName: String;
FieldList: TList<WORD>;
begin
aList.Clear;
try
// var t: TTgTrace;
// Guard(t, TTgTrace.Create(GetRunExePathDir + 'log.txt'));
oDir := OleVariant(ExtractFilePath(sPath));
oFName := OleVariant(ExtractFileName(sPath));
vShell := CreateOleObject('Shell.Application');
if VarIsClear(vShell) or VarIsEmpty(vShell) then
exit;
vFolder := vShell.NameSpace(oDir);
if VarIsClear(vFolder) or VarIsEmpty(vFolder) then
begin
oDir := OleVariant(ExcludeTrailingPathDelimiter(ExtractFilePath(sPath)));
vFolder := vShell.NameSpace(oDir);
if VarIsClear(vFolder) then
exit;
end;
vFolderItem := vFolder.ParseName(oFName);
if VarIsClear(vFolderItem) then
exit;
Guard(FieldList, TList<WORD>.Create);
FieldList.Add(0); // 이름
FieldList.Add(1); // 크기
FieldList.Add(2); // 항목 유형
FieldList.Add(3); // 수정한 날짜
FieldList.Add(4); // 만든 날짜
FieldList.Add(5); // 액세스한 날짜
// FieldList.Add(6); // 특성
FieldList.Add(9); // 인식 유형
FieldList.Add(10); // 소유자
FieldList.Add(11); // 종류
FieldList.Add(12); // 등급
FieldList.Add(20); // 만든 이 (Author)
FieldList.Add(42); // 프로그램 이름
// FieldList.Add(61); // 컴퓨터
FieldList.Add(153); // 마지막으로 인쇄한 날짜
FieldList.Add(154); // 마지막으로 저장한 날짜
FieldList.Add(159); // 총 편집 시간
FieldList.Add(187); // 공유됨
FieldList.Add(196); // 유형 (파일 설명과 유사)
// 4. 데이터 추출 루프
for i := 0 to FieldList.Count - 1 do
// for i := 0 to 320 do
begin
nFieldIdx := FieldList[i];
sPropName := vFolder.GetDetailsOf(Unassigned, nFieldIdx);
sPropValue := vFolder.GetDetailsOf(vFolderItem, nFieldIdx);
// sPropName := vFolder.GetDetailsOf(Unassigned, i);
// sPropValue := vFolder.GetDetailsOf(vFolderItem, i);
if (sPropName <> '') and (sPropValue <> '') then
begin
if bFieldEng then
begin
case nFieldIdx of
0 : sPropName := 'nameP';
1 : sPropName := 'sizeP';
2 : sPropName := 'itemType';
3 : sPropName := 'dateModified';
4 : sPropName := 'dateCreated';
5 : sPropName := 'dateAccessed';
// 6 : sPropName := 'attributes';
9 : sPropName := 'perceivedType';
10 : sPropName := 'owner';
11 : sPropName := 'kind';
12 : sPropName := 'rating';
20 : sPropName := 'author';
42 : sPropName := 'programName';
// 61 : sPropName := ''Computer;
153 : sPropName := 'dateLastPrinted';
154 : sPropName := 'dateLastSaved';
159 : sPropName := 'totalEditingTime';
187 : sPropName := 'shared';
196 : sPropName := 'type';
end;
end;
// TTgTrace.T('Name=%s, idx=%d', [sPropName, i]);
aList.AddPair(sPropName, sPropValue);
end;
end;
except
on E: Exception do
ETgException.TraceException(E, 'Fail .. GetFileProp_all()', 1);
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.