+#include "tclStream.h"
+#include <comdef.h>
+
+class TclStream : public IStream
+{
+public:
+ // IUnknown
+ STDMETHOD(QueryInterface)(REFIID riid, void** ppv);
+ STDMETHOD_(ULONG, AddRef)();
+ STDMETHOD_(ULONG, Release)();
+
+ // ISequentialStream
+ STDMETHOD(Read)(void *pv, ULONG cb, ULONG *pcbRead);
+ STDMETHOD(Write)(void const *pv, ULONG cb, ULONG *pcbWritten);
+
+ // IStream
+ STDMETHOD(Seek)(LARGE_INTEGER dlibMove, DWORD dwOrigin, ULARGE_INTEGER *plibNewPosition);
+ STDMETHOD(SetSize)(ULARGE_INTEGER libNewSize);
+ STDMETHOD(CopyTo)(IStream *pstm, ULARGE_INTEGER cb, ULARGE_INTEGER *pcbRead, ULARGE_INTEGER *pcbWritten);
+ STDMETHOD(Commit)(DWORD grfCommitFlags);
+ STDMETHOD(Revert)();
+ STDMETHOD(LockRegion)(ULARGE_INTEGER libOffset, ULARGE_INTEGER cb, DWORD dwLockType);
+ STDMETHOD(UnlockRegion)(ULARGE_INTEGER libOffset, ULARGE_INTEGER cb, DWORD dwLockType);
+ STDMETHOD(Stat)(STATSTG *pstatstg, DWORD grfStatFlag);
+ STDMETHOD(Clone)(IStream **ppstm);
+
+public:
+ TclStream(Tcl_Channel channel, const char *name);
+ virtual ~TclStream();
+ HRESULT FinalConstruct();
+
+private:
+ long m_lRefCount;
+ Tcl_Channel m_channel;
+ char *m_name;
+ STATSTG m_statstg;
+};
+
+// -------------------------------------------------------------------------
+// IUnknown methods
+
+STDMETHODIMP TclStream::
+QueryInterface(REFIID riid, void** ppv)
+{
+ HRESULT hr = E_NOINTERFACE;
+ *ppv = 0;
+
+ if (riid == IID_IUnknown
+ || riid == IID_IStream
+ || riid == IID_ISequentialStream)
+ {
+ *ppv = static_cast<IStream *>(this);
+ static_cast<IUnknown*>(*ppv)->AddRef();
+ hr = S_OK;
+ }
+
+ return hr;
+}
+
+STDMETHODIMP_(ULONG) TclStream::
+AddRef()
+{
+ return InterlockedIncrement(&m_lRefCount);
+}
+
+STDMETHODIMP_(ULONG) TclStream::
+Release()
+{
+ if (InterlockedDecrement(&m_lRefCount) == 0)
+ {
+ delete this;
+ return 0;
+ }
+ return m_lRefCount;
+}
+
+// -------------------------------------------------------------------------
+// ISequentialStream methods
+
+STDMETHODIMP TclStream::
+Read(void *pv, ULONG cb, ULONG *pcbRead)
+{
+ ULONG cbRead = 0;
+ cbRead = Tcl_Read(m_channel, (char *)pv, cb);
+ if (pcbRead) *pcbRead = cbRead;
+ //if (cbRead == -1) Tcl_GetErrno();
+ return (cbRead == -1) ? E_FAIL : S_OK;
+}
+
+STDMETHODIMP TclStream::
+Write(void const *pv, ULONG cb, ULONG *pcbWritten)
+{
+ ULONG cbWrote = 0;
+ cbWrote = Tcl_Write(m_channel, (const char *)pv, cb);
+ if (pcbWritten) *pcbWritten = cbWrote;
+ return (cbWrote == -1) ? E_FAIL : S_OK;
+}
+
+// -------------------------------------------------------------------------
+// IStream methods
+//
+
+STDMETHODIMP TclStream::
+Seek(LARGE_INTEGER dlibMove, DWORD dwOrigin, ULARGE_INTEGER *plibNewPosition)
+{
+ int mode = SEEK_SET;
+ switch (dwOrigin) {
+ case STREAM_SEEK_SET: mode = SEEK_SET; break;
+ case STREAM_SEEK_CUR: mode = SEEK_CUR; break;
+ case STREAM_SEEK_END: mode = SEEK_END; break;
+ default:
+ return STG_E_INVALIDFUNCTION;
+ }
+
+ Tcl_WideInt pos = Tcl_Seek(m_channel, dlibMove.QuadPart, mode);
+ if (plibNewPosition)
+ plibNewPosition->QuadPart = pos;
+ return (pos == -1) ? E_FAIL : S_OK;
+}
+
+STDMETHODIMP TclStream::
+SetSize(ULARGE_INTEGER libNewSize)
+{
+ return STG_E_INVALIDFUNCTION;
+}
+
+STDMETHODIMP TclStream::
+CopyTo(IStream *pstm, ULARGE_INTEGER cb, ULARGE_INTEGER *pcbRead, ULARGE_INTEGER *pcbWritten)
+{
+ return E_NOTIMPL;
+}
+
+STDMETHODIMP TclStream::
+Commit(DWORD grfCommitFlags)
+{
+ return S_OK;
+}
+
+STDMETHODIMP TclStream::
+Revert()
+{
+ return S_OK;
+}
+
+STDMETHODIMP TclStream::
+LockRegion(ULARGE_INTEGER libOffset, ULARGE_INTEGER cb, DWORD dwLockType)
+{
+ return STG_E_INVALIDFUNCTION;
+}
+
+STDMETHODIMP TclStream::
+UnlockRegion(ULARGE_INTEGER libOffset, ULARGE_INTEGER cb, DWORD dwLockType)
+{
+ return STG_E_INVALIDFUNCTION;
+}
+
+STDMETHODIMP TclStream::
+Stat(STATSTG *pstatstg, DWORD grfStatFlag)
+{
+ HRESULT hr = STG_E_INVALIDPOINTER;
+ if (pstatstg)
+ {
+ CopyMemory(pstatstg, &m_statstg, sizeof(STATSTG));
+ hr = S_OK;
+
+ if (!(grfStatFlag & STATFLAG_NONAME))
+ {
+ int nChars = MultiByteToWideChar(CP_ACP, 0, m_name, -1, NULL, 0);
+ pstatstg->pwcsName = (LPWSTR)CoTaskMemAlloc((nChars+1)*sizeof(WCHAR));
+ nChars = MultiByteToWideChar(CP_ACP, 0, m_name, nChars,
+ pstatstg->pwcsName, nChars+1);
+ }
+ }
+ return hr;
+}
+
+STDMETHODIMP TclStream::
+Clone(IStream **ppstm)
+{
+ return E_NOTIMPL;
+}
+
+// -------------------------------------------------------------------------
+
+TclStream::TclStream(Tcl_Channel channel, const char *name)
+{
+ m_channel = channel;
+ m_name = strdup(name);
+}
+
+TclStream::~TclStream()
+{
+ free(m_name);
+}
+
+HRESULT TclStream::
+FinalConstruct()
+{
+ ZeroMemory(&m_statstg, sizeof(STATSTG));
+ m_statstg.type = STGTY_STREAM;
+ //m_statstg.cbSize.QuadPart = size;
+ //TimetToFileTime(date, &m_statstg.mtime);
+ //m_statstg.ctime = m_statstg.mtime;
+ //m_statstg.atime = m_statstg.mtime;
+ //m_statstg.grfMode = m_grfFlags;
+ m_statstg.grfLocksSupported = (DWORD)0;
+ return S_OK;
+}
+
+// -------------------------------------------------------------------------
+
+HRESULT
+GetStreamFromObj(Tcl_Interp *interp, Tcl_Obj *chanObj, IStream **ppStream)
+{
+ int mode = 0;
+ const char *name = Tcl_GetString(chanObj);
+ Tcl_Channel channel = Tcl_GetChannel(interp, name, &mode);
+ if (channel == NULL)
+ return E_INVALIDARG;
+ TclStream *pTclStream = new TclStream(channel, name);
+ HRESULT hr = pTclStream->FinalConstruct();
+ if (SUCCEEDED(hr))
+ hr = pTclStream->QueryInterface(IID_IStream, (void **)ppStream);
+ return hr;
+}