Delphi-Help

{ 1. Change MS Word properties via OLE } 

uses 

  ComObj; 

procedure TForm1.Button1Click(Sender: TObject); 

const 

  wdPropertyTitle = $00000001; 

  wdPropertySubject = $00000002; 

  wdPropertyAuthor = $00000003; 

  wdPropertyKeywords = $00000004; 

  wdPropertyComments = $00000005; 

  wdPropertyTemplate = $00000006; 

  wdPropertyLastAuthor = $00000007; 

  wdPropertyRevision = $00000008; 

  wdPropertyAppName = $00000009; 

  wdPropertyTimeLastPrinted = $0000000A; 

  wdPropertyTimeCreated = $0000000B; 

  wdPropertyTimeLastSaved = $0000000C; 

  wdPropertyVBATotalEdit = $0000000D; 

  wdPropertyPages = $0000000E; 

  wdPropertyWords = $0000000F; 

  wdPropertyCharacters = $00000010; 

  wdPropertySecurity = $00000011; 

  wdPropertyCategory = $00000012; 

  wdPropertyFormat = $00000013; 

  wdPropertyManager = $00000014; 

  wdPropertyCompany = $00000015; 

  wdPropertyBytes = $00000016; 

  wdPropertyLines = $00000017; 

  wdPropertyParas = $00000018; 

  wdPropertySlides = $00000019; 

  wdPropertyNotes = $0000001A; 

  wdPropertyHiddenSlides = $0000001B; 

  wdPropertyMMClips = $0000001C; 

  wdPropertyHyperlinkBase = $0000001D; 

  wdPropertyCharsWSpaces = $0000001E; 

const 

  AWordDoc = 'C:\Test.doc'; 

  wdSaveChanges = $FFFFFFFF; 

var 

  WordApp: OLEVariant; 

  SaveChanges: OleVariant; 

begin 

  try 

    WordApp := CreateOleObject('Word.Application'); 

  except 

    // Error.... 

    Exit; 

  end; 

  try 

    WordApp.Visible := False; 

    WordApp.Documents.Open(AWordDoc); 

    WordApp.ActiveDocument.BuiltInDocumentProperties[wdPropertyTitle].Value := 'Your Title...'; 

    WordApp.ActiveDocument.BuiltInDocumentProperties[wdPropertySubject].Value := 'Your Subject...'; 

    // ... 

    // ... 

  finally 

    SaveChanges := wdSaveChanges; 

    WordApp.Quit(SaveChanges, EmptyParam, EmptyParam); 

  end; 

end;

{ 

  2. Read MS Word properties via Structured Storage. 

  by Serhiy Perevoznyk 

} 

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;