Read Windows Storage FileProperties
lazarus / 34-Windows

----------------------------------------------------------------------
LazProgger · 2018-09-26 22:17

I am trying to read out the file properties of a file in Windows using
Lazarus.
That is, for example, the rating of an image file or other properties
you can access via the file properties dialog in Windows.

Here are links to the Microsoft Documentation of what I mean:
https://docs.microsoft.com/en-
us/uwp/api/windows.storage.fileproperties
https://docs.microsoft.com/en-
us/uwp/api/windows.storage.fileproperties.imageproperties

I have found some Delphi code on the Internet for doing that task, for
example:
https://www.entwickler-
ecke.de/topic_Dateiinfos+lesen+und+schreiben_25452,0.html
https://www.swissdelphicenter.com/de/showcode.php?id=1614

However, I could not make to run that code without an error.

For example, the following code:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
u_filesummary; {$MODE DELPHI} interface uses Windows, ComObj, ActiveX,
Variants, Sysutils; procedure SetFileSummaryInfo(const FileName :
WideString; Author, Title, Subject, Keywords, Comments :
WideString);function GetFileSummaryInfo(const FileName: WideString):
String;function IsNTFS(AFileName : string) :
boolean; implementation 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}'; STGFMT_FILE = 3;
//Indicates that the file must not be a compound file.               
 //This element is only valid when using the StgCreateStorageEx      
         //or StgOpenStorageEx functions to access the NTFS file
system                 //implementation of the IPropertySetStorage
interface.                 //Therefore, these functions return an
error if the riid                 //parameter does not specify the
IPropertySetStorage interface,                 //or if the specified
file is not located on an NTFS file system volume. STGFMT_ANY = 4;
//Indicates that the system will determine the file type and         
     //use the appropriate structured storage or property set        
      //implementation.                //This value cannot be used
with the StgCreateStorageEx function.  // 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; function IsNTFS(AFileName : string) : boolean;varfso, drv :
OleVariant;beginIsNTFS := False;fso :=
CreateOleObject('Scripting.FileSys]"]>Blockedbject');drv :=
fso.GetDrive(fso.GetDriveName(AFileName)); if drv.FileSystem = 'NTFS'
then  IsNTFS := True;end; function StgOpenStorageEx ( const pwcsName :
POleStr;  //Pointer to the path of the                           
//file containing storage object grfMode : LongInt;        
//Specifies the access mode for the object stgfmt : DWORD;          
 //Specifies the storage file format grfAttrs : DWORD;        
 //Reserved; must be zero pStgOptions : Pointer;     //Address of
STGOPTIONS pointer reserved2 : Pointer;       //Reserved; must be
zero riid : PGUID;              //Specifies the GUID of the interface
pointer out stgOpen :              //Address of an interface
pointer IStorage ) : HResult; stdcall; external 'ole32.dll';  function
GetFileSummaryInfo(const FileName: WideString): String; var I:
Integer; PropSetStg: IPropertySetStorage; PropSpec: array of
TPropSpec; PropStg: IPropertyStorage; PropVariant: array of
TPropVariant; Rslt: HResult; S: String; Stg: IStorage; PropEnum:
IEnumSTATPROPSTG; HR : HResult; PropStat: STATPROPSTG; k :
integer; AHRes: HRESULT; function PropertyPIDToCaption(const ePID:
Cardinal): string;begin case ePID 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(ePID,
8);   endend; begin Result :=
'';try OleCheck(StgOpenStorageEx(PWideChar(FileName), STGM_READ or
STGM_SHARE_DENY_WRITE,  STGFMT_FILE,  0, nil,  nil,
@IID_IPropertySetStorage, stg));  PropSetStg := Stg as
IPropertySetStorage;  AHRes :=
PropSetStg.Open(FmtID_SummaryInformation, STGM_READ or
STGM_SHARE_EXCLUSIVE, PropStg);  if AHRes <> S_OK then exit;   //
AHRes should be 0 ->
ERROR  OleCheck(AHRes);  OleCheck(PropStg.Enum(PropEnum)); I := 0;  hr
:= PropEnum.Next(1, PropStat, nil);  while hr = S_OK do begin   
inc(I);    SetLength(PropSpec,I);    PropSpec[i-1].ulKind :=
PRSPEC_PROPID;    PropSpec[i-1].propid := PropStat.propid;    hr :=
PropEnum.Next(1, PropStat, nil); end;  SetLength(PropVariant,i); Rslt
:= PropStg.ReadMultiple(i, @PropSpec[0], @PropVariant[0]);  if Rslt =
 S_FALSE then Exit;  for k := 0 to i -1 do begin    S := '';    if
