delphiole-automation

GetDetailsOf returns property name instead of value (delphi 2007)


I have never needed to do much COM, so have almost no experience with it. Nearly all of the documentation (certainly from MS) does not include Delphi examples. In my code example, I can't see where I'm going wrong. The code was borrowed from snippets found in several locations on the web. Some were VB. I only found one thread for Free Pascal, and it was incomplete. This runs, but shows displays the same string for both name and value. I hope someone can see what I'm missing. I think the problem is with the line that reads:

PropValue := OleFolder.GetDetailsOf(OleFolderItem, i);

I don't know if I need to do something to initialize "OleFolderItem".

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActiveX, ComObj, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
 pnl1: TPanel;
 btn1: TButton;
 mmo1: TMemo;
 OpenDialog1: TOpenDialog;
 procedure btn1Click(Sender: TObject);
 procedure getExtdProps(AFileName: string);
private
 { Private declarations }
public
 { Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

Procedure TForm1.getExtdProps(AFileName: string);
var
Shell : Variant;
OleFolder : OleVariant;
OleFolderItem: OleVariant;
PropName, PropValue: string;
i: integer;
begin
Shell := CreateOleObject('Shell.Application');
OleFolder := Shell.Namespace(ExtractFilePath(AFileName));
i := 0;
PropName := 'Not an EmptyStr'; //So the next loop will work.
while PropName <> EmptyStr do
begin
 PropName  := OleFolder.GetDetailsOf(null, i); {null gets the name}
 PropValue := OleFolder.GetDetailsOf(OleFolderItem, i); { OleFolderItem should get the value }
 if PropName <> '' then
   mmo1.Lines.Add(PropName + ':  ' + PropValue);
 inc(i);
end;
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
 GetExtdProps(OpenDialog1.FileName);
end;
end;

end.

Solution

  • Try this complete example :

    unit GetDetailsOfDemoMain;
    
    interface
    
    uses
        Winapi.Windows, Winapi.Messages,
        System.SysUtils, System.Variants, System.Win.ComObj, System.Classes,
        Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
    
    type
        TForm1 = class(TForm)
            Button1: TButton;
            OpenDialog1: TOpenDialog;
            Memo1: TMemo;
            procedure Button1Click(Sender: TObject);
        private
            procedure GetExtdProps(AFileName: string);
        end;
    
    var
        Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    procedure TForm1.GetExtdProps(AFileName: string);
    var
        Shell         : Variant;
        OleFolder     : OleVariant;
        OleFolderItem : OleVariant;
        ForlderName   : String;
        PropName      : String;
        PropValue     : string;
        I             : integer;
    begin
        Shell         := CreateOleObject('Shell.Application');
        OleFolder     := Shell.Namespace(ExtractFilePath(AFileName));
        OleFolderItem := OleFolder.ParseName(ExtractFileName(AFileName));
        for I := 0 to 999 do begin
            PropName  := OleFolder.GetDetailsOf(null, i);
            PropValue := OleFolder.GetDetailsOf(OleFolderItem , I);
            if (PropName <> '') and (PropValue <> '') then
                Memo1.Lines.Add(Format('%3d) %-30s: %s',
                                       [I, PropName, PropValue]));
        end;
    end;
    
    procedure TForm1.Button1Click(Sender: TObject);
    begin
        if OpenDialog1.Execute then
            GetExtdProps(OpenDialog1.FileName);
    end;
    
    end.
    

    DFM file:

    object Form1: TForm1
      Left = 0
      Top = 0
      Caption = 'Form1'
      ClientHeight = 441
      ClientWidth = 624
      Color = clBtnFace
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -12
      Font.Name = 'Segoe UI'
      Font.Style = []
      PixelsPerInch = 96
      DesignSize = (
        624
        441)
      TextHeight = 15
      object Button1: TButton
        Left = 40
        Top = 32
        Width = 75
        Height = 25
        Caption = 'Button1'
        TabOrder = 0
        OnClick = Button1Click
      end
      object Memo1: TMemo
        Left = 8
        Top = 72
        Width = 609
        Height = 361
        Anchors = [akLeft, akTop, akRight, akBottom]
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clWindowText
        Font.Height = -12
        Font.Name = 'Consolas'
        Font.Style = []
        ParentFont = False
        ScrollBars = ssBoth
        TabOrder = 1
      end
      object OpenDialog1: TOpenDialog
        Left = 48
        Top = 88
      end
    end