summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
Diffstat (limited to 'win')
-rw-r--r--win/makefile.vc5
-rw-r--r--win/tkWinSend.c874
-rw-r--r--win/tkWinSendCom.c431
-rw-r--r--win/tkWinSendCom.h58
4 files changed, 1363 insertions, 5 deletions
diff --git a/win/makefile.vc b/win/makefile.vc
index c8927e8..73e52fa 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -12,7 +12,7 @@
# Copyright (c) 2001-2002 David Gravereaux.
#
#------------------------------------------------------------------------------
-# RCS: @(#) $Id: makefile.vc,v 1.72 2003/08/25 20:35:59 davygrvy Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.73 2003/09/26 23:59:26 patthoyts Exp $
#------------------------------------------------------------------------------
!if "$(MSVCDIR)" == ""
@@ -241,6 +241,7 @@ TKOBJS = \
$(TMP_DIR)\tkWinRegion.obj \
$(TMP_DIR)\tkWinScrlbr.obj \
$(TMP_DIR)\tkWinSend.obj \
+ $(TMP_DIR)\tkWinSendCom.obj \
$(TMP_DIR)\tkWinWindow.obj \
$(TMP_DIR)\tkWinWm.obj \
$(TMP_DIR)\tkWinX.obj \
@@ -425,7 +426,7 @@ dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
-baselibs = kernel32.lib advapi32.lib user32.lib
+baselibs = kernel32.lib advapi32.lib user32.lib ole32.lib oleaut32.lib uuid.lib
guilibs = $(baselibs) shell32.lib gdi32.lib comdlg32.lib winspool.lib imm32.lib comctl32.lib
diff --git a/win/tkWinSend.c b/win/tkWinSend.c
index d2fe2f2..856e8f6 100644
--- a/win/tkWinSend.c
+++ b/win/tkWinSend.c
@@ -6,15 +6,74 @@
* to interpreter.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
+ * Copyright (c) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkWinSend.c,v 1.3 2002/08/05 04:30:41 dgp Exp $
+ * RCS: @(#) $Id: tkWinSend.c,v 1.4 2003/09/26 23:59:26 patthoyts Exp $
*/
#include "tkPort.h"
#include "tkInt.h"
+#include "tkWinSendCom.h"
+
+/* Should be defined in WTypes.h but mingw 1.0 is missing them */
+#ifndef _ROTFLAGS_DEFINED
+#define _ROTFLAGS_DEFINED
+#define ROTFLAGS_REGISTRATIONKEEPSALIVE 0x01
+#define ROTFLAGS_ALLOWANYCLIENT 0x02
+#endif /* ! _ROTFLAGS_DEFINED */
+
+#define TKWINSEND_CLASS_NAME "TclEval"
+#define TKWINSEND_REGISTRATION_BASE L"TclEval"
+
+#define MK_E_MONIKERALREADYREGISTERED \
+ MAKE_HRESULT(SEVERITY_ERROR, FACILITY_ITF, 0x02A1)
+
+/* Package information structure.
+ * This is used to keep interpreter specific details for use when releasing
+ * the package resources upon interpreter deletion or package removal.
+ */
+typedef struct {
+ char *name; /* the registered application name */
+ DWORD cookie; /* ROT cookie returned on registration */
+ LPUNKNOWN obj; /* Interface for the registration object */
+ Tcl_Interp *interp;
+ Tcl_Command token; /* Winsend command token */
+} RegisteredInterp;
+
+typedef struct SendEvent {
+ Tcl_Event header;
+ Tcl_Interp *interp;
+ Tcl_Obj *cmdPtr;
+} SendEvent;
+
+typedef struct {
+ int initialized;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+static void CmdDeleteProc(ClientData clientData);
+static void InterpDeleteProc(ClientData clientData, Tcl_Interp *interp);
+static void RevokeObjectRegistration(RegisteredInterp *riPtr);
+static HRESULT BuildMoniker(CONST char *name, LPMONIKER *pmk);
+static HRESULT RegisterInterp(CONST char *name, RegisteredInterp *riPtr);
+static int FindInterpreterObject(Tcl_Interp *interp, CONST char *name,
+ LPDISPATCH *ppdisp);
+static int Send(LPDISPATCH pdispInterp, Tcl_Interp *interp, int async,
+ ClientData clientData, int objc, Tcl_Obj *CONST objv[]);
+static Tcl_Obj* Win32ErrorObj(HRESULT hrError);
+static void SendTrace(const char *format, ...);
+
+static Tcl_EventProc SendEventProc;
+
+
+#if defined(DEBUG) || defined(_DEBUG)
+#define TRACE SendTrace
+#else
+#define TRACE 1 ? ((void)0) : SendTrace
+#endif
/*
@@ -52,7 +111,60 @@ Tk_SetAppName(tkwin, name)
* "send" commands. Must be globally
* unique. */
{
- return name;
+ ThreadSpecificData *tsdPtr;
+ TkWindow *winPtr = (TkWindow *)tkwin;
+ RegisteredInterp *riPtr = NULL;
+ Tcl_Interp *interp;
+ HRESULT hr = S_OK;
+
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ interp = winPtr->mainPtr->interp;
+
+ /*
+ * Initialise the COM library for this interpreter just once.
+ */
+ if (tsdPtr->initialized == 0) {
+ hr = CoInitialize(0);
+ if (FAILED(hr)) {
+ Tcl_SetResult(interp,
+ "failed to initialize the COM library", TCL_STATIC);
+ return "";
+ }
+ tsdPtr->initialized = 1;
+ TRACE("Initialized COM library for interp 0x%08X\n", (long)interp);
+ }
+
+ /*
+ * If the interp hasn't been registered before then we need to create
+ * the registration structure and the COM object. If it has been
+ * registered already then we can reuse all and just register the new
+ * name.
+ */
+
+ riPtr = Tcl_GetAssocData(interp, "tkWinSend::ri", NULL);
+ if (riPtr == NULL) {
+
+ riPtr = (RegisteredInterp *)ckalloc(sizeof(RegisteredInterp));
+ memset(riPtr, 0, sizeof(RegisteredInterp));
+ riPtr->interp = interp;
+
+ hr = TkWinSendCom_CreateInstance(interp, &IID_IUnknown,
+ (void **)&riPtr->obj);
+
+ Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd,
+ (ClientData)riPtr, CmdDeleteProc);
+ if (Tcl_IsSafe(interp)) {
+ Tcl_HideCommand(interp, "send", "send");
+ }
+ Tcl_SetAssocData(interp, "tkWinSend::ri", NULL, (ClientData)riPtr);
+
+ } else {
+
+ RevokeObjectRegistration(riPtr);
+ }
+
+ RegisterInterp(name, riPtr);
+ return (CONST char *)riPtr->name;
}
/*
@@ -82,5 +194,761 @@ TkGetInterpNames(interp, tkwin)
Tk_Window tkwin; /* Window whose display is to be used
* for the lookup. */
{
- return TCL_OK;
+ LPRUNNINGOBJECTTABLE pROT = NULL;
+ LPCOLESTR oleszStub = TKWINSEND_REGISTRATION_BASE;
+ HRESULT hr = S_OK;
+ Tcl_Obj *objList;
+ int r = TCL_OK;
+
+ hr = GetRunningObjectTable(0, &pROT);
+ if(SUCCEEDED(hr))
+ {
+ IBindCtx* pBindCtx = NULL;
+ objList = Tcl_NewListObj(0, NULL);
+ hr = CreateBindCtx(0, &pBindCtx);
+ if (SUCCEEDED(hr))
+ {
+
+ IEnumMoniker* pEnum;
+ hr = pROT->lpVtbl->EnumRunning(pROT, &pEnum);
+ if(SUCCEEDED(hr))
+ {
+ IMoniker* pmk = NULL;
+ while (pEnum->lpVtbl->Next(pEnum, 1, &pmk, (ULONG*)NULL) == S_OK)
+ {
+ LPOLESTR olestr;
+ hr = pmk->lpVtbl->GetDisplayName(pmk, pBindCtx, NULL, &olestr);
+ if (SUCCEEDED(hr))
+ {
+ IMalloc *pMalloc = NULL;
+
+ if (wcsncmp(olestr, oleszStub, wcslen(oleszStub)) == 0)
+ {
+ LPOLESTR p = olestr + wcslen(oleszStub);
+ if (*p)
+ r = Tcl_ListObjAppendElement(interp, objList, Tcl_NewUnicodeObj(p + 1, -1));
+ }
+
+ hr = CoGetMalloc(1, &pMalloc);
+ if (SUCCEEDED(hr))
+ {
+ pMalloc->lpVtbl->Free(pMalloc, (void*)olestr);
+ pMalloc->lpVtbl->Release(pMalloc);
+ }
+ }
+ pmk->lpVtbl->Release(pmk);
+ }
+ pEnum->lpVtbl->Release(pEnum);
+ }
+ pBindCtx->lpVtbl->Release(pBindCtx);
+ }
+ pROT->lpVtbl->Release(pROT);
+ }
+
+ if (FAILED(hr)) {
+ /* expire the list if set */
+ if (objList != NULL) {
+ Tcl_DecrRefCount(objList);
+ }
+ Tcl_SetObjResult(interp, Win32ErrorObj(hr));
+ r = TCL_ERROR;
+ }
+
+ if (r == TCL_OK)
+ Tcl_SetObjResult(interp, objList);
+
+ return r;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SendCmd --
+ *
+ * This procedure is invoked to process the "send" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SendObjCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* Information about sender (only
+ * dispPtr field is used). */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ enum {
+ SEND_ASYNC, SEND_DISPLAYOF, SEND_LAST
+ };
+ static CONST char *sendOptions[] = {
+ "-async", "-displayof", "--", (CONST char *)NULL
+ };
+ int r = TCL_OK;
+ int i, optind, async = 0;
+ HRESULT hr = S_OK;
+ Tcl_Obj *displayPtr = NULL;
+
+ /* process the command options */
+ for (i = 1; i < objc; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], sendOptions,
+ "option", 0, &optind) != TCL_OK) {
+ break;
+ }
+ if (optind == SEND_ASYNC) {
+ ++async;
+ } else if (optind == SEND_DISPLAYOF) {
+ displayPtr = objv[++i];
+ } else if (optind == SEND_LAST) {
+ i++;
+ break;
+ }
+ }
+
+ /* ensure we still have a valid command */
+ if ((objc - i) < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-async? ?-displayof? ?--? interpName arg ?arg ...?");
+ r = TCL_ERROR;
+ }
+
+ /*
+ * FIX ME: we don't support displayPtr.
+ */
+
+ if (displayPtr) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "option not implemented: \"displayof\" is not available "
+ "for this platform.", -1);
+ r = TCL_ERROR;
+ }
+
+ /* send the arguments to the foreign interp */
+ /* FIX ME: async and check for local interp */
+ if (r == TCL_OK) {
+ LPDISPATCH pdisp;
+ r = FindInterpreterObject(interp, Tcl_GetString(objv[i]), &pdisp);
+ if (r == TCL_OK) {
+ i++;
+ r = Send(pdisp, interp, async, clientData, (objc - i), &objv[i]);
+ pdisp->lpVtbl->Release(pdisp);
+ }
+ }
+
+ return r;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FindInterpreterObject --
+ *
+ * Search the set of objects currently registered with the
+ * Running Object Table for one which matches the registered
+ * name. Tk objects are named using BuildMoniker by always
+ * prefixing with TclEval.
+ *
+ * Results:
+ * If a matching object registration is found, then the
+ * registered IDispatch interface pointer is returned.
+ * If not, then an error message is placed in the interpreter
+ * and TCL_ERROR is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+FindInterpreterObject(Tcl_Interp *interp, CONST char *name, LPDISPATCH *ppdisp)
+{
+ LPRUNNINGOBJECTTABLE pROT = NULL;
+ int r = TCL_OK;
+ HRESULT hr = GetRunningObjectTable(0, &pROT);
+ if (SUCCEEDED(hr))
+ {
+ IBindCtx* pBindCtx = NULL;
+ hr = CreateBindCtx(0, &pBindCtx);
+ if (SUCCEEDED(hr))
+ {
+ LPMONIKER pmk = NULL;
+ hr = BuildMoniker(name, &pmk);
+ if (SUCCEEDED(hr))
+ {
+ IUnknown* punkInterp = NULL;
+ hr = pROT->lpVtbl->IsRunning(pROT, pmk);
+ hr = pmk->lpVtbl->BindToObject(pmk, pBindCtx, NULL,
+ &IID_IUnknown, (void**)&punkInterp);
+ if (SUCCEEDED(hr)) {
+ hr = punkInterp->lpVtbl->QueryInterface(punkInterp,
+ &IID_IDispatch, (void**)ppdisp);
+ punkInterp->lpVtbl->Release(punkInterp);
+
+ } else {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "no application named \"", name, "\"", NULL);
+ r = TCL_ERROR;
+ }
+
+ pmk->lpVtbl->Release(pmk);
+ }
+ pBindCtx->lpVtbl->Release(pBindCtx);
+ }
+ pROT->lpVtbl->Release(pROT);
+ }
+ if (FAILED(hr) && r == TCL_OK)
+ {
+ Tcl_SetObjResult(interp, Win32ErrorObj(hr));
+ r = TCL_ERROR;
+ }
+ return r;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CmdDeleteProc --
+ *
+ * This procedure is invoked by Tcl when the "send" command
+ * is deleted in an interpreter. It unregisters the interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The interpreter given by riPtr is unregistered, the
+ * registration structure is free'd and the COM object
+ * unregistered and released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CmdDeleteProc(clientData)
+ ClientData clientData; /* Pointer to the interp registration block */
+{
+ RegisteredInterp *riPtr = (RegisteredInterp *)clientData;
+
+ /* Lock the package structure in memory */
+ Tcl_Preserve(clientData);
+
+ /* Revoke the ROT registration */
+ RevokeObjectRegistration(riPtr);
+
+ /* Release the registration object */
+ riPtr->obj->lpVtbl->Release(riPtr->obj);
+ riPtr->obj = NULL;
+
+ Tcl_DeleteAssocData(riPtr->interp, "tkWinSend::ri");
+
+ /* unlock the package data structure. */
+ Tcl_Release(clientData);
+
+ ckfree(clientData);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RevokeObjectRegistration --
+ *
+ * Releases the interpreters registration object from the
+ * Running Object Table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The stored cookie value is zeroed and the name is free'd
+ * and the pointer set to NULL.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+RevokeObjectRegistration(RegisteredInterp *riPtr)
+{
+ LPRUNNINGOBJECTTABLE pROT = NULL;
+ HRESULT hr = S_OK;
+ if (riPtr->cookie != 0) {
+ hr = GetRunningObjectTable(0, &pROT);
+ if (SUCCEEDED(hr)) {
+ hr = pROT->lpVtbl->Revoke(pROT, riPtr->cookie);
+ pROT->lpVtbl->Release(pROT);
+ riPtr->cookie = 0;
+ }
+ }
+
+ /* release the name storage */
+ if (riPtr->name != NULL) {
+ free(riPtr->name);
+ riPtr->name = NULL;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InterpDeleteProc --
+ *
+ * This is called when the interpreter is deleted and used to
+ * unregister the COM libraries.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+InterpDeleteProc(ClientData clientData, Tcl_Interp *interp)
+{
+ CoUninitialize();
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * BuildMoniker --
+ *
+ * Construct a moniker from the given name. This ensures that all our
+ * monikers have the same prefix.
+ *
+ * Results:
+ * S_OK. If the name cannot be turned into a moniker then a
+ * COM error code is returned.
+ *
+ * Side effects:
+ * The moniker created is stored at the address given by ppmk.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static HRESULT
+BuildMoniker(CONST char *name, LPMONIKER *ppmk)
+{
+ LPMONIKER pmkClass = NULL;
+ HRESULT hr = CreateFileMoniker(TKWINSEND_REGISTRATION_BASE, &pmkClass);
+ if (SUCCEEDED(hr)) {
+ LPMONIKER pmkItem = NULL;
+ Tcl_DString dString;
+
+ Tcl_DStringInit(&dString);
+ Tcl_UtfToUniCharDString(name, -1, &dString);
+ hr = CreateFileMoniker((LPOLESTR)Tcl_DStringValue(&dString), &pmkItem);
+ Tcl_DStringFree(&dString);
+ if (SUCCEEDED(hr)) {
+ hr = pmkClass->lpVtbl->ComposeWith(pmkClass, pmkItem, FALSE, ppmk);
+ pmkItem->lpVtbl->Release(pmkItem);
+ }
+ pmkClass->lpVtbl->Release(pmkClass);
+ }
+ return hr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * RegisterInterp --
+ *
+ * Attempts to register the provided name for this interpreter.
+ * If the given name is already in use, then a numeric suffix is
+ * appended as " #n" until we identify a unique name.
+ *
+ * Results:
+ * Returns S_OK if successful, else a COM error code.
+ *
+ * Side effects:
+ * Registration returns a cookie value which is stored. We also store
+ * a copy of the name.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static HRESULT
+RegisterInterp(CONST char *name, RegisteredInterp *riPtr)
+{
+ HRESULT hr = S_OK;
+ LPRUNNINGOBJECTTABLE pROT = NULL;
+ LPMONIKER pmk = NULL;
+ int i, offset;
+ CONST char *actualName = name;
+ Tcl_DString dString;
+
+ hr = GetRunningObjectTable(0, &pROT);
+ if (SUCCEEDED(hr)) {
+
+ Tcl_DStringInit(&dString);
+ offset = 0;
+
+ for (i = 1; SUCCEEDED(hr); i++) {
+ if (i > 1) {
+ if (i == 2) {
+ Tcl_DStringInit(&dString);
+ Tcl_DStringAppend(&dString, name, -1);
+ Tcl_DStringAppend(&dString, " #", 2);
+ offset = Tcl_DStringLength(&dString);
+ Tcl_DStringSetLength(&dString, offset+TCL_INTEGER_SPACE);
+ actualName = Tcl_DStringValue(&dString);
+ }
+ sprintf(Tcl_DStringValue(&dString) + offset, "%d", i);
+ }
+
+ hr = BuildMoniker(actualName, &pmk);
+ if (SUCCEEDED(hr)) {
+
+ hr = pROT->lpVtbl->Register(pROT,
+ ROTFLAGS_REGISTRATIONKEEPSALIVE,
+ riPtr->obj, pmk, &riPtr->cookie);
+
+ pmk->lpVtbl->Release(pmk);
+ }
+
+ if (hr == MK_S_MONIKERALREADYREGISTERED)
+ pROT->lpVtbl->Revoke(pROT, riPtr->cookie);
+ else if (hr == S_OK)
+ break;
+ }
+
+ Tcl_DStringFree(&dString);
+ pROT->lpVtbl->Release(pROT);
+ }
+
+ if (SUCCEEDED(hr))
+ riPtr->name = strdup(actualName);
+ return hr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Send --
+ *
+ * Perform an interface call to the server object. We convert the
+ * Tcl arguments into a BSTR using 'concat'. The result should be a
+ * BSTR that we can set as the interp's result string.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+Send(LPDISPATCH pdispInterp, Tcl_Interp *interp,
+ int async, ClientData clientData, int objc, Tcl_Obj *CONST objv[])
+{
+ VARIANT vCmd, vResult;
+ DISPPARAMS dp;
+ EXCEPINFO ei;
+ UINT uiErr = 0;
+ HRESULT hr = S_OK, ehr = S_OK;
+ Tcl_Obj *cmd = NULL;
+ DISPID dispid;
+ RegisteredInterp *riPtr = (RegisteredInterp *)clientData;
+
+ cmd = Tcl_ConcatObj(objc, objv);
+
+ /*
+ * Setup the arguments for the COM method call.
+ */
+
+ VariantInit(&vCmd);
+ VariantInit(&vResult);
+ memset(&dp, 0, sizeof(dp));
+ memset(&ei, 0, sizeof(ei));
+
+ vCmd.vt = VT_BSTR;
+ vCmd.bstrVal = SysAllocString(Tcl_GetUnicode(cmd));
+
+ dp.cArgs = 1;
+ dp.rgvarg = &vCmd;
+
+ /*
+ * Select the method to use based upon the async flag and
+ * call the method.
+ */
+
+ dispid = async ? TKWINSENDCOM_DISPID_ASYNC : TKWINSENDCOM_DISPID_SEND;
+
+ hr = pdispInterp->lpVtbl->Invoke(pdispInterp, dispid,
+ &IID_NULL, LOCALE_SYSTEM_DEFAULT, DISPATCH_METHOD,
+ &dp, &vResult, &ei, &uiErr);
+
+ /*
+ * Convert the result into a string and place in the interps result.
+ */
+
+ ehr = VariantChangeType(&vResult, &vResult, 0, VT_BSTR);
+ if (SUCCEEDED(ehr))
+ Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(vResult.bstrVal, -1));
+
+ /*
+ * Errors are returned as dispatch exceptions. If an error code was
+ * returned then we decode the exception and setup the Tcl
+ * error variables.
+ */
+
+ if (hr == DISP_E_EXCEPTION)
+ {
+ Tcl_Obj *opError, *opErrorCode, *opErrorInfo;
+
+ if (ei.bstrSource != NULL)
+ {
+ int len;
+ char * szErrorInfo;
+
+ opError = Tcl_NewUnicodeObj(ei.bstrSource, -1);
+ Tcl_ListObjIndex(interp, opError, 0, &opErrorCode);
+ Tcl_SetObjErrorCode(interp, opErrorCode);
+
+ Tcl_ListObjIndex(interp, opError, 1, &opErrorInfo);
+ szErrorInfo = Tcl_GetStringFromObj(opErrorInfo, &len);
+ Tcl_AddObjErrorInfo(interp, szErrorInfo, len);
+ }
+ }
+
+ /*
+ * Clean up any COM allocated resources.
+ */
+
+ SysFreeString(ei.bstrDescription);
+ SysFreeString(ei.bstrSource);
+ SysFreeString(ei.bstrHelpFile);
+ VariantClear(&vCmd);
+
+ return (SUCCEEDED(hr) ? TCL_OK : TCL_ERROR);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Win32ErrorObj --
+ *
+ * Returns a string object containing text from a COM or
+ * Win32 error code
+ *
+ * Results:
+ * A Tcl_Obj containing the Win32 error message.
+ *
+ * Side effects:
+ * Removed the error message from the COM threads error object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static Tcl_Obj*
+Win32ErrorObj(HRESULT hrError)
+{
+ LPTSTR lpBuffer = NULL, p = NULL;
+ TCHAR sBuffer[30];
+ Tcl_Obj* errPtr = NULL;
+
+ FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
+ NULL, hrError, LANG_NEUTRAL, (LPTSTR)&lpBuffer, 0, NULL);
+
+ if (lpBuffer == NULL) {
+ lpBuffer = sBuffer;
+ wsprintf(sBuffer, _T("Error Code: %08lX"), hrError);
+ }
+
+ if ((p = _tcsrchr(lpBuffer, _T('\r'))) != NULL)
+ *p = _T('\0');
+
+#ifdef _UNICODE
+ errPtr = Tcl_NewUnicodeObj(lpBuffer, wcslen(lpBuffer));
+#else
+ errPtr = Tcl_NewStringObj(lpBuffer, strlen(lpBuffer));
+#endif
+
+ if (lpBuffer != sBuffer)
+ LocalFree((HLOCAL)lpBuffer);
+
+ return errPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * SetErrorInfo --
+ *
+ * Convert the error information from a Tcl interpreter into a COM
+ * exception structure. This information is then registered with the
+ * COM thread exception object so that it can be used for rich error
+ * reporting by COM clients.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The current COM thread has its error object modified.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+void
+SetExcepInfo(Tcl_Interp* interp, EXCEPINFO *pExcepInfo)
+{
+ if (pExcepInfo)
+ {
+ Tcl_Obj *opError, *opErrorInfo, *opErrorCode;
+ ICreateErrorInfo *pCEI;
+ IErrorInfo *pEI;
+ HRESULT hr;
+
+ opError = Tcl_GetObjResult(interp);
+ opErrorInfo = Tcl_GetVar2Ex(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
+ opErrorCode = Tcl_GetVar2Ex(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
+
+ Tcl_ListObjAppendElement(interp, opErrorCode, opErrorInfo);
+
+ pExcepInfo->bstrDescription = SysAllocString(Tcl_GetUnicode(opError));
+ pExcepInfo->bstrSource = SysAllocString(Tcl_GetUnicode(opErrorCode));
+ pExcepInfo->scode = E_FAIL;
+
+ hr = CreateErrorInfo(&pCEI);
+ if (SUCCEEDED(hr))
+ {
+ hr = pCEI->lpVtbl->SetGUID(pCEI, &IID_IDispatch);
+ hr = pCEI->lpVtbl->SetDescription(pCEI, pExcepInfo->bstrDescription);
+ hr = pCEI->lpVtbl->SetSource(pCEI, pExcepInfo->bstrSource);
+ hr = pCEI->lpVtbl->QueryInterface(pCEI, &IID_IErrorInfo, (void**)&pEI);
+ if (SUCCEEDED(hr))
+ {
+ SetErrorInfo(0, pEI);
+ pEI->lpVtbl->Release(pEI);
+ }
+ pCEI->lpVtbl->Release(pCEI);
+ }
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TkWinSend_QueueCommand --
+ *
+ * Queue a script for asynchronous evaluation. This is called from
+ * the COM objects Async method.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TkWinSend_QueueCommand(Tcl_Interp *interp, Tcl_Obj *cmdPtr)
+{
+ SendEvent *evPtr;
+
+ TRACE("SendQueueCommand()\n");
+
+ evPtr = (SendEvent *)ckalloc(sizeof(SendEvent));
+ evPtr->header.proc = SendEventProc;
+ evPtr->header.nextPtr = NULL;
+ evPtr->interp = interp;
+ Tcl_Preserve(evPtr->interp);
+
+ if (Tcl_IsShared(cmdPtr)) {
+ evPtr->cmdPtr = Tcl_DuplicateObj(cmdPtr);
+ } else {
+ evPtr->cmdPtr = cmdPtr;
+ Tcl_IncrRefCount(evPtr->cmdPtr);
+ }
+
+ Tcl_QueueEvent((Tcl_Event *)evPtr, TCL_QUEUE_TAIL);
+
+ return 0;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * SendEventProc --
+ *
+ * Handle a request for an asynchronous send. Nothing is returned
+ * to the caller so the result is discarded.
+ *
+ * Results:
+ * Returns 1 if the event was handled or 0 to indicate it has
+ * been deferred.
+ *
+ * Side effects:
+ * The target interpreter's result will be modified.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+SendEventProc(Tcl_Event *eventPtr, int flags)
+{
+ int r = TCL_OK;
+ SendEvent *evPtr = (SendEvent *)eventPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ TRACE("SendEventProc\n");
+
+ r = Tcl_EvalObjEx(evPtr->interp, evPtr->cmdPtr,
+ TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
+
+ Tcl_DecrRefCount(evPtr->cmdPtr);
+ Tcl_Release(evPtr->interp);
+
+ return 1; /* 1 to indicate the event has been handled */
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * SendTrace --
+ *
+ * Provide trace information to the Windows debug stream.
+ * To use this - use the TRACE macro, which compiles to nothing
+ * when DEBUG is not defined.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+SendTrace(const char *format, ...)
+{
+ va_list args;
+ static char buffer[1024];
+ va_start (args, format);
+ _vsnprintf(buffer, 1023, format, args);
+ OutputDebugString(buffer);
+ va_end(args);
}
+
+/*
+ * Local variables:
+ * mode: c
+ * tab-width: 8
+ * c-indentation-style: tcltk
+ * End:
+ */
diff --git a/win/tkWinSendCom.c b/win/tkWinSendCom.c
new file mode 100644
index 0000000..325f127
--- /dev/null
+++ b/win/tkWinSendCom.c
@@ -0,0 +1,431 @@
+/*
+ * tkWinSend.c --
+ *
+ * This file provides procedures that implement the Windows "send"
+ * command, allowing commands to be passed from interpreter
+ * to interpreter.
+ *
+ * We implement a COM class for use in registering Tcl interpreters
+ * with the system's Running Object Table.
+ * This class implements an IDispatch interface with the following method:
+ * Send(String cmd) As String
+ * In other words the Send methods takes a string and evaluates this in
+ * the Tcl interpreter. The result is returned as another string.
+ *
+ * Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net>
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkWinSendCom.c,v 1.1 2003/09/26 23:59:26 patthoyts Exp $
+ */
+
+#include "tkWinSendCom.h"
+
+/*
+ * ----------------------------------------------------------------------
+ * Non-public prototypes.
+ *
+ * These are the interface methods for IUnknown, IDispatch and
+ * ISupportErrorInfo.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void TkWinSendCom_Destroy(LPDISPATCH pdisp);
+
+static STDMETHODIMP WinSendCom_QueryInterface(IDispatch *This,
+ REFIID riid, void **ppvObject);
+static STDMETHODIMP_(ULONG) WinSendCom_AddRef(IDispatch *This);
+static STDMETHODIMP_(ULONG) WinSendCom_Release(IDispatch *This);
+static STDMETHODIMP WinSendCom_GetTypeInfoCount(IDispatch *This,
+ UINT *pctinfo);
+static STDMETHODIMP WinSendCom_GetTypeInfo(IDispatch *This, UINT iTInfo,
+ LCID lcid, ITypeInfo **ppTI);
+static STDMETHODIMP WinSendCom_GetIDsOfNames(IDispatch *This, REFIID riid,
+ LPOLESTR *rgszNames,
+ UINT cNames, LCID lcid,
+ DISPID *rgDispId);
+static STDMETHODIMP WinSendCom_Invoke(IDispatch *This, DISPID dispidMember,
+ REFIID riid, LCID lcid, WORD wFlags,
+ DISPPARAMS *pDispParams,
+ VARIANT *pvarResult,
+ EXCEPINFO *pExcepInfo,
+ UINT *puArgErr);
+
+static STDMETHODIMP ISupportErrorInfo_QueryInterface(ISupportErrorInfo *This,
+ REFIID riid, void **ppvObject);
+static STDMETHODIMP_(ULONG) ISupportErrorInfo_AddRef(ISupportErrorInfo *This);
+static STDMETHODIMP_(ULONG) ISupportErrorInfo_Release(ISupportErrorInfo *This);
+static STDMETHODIMP ISupportErrorInfo_InterfaceSupportsErrorInfo(ISupportErrorInfo *This,
+ REFIID riid);
+
+static HRESULT Send(TkWinSendCom* obj, VARIANT vCmd, VARIANT* pvResult,
+ EXCEPINFO* pExcepInfo, UINT *puArgErr);
+static HRESULT Async(TkWinSendCom* obj, VARIANT Cmd,
+ EXCEPINFO *pExcepInfo, UINT *puArgErr);
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * CreateInstance --
+ *
+ * Create and initialises a new instance of the WinSend COM class and
+ * returns an interface pointer for you to use.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+HRESULT
+TkWinSendCom_CreateInstance(Tcl_Interp *interp, REFIID riid, void **ppv)
+{
+ /* construct v-tables for each interface */
+ static IDispatchVtbl vtbl = {
+ WinSendCom_QueryInterface,
+ WinSendCom_AddRef,
+ WinSendCom_Release,
+ WinSendCom_GetTypeInfoCount,
+ WinSendCom_GetTypeInfo,
+ WinSendCom_GetIDsOfNames,
+ WinSendCom_Invoke,
+ };
+
+ static ISupportErrorInfoVtbl vtbl2 = {
+ ISupportErrorInfo_QueryInterface,
+ ISupportErrorInfo_AddRef,
+ ISupportErrorInfo_Release,
+ ISupportErrorInfo_InterfaceSupportsErrorInfo,
+ };
+
+ HRESULT hr = S_OK;
+ TkWinSendCom *obj = NULL;
+
+ /*
+ * This had probably better always be globally visible memory so
+ * we shall use the COM Task allocator.
+ */
+
+ obj = (TkWinSendCom*)CoTaskMemAlloc(sizeof(TkWinSendCom));
+ if (obj == NULL) {
+ *ppv = NULL;
+ hr = E_OUTOFMEMORY;
+ } else {
+ obj->lpVtbl = &vtbl;
+ obj->lpVtbl2 = &vtbl2;
+ obj->refcount = 0;
+ obj->interp = interp;
+
+ /* lock the interp? Tcl_AddRef/Retain? */
+
+ hr = obj->lpVtbl->QueryInterface((IDispatch*)obj, riid, ppv);
+ }
+
+ return hr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TkWinSendCom_Destroy --
+ *
+ * This helper function is the destructor for our COM class.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Releases the storage allocated for this object.
+ *
+ * ----------------------------------------------------------------------
+ */
+static void
+TkWinSendCom_Destroy(LPDISPATCH pdisp)
+{
+ CoTaskMemFree((void*)pdisp);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * IDispatch --
+ *
+ * The IDispatch interface implements the 'late-binding' COM methods
+ * typically used by scripting COM clients.
+ * The Invoke method is the most important one.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static STDMETHODIMP
+WinSendCom_QueryInterface(IDispatch *This,
+ REFIID riid,
+ void **ppvObject)
+{
+ HRESULT hr = E_NOINTERFACE;
+ TkWinSendCom *this = (TkWinSendCom*)This;
+ *ppvObject = NULL;
+
+ if (memcmp(riid, &IID_IUnknown, sizeof(IID)) == 0
+ || memcmp(riid, &IID_IDispatch, sizeof(IID)) == 0) {
+ *ppvObject = (void**)this;
+ this->lpVtbl->AddRef(This);
+ hr = S_OK;
+ } else if (memcmp(riid, &IID_ISupportErrorInfo, sizeof(IID)) == 0) {
+ *ppvObject = (void**)(this + 1);
+ this->lpVtbl2->AddRef((ISupportErrorInfo*)(this + 1));
+ hr = S_OK;
+ }
+ return hr;
+}
+
+static STDMETHODIMP_(ULONG)
+WinSendCom_AddRef(IDispatch *This)
+{
+ TkWinSendCom *this = (TkWinSendCom*)This;
+ return InterlockedIncrement(&this->refcount);
+}
+
+static STDMETHODIMP_(ULONG)
+WinSendCom_Release(IDispatch *This)
+{
+ long r = 0;
+ TkWinSendCom *this = (TkWinSendCom*)This;
+ if ((r = InterlockedDecrement(&this->refcount)) == 0) {
+ TkWinSendCom_Destroy(This);
+ }
+ return r;
+}
+
+static STDMETHODIMP
+WinSendCom_GetTypeInfoCount(IDispatch *This, UINT *pctinfo)
+{
+ HRESULT hr = E_POINTER;
+ if (pctinfo != NULL) {
+ *pctinfo = 0;
+ hr = S_OK;
+ }
+ return hr;
+}
+
+static STDMETHODIMP
+WinSendCom_GetTypeInfo(IDispatch *This, UINT iTInfo,
+ LCID lcid, ITypeInfo **ppTI)
+{
+ HRESULT hr = E_POINTER;
+ if (ppTI)
+ {
+ *ppTI = NULL;
+ hr = E_NOTIMPL;
+ }
+ return hr;
+}
+
+static STDMETHODIMP
+WinSendCom_GetIDsOfNames(IDispatch *This, REFIID riid,
+ LPOLESTR *rgszNames,
+ UINT cNames, LCID lcid,
+ DISPID *rgDispId)
+{
+ HRESULT hr = E_POINTER;
+ if (rgDispId)
+ {
+ hr = DISP_E_UNKNOWNNAME;
+ if (_wcsicmp(*rgszNames, L"Send") == 0)
+ *rgDispId = TKWINSENDCOM_DISPID_SEND, hr = S_OK;
+ else if (_wcsicmp(*rgszNames, L"Async") == 0)
+ *rgDispId = TKWINSENDCOM_DISPID_ASYNC, hr = S_OK;
+ }
+ return hr;
+}
+
+static STDMETHODIMP
+WinSendCom_Invoke(IDispatch *This, DISPID dispidMember,
+ REFIID riid, LCID lcid, WORD wFlags,
+ DISPPARAMS *pDispParams,
+ VARIANT *pvarResult,
+ EXCEPINFO *pExcepInfo,
+ UINT *puArgErr)
+{
+ HRESULT hr = DISP_E_MEMBERNOTFOUND;
+ TkWinSendCom *this = (TkWinSendCom*)This;
+
+ switch (dispidMember)
+ {
+ case TKWINSENDCOM_DISPID_SEND:
+ if (wFlags | DISPATCH_METHOD)
+ {
+ if (pDispParams->cArgs != 1)
+ hr = DISP_E_BADPARAMCOUNT;
+ else
+ hr = Send(this, pDispParams->rgvarg[0],
+ pvarResult, pExcepInfo, puArgErr);
+ }
+ break;
+
+ case TKWINSENDCOM_DISPID_ASYNC:
+ if (wFlags | DISPATCH_METHOD)
+ {
+ if (pDispParams->cArgs != 1)
+ hr = DISP_E_BADPARAMCOUNT;
+ else
+ hr = Async(this, pDispParams->rgvarg[0],
+ pExcepInfo, puArgErr);
+ }
+ break;
+
+ }
+ return hr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ISupportErrorInfo --
+ *
+ * This interface provides rich error information to COM clients.
+ * Used by VB and scripting COM clients.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static STDMETHODIMP
+ISupportErrorInfo_QueryInterface(ISupportErrorInfo *This,
+ REFIID riid, void **ppvObject)
+{
+ TkWinSendCom *this = (TkWinSendCom*)(This - 1);
+ return this->lpVtbl->QueryInterface((IDispatch*)this, riid, ppvObject);
+}
+
+static STDMETHODIMP_(ULONG)
+ISupportErrorInfo_AddRef(ISupportErrorInfo *This)
+{
+ TkWinSendCom *this = (TkWinSendCom*)(This - 1);
+ return InterlockedIncrement(&this->refcount);
+}
+
+static STDMETHODIMP_(ULONG)
+ISupportErrorInfo_Release(ISupportErrorInfo *This)
+{
+ TkWinSendCom *this = (TkWinSendCom*)(This - 1);
+ return this->lpVtbl->Release((IDispatch*)this);
+}
+
+static STDMETHODIMP
+ISupportErrorInfo_InterfaceSupportsErrorInfo(ISupportErrorInfo *This,
+ REFIID riid)
+{
+ TkWinSendCom *this = (TkWinSendCom*)(This - 1);
+ return S_OK; /* or S_FALSE */
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Async --
+ *
+ * Queues the command for evaluation in the assigned interpreter.
+ *
+ * Results:
+ * A standard COM HRESULT is returned. The Tcl result is discarded.
+ *
+ * Side effects:
+ * The interpreters state and result will be modified.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static HRESULT
+Async(TkWinSendCom* obj, VARIANT Cmd, EXCEPINFO *pExcepInfo, UINT *puArgErr)
+{
+ HRESULT hr = S_OK;
+ int r = TCL_OK;
+ VARIANT vCmd;
+
+ VariantInit(&vCmd);
+
+ hr = VariantChangeType(&vCmd, &Cmd, 0, VT_BSTR);
+ if (FAILED(hr)) {
+ Tcl_SetStringObj(Tcl_GetObjResult(obj->interp),
+ "invalid args: Async(command)", -1);
+ SetExcepInfo(obj->interp, pExcepInfo);
+ hr = DISP_E_EXCEPTION;
+ }
+
+
+ if (SUCCEEDED(hr))
+ {
+ if (obj->interp)
+ {
+ Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(vCmd.bstrVal,
+ SysStringLen(vCmd.bstrVal));
+ r = TkWinSend_QueueCommand(obj->interp, scriptPtr);
+ }
+ }
+
+ VariantClear(&vCmd);
+
+ return hr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * Send --
+ *
+ * Evaluates the string in the assigned interpreter. If the result
+ * is a valid address then set it to the result returned by the
+ * evaluation. Tcl exceptions are converted into COM exceptions.
+ *
+ * Results:
+ * A standard COM HRESULT is returned. The Tcl result is set as
+ * the method calls result.
+ *
+ * Side effects:
+ * The interpreters state and result will be modified.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static HRESULT
+Send(TkWinSendCom* obj, VARIANT vCmd,
+ VARIANT* pvResult, EXCEPINFO* pExcepInfo, UINT *puArgErr)
+{
+ HRESULT hr = S_OK;
+ int r = TCL_OK;
+ VARIANT v;
+
+ VariantInit(&v);
+ hr = VariantChangeType(&v, &vCmd, 0, VT_BSTR);
+ if (SUCCEEDED(hr))
+ {
+ if (obj->interp)
+ {
+ Tcl_Obj *scriptPtr = Tcl_NewUnicodeObj(v.bstrVal,
+ SysStringLen(v.bstrVal));
+
+ r = Tcl_EvalObjEx(obj->interp, scriptPtr,
+ TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
+ if (pvResult)
+ {
+ VariantInit(pvResult);
+ pvResult->vt = VT_BSTR;
+ pvResult->bstrVal = SysAllocString(Tcl_GetUnicode(Tcl_GetObjResult(obj->interp)));
+ }
+ if (r == TCL_ERROR)
+ {
+ hr = DISP_E_EXCEPTION;
+ SetExcepInfo(obj->interp, pExcepInfo);
+ }
+ }
+ VariantClear(&v);
+ }
+ return hr;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * tab-width: 8
+ * c-indentation-style: tcltk
+ * End:
+ */
diff --git a/win/tkWinSendCom.h b/win/tkWinSendCom.h
new file mode 100644
index 0000000..fd98ca2
--- /dev/null
+++ b/win/tkWinSendCom.h
@@ -0,0 +1,58 @@
+/*
+ * tkWinSendCom.h --
+ *
+ * This file provides procedures that implement the Windows "send"
+ * command, allowing commands to be passed from interpreter
+ * to interpreter.
+ *
+ * Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net>
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tkWinSendCom.h,v 1.1 2003/09/26 23:59:26 patthoyts Exp $
+ */
+
+#ifndef _tkWinSendCom_h_INCLUDE
+#define _tkWinSendCom_h_INCLUDE
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+#include <ole2.h>
+
+/*
+ * TkWinSendCom CoClass structure
+ */
+
+typedef struct {
+ IDispatchVtbl *lpVtbl;
+ ISupportErrorInfoVtbl *lpVtbl2;
+ long refcount;
+ Tcl_Interp *interp;
+} TkWinSendCom;
+
+/*
+ * TkWinSendCom Dispatch IDs
+ */
+
+#define TKWINSENDCOM_DISPID_SEND 1
+#define TKWINSENDCOM_DISPID_ASYNC 2
+
+/*
+ * TkWinSendCom public functions
+ */
+
+HRESULT TkWinSendCom_CreateInstance(Tcl_Interp *interp,
+ REFIID riid, void **ppv);
+int TkWinSend_QueueCommand(Tcl_Interp *interp, Tcl_Obj *cmdPtr);
+void SetExcepInfo(Tcl_Interp* interp, EXCEPINFO *pExcepInfo);
+
+#endif /* _tkWinSendCom_h_INCLUDE */
+
+/*
+ * Local Variables:
+ * mode: c
+ * indent-tabs-mode: nil
+ * End:
+ */
generated by cgit v0.12 at 2024-12-28 04:38:20 (GMT)