PropVariant[k].vt = VT_LPSTR then      if
Assigned(PropVariant[k].pszVal) then       S :=
PropVariant[k].pszVal;     S :=
Format(PropertyPIDToCaption(PropSpec[k].Propid)+ ' %s',[s]);   if S <>
'' then Result := Result + S +
LineEnding; end; finally end;end; procedure SetFileSummaryInfo(const
FileName : WideString; Author, Title, Subject, Keywords, Comments :
WideString); varPropSetStg: IPropertySetStorage;PropSpec: array of
TPropSpec;PropStg: IPropertyStorage;PropVariant: array of
TPropVariant;Stg:
IStorage; begin OleCheck(StgOpenStorageEx(PWideChar(FileName),
STGM_SHARE_EXCLUSIVE or STGM_READWRITE, STGFMT_ANY, 0, nil,  nil,
@IID_IPropertySetStorage, stg)); PropSetStg := Stg as IPropertySetStor
age; OleCheck(PropSetStg.Create(FmtID_SummaryInformation,
FmtID_SummaryInformation, PROPSETFLAG_DEFAULT,STGM_CREATE or
STGM_READWRITE or STGM_SHARE_EXCLUSIVE,
PropStg)); Setlength(PropSpec,6); PropSpec[0].ulKind :=
PRSPEC_PROPID; PropSpec[0].propid := PID_AUTHOR; PropSpec[1].ulKind :=
PRSPEC_PROPID; PropSpec[1].propid := PID_TITLE; PropSpec[2].ulKind :=
PRSPEC_PROPID; PropSpec[2].propid := PID_SUBJECT; PropSpec[3].ulKind
:= PRSPEC_PROPID; PropSpec[3].propid :=
PID_KEYWORDS; PropSpec[4].ulKind := PRSPEC_PROPID; PropSpec[4].propid
:= PID_COMMENTS; PropSpec[5].ulKind :=
PRSPEC_PROPID; PropSpec[5].propid := 99;  SetLength(PropVariant,6); Pr
opVariant[0].vt:=VT_LPWSTR; PropVariant[0].pwszVal:=PWideChar(Author);
 PropVariant[1].vt:=VT_LPWSTR; PropVariant[1].pwszVal:=PWideChar(Title
); PropVariant[2].vt:= VT_LPWSTR; PropVariant[2].pwszVal:=PWideChar(Su
bject); PropVariant[3].vt:= VT_LPWSTR; PropVariant[3].pwszVal:=PWideCh
ar(Keywords); PropVariant[4].vt:= VT_LPWSTR; PropVariant[4].pwszVal:=P
WideChar(Comments); PropVariant[5].vt:= VT_LPWSTR; PropVariant[5].pwsz
Val:=PWideChar(Comments); OleCheck(PropStg.Wri]"]>Blockedltiple(6,
@PropSpec[0], @PropVariant[0], 2
)); PropStg.Commit(STGC_DEFAULT);end; end.     
Here, the problem is the following line in GetFileSummaryInfo:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i AHRes :=
PropSetStg.Open(FmtID_SummaryInformation,      STGM_READ or
STGM_SHARE_EXCLUSIVE, PropStg); if AHRes <> S_OK then
exit; OleCheck(AHRes);   
PropSetStg.Open should return S_OK = 0 if the function is not failing.
But it fails and the result is something else. I have added the AHRes
check, because without an exit, it crashes at that point.

Have someone an idea to make it work? According to the discussion, the
same code seems to run in Delphi.

----------------------------------------------------------------------
Remy Lebeau · 2018-09-26 23:54

Quote from: LazProgger on September 27, 2018, 12:17:49 amfso :=
CreateOleObject('Scripting.FileSys]"]>Blockedbject');
drv := fso.GetDrive(fso.GetDriveName(AFileName));
 if drv.FileSystem = 'NTFS' then
  IsNTFS := True;

Why not use GetVolumeInformation() instead?  It has an optional
FileSystemName output, and doesn't require you to use a COM object to
access it.

Quote from: LazProgger on September 27, 2018, 12:17:49 amCode:
[Select] AHRes := PropSetStg.Open(FmtID_SummaryInformation, STGM_READ
or STGM_SHARE_EXCLUSIVE, PropStg);

 if AHRes <> S_OK then exit;   // AHRes should be 0 -> ERROR

 OleCheck(AHRes);

That OleCheck() is useless, since you already checked AHRes for error.

Quote from: LazProgger on September 27, 2018, 12:17:49 amCode:
[Select] SetLength(PropVariant,i);
 Rslt := PropStg.ReadMultiple(i, @PropSpec[0], @PropVariant[0]);

 if Rslt =  S_FALSE then Exit;

You are not handling the case where the number of values may be 0,
thus PropSpec[0] and PropVariant[0] would be invalid, and cause a
bounds error if range checking is enabled.

Code: [Select]if i = 0 then Exit; // <-- add this!

SetLength(PropVariant,i);
...

Quote from: LazProgger on September 27, 2018, 12:17:49 amHere, the
problem is the following line in GetFileSummaryInfo:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i AHRes :=
PropSetStg.Open(FmtID_SummaryInformation,      STGM_READ or
STGM_SHARE_EXCLUSIVE, PropStg); if AHRes <> S_OK then
exit; OleCheck(AHRes);   
PropSetStg.Open should return S_OK = 0 if the function is not failing.
But it fails and the result is something else.

What value is it ACTUALLY returning instead of 0?

