:: IStream-unlock-region ( stream offset cb lock-type -- hresult )\r
STG_E_INVALIDFUNCTION ;\r
\r
+:: stream-size ( stream -- size )\r
+ stream stream-tell :> old-pos\r
+ 0 seek-end stream stream-seek\r
+ stream stream-tell :> size\r
+ old-pos seek-absolute stream stream-seek\r
+ size ;\r
+\r
:: IStream-stat ( stream out-stat stat-flag -- hresult )\r
[\r
out-stat\r
f >>pwcsName\r
STGTY_STREAM >>type\r
- 0 >>cbSize\r
+ stream stream-size >>cbSize\r
FILETIME <struct> >>mtime\r
FILETIME <struct> >>ctime\r
FILETIME <struct> >>atime\r
GUID_NULL >>clsid\r
0 >>grfStateBits\r
0 >>reserved\r
+ drop\r
+ S_OK\r
] with-hresult ;\r
\r
:: IStream-clone ( out-clone-stream -- hresult )\r
f out-clone-stream 0 void* set-alien-value\r
STG_E_INVALIDFUNCTION ;\r
\r
-MEMO: stream-wrapper ( -- wrapper )\r
- {\r
- { IStream {\r
- [ IStream-read ]\r
- [ IStream-write ]\r
- [ IStream-seek ]\r
- [ IStream-set-size ]\r
- [ IStream-copy-to ]\r
- [ IStream-commit ]\r
- [ IStream-revert ]\r
- [ IStream-lock-region ]\r
- [ IStream-unlock-region ]\r
- [ IStream-stat ]\r
- [ IStream-clone ]\r
- } }\r
- } <com-wrapper> ;\r
+CONSTANT: stream-wrapper\r
+ $[\r
+ {\r
+ { IStream {\r
+ [ IStream-read ]\r
+ [ IStream-write ]\r
+ [ IStream-seek ]\r
+ [ IStream-set-size ]\r
+ [ IStream-copy-to ]\r
+ [ IStream-commit ]\r
+ [ IStream-revert ]\r
+ [ IStream-lock-region ]\r
+ [ IStream-unlock-region ]\r
+ [ IStream-stat ]\r
+ [ IStream-clone ]\r
+ } }\r
+ } <com-wrapper>\r
+ ]\r
\r
PRIVATE>\r
\r