Support object initialization from a Tcl channel. master
authorPat Thoyts <patthoyts@users.sourceforge.net>
Thu, 18 Jun 2009 01:57:39 +0000 (02:57 +0100)
committerPat Thoyts <patthoyts@users.sourceforge.net>
Thu, 18 Jun 2009 01:57:39 +0000 (02:57 +0100)
This commit allows a Tcl channel to be presented to an object upon creation
as an IStream. The object can then use its IPersistStream interface to
initialize itself via tcom::ref createobject -init $chan $progid

Signed-off-by: Pat Thoyts <patthoyts@users.sourceforge.net>
src/refCmd.cpp
src/tclStream.cpp [new file with mode: 0644]
src/tclStream.h [new file with mode: 0644]
src/tcom.dsp

index 9a964571ea29aaea7b408d4037dbb68dc87d3bb5..b4772913fd8eb17ad21b410c51241fd866bdcb82 100644 (file)
@@ -6,6 +6,7 @@
 #include "TypeInfo.h"
 #include "TclObject.h"
 #include "Arguments.h"
 #include "TypeInfo.h"
 #include "TclObject.h"
 #include "Arguments.h"
+#include "tclStream.h"
 
 static int referenceObjCmd(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []);
 HandleSupport<Reference> Extension::referenceHandles(referenceObjCmd);
 
 static int referenceObjCmd(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []);
 HandleSupport<Reference> Extension::referenceHandles(referenceObjCmd);
@@ -737,14 +738,15 @@ Extension::refCmd (
 
     bool clsIdOpt = false;
     DWORD clsCtx = CLSCTX_SERVER;
 
     bool clsIdOpt = false;
     DWORD clsCtx = CLSCTX_SERVER;
+    IStreamPtr pStream;
 
     int i = 2;
     for (; i < objc; ++i) {
         static char *options[] = {
 
     int i = 2;
     for (; i < objc; ++i) {
         static char *options[] = {
-           "-clsid", "-inproc", "-local", "-remote", NULL
+           "-clsid", "-inproc", "-local", "-remote", "-init", NULL
         };
         enum OptionEnum {
         };
         enum OptionEnum {
-            OPTION_CLSID, OPTION_INPROC, OPTION_LOCAL, OPTION_REMOTE
+            OPTION_CLSID, OPTION_INPROC, OPTION_LOCAL, OPTION_REMOTE, OPTION_INIT
         };
 
         int index;
         };
 
         int index;
@@ -766,6 +768,13 @@ Extension::refCmd (
         case OPTION_REMOTE:
             clsCtx = CLSCTX_REMOTE_SERVER;
             break;
         case OPTION_REMOTE:
             clsCtx = CLSCTX_REMOTE_SERVER;
             break;
+        case OPTION_INIT:
+            if (objc < i+1) {
+                Tcl_WrongNumArgs(interp, i-1, objv, "-init channel");
+                return TCL_ERROR;
+            }
+            GetStreamFromObj(interp, objv[++i], &pStream);
+            break;
         }
     }
 
         }
     }
 
@@ -774,7 +783,7 @@ Extension::refCmd (
             interp,
             2,
             objv,
             interp,
             2,
             objv,
-            "?-clsid? ?-inproc? ?-local? ?-remote? progID ?hostName?");
+            "?-clsid? ?-inproc? ?-local? ?-remote? ?-init channel? progID ?hostName?");
        return TCL_ERROR;
     }
 
        return TCL_ERROR;
     }
 
@@ -811,6 +820,19 @@ Extension::refCmd (
                 : Reference::createInstance(progId, clsCtx, hostName);
         }
 
                 : Reference::createInstance(progId, clsCtx, hostName);
         }
 
+        IPersistStreamInitPtr pPersistStreamInit;
+        if (SUCCEEDED(pReference->unknown()->QueryInterface(&pPersistStreamInit))) {
+            if (pStream) {
+                pPersistStreamInit->Load(pStream);
+            } else {
+                pPersistStreamInit->InitNew();
+            }
+        } else if (pStream) {
+            IPersistStreamPtr pPersistStream;
+            if (SUCCEEDED(pReference->unknown()->QueryInterface(&pPersistStream)))
+                pPersistStream->Load(pStream);
+        }
+
         Tcl_SetObjResult(
             interp,
             referenceHandles.newObj(interp, pReference));
         Tcl_SetObjResult(
             interp,
             referenceHandles.newObj(interp, pReference));