Quote from: LazProgger on September 27, 2018, 12:17:49 amI have added
the AHRes check, because without an exit, it crashes at that point.

It doesn't *crash*, it just raises an exception you are not handling.

----------------------------------------------------------------------
LazProgger · 2018-09-27 01:40

First, I have to say that I just took this code from the Internet and
I have not optimized it yet. I found several codes, but they are all
not working or stopping at some point.
Suggestions such as better using GetVolumeInformation(), are good
points for the optimization later, I will keep that in mind.
But now I just want to make it work and I even don't know whether this
is the right approach to read those information.

Quote from: Remy Lebeau on September 27, 2018, 01:54:43 amQuote from:
LazProgger on September 27, 2018, 12:17:49 amCode: [Select] AHRes :=
PropSetStg.Open(FmtID_SummaryInformation, STGM_READ or
STGM_SHARE_EXCLUSIVE, PropStg);

 if AHRes <> S_OK then exit;   // AHRes should be 0 -> ERROR

 OleCheck(AHRes);

That OleCheck() is useless, since you already checked AHRes for error.

The original code was OleCheck(PropSetStg.Open...) in just one line -
I have introduced the variable AHRes to see what's going on there and
I have added the line " if AHRes <> S_OK then exit;" to find out at
which line the error occurs. Again, this is just the debugging code to
make it work at all (to find out how to make it work), the
optimization will be done later.

Quote from: Remy Lebeau on September 27, 2018, 01:54:43 amQuote from:
LazProgger on September 27, 2018, 12:17:49 amHere, the problem is the
following line in GetFileSummaryInfo:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i AHRes :=
PropSetStg.Open(FmtID_SummaryInformation,      STGM_READ or
STGM_SHARE_EXCLUSIVE, PropStg); if AHRes <> S_OK then
exit; OleCheck(AHRes);   
PropSetStg.Open should return S_OK = 0 if the function is not failing.
But it fails and the result is something else.

What value is it ACTUALLY returning instead of 0?


It is returning -2147287038.
The exception is:
exception class EOleSysError
dgb unparsed remainder: Cannot acces memory at address 0x0

Quote from: Remy Lebeau on September 27, 2018, 01:54:43 amQuote from:
LazProgger on September 27, 2018, 12:17:49 amI have added the AHRes
check, because without an exit, it crashes at that point.

It doesn't *crash*, it just raises an exception you are not handling.

Yes, you are right. But the problem remains the same, something is not
working.
For example, this code:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
u_fileprops; {$MODE DELPHI} interface uses  Classes, SysUtils,
Windows, ComObj, ShlObj, ActiveX; 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}'; 
FMTID_AudioSummaryInformation     : TGuid =
'{64440490-4C8B-11D1-8B70-080036B11A03}'; 
FMTID_VideoSummaryInformation     : TGUID =
'{64440491-4C8B-11D1-8B70-080036B11A03}'; 
FMTID_ImageSummaryInformation     : TGUID =
'{6444048f-4c8b-11d1-8b70-080036b11a03}'; 
FMTID_MediaFileSummaryInformation : TGUID =
'{64440492-4c8b-11d1-8b70-080036b11a03}';    STGFMT_STORAGE     = 0; 
STGFMT_FILE        = 3;  STGFMT_ANY         = 4;  STGFMT_DOCFILE     =
5;   // Summary Information  PIDSI_TITLE        = $00000002;     //
VT_LPSTR  PIDSI_SUBJECT      = $00000003;  PIDSI_AUTHOR       =
$00000004;  PIDSI_KEYWORDS     = $00000005;  PIDSI_COMMENTS     =
$00000006;  PIDSI_TEMPLATE     = $00000007;  PIDSI_LASTAUTHOR   =
$00000008;  PIDSI_REVNUMBER    = $00000009;  PIDSI_EDITTIME     =
$0000000A;     // VT_FILETIME (UTC)  PIDSI_LASTPRINTED  = $0000000B; 
PIDSI_CREATE_DTM   = $0000000C;  PIDSI_LASTSAVE_DTM = $0000000D; 
PIDSI_PAGECOUNT    = $0000000E;     // VT_I4  PIDSI_WORDCOUNT    =
$0000000F;  PIDSI_CHARCOUNT    = $00000010;  PIDSI_THUMBNAIL    =
$00000011;     // VT_CF  PIDSI_APPNAME      = $00000012;     //
VT_LPSTR  PIDSI_DOC_SECURITY = $00000013;     // VT_I4   // Document
Summary Information  PIDDSI_CATEGORY    = $00000002;     // VT_LPSTR 
PIDDSI_PRESFORMAT  = $00000003;  PIDDSI_BYTECOUNT   = $00000004;    
// VT_I4  PIDDSI_LINECOUNT   = $00000005;  PIDDSI_PARCOUNT    =
$00000006;  PIDDSI_SLIDECOUNT  = $00000007;  PIDDSI_NOTECOUNT   =
$00000008;  PIDDSI_HIDDENCOUNT = $00000009;  PIDDSI_MMCLIPCOUNT =
$0000000A;  PIDDSI_SCALE       = $0000000B;     // VT_BOOL 
PIDDSI_HEADINGPAIR = $0000000C;     // VT_VARIANT | VT_VECTOR 
PIDDSI_DOCPARTS    = $0000000D;     // VT_LPSTR | VT_VECTOR 
PIDDSI_MANAGER     = $0000000E;     // VT_LPSTR  PIDDSI_COMPANY     =
$0000000F;  PIDDSI_LINKSDIRTY  = $00000010;     // VT_BOOL   //
FMTID_MediaFileSummaryInfo  PIDMSI_EDITOR      = $00000002;     //
VT_LPWSTR  PIDMSI_SUPPLIER    = $00000003;  PIDMSI_SOURCE      =
$00000004;  PIDMSI_SEQUENCE_NO = $00000005;  PIDMSI_PROJECT     =
$00000006;  PIDMSI_STATUS      = $00000007;     // VT_UI4 
PIDMSI_OWNER       = $00000008;     // VT_LPWSTR  PIDMSI_RATING      =
$00000009;  PIDMSI_PRODUCTION  = $0000000A;     // VT_FILETIME (UTC) 
PIDMSI_COPYRIGHT   = $0000000B;     // VT_LPWSTR   //
FMTID_AudioSummaryInformation  PIDASI_FORMAT        = $00000002;   //
VT_BSTR  PIDASI_TIMELENGTH    = $00000003;   // VT_UI4, milliseconds 
PIDASI_AVG_DATA_RATE = $00000004;   // VT_UI4,  Hz  PIDASI_SAMPLE_RATE
  = $00000005;   // VT_UI4,  bits  PIDASI_SAMPLE_SIZE   = $00000006; 
