Как прочитать/изменить свойства Word документа?
Как прочитать/изменить свойства Word документа?
{ 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;
Взято с сайта