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.
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
Collected from the Internet
Please contact [email protected] to delete if infringement.
Comments