// VT_UI4,  bits  PIDASI_CHANNEL_COUNT = $00000007;   // VT_UI4 
PIDASI_STREAM_NUMBER = $00000008;   // VT_UI2  PIDASI_STREAM_NAME   =
$00000009;   // VT_LPWSTR  PIDASI_COMPRESSION   = $0000000A;   //
VT_LPWSTR   // FMTID_VideoSummaryInformation  PIDVSI_STREAM_NAME   =
$00000002;   // "StreamName", VT_LPWSTR  PIDVSI_FRAME_WIDTH   =
$00000003;   // "FrameWidth", VT_UI4  PIDVSI_FRAME_HEIGHT  =
$00000004;   // "FrameHeight", VT_UI4  PIDVSI_TIMELENGTH    =
$00000007;   // "TimeLength", VT_UI4, milliseconds  PIDVSI_FRAME_COUNT
  = $00000005;   // "FrameCount". VT_UI4  PIDVSI_FRAME_RATE    =
$00000006;   // "FrameRate", VT_UI4, frames/millisecond 
PIDVSI_DATA_RATE     = $00000008;   // "DataRate", VT_UI4,
bytes/second  PIDVSI_SAMPLE_SIZE   = $00000009;   // "SampleSize",
VT_UI4  PIDVSI_COMPRESSION   = $0000000A;   // "Compression",
VT_LPWSTR  PIDVSI_STREAM_NUMBER = $0000000B;   // "StreamNumber",
VT_UI2 type  TMultipleArray     = record    pidInfoType : cardinal;  
pidInfoStr  : pchar;  end;  TMultipleArrayList = array of
TMultipleArray;  function GetFileSummaryInfo(const FileName:
WideString; GUID_SummaryType: TGUID; PID_InfoType: cardinal):
string;  implementation  const  szOleDll                =
'ole32.dll';  IID_IPropertySetStorage : TGUID =
'{0000013A-0000-0000-C000-000000000046}';type  TStgOpenStorageEx     
= function(const pwcsName: PWideChar;    grfMode: DWORD; stgfmt:
DWORD; grfAttrs: DWORD; pStgOptions: pointer;    reserved2: pointer;
riid: PGUID; out ppObjectOpen: IStorage): HRESULT;    stdcall;var 
StgOpenStorageEx        : TStgOpenStorageEx = nil;  dll              
     : HANDLE = 0; // dword = 0;  Win2k                   : boolean =
false;  function GetFileSummaryInfo(const FileName: WideString;
GUID_SummaryType: TGUID; PID_InfoType: cardinal): string;var  hr     
   : HRESULT;  Stg         : IStorage;  PropSetStg  :
IPropertySetStorage;  PropStg     : IPropertyStorage;  PropSpec    :
TPropSpec;  PropVariant : TPropVariant;begin  Result      := '';  hr 
       := S_FALSE;   // for 9x and NT4 users  if(not Win2k) or
(@StgOpenStorageEx = nil) then    hr :=
StgOpenStorage(pwidechar(FileName),nil,STGM_READ or
 STGM_SHARE_DENY_WRITE,nil,0,Stg)  // for 2000, XP and higher  else