diff --git a/src/tclStream.cpp b/src/tclStream.cpp
new file mode 100644 (file)
index 0000000..d9aa254
--- /dev/null
@@ -0,0 +1,225 @@
+#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;
+}
diff --git a/src/tclStream.h b/src/tclStream.h
new file mode 100644 (file)
index 0000000..2d6a7ac
--- /dev/null
@@ -0,0 +1,9 @@
+#ifndef tclStream_h_INCLUDE
+#define tclStream_h_INCLUDE
+
+#include <ole2.h>
+#include "tclRunTime.h" //<tcl.h>
+
+HRESULT GetStreamFromObj(Tcl_Interp *interp, Tcl_Obj *chanObj, IStream **ppStream);
+
+#endif // tclStream_h_INCLUDE
index e7cc1eee4d2b6b430444474c1819d3fc4b935b33..b37060098af91b13b20cf04294aaaf9fd8e5aa7b 100644 (file)
@@ -41,11 +41,11 @@ RSC=rc.exe
 # PROP Use_MFC 0
 # PROP Use_Debug_Libraries 0
 # PROP Output_Dir "Release"
 # PROP Use_MFC 0
 # PROP Use_Debug_Libraries 0
 # PROP Output_Dir "Release"
-# PROP Intermediate_Dir "Release"
+# PROP Intermediate_Dir "Release\Objects"
 # PROP Ignore_Export_Lib 0
 # PROP Target_Dir ""
 # ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "TCOM_EXPORTS" /YX /FD /c
 # PROP Ignore_Export_Lib 0
 # PROP Target_Dir ""
 # ADD BASE CPP /nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "TCOM_EXPORTS" /YX /FD /c
-# ADD CPP /nologo /MD /W3 /GX /Zi /Od /I "\tcl\include" /D "NDEBUG" /D "_WIN32_DCOM" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "TCOM_EXPORTS" /D "TCOM_VTBL_SERVER" /D "TCL_THREADS" /D "USE_TCL_STUBS" /D "USE_NON_CONST" /YX /FD /c
+# ADD CPP /nologo /MD /W3 /GX /Zi /O2 /I "c:\opt\tcl8.4\include" /D "NDEBUG" /D "_WIN32_DCOM" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "TCOM_EXPORTS" /D "TCOM_VTBL_SERVER" /D "TCL_THREADS" /D "USE_TCL_STUBS" /D "USE_NON_CONST" /YX /FD /c
 # ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
 # ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
 # ADD BASE RSC /l 0x409 /d "NDEBUG"
 # ADD BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
 # ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
 # ADD BASE RSC /l 0x409 /d "NDEBUG"
@@ -55,7 +55,7 @@ BSC32=bscmake.exe
 # ADD BSC32 /nologo
 LINK32=link.exe
 # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
 # ADD BSC32 /nologo
 LINK32=link.exe
 # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /machine:I386
-# ADD LINK32 rpcrt4.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /libpath:"\tcl\lib"
+# ADD LINK32 rpcrt4.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib /nologo /dll /debug /machine:I386 /libpath:"c:\opt\tcl8.4\lib"
 
 !ELSEIF  "$(CFG)" == "tcom - Win32 Debug"
 
 
 !ELSEIF  "$(CFG)" == "tcom - Win32 Debug"
 
@@ -254,6 +254,10 @@ SOURCE=.\TclObject.cpp
 # End Source File
 # Begin Source File
 
 # End Source File
 # Begin Source File
 
+SOURCE=.\tclStream.cpp
+# End Source File
+# Begin Source File
+
 SOURCE=.\tcomVersion.rc
 # End Source File
 # Begin Source File
 SOURCE=.\tcomVersion.rc
 # End Source File
 # Begin Source File
@@ -354,6 +358,10 @@ SOURCE=.\tclRunTime.h
 # End Source File
 # Begin Source File
 
 # End Source File
 # Begin Source File
 
+SOURCE=.\tclStream.h
+# End Source File
+# Begin Source File
+
 SOURCE=.\tcomApi.h
 # End Source File
 # Begin Source File
 SOURCE=.\tcomApi.h
 # End Source File
 # Begin Source File