kmotavali
جمعه 21 تیر 1387, 11:47 صبح
من این کد رو پیداکرم اگه میشه در این مورد راهنماییم کنین
{************************************************* ****************************
Name : psvFileProperties
Author : Perevoznyk Serhiy
************************************************** ***************************}
unit psvFileProperties;
interface
uses
Windows,
SysUtils,
Classes,
Controls,
Graphics,
ActiveX,
Registry;
const
FmtID_SummaryInformation: TGUID = '{F29F85E0-4FF9-1068-AB91-08002B27B3D9}';
FMTID_DocSummaryInformation : TGUID = '{D5CDD502-2E9C-101B-9397-08002B2CF9AE}';
FMTID_UserDefinedProperties : TGUID = '{D5CDD505-2E9C-101B-9397-08002B2CF9AE}';
IID_IPropertySetStorage : TGUID = '{0000013A-0000-0000-C000-000000000046}';
//DocSummaryInformation properties
const
PIDDSI_CATEGORY = $2; // Category
PIDDSI_PRESFORMAT = $3; // PresentationTarget
PIDDSI_BYTECOUNT = $4; // Bytes
PIDDSI_LINECOUNT = $5; // Lines
PIDDSI_PARCOUNT = $6; // Paragraphs
PIDDSI_SLIDECOUNT = $7; // Slides
PIDDSI_NOTECOUNT = $8; // Notes
PIDDSI_HIDDENCOUNT = $9; // HiddenSlides
PIDDSI_MMCLIPCOUNT = $A; // MMClips
PIDDSI_SCALE = $B; // ScaleCrop
PIDDSI_HEADINGPAIR = $C; // HeadingPairs
PIDDSI_DOCPARTS = $D; // TitlesofParts
PIDDSI_MANAGER = $E; // Manager
PIDDSI_COMPANY = $F; // Company
PIDDSI_LINKSDIRTY = $10; // LinksUpToDate
//Category
// A text string typed by the user indicating what category the file
// belongs to (memo, proposal, and so forth). It is useful for finding
// files of same type.
//PresentationTarget
// Target format for presentation (35mm, printer, video, and so forth).
//Bytes
// Number of bytes.
//Lines
// Number of lines.
//Paragraphs
// Number of paragraphs.
//Slides
// Number of slides.
//Notes
// Number of pages that contain notes.
//HiddenSlides
// Number of slides that are hidden.
//MMClips
// Number of sound or video clips.
//ScaleCrop
// Set to True (-1) when scaling of the thumbnail is desired.
// If not set, cropping is desired.
//HeadingPairs
// Internally used property indicating the grouping of different
// document parts and the number of items in each group. The titles of the
// document parts are stored in the PIDDSI_DOCPARTS property. The
// HeadingPairs property is stored as a vector of variants, in repeating
// pairs of VT_LPSTR (or VT_LPWSTR) and VT_I4 values. The VT_LPSTR value
// represents a heading name, and the VT_I4 value indicates the count of
// document parts under that heading.
//TitlesofParts
// Names of document parts.
//Manager
// Manager of the project.
//Company
// Company name.
//LinksUpToDate
// Boolean value to indicate whether the custom links are hampered by
// excessive noise, for all applications.
//Security
PIDDSI_SECURITYNONE = 0;
PIDDSI_PASSWORDPROTECTED = 1;
PIDDSI_READONLYRECOMMENDED = 2;
PIDDSI_READONLYENFORCED = 4;
PIDDSI_LOCKEDFORANNOTATION = 8;
const
STGFMT_FILE = 3; //Indicates that the file must not be a compound file.
//This element is only valid when using the StgCreateStorageEx
//or StgOpenStorageEx functions to access the NTFS file system
//implementation of the IPropertySetStorage interface.
//Therefore, these functions return an error if the riid
//parameter does not specify the IPropertySetStorage interface,
//or if the specified file is not located on an NTFS file system volume.
STGFMT_ANY = 4; //Indicates that the system will determine the file type and
//use the appropriate structured storage or property set
//implementation.
//This value cannot be used with the StgCreateStorageEx function.
type
TpsvFileProperties = class
private
Handle : THandle;
//DocSummary
FByteCount : integer;
FCategory : string;
FCompany : string;
FLines : integer;
FParagraphs : integer;
FNotes : integer;
FManager : string;
FCustom : TStringList;
//Summary
FTitle : string;
FSubject : string;
FAuthor : string;
FKeyWords : string;
FComments : string;
FTemplate : string;
FLastSavedBy : string;
FRevisionNumber : string;
FTotalEditingTime : TFileTime;
FLastPrinted : TFileTime;
FCreateTimeDate : TFileTime;
FLastSaved : TFileTime;
FNumberOfPages : longint;
FNumberOfWords : longint;
FNumberOfCharacters : longint;
FAppName : string;
FSecurity : integer;
FPreview : TMetafile;
FFileName : string;
procedure SetCustom(AValue : TStringList);
procedure SetPreview(AValue : TMetafile);
protected
procedure LoadFromStorage();
procedure SaveToStorage();
public
constructor Create; virtual;
destructor Destroy; override;
procedure ReadFileInformation(AFileName : string);
procedure WriteFileInformation(AFileName : string);
procedure Clear;
procedure SetDefaultValues; virtual;
property ByteCount : integer read FByteCount write FByteCount;
property Category : string read FCategory write FCategory;
property Company : string read FCompany write FCompany;
property Lines : integer read FLines write FLines;
property Paragraphs : integer read FParagraphs write FParagraphs;
property Notes : integer read FNotes write FNotes;
property Manager : string read FManager write FManager;
property Custom : TStringList read FCustom write SetCustom;
property Title : string read FTitle write FTitle;
property Subject : string read FSubject write FSubject;
property Author : string read FAuthor write FAuthor;
property Keywords : string read FKeywords write FKeywords;
property Comments : string read FComments write FComments;
property Template : string read FTemplate write FTemplate;
property LastSavedBy : string read FLastSavedBy write FLastSavedBy;
property RevisionNumber : string read FRevisionNumber write FRevisionNumber;
property TotalEditingTime : TFileTime read FTotalEditingTime write FTotalEditingTime;
property LastPrinted : TFileTime read FLastPrinted write FLastPrinted;
property CreateTimeDate : TFileTime read FCreateTimeDate write FCreateTimeDate;
property LastSaved : TFileTime read FLastSaved write FLastSaved;
property NumberOfPages : longint read FNumberOfPages write FNumberOfPages;
property NumberOfWords : longint read FNumberOfWords write FNumberOfWords;
property NumberOfCharacters : longint read FNumberOfCharacters write FNumberOfCharacters;
property AppName : string read FAppName write FAppName;
property Security : integer read FSecurity write FSecurity;
property Preview : TMetafile read FPreview write SetPreview;
end;
implementation
type TStgOpenStorageEx = function (
const pwcsName : POleStr; //Pointer to the path of the
//file containing storage object
grfMode : LongInt; //Specifies the access mode for the object
stgfmt : DWORD; //Specifies the storage file format
grfAttrs : DWORD; //Reserved; must be zero
pStgOptions : Pointer; //Address of STGOPTIONS pointer
reserved2 : Pointer; //Reserved; must be zero
riid : PGUID; //Specifies the GUID of the interface pointer
out stgOpen : //Address of an interface pointer
IStorage ) : HResult; stdcall;
var
VStgOpenStorageEx : TStgOpenStorageEx = nil;
type
TPackedMeta = record
mm : word;
xExt : word;
yExt : word;
reserved : word;
end;
function DateTimeToFileTime(DateTime: TDateTime): TFileTime;
const
FileTimeBase = -109205.0;
FileTimeStep: Extended = 24.0 * 60.0 * 60.0 * 1000.0 * 1000.0 * 10.0; // 100 nSek per Day
var
E: Extended;
F64: Int64;
begin
E := (DateTime - FileTimeBase) * FileTimeStep;
F64 := Round(E);
Result := TFileTime(F64);
end;
function StringToPWideChar(S: string): PWideChar;
var
OldSize: Integer;
NewSize: Integer;
begin
OldSize := Length(S) + 1;
NewSize := OldSize * 2;
Result := AllocMem(NewSize);
MultiByteToWideChar(CP_ACP, 0, PChar(S), OldSize, Result, NewSize);
end;
function GetRegisteredCompany: string;
var
RegKey: HKEY;
Size: DWORD;
StrVal: string;
RegKind: DWORD;
function REG_CURRENT_VERSION: string;
begin
if (Win32Platform = VER_PLATFORM_WIN32_NT) then
Result := 'Software\Microsoft\Windows NT\CurrentVersion'
else
Result := 'Software\Microsoft\Windows\CurrentVersion';
end;
begin
Result := '';
if RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(REG_CURRENT_VERSION), 0, KEY_READ, RegKey) = ERROR_SUCCESS then
begin
RegKind := 0;
Size := 0;
if RegQueryValueEx(RegKey, PChar('RegisteredOrganization'), nil, @RegKind, nil, @Size) = ERROR_SUCCESS then
if RegKind in [REG_SZ, REG_EXPAND_SZ] then
begin
SetLength(StrVal, Size);
if RegQueryValueEx(RegKey, PChar('RegisteredOrganization'), nil, @RegKind, PByte(StrVal), @Size) = ERROR_SUCCESS then
begin
SetLength(StrVal, StrLen(PChar(StrVal)));
Result := StrVal;
end;
end;
RegCloseKey(RegKey);
end;
end;
function GetLocalUserName: string;
var
Count: DWORD;
begin
Count := 256 + 1;
SetLength(Result, Count);
if GetUserName(PChar(Result), Count) then
SetLength(Result, StrLen(PChar(Result)))
else
Result := '';
end;
{ TpsvFileProperties }
procedure TpsvFileProperties.Clear;
begin
FByteCount := 0;
FCategory := '';
FCompany := '';
FLines := 0;
FParagraphs := 0;
FNotes := 0;
FManager := '';
FCustom.Clear;
FTitle := '';
FAuthor := '';
FKeyWords := '';
FComments := '';
FTemplate := '';
FLastSavedBy := '';
FRevisionNumber := '';
FTotalEditingTime.dwLowDateTime := 0;
FTotalEditingTime.dwHighDateTime := 0;
FLastPrinted.dwLowDateTime := 0;
FLastPrinted.dwHighDateTime := 0;
FCreateTimeDate := DateTimeToFileTime(Time);
FLastSaved := DateTimeToFileTime(Time);
FNumberOfPages := 0;
FNumberOfWords := 0;
FNumberOfCharacters := 0;
FAppName := '';
FSecurity := 0;
end;
constructor TpsvFileProperties.Create;
begin
inherited;
FCustom := TStringList.Create;
FPreview := TMetafile.Create;
FByteCount := 0;
FLines := 0;
Handle := LoadLibrary('ole32.dll');
if Handle > 0 then
VStgOpenStorageEx := GetProcAddress(Handle, 'StgOpenStorageEx')
else
VStgOpenStorageEx := nil;
end;
destructor TpsvFileProperties.Destroy;
begin
FCustom.Free;
FPreview.Free;
if Handle > 0 then
FreeLibrary(Handle);
inherited;
end;
procedure TpsvFileProperties.LoadFromStorage;
var
PropSetStg: IPropertySetStorage;
PropStg: IPropertyStorage;
PropSpec: array of TPropSpec;
PropVariant: array of TPropVariant;
PropEnum: IEnumSTATPROPSTG;
Hr : HREsult;
PropStat: STATPROPSTG;
cnt : integer;
I : integer;
stg : IStorage;
function GetTextValue : string;
begin
if PropVariant[I].vt = VT_LPSTR then
Result := PropVariant[I].pszVal
else
if PropVariant[I].vt = VT_LPWSTR then
Result := PropVariant[I].pwszVal;
end;
begin
Clear;
if not Assigned(VStgOpenStorageEx) then
Exit;
hr := VStgOpenStorageEx(StringToPWideChar(FFileName), STGM_READ or STGM_SHARE_DENY_WRITE,
STGFMT_FILE, 0, nil, nil, @IID_IPropertySetStorage, stg);
if FAILED(hr) then
Exit;
stg.QueryInterface(IPropertySetStorage, PropSetStg);
if Assigned(PropSetStg) then
begin
HR := PropSetStg.Open(FMTID_DocSummaryInformation, STGM_READ or STGM_SHARE_EXCLUSIVE, PropStg);
if not FAILED(hr) then
begin
PropStg.Enum(PropEnum);
cnt := 0;
hr := PropEnum.Next(1, PropStat, nil);
while hr = S_OK do
begin
inc(cnt);
SetLength(PropSpec,cnt);
PropSpec[cnt-1].ulKind := PRSPEC_PROPID;
PropSpec[cnt-1].propid := PropStat.propid;
hr := PropEnum.Next(1, PropStat, nil);
end;
SetLength(PropVariant,cnt);
PropStg.ReadMultiple(cnt, @PropSpec[0], @PropVariant[0]);
for I := 0 to cnt -1 do
begin
case PropSpec[i].PropID of
PIDDSI_BYTECOUNT : FByteCount := PropVariant[i].lVal;
PIDDSI_LINECOUNT : FLines := PropVariant[i].lVal;
PIDDSI_PARCOUNT : FParagraphs := PropVariant[i].lVal;
PIDDSI_NOTECOUNT : FNotes := PropVariant[i].lVal;
PIDDSI_CATEGORY : FCategory := GetTextValue;
PIDDSI_MANAGER : FManager := GetTextValue;
PIDDSI_COMPANY : FCompany := GetTextValue;
end;
end;
end;
hr := PropSetStg.Open(FMTID_UserDefinedProperties, STGM_READ or STGM_SHARE_EXCLUSIVE, PropStg);
if not FAILED(hr) then begin
PropStg.Enum(PropEnum);
cnt := 0;
hr := PropEnum.Next(1, PropStat, nil);
while hr = S_OK do
begin
inc(cnt);
SetLength(PropSpec,cnt);
PropSpec[cnt-1].ulKind := PRSPEC_LPWSTR;
PropSpec[cnt-1].lpwstr := PropStat.lpwstrName;
hr := PropEnum.Next(1, PropStat, nil);
end;
SetLength(PropVariant,cnt);
PropStg.ReadMultiple(cnt, @PropSpec[0], @PropVariant[0]);
for I := 0 to cnt -1 do
begin
FCustom.Values[PropSpec[I].lpwstr] := GetTextValue;
end;
end;
hr := PropSetStg.Open(FmtID_SummaryInformation, STGM_READ or STGM_SHARE_EXCLUSIVE, PropStg);
if Succeeded(hr) then begin
PropStg.Enum(PropEnum);
cnt := 0;
hr := PropEnum.Next(1, PropStat, nil);
while hr = S_OK do
begin
inc(cnt);
SetLength(PropSpec,cnt);
PropSpec[cnt-1].ulKind := PRSPEC_PROPID;
PropSpec[cnt-1].propid := PropStat.propid;
hr := PropEnum.Next(1, PropStat, nil);
end;
SetLength(PropVariant,cnt);
PropStg.ReadMultiple(cnt, @PropSpec[0], @PropVariant[0]);
for I := 0 to cnt -1 do
begin
case PropSpec[i].PropID of
PIDSI_TITLE : FTitle := GetTextValue;
PIDSI_SUBJECT : FSubject := GetTextValue;
PIDSI_AUTHOR : FAuthor := GetTextValue;
PIDSI_KEYWORDS : FKeyWords := GetTextValue;
PIDSI_COMMENTS : FComments := GetTextValue;
PIDSI_TEMPLATE : FTemplate := GetTextValue;
PIDSI_LASTAUTHOR : FLastSavedBy := GetTextValue;
PIDSI_REVNUMBER : FRevisionNumber := GetTextValue;
PIDSI_APPNAME : FAppName := GetTextValue;
PIDSI_EDITTIME : FTotalEditingTime := PropVariant[I].filetime;
PIDSI_LASTPRINTED : FLastPrinted := PropVariant[I].filetime;
PIDSI_CREATE_DTM : FCreateTimeDate := PropVariant[I].filetime;
PIDSI_LASTSAVE_DTM : FLastSaved := PropVariant[I].filetime;
PIDSI_PAGECOUNT : FNumberOfPages := PropVariant[I].lVal;
PIDSI_WORDCOUNT : FNumberOfWords := PropVariant[I].lVal;
PIDSI_CHARCOUNT : FNumberOfCharacters := PropVariant[I].lVal;
PIDSI_DOC_SECURITY : FSecurity := PropVariant[I].lVal;
end;
end;
end;
end;
end;
procedure TpsvFileProperties.ReadFileInformation(AFileName: string);
begin
if not FileExists(AFileName) then
Exit;
FFileName := AFileName;
LoadFromStorage;
end;
procedure TpsvFileProperties.WriteFileInformation(AFileName : string);
begin
if not FileExists(AFileName) then
Exit;
FFileName := AFileName;
SaveToStorage;
end;
procedure TpsvFileProperties.SaveToStorage;
var
PropSetStg: IPropertySetStorage;
PropSpec: array of TPropSpec;
PropStg: IPropertyStorage;
PropVariant: array of TPropVariant;
cnt : integer;
CustomName : String;
CustomValue : String;
Parts : array of TPropVariant;
hr : HResult;
DefaultFormat : DWORD;
MetaData : TPackedMeta;
MemStream : TMemoryStream;
Buffer : Pointer;
PT : TPoint;
oldMapMode : integer;
Size : integer;
RefDC : HDC;
stg : IStorage;
procedure SetIntValue(ID : integer; AValue : integer; I4: boolean = true);
begin
inc(cnt);
SetLength(PropSpec, cnt);
PropSpec[cnt - 1].ulKind := PRSPEC_PROPID;
PropSpec[cnt - 1].propid := ID;
SetLength(PropVariant, cnt);
if I4 then
begin
PropVariant[cnt-1].vt := VT_I4;
PropVariant[cnt-1].lVal := AValue;
end
else
begin
PropVariant[cnt-1].vt := VT_I2;
PropVariant[cnt-1].iVal := AValue;
end;
end;
procedure SavePreview;
begin
if not Assigned(FPreview) then
Exit;
PT.x := FPreview.Width;
PT.Y := FPreview.Height;
RefDC := GetDC(0);
Size := GetWinMetafileBits(FPreview.Handle, 0, nil, MM_ANISOTROPIC, RefDC );
GetMem(Buffer, Size );
GetWinMetafileBits(FPreview.Handle, Size, Buffer, MM_ANISOTROPIC, RefDC );
oldMapMode := SetMapMode(RefDC, MM_HIMETRIC);
DPtoLP(RefDC, PT, 1);
SetMapMode(RefDC, oldMapMode);
ReleaseDC(0,RefDC);
DefaultFormat := CF_METAFILEPICT;
MetaData.mm := MM_ANISOTROPIC;
MetaData.xExt := ABS(PT.x);
MetaData.yExt := ABS(PT.y);
MetaData.reserved := 0;
MemStream := TMemoryStream.Create;
MemStream.Write(DefaultFormat, SizeOf(DefaultFormat));
MemStream.Write(MetaData, SizeOf(MetaData));
MemStream.Write(Buffer^, Size);
FreeMem(Buffer);
inc(cnt);
SetLength(PropSpec, cnt);
PropSpec[cnt - 1].ulKind := PRSPEC_PROPID;
PropSpec[cnt - 1].propid := PIDSI_THUMBNAIL;
SetLength(PropVariant, cnt);
propVariant[cnt - 1].vt := VT_CF;
new(PropVariant[cnt - 1].pclipdata);
PropVariant[cnt - 1].pclipdata.ulClipFmt := -1;
PropVariant[cnt - 1].pclipdata.pClipData := MemStream.Memory;
PropVariant[cnt - 1].pclipdata.cbSize := MemStream.Size + SizeOf(DefaultFormat);
end;
procedure SetPCharValue(ID : integer; AValue : String);
begin
inc(cnt);
SetLength(PropSpec, cnt);
PropSpec[cnt - 1].ulKind := PRSPEC_PROPID;
PropSpec[cnt - 1].propid := ID;
SetLength(PropVariant, cnt);
PropVariant[cnt-1].vt := VT_LPSTR;
PropVariant[cnt-1].pszVal := StrNew(PChar(AValue));
end;
procedure SetTextValue(ID : integer; AValue : String);
begin
inc(cnt);
SetLength(PropSpec, cnt);
PropSpec[cnt - 1].ulKind := PRSPEC_PROPID;
PropSpec[cnt - 1].propid := ID;
SetLength(PropVariant, cnt);
PropVariant[cnt-1].vt := VT_LPWSTR;
PropVariant[cnt-1].pwszVal := StringToPWideChar(AValue);
end;
procedure SetFileTimeValue(ID : integer; AValue : TFileTime);
begin
inc(cnt);
SetLength(PropSpec, cnt);
PropSpec[cnt - 1].ulKind := PRSPEC_PROPID;
PropSpec[cnt - 1].propid := ID;
SetLength(PropVariant, cnt);
PropVariant[cnt-1].vt := VT_FILETIME;
PropVariant[cnt-1].filetime := AValue;
end;
procedure SetCustomValue(ID : String; AValue : String);
begin
PropSpec[cnt - 1].ulKind := PRSPEC_LPWSTR;
PropSpec[cnt - 1].lpwstr := StringToPWideChar(ID);
PropVariant[cnt-1].vt := VT_LPWSTR;
PropVariant[cnt-1].pwszVal := StringToPWideChar(AValue);
end;
begin
if not Assigned(VStgOpenStorageEx) then
Exit;
hr := VStgOpenStorageEx(StringToPWideChar(FFileName), STGM_READ or STGM_SHARE_DENY_WRITE,
STGFMT_FILE, 0, nil, nil, @IID_IPropertySetStorage, stg);
if FAILED(hr) then
Exit;
stg.QueryInterface(IPropertySetStorage, PropSetStg);
if Assigned(PropSetStg) then
begin
PropSetStg.Create(FMTID_DocSummaryInformation , FMTID_DocSummaryInformation , PROPSETFLAG_DEFAULT,
STGM_CREATE or STGM_READWRITE or STGM_SHARE_EXCLUSIVE, PropStg);
try
SetLength(PropSpec,1);
PropSpec[0].ulKind := PRSPEC_PROPID;
PropSpec[0].propid := $C;
SetLength(Parts, 2);
Parts[0].vt := VT_LPWSTR;
Parts[0].pwszVal := 'Title';
Parts[1].vt := VT_I4;
Parts[1].lVal := 0;
SetLength(PropVariant,1);
PropVariant[0].vt := VT_VECTOR or VT_VARIANT;
Propvariant[0].capropvar.cElems := 2;
Propvariant[0].capropvar.pElems := @Parts[0];
cnt := 1;
if FByteCount > 0 then
SetIntValue(PIDDSI_BYTECOUNT, FByteCount);
if FLines > 0 then
SetIntValue(PIDDSI_LINECOUNT, FLines);
if FNotes > 0 then
SetIntValue(PIDDSI_NOTECOUNT, FNotes);
if FParagraphs > 0 then
SetIntValue(PIDDSI_PARCOUNT, FParagraphs);
if FCategory <> '' then
SetTextValue(PIDDSI_CATEGORY, FCategory);
if FCompany <> '' then
SetTextValue(PIDDSI_COMPANY, FCompany);
if FManager <> '' then
SetTextValue(PIDDSI_MANAGER, FManager);
PropStg.WriteMultiple(cnt, @PropSpec[0], @PropVariant[0], 2 );
PropStg.Commit(STGC_DEFAULT);
PropSetStg.Create(FMTID_UserDefinedProperties, FMTID_UserDefinedProperties, PROPSETFLAG_DEFAULT,
STGM_CREATE or STGM_READWRITE or STGM_SHARE_EXCLUSIVE, PropStg);
SetLength(PropSpec, FCustom.Count);
SetLength(PropVariant, FCustom.Count);
for cnt := 1 to FCustom.Count do
begin
CustomName := FCustom.Names[cnt-1];
CustomValue := FCustom.Values[CustomName];
SetCustomValue(CustomName, Customvalue);
end;
PropStg.WriteMultiple(cnt-1, @PropSpec[0], @PropVariant[0], 2 );
PropStg.Commit(STGC_DEFAULT);
PropSetStg.Create(FmtID_SummaryInformation, FmtID_SummaryInformation, PROPSETFLAG_DEFAULT,
STGM_CREATE or STGM_READWRITE or STGM_SHARE_EXCLUSIVE, PropStg);
cnt := 0;
SetTextValue(PIDSI_TITLE, FTitle);
SetTextValue(PIDSI_SUBJECT, FSubject);
SetTextValue(PIDSI_AUTHOR, FAuthor);
SetTextValue(PIDSI_KEYWORDS, FKeywords);
SetTextValue(PIDSI_COMMENTS, FComments);
SetTextValue(PIDSI_TEMPLATE, FTemplate);
SetTextValue(PIDSI_LASTAUTHOR, FLastSavedBy);
SetTextValue(PIDSI_REVNUMBER, FRevisionNumber);
SetFileTimeValue(PIDSI_EDITTIME, FTotalEditingTime);
SetFileTimeValue(PIDSI_LASTPRINTED, FLastPrinted);
SetFileTimeValue(PIDSI_CREATE_DTM, FCreateTimeDate);
SetFileTimeValue(PIDSI_LASTSAVE_DTM, FLastSaved);
SetIntValue(PIDSI_PAGECOUNT, FNumberOfPages);
SetIntValue(PIDSI_WORDCOUNT, FNumberOfWords);
SetIntValue(PIDSI_CHARCOUNT, FNumberOfCharacters);
SetIntValue(PIDSI_DOC_SECURITY, FSecurity);
SetTextValue(PIDSI_APPNAME, FAppName);
SavePreview;
PropStg.WriteMultiple(cnt, @PropSpec[0], @PropVariant[0], 2 );
PropStg.Commit(STGC_DEFAULT);
MemStream.Free;
except
PropStg.Revert;
end;
end;
end;
procedure TpsvFileProperties.SetCustom(AValue: TStringList);
begin
FCustom.Assign(AValue);
end;
procedure TpsvFileProperties.SetDefaultValues;
begin
FCompany := GetRegisteredCompany;
FCategory := 'Document';
FManager := GetLocalUserName;
FAppName := ExtractFileName(ParamStr(0));
FRevisionNumber := '1.0';
FSecurity := 0;
FAuthor := GetLocalUserName;
FLastSavedBy := FAuthor;
FLastSaved := DateTimeToFileTime(Now);
FByteCount := 0;
FLines := 0;
FParagraphs := 0;
FNotes := 0;
end;
procedure TpsvFileProperties.SetPreview(AValue: TMetafile);
begin
FPreview.Assign(AValue);
end;
end.
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.