if(@StgOpenStorageEx <> nil) then    hr :=
StgOpenStorageEx(pwidechar(FileName),STGM_READ or
STGM_SHARE_DENY_WRITE,STGFMT_ANY,0,nil,nil,
@IID_IPropertySetStorage,Stg);   if(hr = S_OK) then  begin    
PropSetStg := Stg as IPropertySetStorage;              
if(PropSetStg.Open(GUID_SummaryType,STGM_READ or
STGM_SHARE_EXCLUSIVE,PropStg) = S_OK) then begin      PropSpec.ulKind
:= PRSPEC_PROPID;      PropSpec.propid := PID_InfoType;      
if(PropStg.ReadMultiple(1,@PropSpec,@PropVariant) = S_OK) and
(PropVariant.vt = VT_LPSTR) and (PropVariant.pszVal <> nil) then     
Result := PropVariant.pszVal;    end;  end;end;   //// Main//var  os :
TOSVersionInfo; initialization  // get OS 
ZeroMemory(@os,sizeof(os));  os.dwOSVersionInfoSize := sizeof(os);  
// is it Windows 2000 or higher?  Win2k                  :=
(GetVersionEx(os)) and    (os.dwMajorVersion >= 5) and   
(os.dwPlatformId = VER_PLATFORM_WIN32_NT);   CoInitialize(nil);   dll
:= LoadLibrary(szOleDll);  if(dll <> 0) then begin    StgOpenStorageEx
:= GetProcAddress(dll,'StgOpenStorageEx');    if(@StgOpenStorageEx =
nil) then begin      FreeLibrary(dll);      dll := 0;    end; 
end;finalization  if(dll <> 0) then FreeLibrary(dll); 
CoUninitialize;end.   
Again, it always "stops" at the PropSetStg.Open() line (I have tested
it with several files):

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
if(PropSetStg.Open(GUID_SummaryType,STGM_READ or
STGM_SHARE_EXCLUSIVE,PropStg) = S_OK) then begin 
In this case, the code checks whether the result is S_OK and only
continues if it is S_OK. So, there is no exception occurring compared
to the first code.
But again, I don't know why PropSetStg.Open does not return S_OK and
why this function is not working like it should. The result is
-2147287038 in this code, too.

----------------------------------------------------------------------
ASerge · 2018-09-28 14:12

Quote from: LazProgger on September 27, 2018, 12:17:49 amI am trying
to read out the file properties of a file in Windows using Lazarus.
For example: Topic: how to get the original filedate not date modifyed

----------------------------------------------------------------------
LazProgger · 2018-09-30 15:23

Quote from: ASerge on September 28, 2018, 04:12:52 pmFor example:
Topic: how to get the original filedate not date modifyed

Thanks! I have tried your code, but unfortunately, it crashes.

I get a SIGSEGV here:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i and
Succeeded(DirFolder.GetDetailsEx(FilePIDL, Column, @Value))
If I remove this part, the rest of the code is running without any
error, but that's the part where the value is read out...

Anyone an idea how to fix that?

----------------------------------------------------------------------
ASerge · 2018-09-30 16:56

Quote from: LazProgger on September 30, 2018, 05:23:17 pmAnyone an
idea how to fix that?
Show your code. My works without errors.

----------------------------------------------------------------------
LazProgger · 2018-09-30 18:48

I just took the code you have linked:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i  {$APPTYPE
CONSOLE}program project1; uses Windows, SysUtils, ActiveX,
ShlObj; function GetShellFolder2(const Dir: UnicodeString; out Intf:
IShellFolder2): Boolean;var  DesktopFolder: IShellFolder;  DirPIDL:
PItemIDList = nil;begin  Result :=
Succeeded(SHGetDesktopFolder(DesktopFolder)) and           
Succeeded(DesktopFolder.ParseDisplayName(0, nil, PWideChar(Dir),
ULONG(nil^), DirPIDL, ULONG(nil^))) and           
Succeeded(DesktopFolder.BindToObject(DirPIDL, nil, IID_IShellFolder2,
Intf));  CoTaskMemFree(DirPIDL);end; function GetFileProperty(const
FileName: string; const Column: SHColumnID; out Value: OleVariant):
Boolean;var  DirFolder: IShellFolder2;  FilePIDL: PItemIDList = nil; 
WFileName: UnicodeString;  Path: PChar;begin  WFileName :=
Utf8Decode(FileName);  Result := False;  if
GetShellFolder2(ExtractFileDir(WFileName), DirFolder) then  begin   
Result := Succeeded(DirFolder.ParseDisplayName(0, nil,
PWideChar(ExtractFileName(WFileName)), ULONG(nil^), FilePIDL,
ULONG(nil^))) and             
Succeeded(DirFolder.GetDetailsEx(FilePIDL, Column, @Value));  // FAILS
HERE     CoTaskMemFree(FilePIDL);  end;end; const  CFileName =
 'E:\file.jpg';   // All available values see in propkey.h in SDK 
CColumnPhotoDateTaken: SHColumnID = ( // PKEY_Photo_DateTaken   
fmtid: '{14B81DA1-0135-4D31-96D9-6CBFC9671A99}'; //
FMTID_ImageProperties    pid: 36867);var  Value: OleVariant; begin 
CoInitialize(nil);   WriteLn('Start...');  if
GetFileProperty(CFileName, CColumnPhotoDateTaken, Value) then begin  
Writeln('Photo Date Taken at UTC: ', Value);  end else begin   
WriteLn('Error');  end;  Readln;end.   
Perhaps, the FilePIDL contains a bad reference, so that it comes to
the SIGSEGV when passing it to DirFolder.GetDetailsEx.

