Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 869
  • Last Modified:

Getting Word document properties in delphi 7

I am trying to produce a directory list utility that will display in addition to the normal file name, size and date information, details from the document properties section of word documents e.g Subject, Author and manager fields.

I would be grateful for suggestions, with example code of ways of getting this additional document information.

Thanks in advance
0
alanjbrown
Asked:
alanjbrown
  • 3
  • 2
1 Solution
 
CodedKCommented:
Hi alanjbrown.
Check this out :
uses
  ComObj, ActiveX;
 
const
  FmtID_SummaryInformation: TGUID =
    '{F29F85E0-4FF9-1068-AB91-08002B27B3D9}';
 
function FileTimeToDateTimeStr(F: TFileTime): string;
var
  LocalFileTime: TFileTime;
  SystemTime: TSystemTime;
  DateTime: TDateTime;
begin
  if Comp(F) = 0 then Result := '-'
  else 
  begin
    FileTimeToLocalFileTime(F, LocalFileTime);
    FileTimeToSystemTime(LocalFileTime, SystemTime);
    with SystemTime do
      DateTime := EncodeDate(wYear, wMonth, wDay) +
        EncodeTime(wHour, wMinute, wSecond, wMilliseconds);
    Result := DateTimeToStr(DateTime);
  end;
end;
 
function GetDocInfo(const FileName: WideString): string;
var
  I: Integer;
  PropSetStg: IPropertySetStorage;
  PropSpec: array[2..19] of TPropSpec;
  PropStg: IPropertyStorage;
  PropVariant: array[2..19] of TPropVariant;
  Rslt: HResult;
  S: string;
  Stg: IStorage;
begin
  Result := '';
  try
    OleCheck(StgOpenStorage(PWideChar(FileName), nil, STGM_READ or
      STGM_SHARE_DENY_WRITE,
      nil, 0, Stg));
    PropSetStg := Stg as IPropertySetStorage;
    OleCheck(PropSetStg.Open(FmtID_SummaryInformation,
      STGM_READ or STGM_SHARE_EXCLUSIVE, PropStg));
    for I := 2 to 19 do
    begin
      PropSpec[I].ulKind := PRSPEC_PROPID;
      PropSpec[I].PropID := I;
    end;
    Rslt := PropStg.ReadMultiple(18, @PropSpec, @PropVariant);
    OleCheck(Rslt);
    if Rslt <> S_FALSE then for I := 2 to 19 do
      begin
        S := '';
        if PropVariant[I].vt = VT_LPSTR then
          if Assigned(PropVariant[I].pszVal) then
            S := PropVariant[I].pszVal;
        case I of
          2:  S  := Format('Title: %s', [S]);
          3:  S  := Format('Subject: %s', [S]);
          4:  S  := Format('Author: %s', [S]);
          5:  S  := Format('Keywords: %s', [S]);
          6:  S  := Format('Comments: %s', [S]);
          7:  S  := Format('Template: %s', [S]);
          8:  S  := Format('Last saved by: %s', [S]);
          9:  S  := Format('Revision number: %s', [S]);
          10: S := Format('Total editing time: %g sec',
              [Comp(PropVariant[I].filetime) / 1.0E9]);
          11: S := Format('Last printed: %s',
              [FileTimeToDateTimeStr(PropVariant[I].filetime)]);
          12: S := Format('Create time/date: %s',
              [FileTimeToDateTimeStr(PropVariant[I].filetime)]);
          13: S := Format('Last saved time/date: %s',
              [FileTimeToDateTimeStr(PropVariant[I].filetime)]);
          14: S := Format('Number of pages: %d', [PropVariant[I].lVal]);
          15: S := Format('Number of words: %d', [PropVariant[I].lVal]);
          16: S := Format('Number of characters: %d',
              [PropVariant[I].lVal]);
          17:; // thumbnail
          18: S := Format('Name of creating application: %s', [S]);
          19: S := Format('Security: %.8x', [PropVariant[I].lVal]);
        end;
        if S <> '' then Result := Result + S + #13;
      end;
  finally
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if Opendialog1.Execute then
    ShowMessage(GetDocInfo(opendialog1.FileName));
end;

Open in new window

0
 
CodedKCommented:
Just drop a button, an OpenDialog in the form. Add the 2 functions and try it.
0
 
alanjbrownAuthor Commented:
Thank you Codedk.

Excelent solution
0
 
alanjbrownAuthor Commented:
Excelent
0
 
CodedKCommented:
Glad i've helped :)
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now