1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
| unit storage;
interface
uses
Windows, ComObj, ActiveX;
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}';
FMTID_AudioSummaryInformation : TGuid =
'{64440490-4C8B-11D1-8B70-080036B11A03}';
FMTID_VideoSummaryInformation : TGUID =
'{64440491-4C8B-11D1-8B70-080036B11A03}';
FMTID_ImageSummaryInformation : TGUID =
'{6444048f-4c8b-11d1-8b70-080036b11a03}';
FMTID_MediaFileSummaryInformation : TGUID =
'{64440492-4c8b-11d1-8b70-080036b11a03}';
STGFMT_STORAGE = 0;
STGFMT_FILE = 3;
STGFMT_ANY = 4;
STGFMT_DOCFILE = 5;
PIDSI_TITLE = $00000002; PIDSI_SUBJECT = $00000003;
PIDSI_AUTHOR = $00000004;
PIDSI_KEYWORDS = $00000005;
PIDSI_COMMENTS = $00000006;
PIDSI_TEMPLATE = $00000007;
PIDSI_LASTAUTHOR = $00000008;
PIDSI_REVNUMBER = $00000009;
PIDSI_EDITTIME = $0000000A; PIDSI_LASTPRINTED = $0000000B;
PIDSI_CREATE_DTM = $0000000C;
PIDSI_LASTSAVE_DTM = $0000000D;
PIDSI_PAGECOUNT = $0000000E; PIDSI_WORDCOUNT = $0000000F;
PIDSI_CHARCOUNT = $00000010;
PIDSI_THUMBNAIL = $00000011; PIDSI_APPNAME = $00000012; PIDSI_DOC_SECURITY = $00000013;
PIDDSI_CATEGORY = $00000002; PIDDSI_PRESFORMAT = $00000003;
PIDDSI_BYTECOUNT = $00000004; PIDDSI_LINECOUNT = $00000005;
PIDDSI_PARCOUNT = $00000006;
PIDDSI_SLIDECOUNT = $00000007;
PIDDSI_NOTECOUNT = $00000008;
PIDDSI_HIDDENCOUNT = $00000009;
PIDDSI_MMCLIPCOUNT = $0000000A;
PIDDSI_SCALE = $0000000B; PIDDSI_HEADINGPAIR = $0000000C; PIDDSI_DOCPARTS = $0000000D; PIDDSI_MANAGER = $0000000E; PIDDSI_COMPANY = $0000000F;
PIDDSI_LINKSDIRTY = $00000010;
PIDMSI_EDITOR = $00000002; PIDMSI_SUPPLIER = $00000003;
PIDMSI_SOURCE = $00000004;
PIDMSI_SEQUENCE_NO = $00000005;
PIDMSI_PROJECT = $00000006;
PIDMSI_STATUS = $00000007; PIDMSI_OWNER = $00000008; PIDMSI_RATING = $00000009;
PIDMSI_PRODUCTION = $0000000A; PIDMSI_COPYRIGHT = $0000000B;
PIDASI_FORMAT = $00000002; PIDASI_TIMELENGTH = $00000003; PIDASI_AVG_DATA_RATE = $00000004; PIDASI_SAMPLE_RATE = $00000005; PIDASI_SAMPLE_SIZE = $00000006; PIDASI_CHANNEL_COUNT = $00000007; PIDASI_STREAM_NUMBER = $00000008; PIDASI_STREAM_NAME = $00000009; PIDASI_COMPRESSION = $0000000A;
PIDVSI_STREAM_NAME = $00000002; PIDVSI_FRAME_WIDTH = $00000003; PIDVSI_FRAME_HEIGHT = $00000004; PIDVSI_TIMELENGTH = $00000007; PIDVSI_FRAME_COUNT = $00000005; PIDVSI_FRAME_RATE = $00000006; PIDVSI_DATA_RATE = $00000008; PIDVSI_SAMPLE_SIZE = $00000009; PIDVSI_COMPRESSION = $0000000A; PIDVSI_STREAM_NUMBER = $0000000B;
type
TMultipleArray = record
pidInfoType : cardinal;
pidInfoStr : pchar;
end;
TMultipleArrayList = array of TMultipleArray;
function GetFileSummaryInfo(const FileName: WideString;
GUID_SummaryType: TGUID; PID_InfoType: cardinal): string;
function SetFileSummaryInfo(const FileName: WideString; GUID_InfoType: TGUID;
PID_InfoType: cardinal; InfoStr: string): boolean;
function SetMultipleFileSummaryInfo(const FileName: WideString;
GUID_InfoType: TGUID; MultipleArrayList: TMultipleArrayList): boolean;
implementation
const
szOleDll = 'ole32.dll';
IID_IPropertySetStorage : TGUID = '{0000013A-0000-0000-C000-000000000046}';
type
TStgOpenStorageEx = function(const pwcsName: PWideChar;
grfMode: DWORD; stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: pointer;
reserved2: pointer; riid: PGUID; out ppObjectOpen: IStorage): HRESULT;
stdcall;
var
StgOpenStorageEx : TStgOpenStorageEx = nil;
dll : dword = 0;
Win2k : boolean = false;
function GetFileSummaryInfo(const FileName: WideString;
GUID_SummaryType: TGUID; PID_InfoType: cardinal): string;
var
hr : HRESULT;
Stg : IStorage;
PropSetStg : IPropertySetStorage;
PropStg : IPropertyStorage;
PropSpec : TPropSpec;
PropVariant : TPropVariant;
begin
Result := '';
hr := S_FALSE;
if(not Win2k) or (@StgOpenStorageEx = nil) then
hr := StgOpenStorage(pwidechar(FileName),nil,STGM_READ or
STGM_SHARE_DENY_WRITE,nil,0,Stg)
else if(@StgOpenStorageEx <> nil) then
hr := StgOpenStorageEx(pwidechar(FileName),STGM_READ or
STGM_SHARE_DENY_WRITE,STGFMT_ANY,0,nil,nil,
@IID_IPropertySetStorage,Stg);
if(hr = S_OK) then
begin
PropSetStg := Stg as IPropertySetStorage;
if(PropSetStg.Open(GUID_SummaryType,STGM_READ or
STGM_SHARE_EXCLUSIVE,PropStg) = S_OK) then
begin
PropSpec.ulKind := PRSPEC_PROPID;
PropSpec.propid := PID_InfoType;
if(PropStg.ReadMultiple(1,@PropSpec,@PropVariant) = S_OK) and
(PropVariant.vt = VT_LPSTR) and
(PropVariant.pszVal <> nil) then
Result := PropVariant.pszVal;
end;
end;
end;
function SetFileSummaryInfo(const FileName: WideString; GUID_InfoType: TGUID;
PID_InfoType: cardinal; InfoStr: string): boolean;
var
hr : HRESULT;
Stg : IStorage;
PropSetStg : IPropertySetStorage;
PropStg : IPropertyStorage;
PropSpec : TPropSpec;
PropVariant : TPropVariant;
begin
Result := false;
hr := S_FALSE;
if(not Win2k) or (@StgOpenStorageEx = nil) then
hr := StgOpenStorage(pwidechar(FileName),nil,STGM_SHARE_EXCLUSIVE or
STGM_READWRITE,nil,0,Stg)
else if(@StgOpenStorageEx <> nil) then
hr := StgOpenStorageEx(pwidechar(FileName),STGM_SHARE_EXCLUSIVE or
STGM_READWRITE,STGFMT_ANY,0,nil,nil,@IID_IPropertySetStorage,Stg);
if(hr = S_OK) then
begin
PropSetStg := Stg as IPropertySetStorage;
hr := PropSetStg.Open(GUID_InfoType,STGM_READWRITE or
STGM_SHARE_EXCLUSIVE,PropStg);
if(hr <> S_OK) then
hr := PropSetStg.Create(GUID_InfoType,GUID_InfoType,
PROPSETFLAG_DEFAULT,STGM_CREATE or STGM_READWRITE or
STGM_SHARE_EXCLUSIVE,PropStg);
if(hr = S_OK) then
begin
PropSpec.ulKind := PRSPEC_PROPID;
PropSpec.propid := PID_InfoType;
PropVariant.vt := VT_LPSTR;
PropVariant.pszVal := pchar(InfoStr);
if(PropStg.WriteMultiple(1,@PropSpec,@PropVariant,2) = S_OK) then
begin
Result := (PropStg.Commit(STGC_DEFAULT) = S_OK);
end;
end;
end;
end;
function SetMultipleFileSummaryInfo(const FileName: WideString;
GUID_InfoType: TGUID; MultipleArrayList: TMultipleArrayList): boolean;
var
Stg : IStorage;
PropSetStg : IPropertySetStorage;
hr : HRESULT;
PropStg : IPropertyStorage;
PropSpec : array of TPropSpec;
PropVariant : array of TPropVariant;
i : integer;
begin
Result := false;
hr := S_FALSE;
if(length(MultipleArrayList) = 0) then exit;
if(not Win2k) or (@StgOpenStorageEx = nil) then
hr := StgOpenStorage(pwidechar(FileName),nil,STGM_SHARE_EXCLUSIVE or
STGM_READWRITE,nil,0,Stg)
else if(@StgOpenStorageEx <> nil) then
hr := StgOpenStorageEx(pwidechar(FileName),STGM_SHARE_EXCLUSIVE or
STGM_READWRITE,STGFMT_ANY,0,nil,nil,@IID_IPropertySetStorage,Stg);
if(hr = S_OK) then
begin
PropSetStg := Stg as IPropertySetStorage;
hr := PropSetStg.Open(GUID_InfoType,STGM_READWRITE or
STGM_SHARE_EXCLUSIVE,PropStg);
if(hr <> S_OK) then
hr := PropSetStg.Create(GUID_InfoType,GUID_InfoType,
PROPSETFLAG_DEFAULT,STGM_CREATE or STGM_READWRITE or
STGM_SHARE_EXCLUSIVE,PropStg);
if(hr = S_OK) then
begin
SetLength(PropSpec,0);
SetLength(PropVariant,0);
for i := 0 to length(MultipleArrayList) - 1 do
if(MultipleArrayList[i].pidInfoType <> 0) and
(MultipleArrayList[i].pidInfoStr <> nil) then
begin
SetLength(PropSpec,length(PropSpec) + 1);
PropSpec[length(PropSpec)-1].ulKind := PRSPEC_PROPID;
PropSpec[length(PropSpec)-1].propid :=
MultipleArrayList[i].pidInfoType;
SetLength(PropVariant,length(PropVariant) + 1);
PropVariant[length(PropVariant)-1].vt := VT_LPSTR;
PropVariant[length(PropVariant)-1].pszVal :=
MultipleArrayList[i].pidInfoStr;
end;
if(length(PropSpec) > 0) and
(length(PropVariant) > 0) and
(length(PropSpec) = length(PropVariant)) then
begin
if(PropStg.WriteMultiple(length(PropSpec),@PropSpec[0],
@PropVariant[0],2) = S_OK) then
begin
Result := (PropStg.Commit(STGC_DEFAULT) = S_OK);
end;
SetLength(PropSpec,0);
SetLength(PropVariant,0);
end;
end;
end;
end;
var
os : TOSVersionInfo;
initialization
ZeroMemory(@os,sizeof(os));
os.dwOSVersionInfoSize := sizeof(os);
Win2k := (GetVersionEx(os)) and
(os.dwMajorVersion >= 5) and
(os.dwPlatformId = VER_PLATFORM_WIN32_NT);
CoInitialize(nil);
dll := LoadLibrary(szOleDll);
if(dll <> 0) then
begin
StgOpenStorageEx := GetProcAddress(dll,'StgOpenStorageEx');
if(@StgOpenStorageEx = nil) then
begin
FreeLibrary(dll);
dll := 0;
end;
end;
finalization
if(dll <> 0) then FreeLibrary(dll);
CoUninitialize;
end. |
Christian S.
.