----------------------------------------------------------------------
LazProgger · 2018-09-30 19:07

Okay, it becomes stranger!

I have just tested the program and code from my last post in some
virtual machines.

And I found:

There is no error and the attribut is read out correctly, when the
application is compiled for Win64 and run on a 64bit system.

However, the error occurs when the application is compiled for Win32
and run on a 64bit system.

So, my new question is: How to make the code working as a Win32
application?

----------------------------------------------------------------------
ASerge · 2018-10-01 16:38

Quote from: LazProgger on September 30, 2018, 09:07:27 pmHowever, the
error occurs when the application is compiled for Win32 and run on a
64bit system.
Error found. Definition of shlobj.PSHColumnID is incorrect. It must be
a pointer, but it is defined equal to the SHColumnID structure.
Due to the fact that the 64-bit stdcall convention implies that
complex structures are passed through the pointer, this did not cause
problems for the 64-bit program, but 32-bit honestly pushes the entire
record onto the stack.

It is easy to make the example work if you copy the definition of the
IShellFolder2 interface from shlobj to the beginning and add before it
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i PSHColumnID
= ^SHColumnID;and, of course, change Column to @Column in GetDetailsEx
call.

----------------------------------------------------------------------
Thaddy · 2018-10-01 16:48

Quote from: ASerge on October 01, 2018, 06:38:31 pmDue to the fact
that the 64-bit stdcall convention implies
Uhmmm win64 does not have stdcall as convention...
https://msdn.microsoft.com/en-us/library/ms235286.aspx

Maybe you are mistaken that Delphi accepts it (but ignores it) as does
FPC.

----------------------------------------------------------------------
Remy Lebeau · 2018-10-01 21:04

Quote from: LazProgger on September 27, 2018, 03:40:21 amIt is
returning -2147287038.

That is STG_E_FILENOTFOUND, which means the specified FMTID doesn't
exist in the storage object you are querying.

----------------------------------------------------------------------
LazProgger · 2018-10-02 01:08

Quote from: ASerge on October 01, 2018, 06:38:31 pmIt is easy to make
the example work if you copy the definition of the IShellFolder2
interface from shlobj to the beginning and add before it
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i PSHColumnID
= ^SHColumnID;and, of course, change Column to @Column in GetDetailsEx
call.

Thank you very much! It's working now. Here is the full test code:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i  {$APPTYPE
CONSOLE}program project1; uses Windows, SysUtils, ActiveX,
ShlObj; type  PSHColumnID = ^SHColumnID;     function
GetShellFolder2(const Dir: UnicodeString; out Intf: IShellFolder2):
Boolean;var  DesktopFolder: IShellFolder;  DirPIDL: PItemIDList =
nil;begin  Result := Succeeded(SHGetDesktopFolder(DesktopFolder)) and 
          Succeeded(DesktopFolder.ParseDisplayName(0, nil,
PWideChar(Dir), ULONG(nil^), DirPIDL, ULONG(nil^))) and           
Succeeded(DesktopFolder.BindToObject(DirPIDL, nil, IID_IShellFolder2,
Intf));  CoTaskMemFree(DirPIDL);end; function GetFileProperty(const
FileName: string; const Column: SHColumnID; out Value: OleVariant):
Boolean;var  DirFolder: IShellFolder2;  FilePIDL: PItemIDList = nil; 
WFileName: UnicodeString;  Path: PChar;begin  WFileName :=
Utf8Decode(FileName);  Result := False;  if
GetShellFolder2(ExtractFileDir(WFileName), DirFolder) then  begin   
Result := Succeeded(DirFolder.ParseDisplayName(0, nil,
PWideChar(ExtractFileName(WFileName)), ULONG(nil^), FilePIDL,
ULONG(nil^))) and             
Succeeded(DirFolder.GetDetailsEx(FilePIDL, Column, @Value));  // FAILS
HERE     CoTaskMemFree(FilePIDL);  end;end; const  CFileName =
 'E:\file.jpg';  // All available values see in propkey.h in SDK 
CColumnPhotoDateTaken: SHColumnID = ( // PKEY_Photo_DateTaken   
fmtid: '{14B81DA1-0135-4D31-96D9-6CBFC9671A99}'; //
FMTID_ImageProperties    pid: 36867);var  Value: OleVariant; begin 
CoInitialize(nil);   WriteLn('Start...');  if
GetFileProperty(CFileName, CColumnPhotoDateTaken, Value) then begin  
Writeln('Photo Date Taken at UTC: ', Value);  end else begin   
WriteLn('Error');  end;  Readln;end. 
However, I have not change Column to @Column. When doing so, I get the
compiler error:

Code: Diff  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
project1.lpr(34,65) Error: Incompatible type for arg no. 2: Got
"Pointer", expected "SHColumnID"
But it's also working without @.

----------------------------------------------------------------------
ASerge · 2018-10-02 09:24

Quote from: LazProgger on October 02, 2018, 03:08:20 amHowever, I have
not change Column to @Column. When doing so, I get the compiler error:
But it's also working without @.
I think you did it again on Win64. You skipped "copy the definition of
the IShellFolder2 interface from shlobj to the beginning".

----------------------------------------------------------------------
LazProgger · 2018-10-02 12:49

Quote from: ASerge on October 02, 2018, 11:24:37 amI think you did it
again on Win64. You skipped "copy the definition of the IShellFolder2
interface from shlobj to the beginning".

Oh yes... :/

Here is the working code for everyone having the same problem:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i  {$APPTYPE
CONSOLE}program project1; uses Windows, SysUtils, ActiveX,
ShlObj; type  PSHColumnID = ^SHColumnID;   IShellFolder2 =
interface(IShellFolder)    ['{93F2F68C-1D1B-11d3-A30E-00C04F79ABD1}'] 
   function GetDefaultSearchGUID(out guid:TGUID):HResult;StdCall;   
 function EnumSearches(out ppenum:IEnumExtraSearch):HResult;StdCall; 
  function GetDefaultColumn(dwres:DWORD;psort :pulong;
pdisplay:pulong):HResult;StdCall;     function GetDefaultColumnState(i
column:UINT;pscflag:PSHCOLSTATEF):HResult;StdCall;     function
GetDetailsEx(pidl:LPCITEMIDLIST;pscid:PSHCOLUMNID; pv :
pOLEvariant):HResult;StdCall;     function GetDetailsOf(pidl:LPCITEMID
LIST;iColumn:UINT;psd:PSHELLDETAILS):HResult;StdCall;     function
MapColumnToSCID(iColumn:UINT;pscid:PSHCOLUMNID):HResult;StdCall;   
end;       function GetShellFolder2(const Dir: UnicodeString; out
Intf: IShellFolder2): Boolean;var  DesktopFolder: IShellFolder; 
DirPIDL: PItemIDList = nil;begin  Result :=
Succeeded(SHGetDesktopFolder(DesktopFolder)) and           
Succeeded(DesktopFolder.ParseDisplayName(0, nil, PWideChar(Dir),
ULONG(nil^), DirPIDL, ULONG(nil^))) and           
Succeeded(DesktopFolder.BindToObject(DirPIDL, nil, IID_IShellFolder2,
Intf));  CoTaskMemFree(DirPIDL);end; function GetFileProperty(const
FileName: string; const Column: SHColumnID; out Value: OleVariant):
Boolean;var  DirFolder: IShellFolder2;  FilePIDL: PItemIDList = nil; 
WFileName: UnicodeString;  Path: PChar;begin  WFileName :=
Utf8Decode(FileName);  Result := False;  if
GetShellFolder2(ExtractFileDir(WFileName), DirFolder) then  begin   
Result := Succeeded(DirFolder.ParseDisplayName(0, nil,
PWideChar(ExtractFileName(WFileName)), ULONG(nil^), FilePIDL,
ULONG(nil^))) and             
Succeeded(DirFolder.GetDetailsEx(FilePIDL, @Column, @Value));  //
FAILS HERE     CoTaskMemFree(FilePIDL);  end;end; const  CFileName =
 'E:\file.jpg';  // All available values see in propkey.h in SDK 
CColumnPhotoDateTaken: SHColumnID = ( // PKEY_Photo_DateTaken   
fmtid: '{14B81DA1-0135-4D31-96D9-6CBFC9671A99}'; //
FMTID_ImageProperties    pid: 36867);var  Value: OleVariant; begin 
CoInitialize(nil);   WriteLn('Start...');  if
GetFileProperty(CFileName, CColumnPhotoDateTaken, Value) then begin  
Writeln('Photo Date Taken at UTC: ', Value);  end else begin   
WriteLn('Error');  end;  Readln;end.

----------------------------------------------------------------------
LazProgger · 2018-10-02 13:23

I have published a bug report of the issue:

https://bugs.freepascal.org/view.php?id=34375

----------------------------------------------------------------------
LazProgger · 2018-10-02 13:32

One more question about the line:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
CoInitialize(nil);
According to the Microsoft Documentation, this line is needed to
initialize the COM library.

Do I have to ensure that this function is only called once? When
reading out multiple files, could it be a problem to call it before
each file processing or do I even have to?

For example, when putting the reading process into a function like
GetFilePropertyX(AFileName: string): string, would it be a
problem/performance hit to call CoInitialize each time calling the
function from within the function? The backgound is: The function will
not be called every time the program is started, so I do not want to
call CoInitialize each time at program startup but only when needed.

----------------------------------------------------------------------
Remy Lebeau · 2018-10-02 17:41

Quote from: LazProgger on October 02, 2018, 03:32:39 pmOne more
question about the line:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
CoInitialize(nil);
According to the Microsoft Documentation, this line is needed to
initialize the COM library.

Do I have to ensure that this function is only called once? When
reading out multiple files, could it be a problem to call it before
each file processing or do I even have to?

It needs to be called once *per thread*.  It CAN be called more than
once per thread, but if you try to specify a different threading model
than the used by the 1st call, you will get an RPC_E_CHANGED_MODE
error.  Every *successful* call to CoInitialize/Ex() requires a
matching CoUninitialize() call.

Quote from: LazProgger on October 02, 2018, 03:32:39 pmFor example,
when putting the reading process into a function like
GetFilePropertyX(AFileName: string): string, would it be a
problem/performance hit to call CoInitialize each time calling the
function from within the function?

Don't do that.  It is the calling thread's responsibility to
initialize COM, not your function's.  And if the thread hasn't
initialized COM yet when your function is called, and you silently
initialize COM on the caller's behalf, unexpected things *may* happen
later on in the thread's code long after your function has exited.  So
just don't do it.  If COM hasn't been initialized yet, you should just
fail and exit.  And document that your function requires COM to be
initialized before called.

Quote from: LazProgger on October 02, 2018, 03:32:39 pmThe backgound
is: The function will not be called every time the program is started,
so I do not want to call CoInitialize each time at program startup but
only when needed.

The calling thread should initialize COM before calling your
function.  If the thread doesn't call your function, it doesn't need
to initialize COM.

----------------------------------------------------------------------
LazProgger · 2018-10-02 18:00

Quote from: Remy Lebeau on October 02, 2018, 07:41:41 pm
It needs to be called once *per thread*.  It CAN be called more than
once per thread, but if you try to specify a different threading model
than the used by the 1st call, you will get an RPC_E_CHANGED_MODE
error.  Every *successful* call to CoInitialize/Ex() requires a
matching CoUninitialize() call.


Oh thanks.. The initial code had no CoUninitialize() call at all...

Quote from: Remy Lebeau on October 02, 2018, 07:41:41 pmAnd if the
thread hasn't initialized COM yet when your function is called, and
you silently initialize COM on the caller's behalf, unexpected things
*may* happen later on in the thread's code long after your function
has exited.  So just don't do it.  If COM hasn't been initialized yet,
you should just fail and exit.  And document that your function
requires COM to be initialized before called.

Is there a way to check whether CoInitialize/Ex() has been called / is
initialized?

----------------------------------------------------------------------
ASerge · 2018-10-02 18:47

Quote from: LazProgger on October 02, 2018, 08:00:55 pmIs there a way
to check whether CoInitialize/Ex() has been called / is initialized?
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i case
CoInitialize(nil) of  S_OK: // First time    ;  S_FALSE: // Already
initialized    CoUninitialize;  RPC_E_CHANGED_MODE: // Already
initialized, but with differ concurrency model    ; // Ignoreend;

----------------------------------------------------------------------
LazProgger · 2018-10-02 18:55

However, when checking it this way, I have again multiple CoInitialize
calls and I thought I have to avoid that...

----------------------------------------------------------------------
Thaddy · 2018-10-02 19:00

Well,
CoInitialize  and family should be called in an initialization and
finalization part of a unit.
Anyway I just remembered I wrote or contributed to an article in UNDU
about this around the beginning of this century.
I'll see if I can retrieve the code from somewhere.

Remy, I seem to remember there is indeed a per thread need, but
depending on the COM model. (YOU remember UNDU for sure...  )
Anyway a matching pair is required.

----------------------------------------------------------------------
LazProgger · 2018-10-02 19:09

That means, if I use CoInitialize from within a thread, I cannot do it
in the initialization and finalization, because the unit is the main
thread and not the thread in which the COM thing is used?

----------------------------------------------------------------------
Remy Lebeau · 2018-10-02 19:16

Quote from: Thaddy on October 02, 2018, 09:00:54 pmCoInitialize  and
family should be called in an initialization and finalization part of
a unit.

That is actually a very bad idea.  Besides, that only (un)initializes
the thread that is (un)initializing the unit, which may not be the
same thread that is calling the function in question.

Quote from: Thaddy on October 02, 2018, 09:00:54 pmRemy, I seem to
remember there is indeed a per thread need, but depending on the COM
model.

COM is *always* initialized per-thread, regardless of the threading
model.  A thread's threading model must be established before it can
interact with any COM objects.  And a COM object has its own threading
model, so the two models need to be known in order for COM to
successfully interact (and know HOW to interact) between the thread
and the COM object (direct access vs proxying, etc).

Quote from: Thaddy on October 02, 2018, 09:00:54 pm(YOU remember UNDU
for sure...  )

Never heard of it.

----------------------------------------------------------------------
Remy Lebeau · 2018-10-02 19:17

Quote from: LazProgger on October 02, 2018, 09:09:15 pmThat means, if
I use CoInitialize from within a thread, I cannot do it in the
initialization and finalization, because the unit is the main thread
and not the thread in which the COM thing is used?

Correct.  Every thread must call CoInitialize/Ex() and
CoUninitialize() for itself.  This is why your function should NOT be
(un)initializing COM at all, that is the thread's responsibility
outside of your function.