+Version 3.10
+- Workaround type mismatch error when passing VT_UINT | VT_BYREF parameters.
+- Added support for 64-bit integer arguments.
+- On type mismatch errors, the error result now indicates which argument cannot
+ be converted.
+- Added missing conversions from VT_DISPATCH | VT_BYREF, VT_UNKNOWN | VT_BYREF,
+ VT_VARIANT | VT_BYREF, and VT_ARRAY | VT_BYREF arguments.
+- Load type library using neutral language argument.
+- Replace -method option with -call option.
+- Fixed invalid pointer error when returned EXCEPINFO contains null
+ description.
+- Fixed passing SAFEARRAY(short) parameters.
+
Version 3.9
- Fixed defect where eval may trigger premature destruction of handle internal
representation.
-# $Id: chart.tcl,v 1.5 2004/02/26 18:07:38 cthuang Exp $
+# $Id: chart.tcl 5 2005-02-16 14:57:24Z cthuang $
#
# This example controls Excel. It performs the following steps.
# - Start Excel application.
-# $Id: events.tcl,v 1.2 2001/06/30 18:42:58 cthuang Exp $
+# $Id: events.tcl 5 2005-02-16 14:57:24Z cthuang $
package require tcom
-# $Id: excel.tcl,v 1.10 2002/09/27 22:11:03 cthuang Exp $
+# $Id: excel.tcl 5 2005-02-16 14:57:24Z cthuang $
#
# This example controls Excel. It performs the following steps.
# - Start Excel application.
-# $Id: sendkeys.tcl,v 1.3 2001/06/30 18:42:58 cthuang Exp $
+# $Id: sendkeys.tcl 5 2005-02-16 14:57:24Z cthuang $
#
# This example demonstrates how to send keys to Windows applications.
# It requires Windows Script Host 2.0 installed on the system.
-# $Id: Makefile,v 1.6 2002/04/17 22:07:57 cthuang Exp $
+# $Id: Makefile 5 2005-02-16 14:57:24Z cthuang $
all: tcom.n.html server.html
<?xml version="1.0"?>
-<!-- $Id: article2html.xsl,v 1.11 2002/06/29 15:34:52 cthuang Exp $ -->
+<!-- $Id: article2html.xsl 7 2005-02-24 05:18:47Z cthuang $ -->
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output method="html" encoding="UTF-8"
doctype-public="-//W3C//DTD HTML 4.01 Transitional//EN"
<xsl:template match="article">
<html>
<head>
- <title><xsl:value-of select="artheader/title"/></title>
+ <title><xsl:value-of select="title"/></title>
<style type="text/css">
.command
{ font-style: normal; font-weight: bold; }
.option
{ font-style: normal; font-weight: bold; }
- .replaceable
- { font-style: italic; font-weight: normal; }
- .listing
- { font-size: 9pt; }
+ .programlisting
+ { background-color: #E8E8E8; font-size: 9pt; }
+ .screen
+ { background-color: #FFFFCC; }
</style>
</head>
<body>
- <h1><xsl:value-of select="artheader/title"/></h1>
<xsl:apply-templates/>
</body>
</html>
</xsl:template>
- <xsl:template match="artheader"/>
+ <xsl:template match="article/title">
+ <h1><xsl:value-of select="text()"/></h1>
+ </xsl:template>
+
+ <xsl:template match="articleinfo"/>
<xsl:template match="cmdsynopsis">
<xsl:apply-templates/>
</xsl:template>
<xsl:template match="arg">
- <var>
<xsl:choose>
<xsl:when test="@choice='plain'"></xsl:when>
<xsl:otherwise>?</xsl:otherwise>
<xsl:when test="@choice='plain'"></xsl:when>
<xsl:otherwise>?</xsl:otherwise>
</xsl:choose>
- </var>
</xsl:template>
<xsl:template match="option">
</xsl:template>
<xsl:template match="programlisting">
- <table bgcolor="#CCCCCC" width="100%"><tr><td><pre class="listing">
+ <pre class="programlisting">
<xsl:apply-templates/>
- </pre></td></tr></table>
+ </pre>
</xsl:template>
<xsl:template match="screen">
- <table bgcolor="#FFFFCC" width="100%"><tr><td><pre>
+ <pre class="screen">
<xsl:apply-templates/>
- </pre></td></tr></table>
+ </pre>
</xsl:template>
<xsl:template match="userinput">
<?xml version="1.0"?>
-<!-- $Id: refentry2html.xsl,v 1.16 2002/06/29 15:34:52 cthuang Exp $ -->
+<!-- $Id: refentry2html.xsl 7 2005-02-24 05:18:47Z cthuang $ -->
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
<xsl:output method="html" encoding="UTF-8"
doctype-public="-//W3C//DTD HTML 4.01 Transitional//EN"
<head>
<title><xsl:value-of select="refnamediv/refname"/></title>
<style type="text/css">
+ table
+ { margin-left: 2em; border-collapse: collapse; }
+ th
+ { color: white; background-color: navy; }
+ .cell
+ { border: 2px solid navy; padding: 1px 4px 1px 4px; }
.command
{ font-style: normal; font-weight: bold; }
.option
{ font-style: normal; font-weight: bold; }
- .parameter
- { font-style: italic; font-weight: normal; }
+ .programlisting
+ { background-color: #E8E8E8; }
</style>
</head>
<body>
</html>
</xsl:template>
- <xsl:template match="docinfo"/>
+ <xsl:template match="refentryinfo"/>
<xsl:template match="refmeta"/>
</xsl:template>
<xsl:template match="arg">
- <var>
<xsl:choose>
<xsl:when test="@choice='plain'"></xsl:when>
<xsl:otherwise>?</xsl:otherwise>
<xsl:when test="@choice='plain'"></xsl:when>
<xsl:otherwise>?</xsl:otherwise>
</xsl:choose>
- </var>
+ </xsl:template>
+
+ <xsl:template match="replaceable">
+ <var><xsl:apply-templates/></var>
</xsl:template>
<xsl:template match="option">
</xsl:template>
<xsl:template match="table">
- <blockquote>
- <xsl:apply-templates/>
- </blockquote>
+ <table class="cell">
+ <xsl:apply-templates/>
+ </table>
</xsl:template>
<xsl:template match="table/title">
- <b><xsl:value-of select="."/></b><br/>
+ <caption><xsl:value-of select="."/></caption>
</xsl:template>
<xsl:template match="table/tgroup">
- <table border="1">
<xsl:apply-templates/>
- </table>
</xsl:template>
<xsl:template match="thead">
</xsl:template>
<xsl:template match="thead/row/entry">
- <td><b><xsl:value-of select="."/></b></td>
+ <th class="cell"><xsl:value-of select="."/></th>
</xsl:template>
<xsl:template match="tbody/row/entry">
- <td><xsl:value-of select="."/></td>
+ <td class="cell"><xsl:value-of select="."/></td>
</xsl:template>
<xsl:template match="programlisting">
- <table bgcolor="#CCCCCC" width="100%"><tr><td><pre>
+ <pre class="programlisting">
<xsl:apply-templates/>
- </pre></td></tr></table>
+ </pre>
</xsl:template>
<xsl:template match="*">
+++ /dev/null
-<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"><html>
-<head>
-<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
-<title>COM Object Implementation in Tcl</title>
-<style type="text/css">
- .command
- { font-style: normal; font-weight: bold; }
- .option
- { font-style: normal; font-weight: bold; }
- .replaceable
- { font-style: italic; font-weight: normal; }
- .listing
- { font-size: 9pt; }
- </style>
-</head>
-<body>
-<h1>COM Object Implementation in Tcl</h1>
-
-
- <h2>Introduction</h2>
- <p>This article shows by example how to implement COM objects in
- Tcl with the <span class="command">tcom</span> extension. It shows how an object
- can be implemented by an [incr Tcl] class or in just plain Tcl.
- </p>
- <div>
-
- <img src="bankingClassDiagram.png">
-
- </div>
- <p>The class diagram shows the structure of server objects which implement
- two COM interfaces. The IAccount interface defines a Balance property, and
- Deposit and Withdraw methods which modify the balance. The Account class
- implements the IAccount interface by delegating its operations to the
- AccountImpl class, which is written in [incr Tcl] and actually implements
- the operations. The IBank interface defines a method to create an account.
- Following the same pattern, the Bank class implements the IBank interface by
- delegating to the BankImpl class, which provides the actual implementation.
- </p>
-
-
- <h2>Write MIDL Specification</h2>
- <p> The file <tt>Banking.idl</tt> contains the MIDL
- specification for the COM interfaces and classes. The interfaces can be
- declared <tt>dual</tt> because <span class="command">tcom</span> can
- implement objects whose operations are invoked through the IDispatch
- interface or the virtual function table.</p>
- <table bgcolor="#CCCCCC" width="100%"><tr><td><pre class="listing">
-
-import "oaidl.idl";
-import "ocidl.idl";
-
- [
- object,
- uuid(0A0059C4-E0B0-11D2-942A-00C04F7040AB),
- dual,
- helpstring("IAccount Interface"),
- pointer_default(unique)
- ]
- interface IAccount: IDispatch
- {
- [id(1), propget, helpstring("property Balance")]
- HRESULT Balance([out, retval] long *pValue);
-
- [id(2), helpstring("method Deposit")]
- HRESULT Deposit([in] long amount);
-
- [id(3), helpstring("method Withdraw")]
- HRESULT Withdraw([in] long amount);
- };
-
- [
- object,
- uuid(0A0059C4-E0B0-11D2-942A-00C04F7040AC),
- dual,
- helpstring("IBank Interface"),
- pointer_default(unique)
- ]
- interface IBank: IDispatch
- {
- [id(1), helpstring("method CreateAccount")]
- HRESULT CreateAccount([out, retval] IAccount **pAccount);
- };
-
-[
- uuid(0A0059B8-E0B0-11D2-942A-00C04F7040AB),
- version(1.0),
- helpstring("Banking 1.0 Type Library")
-]
-library Banking
-{
- importlib("stdole32.tlb");
-
- [
- uuid(0A0059C5-E0B0-11D2-942A-00C04F7040AB),
- helpstring("Account Class")
- ]
- coclass Account
- {
- [default] interface IAccount;
- };
-
- [
- uuid(0A0059C5-E0B0-11D2-942A-00C04F7040AC),
- helpstring("Bank Class")
- ]
- coclass Bank
- {
- [default] interface IBank;
- };
-};
-</pre></td></tr></table>
-
-
- <h2>Create Type Library</h2>
- <p>Run this command to generate a type library file
- <tt>Banking.tlb</tt> from the MIDL specification.</p>
- <table bgcolor="#FFFFCC" width="100%"><tr><td><pre>
-
-<kbd>midl Banking.idl</kbd>
-</pre></td></tr></table>
-
-
- <h2>Create Tcl Package</h2>
- <p>The <span class="command">tcom</span> server implementation depends on the Tcl
- package mechanism to provide the code that implements specific COM interfaces.
- In this example, we'll create a package named Banking, which provides code
- that implements the IBank and IAccount interfaces.</p>
-
- <p>Create a directory for the package by making a subdirectory named
- <tt>Banking</tt> under one of the directories in the
- <tt>auto_path</tt> variable. Create a
- <tt>pkgIndex.tcl</tt> file in the package directory.</p>
-<table bgcolor="#CCCCCC" width="100%"><tr><td><pre class="listing">
-
-package ifneeded Banking 1.0 [list source [file join $dir server.itcl]]
-</pre></td></tr></table>
-
- <p>Copy the <tt>Banking.tlb</tt> type library file into the
- package directory.</p>
-
- <p>Create the following <tt>server.itcl</tt> file in the package
- directory. This file defines [incr Tcl] classes that implement the
- IBank and IAccount interfaces.</p>
-
- <table bgcolor="#CCCCCC" width="100%"><tr><td><pre class="listing">
-
-package provide Banking 1.0
-
-package require Itcl
-namespace import ::itcl::*
-
-package require tcom
-::tcom::import [file join [file dirname [info script]] Banking.tlb]
-
-class AccountImpl {
- private variable balance 0
-
- public method _get_Balance {} {
- return $balance
- }
-
- public method Deposit {amount} {
- set balance [expr $balance + $amount]
- }
-
- public method Withdraw {amount} {
- set balance [expr $balance - $amount]
- }
-}
-
-class BankImpl {
- public method CreateAccount {} {
- set accountImpl [AccountImpl #auto]
- return [::tcom::object create ::Banking::Account \
- [code $accountImpl] {delete object}] ;# 1
- }
-}
-
-::tcom::object registerfactory ::Banking::Bank {BankImpl #auto} {delete object} ;# 2
-</pre></td></tr></table>
-
- <p>On line 1, the <span class="command">::tcom::object create</span> command creates
- a COM object that implements the IAccount interface by delegating its
- operations to an [incr Tcl] object specified by an [incr Tcl] object handle.
- Interface methods are mapped to a method with the same name. Interface
- properties are mapped to methods named by prepending <tt>_get_</tt>
- and <tt>_set_</tt> to the property name. When the last reference
- to the COM object is released, <span class="command">tcom</span> invokes the
- <tt>delete object</tt> command with the [incr Tcl] object handle as
- an additional argument to clean up the [incr Tcl] object.</p>
-
- <p>Line 2 creates a factory for creating instances of the Bank class and
- registers the factory with COM. To create a COM object, the factory invokes
- a command which returns a handle to an [incr Tcl] object that implements the
- operations. In this example, the factory invokes the <tt>BankImpl
- #auto</tt> command which creates a BankImpl [incr Tcl] object and
- returns a handle to that object. To clean up when the COM object is
- destroyed, <span class="command">tcom</span> invokes the <tt>delete
- object</tt> command with the [incr Tcl] object handle as an additional
- argument.</p>
-
-
- <h2>Register Server</h2>
- <p>Run these Tcl commands to create entries in the Windows registry
- required by COM and the <span class="command">tcom</span> server implementation.
- </p>
- <table bgcolor="#FFFFCC" width="100%"><tr><td><pre>
-
-<kbd>package require tcom</kbd>
-<kbd>::tcom::server register Banking.tlb</kbd>
-</pre></td></tr></table>
-
-
- <h2>Implement Client</h2>
- <p>The <tt>client.tcl</tt> script implements a simple client.
- It gets a reference to an object that implements the bank interface, creates
- an account, and performs some operations on the account.</p>
- <table bgcolor="#CCCCCC" width="100%"><tr><td><pre class="listing">
-
-package require tcom
-
-set bank [::tcom::ref createobject "Banking.Bank"]
-set account [$bank CreateAccount]
-puts [$account Balance]
-$account Deposit 20
-puts [$account Balance]
-$account Withdraw 10
-puts [$account Balance]
-</pre></td></tr></table>
-
-
- <h2>Implement Objects In Plain Tcl</h2>
- <p>You can implement objects in plain Tcl. The servant command passed to
- the <span class="command">::tcom::object create</span> command can be the name of any
- object-style command. Similarly, the factory command passed to the
- <span class="command">::tcom::object registerfactory</span> command can return the
- name of any object-style command. The following Tcl script defines the
- procedures <tt>accountImpl</tt> and <tt>bankImpl</tt>,
- which have parameters in the style of a method name followed by any
- arguments.</p>
- <table bgcolor="#CCCCCC" width="100%"><tr><td><pre class="listing">
-
-package provide Banking 1.0
-
-package require tcom
-::tcom::import [file join [file dirname [info script]] Banking.tlb]
-
-proc accountImpl {method args} {
- global balance
-
- switch -- $method {
- _get_Balance {
- return $balance
- }
-
- Deposit {
- set amount [lindex $args 0]
- set balance [expr $balance + $amount]
- }
-
- Withdraw {
- set amount [lindex $args 0]
- set balance [expr $balance - $amount]
- }
-
- default {
- error "unknown method $method $args"
- }
- }
-}
-
-proc bankImpl {method args} {
- global balance
-
- switch -- $method {
- CreateAccount {
- set balance 0
- return [::tcom::object create ::Banking::Account accountImpl]
- }
-
- default {
- error "unknown method $method $args"
- }
- }
-}
-
-::tcom::object registerfactory ::Banking::Bank {list bankImpl}
-</pre></td></tr></table>
-
-</body>
-</html>
<?xml version="1.0"?>
-<!-- $Id: server.xml,v 1.23 2002/06/29 15:34:52 cthuang Exp $ -->
-<!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4.1.2//EN" "docbookx.dtd">
+<!-- $Id: server.xml 12 2005-04-14 14:01:20Z cthuang $ -->
+<!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd">
<article>
- <artheader>
- <date>$Date: 2002/06/29 15:34:52 $</date>
- <releaseinfo>$Revision: 1.23 $</releaseinfo>
- <title>COM Object Implementation in Tcl</title>
- </artheader>
+ <title>COM Object Implementation in Tcl</title>
+ <articleinfo>
+ <date>$Date: 2005-04-14 10:01:20 -0400 (Thu, 14 Apr 2005) $</date>
+ <releaseinfo>$Revision: 12 $</releaseinfo>
+ </articleinfo>
<sect1>
<title>Introduction</title>
<para>This article shows by example how to implement COM objects in
implement objects whose operations are invoked through the IDispatch
interface or the virtual function table.</para>
<programlisting>
-
import "oaidl.idl";
import "ocidl.idl";
<para>Run this command to generate a type library file
<literal>Banking.tlb</literal> from the MIDL specification.</para>
<screen>
-
<userinput>midl Banking.idl</userinput>
</screen>
</sect1>
<literal>auto_path</literal> variable. Create a
<literal>pkgIndex.tcl</literal> file in the package directory.</para>
<programlisting>
-
package ifneeded Banking 1.0 [list source [file join $dir server.itcl]]
</programlisting>
IBank and IAccount interfaces.</para>
<programlisting>
-
package provide Banking 1.0
package require Itcl
required by COM and the <command>tcom</command> server implementation.
</para>
<screen>
-
<userinput>package require tcom</userinput>
<userinput>::tcom::server register Banking.tlb</userinput>
</screen>
It gets a reference to an object that implements the bank interface, creates
an account, and performs some operations on the account.</para>
<programlisting>
-
package require tcom
set bank [::tcom::ref createobject "Banking.Bank"]
which have parameters in the style of a method name followed by any
arguments.</para>
<programlisting>
-
package provide Banking 1.0
package require tcom
+++ /dev/null
-<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"><html>
-<head>
-<META http-equiv="Content-Type" content="text/html; charset=UTF-8">
-<title>tcom</title>
-<style type="text/css">
- .command
- { font-style: normal; font-weight: bold; }
- .option
- { font-style: normal; font-weight: bold; }
- .parameter
- { font-style: italic; font-weight: normal; }
- </style>
-</head>
-<body>
-<h2>Name</h2>
-<p>tcom -- Access COM objects from Tcl</p>
-
-
-
- <h2>Synopsis</h2>
-
- <span class="command">package require tcom</span>
- <var>?<span class="option">3.9</span>?</var>
- <br>
- <span class="command">::tcom::ref</span>
- <span class="command">createobject</span>
- <var>?<span class="option">-inproc</span>?</var>
- <var>?<span class="option">-local</span>?</var>
- <var>?<span class="option">-remote</span>?</var>
- <var>?<span class="option">-clsid</span>?</var>
- <var>progID</var>
- <var>?hostName?</var>
- <br>
- <span class="command">::tcom::ref</span>
- <span class="command">getactiveobject</span>
- <var>?<span class="option">-clsid</span>?</var>
- <var>progID</var>
- <br>
- <span class="command">::tcom::ref</span>
- <span class="command">getobject</span>
- <var>pathName</var>
- <br>
- <span class="command">::tcom::ref</span>
- <span class="command">equal</span>
- <var>handle1</var>
- <var>handle2</var>
- <br>
- <var>handle</var>
- <var>?<span class="option">-method</span>?</var>
- <var>method</var>
- <var>?argument ...?</var>
- <br>
- <var>handle</var>
- <var><span class="option">-namedarg</span></var>
- <var>method</var>
- <var>?argumentName argumentValue ...?</var>
- <br>
- <var>handle</var>
- <var>?<span class="option">-get</span>?</var>
- <var>?<span class="option">-set</span>?</var>
- <var>property</var>
- <var>?index ...?</var>
- <var>?value?</var>
- <br>
- <span class="command">::tcom::foreach</span>
- <var>varname</var>
- <var>collectionHandle</var>
- <var>body</var>
- <br>
- <span class="command">::tcom::foreach</span>
- <var>varlist</var>
- <var>collectionHandle</var>
- <var>body</var>
- <br>
- <span class="command">::tcom::bind</span>
- <var>handle</var>
- <var>command</var>
- <var>?eventIID?</var>
- <br>
- <span class="command">::tcom::unbind</span>
- <var>handle</var>
- <br>
- <span class="command">::tcom::na</span>
- <br>
- <span class="command">::tcom::info interface</span>
- <var>handle</var>
- <br>
- <span class="command">::tcom::configure</span>
- <var>name</var>
- <var>?value?</var>
- <br>
- <span class="command">::tcom::import</span>
- <var>typeLibrary</var>
- <var>?namespace?</var>
- <br>
-
-
-
- <h2>Description</h2>
- <p>The <span class="command">tcom</span> package provides commands to access COM
- objects through IDispatch and IUnknown derived interfaces.</p>
-
-
- <h2>Commands</h2>
- <dl>
-
- <dt>
-
- <span class="command">::tcom::ref</span>
- <span class="command">createobject</span>
- <var>?<span class="option">-inproc</span>?</var>
- <var>?<span class="option">-local</span>?</var>
- <var>?<span class="option">-remote</span>?</var>
- <var>?<span class="option">-clsid</span>?</var>
- <var>progID</var>
- <var>?hostName?</var>
- <br>
- <span class="command">::tcom::ref</span>
- <span class="command">getactiveobject</span>
- <var>?<span class="option">-clsid</span>?</var>
- <var>progID</var>
-
- </dt>
- <dd>
- <p>These commands return a handle representing a reference to a COM
- object through an interface pointer. The handle can be used as a Tcl
- command to invoke operations on the object. In practice, you should store
- the handle in a Tcl variable or pass it as an argument to another command.
- </p>
- <p>References to COM objects are automatically released. If you store
- the handle in a local variable, the reference is released when execution
- leaves the variable's scope. If you store the handle in a global
- variable, you can release the reference by unsetting the variable, setting
- the variable to another value, or exiting the Tcl interpreter.</p>
- <p>The <span class="command">createobject</span> subcommand creates an instance
- of the object. The <span class="option">-inproc</span> option requests the object be
- created in the same process. The <span class="option">-local</span> option requests
- the object be created in another process on the local machine. The
- <span class="option">-remote</span> option requests the object be created on a remote
- machine. The <var>progID</var> parameter is the programmatic
- identifier of the object class. Use the <span class="option">-clsid</span> option if
- you want to specify the class using a class ID instead. The
- <var>hostName</var> parameter specifies the machine where you
- want to create the object instance.</p>
- <p>The <span class="command">getactiveobject</span> subcommand gets a reference
- to an already existing object.</p>
- </dd>
-
-
- <dt>
-
- <span class="command">::tcom::ref</span>
- <span class="command">getobject</span>
- <var>pathName</var>
-
- </dt>
- <dd>
- <p>This command returns a reference to a COM object from a file. The
- <var>pathName</var> parameter is the full path and name of the
- file containing the object.</p>
- </dd>
-
-
- <dt>
-
- <span class="command">::tcom::ref</span>
- <span class="command">equal</span>
- <var>handle1</var>
- <var>handle2</var>
-
- </dt>
- <dd>
- <p>This command compares the interface pointers represented by two
- handles for COM identity, returning 1 if the interface pointers refer to
- the same COM object, or 0 if not.</p>
- </dd>
-
-
- <dt>
-
- <var>handle</var>
- <var>?<span class="option">-method</span>?</var>
- <var>method</var>
- <var>?argument ...?</var>
-
- </dt>
- <dd>
- <p>This command invokes a method on the object represented by the
- <var>handle</var>. The return value of the method is returned
- as a Tcl value. A Tcl error will be raised if the method returns a
- failure HRESULT code. Parameters with the [in] attribute are passed by
- value. For each parameter with the [out] or [in, out] attributes, pass
- the name of a Tcl variable as the argument. After the method returns, the
- variables will contain the output values. In some cases where
- <span class="command">tcom</span> cannot get information about the object's
- interface, you may have to use the <span class="option">-method</span> option to
- specify you want to invoke a method.</p>
- </dd>
-
-
- <dt>
-
- <var>handle</var>
- <var><span class="option">-namedarg</span></var>
- <var>method</var>
- <var>?argumentName argumentValue ...?</var>
-
- </dt>
- <dd>
- <p>Use the <span class="option">-namedarg</span> option to invoke a method
- with named arguments. This only works with objects that implement
- IDispatch. You specify arguments by passing name and value pairs.</p>
- </dd>
-
-
- <dt>
-
- <var>handle</var>
- <var>?<span class="option">-get</span>?</var>
- <var>?<span class="option">-set</span>?</var>
- <var>property</var>
- <var>?index ...?</var>
- <var>?value?</var>
-
- </dt>
- <dd>
- <p>This command gets or sets a property of the object represented by
- the <var>handle</var>. If you supply a
- <var>value</var> argument, this command sets the named
- property to the value, otherwise it returns the property value. For
- indexed properties, you must specify one or more
- <var>index</var> values. The command raises a Tcl error if
- you specify an invalid property name or if you try to set a value that
- cannot be converted to the property's type. In some cases where
- <span class="command">tcom</span> cannot get information about the object's
- interface, you may have to use the <span class="option">-get</span> or
- <span class="option">-set</span> option to specify you want to get or set a property
- respectively.</p>
- </dd>
-
-
- <dt>
-
- <span class="command">::tcom::foreach</span>
- <var>varname</var>
- <var>collectionHandle</var>
- <var>body</var>
- <br>
- <span class="command">::tcom::foreach</span>
- <var>varlist</var>
- <var>collectionHandle</var>
- <var>body</var>
-
- </dt>
- <dd>
- <p>This command implements a loop where the loop variable(s) take on
- values from a collection object represented by
- <var>collectionHandle</var>. In the simplest case, there
- is one loop variable, <var>varname</var>. The
- <var>body</var> argument is a Tcl script. For each
- element of the collection, the command assigns the contents of the element
- to <var>varname</var>, then calls the Tcl interpreter to
- execute <var>body</var>.</p>
- <p>In the general case, there can be more than one loop variable.
- During each iteration of the loop, the variables of
- <var>varlist</var> are assigned consecutive elements from
- the collection. Each element is used exactly once. The total number of
- loop iterations is large enough to use up all the elements from the
- collection. On the last iteration, if the collection does not contain
- enough elements for each of the loop variables, empty values are used for
- the missing elements.</p>
- <p>The <span class="command">break</span> and <span class="command">continue</span>
- statements may be invoked inside <var>body</var>, with the
- same effect as in the <span class="command">for</span> command. The
- <span class="command">::tcom::foreach</span> command returns an empty string.</p>
- </dd>
-
-
- <dt>
-
- <span class="command">::tcom::bind</span>
- <var>handle</var>
- <var>command</var>
- <var>?eventIID?</var>
-
- </dt>
- <dd>
- <p>This command specifies a Tcl command that will be executed when
- events are received from an object. The <var>command</var>
- will be called with additional arguments: the event name and the event
- arguments. By default, the event interface is the default event source
- interface of the object's class. Use the <var>eventIID</var>
- parameter to specify the IID of another event interface. If an error
- occurs while executing the command then the bgerror mechanism is used to
- report the error.</p>
- </dd>
-
-
- <dt>
-
- <span class="command">::tcom::unbind</span>
- <var>handle</var>
-
- </dt>
- <dd>
- <p>This command tears down all event connections to the object that
- were set up by the <span class="command">::tcom::bind</span> command.</p>
- </dd>
-
-
- <dt>
-
- <span class="command">::tcom::na</span>
-
- </dt>
- <dd>
- <p>Objects that implement the IDispatch interface allow some method
- parameters to be optional. This command returns a token representing a
- missing optional argument. In practice, you would pass this token as a
- method argument in place of a missing optional argument.</p>
- </dd>
-
-
- <dt>
-
- <span class="command">::tcom::info interface</span>
- <var>handle</var>
-
- </dt>
- <dd>
- <p>This command returns a handle representing a description of the
- interface exposed by the object. The handle supports the following
- commands.</p>
- <dl>
-
- <dt>
-
- <var>interfaceHandle</var>
- <span class="command">iid</span>
-
- </dt>
- <dd>
- <p>This command returns an interface identifier code.</p>
- </dd>
-
-
- <dt>
-
- <var>interfaceHandle</var>
- <span class="command">methods</span>
-
- </dt>
- <dd>
- <p>This command returns a list of method descriptions for methods
- defined in the interface. Each method description is a list. The
- first element is the member ID. The second element is the return type.
- The third element is the method name. The fourth element is a list of
- parameter descriptions.</p>
- </dd>
-
-
- <dt>
-
- <var>interfaceHandle</var>
- <span class="command">name</span>
-
- </dt>
- <dd>
- <p>This command returns the interface's name.</p>
- </dd>
-
-
- <dt>
-
- <var>interfaceHandle</var>
- <span class="command">properties</span>
-
- </dt>
- <dd>
- <p>This command returns a list of property descriptions for
- properties defined in the interface. Each property description is a
- list. The first element is the member ID. The second element is the
- property read/write mode. The third element is the property data type.
- The fourth element is the property name. If the property is an indexed
- property, there is a fifth element which is a list of parameter
- descriptions.</p>
- </dd>
-
- </dl>
- </dd>
-
-
- <dt>
-
- <span class="command">::tcom::configure</span>
- <var>name</var>
- <var>?value?</var>
-
- </dt>
- <dd>
- <p>This command sets and retrieves options for the package. If
- <var>name</var> is supplied but no
- <var>value</var> then the command returns the current
- value of the given option. If one or more pairs of
- <var>name</var> and <var>value</var> are
- supplied, the command sets each of the named options to the corresponding
- value; in this case the return value is an empty string.</p>
- <dl>
-
- <dt>
-
- <var><span class="option">-concurrency</span></var>
- <var>?concurrencyModel?</var>
-
- </dt>
- <dd>
- <p>This option sets the concurrency model, which can be
- <span class="option">apartmentthreaded</span> or <span class="option">multithreaded</span>.
- The default is <span class="option">apartmentthreaded</span>. You must configure
- this option before performing any COM operations such as getting a
- reference to an object. After a COM operation has been done, changing
- this option has no effect.</p>
- </dd>
-
- </dl>
- </dd>
-
- </dl>
-
-
- <h2>Importing Type Library Information</h2>
-
- <span class="command">::tcom::import</span>
- <var>typeLibrary</var>
- <var>?namespace?</var>
-
- <p>Use the <span class="command">::tcom::import</span> command to convert type
- information from a type library into Tcl commands to access COM classes and
- interfaces. The <var>typeLibrary</var> argument specifies a
- type library file. By default, the commands are defined in a namespace named
- after the type library, but you may specify another namespace by supplying a
- <var>namespace</var> argument. This command returns the
- library name stored in the type library file.</p>
-
- <h3>Commands</h3>
- <dl>
-
- <dt>
-
- <var>class</var>
- <var>?<span class="option">-inproc</span>?</var>
- <var>?<span class="option">-local</span>?</var>
- <var>?<span class="option">-remote</span>?</var>
- <var>?hostName?</var>
-
- </dt>
- <dd>
- <p>For each class in the type library,
- <span class="command">::tcom::import</span> defines a Tcl command with the same
- name as the class. The class command creates an object of the class and
- returns a handle representing an interface pointer to the object. The
- command accepts an optional <var>hostName</var> argument
- to specify the machine where you want to create the object. You can use
- the returned handle to invoke methods and access properties of the
- object. In practice, you should store this handle in a Tcl variable or
- pass it as an argument to a Tcl command.</p>
- </dd>
-
-
- <dt>
-
- <var>interface</var>
- <var>handle</var>
-
- </dt>
- <dd>
- <p>For each interface in the type library,
- <span class="command">::tcom::import</span> defines a Tcl command with the same
- name as the interface. The interface command queries the object
- represented by <var>handle</var> for an interface pointer
- to that specific interface. The command returns a handle representing
- the interface pointer. You can use the returned handle to invoke methods
- and access properties of the object. In practice, you should store this
- handle in a Tcl variable or pass it as an argument to a Tcl
- command.</p>
- </dd>
-
- </dl>
-
-
- <h3>Enumerations</h3>
- <p>The <span class="command">::tcom::import</span> command generates a Tcl array
- for each enumeration defined in the type library. The array name is the
- enumeration name. To get an enumerator value, use an enumerator name as an
- index into the array.</p>
-
-
-
- <h2>Tcl Value to VARIANT Mapping</h2>
- <p>Each Tcl value has two representations. A Tcl value has a string
- representation and also has an internal representation that can be
- manipulated more efficiently. For example, a Tcl list is represented as an
- object that holds the list's string representation as well as an array of
- pointers to the objects for each list element. The two representations are a
- cache of each other and are computed lazily. That is, each representation is
- only computed when necessary, is computed from the other representation, and,
- once computed, is saved. In addition, a change in one representation
- invalidates the other one. As an example, a Tcl program doing integer
- calculations can operate directly on a variable's internal machine integer
- representation without having to constantly convert between integers and
- strings. Only when it needs a string representing the variable's value, say
- to print it, will the program regenerate the string representation from the
- integer. The internal representations built into Tcl include boolean,
- integer and floating point types.</p>
- <p>When invoking COM object methods, <span class="command">tcom</span> tries to
- convert each Tcl argument to the parameter type specified by the method
- interface. For example, if a method accepts an <tt>int</tt>
- parameter, <span class="command">tcom</span> tries to convert the argument to that
- type. If the parameter type is a VARIANT, the conversion has an extra
- complication because a VARIANT is designed to hold many different data types.
- One approach might be to simply copy the Tcl value's string representation
- to a string in the VARIANT, and hope the method's implementation can correctly
- interpret the string, but this doesn't work in general because some
- implementations expect certain VARIANT types.</p>
- <p><span class="command">Tcom</span> uses the Tcl value's internal representation
- type as a hint to choose the resulting VARIANT type.</p>
- <blockquote>
- <b>Tcl value to VARIANT mapping</b><br>
- <table border="1">
-
- <tr>
- <td><b>Tcl internal representation</b></td>
- <td><b>VARIANT type</b></td>
- </tr>
-
-
- <tr>
- <td>boolean</td>
- <td>VT_BOOL</td>
- </tr>
- <tr>
- <td>int</td>
- <td>VT_I4</td>
- </tr>
- <tr>
- <td>double</td>
- <td>VT_R8</td>
- </tr>
- <tr>
- <td>list</td>
- <td>one-dimensional array of VT_VARIANT</td>
- </tr>
- <tr>
- <td>bytearray</td>
- <td>one-dimensional array of VT_UI1</td>
- </tr>
- <tr>
- <td>other</td>
- <td>VT_BSTR</td>
- </tr>
-
- </table>
- </blockquote>
-
- <h3>Invoking Methods With VARIANT Parameters</h3>
- <p>The internal representation of a Tcl value may become significant when
- it is passed to a VARIANT parameter of a method. For example, the standard
- interface for COM collections defines the <span class="command">Item</span> method for
- getting an element by specifying an index. Many implementations of the
- method allow the index to be an integer value (usually based from 1) or a
- string key. If the index parameter is a VARIANT, you must account for the
- internal representation type of the Tcl argument passed to that
- parameter.</p>
- <table bgcolor="#CCCCCC" width="100%"><tr><td><pre>
-
-# Assume $collection is a handle to a collection.
-set element [$collection Item 1]
-</pre></td></tr></table>
- <p>This command passes a string consisting of the single character "1"
- to the Item method. The method may return an error because it can't find an
- element with that string key.</p>
-<table bgcolor="#CCCCCC" width="100%"><tr><td><pre>
-
-set numElements [$collection Count]
-for {set i 1} {$i <= $numElements} {incr i} { ;# 1
- set element [$collection Item $i] ;# 2
-}
-</pre></td></tr></table>
- <p>In line 1, the <span class="command">for</span> command sets the internal
- representation of <tt>$i</tt> to an int type as a side effect of
- evaluating the condition expression <tt>{$i <=
- $numElements}</tt>. The command in line 2 passes the integer value in
- <tt>$i</tt> to the Item method, which should succeed if the method
- can handle integer index values.</p>
-
-
-</body>
-</html>
<?xml version="1.0"?>
-<!-- $Id: tcom.n.xml,v 1.65 2002/10/22 22:07:55 cthuang Exp $ -->
-<!DOCTYPE refentry PUBLIC "-//OASIS//DTD DocBook XML V4.1.2//EN" "docbookx.dtd">
+<!-- $Id: tcom.n.xml 12 2005-04-14 14:01:20Z cthuang $ -->
+<!DOCTYPE refentry PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd">
<refentry id="tcom">
- <docinfo>
- <date>$Date: 2002/10/22 22:07:55 $</date>
- <releaseinfo>$Revision: 1.65 $</releaseinfo>
- </docinfo>
+ <refentryinfo>
+ <date>$Date: 2005-04-14 10:01:20 -0400 (Thu, 14 Apr 2005) $</date>
+ <releaseinfo>$Revision: 12 $</releaseinfo>
+ </refentryinfo>
<refmeta>
<refentrytitle>tcom</refentrytitle>
<manvolnum>n</manvolnum>
<refsynopsisdiv>
<cmdsynopsis>
<command>package require tcom</command>
- <arg><option>3.9</option></arg>
+ <arg>3.10</arg>
<sbr/>
- <command>::tcom::ref</command>
- <command>createobject</command>
- <arg><option>-inproc</option></arg>
- <arg><option>-local</option></arg>
- <arg><option>-remote</option></arg>
- <arg><option>-clsid</option></arg>
- <arg choice="plain">progID</arg>
- <arg>hostName</arg>
+ <command>::tcom::ref createobject</command>
+ <arg>-inproc</arg>
+ <arg>-local</arg>
+ <arg>-remote</arg>
+ <arg>-clsid</arg>
+ <arg choice="plain"><replaceable>progID</replaceable></arg>
+ <arg><replaceable>hostName</replaceable></arg>
<sbr/>
- <command>::tcom::ref</command>
- <command>getactiveobject</command>
- <arg><option>-clsid</option></arg>
- <arg choice="plain">progID</arg>
+ <command>::tcom::ref getactiveobject</command>
+ <arg>-clsid</arg>
+ <arg choice="plain"><replaceable>progID</replaceable></arg>
<sbr/>
- <command>::tcom::ref</command>
- <command>getobject</command>
- <arg choice="plain">pathName</arg>
+ <command>::tcom::ref getobject</command>
+ <arg choice="plain"><replaceable>pathName</replaceable></arg>
<sbr/>
- <command>::tcom::ref</command>
- <command>equal</command>
- <arg choice="plain">handle1</arg>
- <arg choice="plain">handle2</arg>
+ <command>::tcom::ref equal</command>
+ <arg choice="plain"><replaceable>handle1</replaceable></arg>
+ <arg choice="plain"><replaceable>handle2</replaceable></arg>
<sbr/>
- <arg choice="plain">handle</arg>
- <arg><option>-method</option></arg>
- <arg choice="plain">method</arg>
- <arg rep="repeat">argument</arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
+ <arg>-call</arg>
+ <arg choice="plain"><replaceable>method</replaceable></arg>
+ <arg rep="repeat"><replaceable>argument</replaceable></arg>
<sbr/>
- <arg choice="plain">handle</arg>
- <arg choice="plain"><option>-namedarg</option></arg>
- <arg choice="plain">method</arg>
- <arg rep="repeat">argumentName argumentValue</arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
+ <arg choice="plain">-namedarg</arg>
+ <arg choice="plain"><replaceable>method</replaceable></arg>
+ <arg rep="repeat"><replaceable>argumentName argumentValue</replaceable></arg>
<sbr/>
- <arg choice="plain">handle</arg>
- <arg><option>-get</option></arg>
- <arg><option>-set</option></arg>
- <arg choice="plain">property</arg>
- <arg rep="repeat">index</arg>
- <arg>value</arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
+ <arg>-get</arg>
+ <arg>-set</arg>
+ <arg choice="plain"><replaceable>property</replaceable></arg>
+ <arg rep="repeat"><replaceable>index</replaceable></arg>
+ <arg><replaceable>value</replaceable></arg>
<sbr/>
<command>::tcom::foreach</command>
- <arg choice="plain">varname</arg>
- <arg choice="plain">collectionHandle</arg>
- <arg choice="plain">body</arg>
+ <arg choice="plain"><replaceable>varname</replaceable></arg>
+ <arg choice="plain"><replaceable>collectionHandle</replaceable></arg>
+ <arg choice="plain"><replaceable>body</replaceable></arg>
<sbr/>
<command>::tcom::foreach</command>
- <arg choice="plain">varlist</arg>
- <arg choice="plain">collectionHandle</arg>
- <arg choice="plain">body</arg>
+ <arg choice="plain"><replaceable>varlist</replaceable></arg>
+ <arg choice="plain"><replaceable>collectionHandle</replaceable></arg>
+ <arg choice="plain"><replaceable>body</replaceable></arg>
<sbr/>
<command>::tcom::bind</command>
- <arg choice="plain">handle</arg>
- <arg choice="plain">command</arg>
- <arg>eventIID</arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
+ <arg choice="plain"><replaceable>command</replaceable></arg>
+ <arg><replaceable>eventIID</replaceable></arg>
<sbr/>
<command>::tcom::unbind</command>
- <arg choice="plain">handle</arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
<sbr/>
<command>::tcom::na</command>
<sbr/>
<command>::tcom::info interface</command>
- <arg choice="plain">handle</arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
<sbr/>
<command>::tcom::configure</command>
- <arg choice="plain">name</arg>
- <arg>value</arg>
+ <arg choice="plain"><replaceable>name</replaceable></arg>
+ <arg><replaceable>value</replaceable></arg>
<sbr/>
<command>::tcom::import</command>
- <arg choice="plain">typeLibrary</arg>
- <arg>namespace</arg>
+ <arg choice="plain"><replaceable>typeLibrary</replaceable></arg>
+ <arg><replaceable>namespace</replaceable></arg>
<sbr/>
</cmdsynopsis>
</refsynopsisdiv>
<varlistentry>
<term>
<cmdsynopsis id="ref_createobject">
- <command>::tcom::ref</command>
- <command>createobject</command>
- <arg><option>-inproc</option></arg>
- <arg><option>-local</option></arg>
- <arg><option>-remote</option></arg>
- <arg><option>-clsid</option></arg>
- <arg choice="plain">progID</arg>
- <arg>hostName</arg>
+ <command>::tcom::ref createobject</command>
+ <arg>-inproc</arg>
+ <arg>-local</arg>
+ <arg>-remote</arg>
+ <arg>-clsid</arg>
+ <arg choice="plain"><replaceable>progID</replaceable></arg>
+ <arg><replaceable>hostName</replaceable></arg>
<sbr/>
- <command>::tcom::ref</command>
- <command>getactiveobject</command>
- <arg><option>-clsid</option></arg>
- <arg choice="plain">progID</arg>
+ <command>::tcom::ref getactiveobject</command>
+ <arg>-clsid</arg>
+ <arg choice="plain"><replaceable>progID</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
<varlistentry>
<term>
<cmdsynopsis id="ref_getobject">
- <command>::tcom::ref</command>
- <command>getobject</command>
- <arg choice="plain">pathName</arg>
+ <command>::tcom::ref getobject</command>
+ <arg choice="plain"><replaceable>pathName</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
<varlistentry>
<term>
<cmdsynopsis id="ref_equal">
- <command>::tcom::ref</command>
- <command>equal</command>
- <arg choice="plain">handle1</arg>
- <arg choice="plain">handle2</arg>
+ <command>::tcom::ref equal</command>
+ <arg choice="plain"><replaceable>handle1</replaceable></arg>
+ <arg choice="plain"><replaceable>handle2</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
<varlistentry>
<term>
<cmdsynopsis id="handle_method">
- <arg choice="plain">handle</arg>
- <arg><option>-method</option></arg>
- <arg choice="plain">method</arg>
- <arg rep="repeat">argument</arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
+ <arg>-call</arg>
+ <arg choice="plain"><replaceable>method</replaceable></arg>
+ <arg rep="repeat"><replaceable>argument</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
the name of a Tcl variable as the argument. After the method returns, the
variables will contain the output values. In some cases where
<command>tcom</command> cannot get information about the object's
- interface, you may have to use the <option>-method</option> option to
+ interface, you may have to use the <option>-call</option> option to
specify you want to invoke a method.</para>
</listitem>
</varlistentry>
<varlistentry>
<term>
<cmdsynopsis id="namedarg">
- <arg choice="plain">handle</arg>
- <arg choice="plain"><option>-namedarg</option></arg>
- <arg choice="plain">method</arg>
- <arg rep="repeat">argumentName argumentValue</arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
+ <arg choice="plain">-namedarg</arg>
+ <arg choice="plain"><replaceable>method</replaceable></arg>
+ <arg rep="repeat">
+ <replaceable>argumentName argumentValue</replaceable>
+ </arg>
</cmdsynopsis>
</term>
<listitem>
<varlistentry>
<term>
<cmdsynopsis id="handle_property">
- <arg choice="plain">handle</arg>
- <arg><option>-get</option></arg>
- <arg><option>-set</option></arg>
- <arg choice="plain">property</arg>
- <arg rep="repeat">index</arg>
- <arg>value</arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
+ <arg>-get</arg>
+ <arg>-set</arg>
+ <arg choice="plain"><replaceable>property</replaceable></arg>
+ <arg rep="repeat"><replaceable>index</replaceable></arg>
+ <arg><replaceable>value</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
<term>
<cmdsynopsis id="foreach">
<command>::tcom::foreach</command>
- <arg choice="plain">varname</arg>
- <arg choice="plain">collectionHandle</arg>
- <arg choice="plain">body</arg>
+ <arg choice="plain"><replaceable>varname</replaceable></arg>
+ <arg choice="plain"><replaceable>collectionHandle</replaceable></arg>
+ <arg choice="plain"><replaceable>body</replaceable></arg>
<sbr/>
<command>::tcom::foreach</command>
- <arg choice="plain">varlist</arg>
- <arg choice="plain">collectionHandle</arg>
- <arg choice="plain">body</arg>
+ <arg choice="plain"><replaceable>varlist</replaceable></arg>
+ <arg choice="plain"><replaceable>collectionHandle</replaceable></arg>
+ <arg choice="plain"><replaceable>body</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
<term>
<cmdsynopsis id="bind">
<command>::tcom::bind</command>
- <arg choice="plain">handle</arg>
- <arg choice="plain">command</arg>
- <arg>eventIID</arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
+ <arg choice="plain"><replaceable>command</replaceable></arg>
+ <arg><replaceable>eventIID</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
<term>
<cmdsynopsis id="unbind">
<command>::tcom::unbind</command>
- <arg choice="plain">handle</arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
<term>
<cmdsynopsis id="info">
<command>::tcom::info interface</command>
- <arg choice="plain">handle</arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
<varlistentry>
<term>
<cmdsynopsis id="interface_iid">
- <arg choice="plain">interfaceHandle</arg>
+ <arg choice="plain"><replaceable>interfaceHandle</replaceable></arg>
<command>iid</command>
</cmdsynopsis>
</term>
<varlistentry>
<term>
<cmdsynopsis id="interface_methods">
- <arg choice="plain">interfaceHandle</arg>
+ <arg choice="plain"><replaceable>interfaceHandle</replaceable></arg>
<command>methods</command>
</cmdsynopsis>
</term>
<varlistentry>
<term>
<cmdsynopsis id="interface_name">
- <arg choice="plain">interfaceHandle</arg>
+ <arg choice="plain"><replaceable>interfaceHandle</replaceable></arg>
<command>name</command>
</cmdsynopsis>
</term>
<varlistentry>
<term>
<cmdsynopsis id="interface_properties">
- <arg choice="plain">interfaceHandle</arg>
+ <arg choice="plain"><replaceable>interfaceHandle</replaceable></arg>
<command>properties</command>
</cmdsynopsis>
</term>
<term>
<cmdsynopsis id="configure">
<command>::tcom::configure</command>
- <arg choice="plain">name</arg>
- <arg>value</arg>
+ <arg choice="plain"><replaceable>name</replaceable></arg>
+ <arg><replaceable>value</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
<varlistentry>
<term>
<cmdsynopsis id="configure_concurrency">
- <arg choice="plain"><option>-concurrency</option></arg>
- <arg>concurrencyModel</arg>
+ <arg choice="plain">-concurrency</arg>
+ <arg><replaceable>concurrencyModel</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
<title>Importing Type Library Information</title>
<cmdsynopsis id="import">
<command>::tcom::import</command>
- <arg choice="plain">typeLibrary</arg>
- <arg>namespace</arg>
+ <arg choice="plain"><replaceable>typeLibrary</replaceable></arg>
+ <arg><replaceable>namespace</replaceable></arg>
</cmdsynopsis>
<para>Use the <command>::tcom::import</command> command to convert type
information from a type library into Tcl commands to access COM classes and
<varlistentry>
<term>
<cmdsynopsis id="import_class">
- <arg choice="plain">class</arg>
- <arg><option>-inproc</option></arg>
- <arg><option>-local</option></arg>
- <arg><option>-remote</option></arg>
- <arg>hostName</arg>
+ <arg choice="plain"><replaceable>class</replaceable></arg>
+ <arg>-inproc</arg>
+ <arg>-local</arg>
+ <arg>-remote</arg>
+ <arg><replaceable>hostName</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
<varlistentry>
<term>
<cmdsynopsis id="import_interface">
- <arg choice="plain">interface</arg>
- <arg choice="plain">handle</arg>
+ <arg choice="plain"><replaceable>interface</replaceable></arg>
+ <arg choice="plain"><replaceable>handle</replaceable></arg>
</cmdsynopsis>
</term>
<listitem>
internal representation type of the Tcl argument passed to that
parameter.</para>
<programlisting>
-
# Assume $collection is a handle to a collection.
set element [$collection Item 1]
</programlisting>
to the Item method. The method may return an error because it can't find an
element with that string key.</para>
<programlisting>
-
set numElements [$collection Count]
for {set i 1} {$i <= $numElements} {incr i} { ;# 1
set element [$collection Item $i] ;# 2
-# $Id: xslt.tcl,v 1.2 2002/09/05 22:10:25 cthuang Exp $
+# $Id: xslt.tcl 7 2005-02-24 05:18:47Z cthuang $
#
# Run an XML document through an XSLT processor.
set domProgId "Msxml2.DOMDocument"
set source [::tcom::ref createobject $domProgId]
+$source async 0
$source preserveWhiteSpace 1
$source validateOnParse 0
$source resolveExternals 0
}
set xslt [::tcom::ref createobject $domProgId]
+$xslt async 0
$xslt preserveWhiteSpace 1
$xslt validateOnParse 0
set xsltUrl [lindex $argv 1]
}
regsub {<META http-equiv="Content-Type"[^>]*>} [$source transformNode $xslt] \
- {<META http-equiv="Content-Type" content="text/html; charset=UTF-8">} \
+ {<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">} \
resultHtml
set out [open [lindex $argv 2] "w"]
-# $Id: pkgIndex.tcl,v 1.3 2001/07/04 03:36:16 cthuang Exp $
+# $Id: pkgIndex.tcl 5 2005-02-16 14:57:24Z cthuang $
package ifneeded Banking 1.0 [list source [file join $dir server.tcl]]
-# $Id: server.itcl,v 1.7 2002/06/29 15:34:52 cthuang Exp $
+# $Id: server.itcl 5 2005-02-16 14:57:24Z cthuang $
package provide Banking 1.0
package require Itcl
-# $Id: server.tcl,v 1.4 2003/03/07 00:03:00 cthuang Exp $
+# $Id: server.tcl 5 2005-02-16 14:57:24Z cthuang $
package provide Banking 1.0
package require tcom
-# $Id: TclScript.itcl,v 1.6 2003/11/08 17:38:09 cthuang Exp $
+# $Id: TclScript.itcl 5 2005-02-16 14:57:24Z cthuang $
package require Itcl
namespace import itcl::*
-# $Id: pkgIndex.tcl,v 1.2 2002/03/30 18:49:10 cthuang Exp $
+# $Id: pkgIndex.tcl 5 2005-02-16 14:57:24Z cthuang $
package ifneeded TclScript 1.0 \
[list load [file join $dir TclScript.dll]]\n[list source [file join $dir TclScript.itcl]]
-# $Id: register.tcl,v 1.3 2002/03/20 23:52:35 cthuang Exp $
+# $Id: register.tcl 5 2005-02-16 14:57:24Z cthuang $
#
# This script registers the Tcl Active Scripting engine.
-# $Id: unregister.tcl,v 1.1 2003/03/20 00:12:14 cthuang Exp $
+# $Id: unregister.tcl 5 2005-02-16 14:57:24Z cthuang $
#
# This script unregisters the Tcl Active Scripting engine.
-# $Id: pkgIndex.tcl,v 1.16 2003/04/17 03:17:30 cthuang Exp $
+# $Id: pkgIndex.tcl 5 2005-02-16 14:57:24Z cthuang $
package ifneeded tcom 3.9 \
[list load [file join $dir tcom.dll]]\n[list source [file join $dir tcom.tcl]]
-# $Id: tcom.tcl,v 1.17 2003/04/02 22:46:51 cthuang Exp $
+# $Id: tcom.tcl 5 2005-02-16 14:57:24Z cthuang $
namespace eval ::tcom {
# Tear down all event connections to the object.
-// $Id: ActiveScriptError.cpp,v 1.1 2002/03/30 18:49:53 cthuang Exp $
+// $Id: ActiveScriptError.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "ActiveScriptError.h"
STDMETHODIMP
-// $Id: ActiveScriptError.h,v 1.2 2002/04/12 02:55:27 cthuang Exp $
+// $Id: ActiveScriptError.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef ACTIVESCRIPTERROR_H
#define ACTIVESCRIPTERROR_H
-// $Id: Arguments.cpp,v 1.35 2003/03/15 01:32:09 cthuang Exp $
+// $Id: Arguments.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "Arguments.h"
#include "Extension.h"
#include "TclObject.h"
// For out parameters, set a pointer to where the out value
// will be stored.
- if (vt == VT_INT) {
+ switch (vt) {
+ case VT_INT:
// IDispatch::Invoke returns DISP_E_TYPEMISMATCH on
// VT_INT | VT_BYREF parameters.
vt = VT_I4;
- } else if (vt == VT_USERDEFINED) {
+ break;
+
+ case VT_UINT:
+ // IDispatch::Invoke returns DISP_E_TYPEMISMATCH on
+ // VT_UINT | VT_BYREF parameters.
+ vt = VT_UI4;
+ break;
+
+ case VT_USERDEFINED:
// Assume user defined types derive from IUnknown.
vt = VT_UNKNOWN;
+ break;
}
if (vt == VT_SAFEARRAY) {
// If the argument is an interface pointer, increment its reference
// count because the _variant_t destructor will release it.
- value.toVariant(
+ value.toNativeValue(
&m_outValues[argIndex], parameter.type(), interp, true);
} else {
if (vt == VT_UNKNOWN) {
} else {
// If the argument is an interface pointer, increment its reference
// count because the _variant_t destructor will release it.
- argument.toVariant(&m_args[argIndex], parameter.type(), interp, true);
+ argument.toNativeValue(
+ &m_args[argIndex], parameter.type(), interp, true);
}
return TCL_OK;
}
if (method.vararg() && inputCount > 0) {
- m_args = new _variant_t[inputCount];
+ m_args = new NativeValue[inputCount];
// Convert the arguments actually provided.
int inputIndex = 0;
int argIndex = inputCount - 1;
for (; inputIndex < inputCount; ++inputIndex, --argIndex) {
TclObject value(objv[inputIndex]);
- value.toVariant(&m_args[argIndex], Type::variant(), interp, true);
+ value.toNativeValue(
+ &m_args[argIndex], Type::variant(), interp, true);
}
paramCount = inputCount;
} else if (paramCount > 0) {
- m_args = new _variant_t[paramCount];
- m_outValues = new _variant_t[paramCount];
+ m_args = new NativeValue[paramCount];
+ m_outValues = new NativeValue[paramCount];
int j = paramCount - 1;
Method::Parameters::const_iterator p = parameters.begin();
if (dispatchFlags == DISPATCH_PROPERTYPUT
|| dispatchFlags == DISPATCH_PROPERTYPUTREF) {
TclObject value = objv[i];
- value.toVariant(&m_args[j], method.type(), interp, true);
+ value.toNativeValue(&m_args[j], method.type(), interp, true);
}
}
int cArgs = objc / 2;
if (cArgs > 0) {
- m_args = new _variant_t[cArgs];
- m_outValues = new _variant_t[cArgs];
+ m_args = new NativeValue[cArgs];
+ m_outValues = new NativeValue[cArgs];
m_namedDispids = new DISPID[cArgs];
int j = cArgs - 1;
WORD dispatchFlags)
{
if (objc > 0) {
- m_args = new _variant_t[objc];
+ m_args = new NativeValue[objc];
int j = objc - 1;
for (int i = 0; i < objc; ++i, --j) {
// If the argument is an interface pointer, increment its reference
// count because the _variant_t destructor will release it.
- value.toVariant(&m_args[j], Type::variant(), interp, true);
+ value.toNativeValue(&m_args[j], Type::variant(), interp, true);
}
}
-// $Id: Arguments.h,v 1.8 2001/10/13 17:56:14 Administrator Exp $
+// $Id: Arguments.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef ARGUMENTS_H
#define ARGUMENTS_H
#include "TypeInfo.h"
+#include "NativeValue.h"
class Arguments
{
DISPPARAMS m_dispParams;
// argument values
- _variant_t *m_args;
+ NativeValue *m_args;
Arguments();
{
protected:
// used to hold values returned from out parameters
- _variant_t *m_outValues;
+ NativeValue *m_outValues;
TypedArguments();
-// $Id: ComModule.cpp,v 1.15 2002/05/31 04:03:06 cthuang Exp $
+// $Id: ComModule.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include "ComObjectFactory.h"
#include "ComModule.h"
-// $Id: ComModule.h,v 1.13 2002/04/13 03:53:56 cthuang Exp $
+// $Id: ComModule.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef COMMODULE_H
#define COMMODULE_H
-// $Id: ComObject.cpp,v 1.41 2003/04/04 23:55:04 cthuang Exp $
+// $Id: ComObject.cpp 13 2005-04-18 12:24:14Z cthuang $
#pragma warning(disable: 4786)
#include "ComObject.h"
#include <stdexcept>
#include "ComModule.h"
+#include "DispatchAdapter.h"
+#ifdef TCOM_VTBL_SERVER
#include "InterfaceAdapter.h"
+#endif
#include "Reference.h"
#include "Extension.h"
m_registeredActiveObject = true;
}
-InterfaceAdapter *
+void *
ComObject::implementInterface (const Interface &interfaceDesc)
{
- InterfaceAdapter *pAdapter = new InterfaceAdapter(*this, interfaceDesc);
+ void *pAdapter =
+#ifdef TCOM_VTBL_SERVER
+ new InterfaceAdapter(*this, interfaceDesc);
+#else
+ new DispatchAdapter(*this, interfaceDesc);
+#endif
+
m_iidToAdapterMap.insert(interfaceDesc.iid(), pAdapter);
return pAdapter;
}
if (IsEqualIID(iid, IID_IDispatch)) {
// Expose the operations of the default interface through IDispatch.
if (m_pDispatch == 0) {
- m_pDispatch = new InterfaceAdapter(*this, m_defaultInterface, true);
+ m_pDispatch = new DispatchAdapter(*this, m_defaultInterface);
}
*ppvObj = m_pDispatch;
addRef();
return S_OK;
}
- InterfaceAdapter *pAdapter = m_iidToAdapterMap.find(iid);
+ void *pAdapter = m_iidToAdapterMap.find(iid);
if (pAdapter == 0) {
const Interface *pInterface = m_supportedInterfaceMap.find(iid);
if (pInterface != 0) {
}
break;
+ case VT_SAFEARRAY:
+ if (*V_ARRAYREF(pDest) != 0) {
+ SafeArrayDestroy(*V_ARRAYREF(pDest));
+ }
+ *V_ARRAYREF(pDest) =
+ tclObject.getSafeArray(type.elementType(), interp);
+ break;
+
default:
*V_I4REF(pDest) = tclObject.getLong();
}
}
HRESULT
-ComObject::invoke (InterfaceAdapter *pAdapter,
- DISPID dispid,
+ComObject::invoke (const Method &method,
+ bool isProperty,
REFIID /*riid*/,
LCID /*lcid*/,
WORD wFlags,
EXCEPINFO *pExcepInfo,
UINT *pArgErr)
{
- // Get the method description for method being invoked.
- const Method *pMethod = pAdapter->findDispatchMethod(dispid);
- if (pMethod == 0) {
- return DISP_E_MEMBERNOTFOUND;
- }
HRESULT hresult;
// Get the method or property to invoke on the servant.
std::string operation;
- if ((wFlags & DISPATCH_PROPERTYGET) != 0
- && pAdapter->isProperty(dispid)) {
- operation = getPrefix + pMethod->name();
+ if ((wFlags & DISPATCH_PROPERTYGET) != 0 && isProperty) {
+ operation = getPrefix + method.name();
} else if (wFlags & (DISPATCH_PROPERTYPUT | DISPATCH_PROPERTYPUTREF)) {
- operation = setPrefix + pMethod->name();
+ operation = setPrefix + method.name();
} else if (wFlags & DISPATCH_METHOD) {
- operation = pMethod->name();
+ operation = method.name();
} else {
return DISP_E_MEMBERNOTFOUND;
// Convert arguments to Tcl values.
// TODO: Should handle named arguments differently than positional
// arguments.
- const Method::Parameters ¶meters = pMethod->parameters();
+ const Method::Parameters ¶meters = method.parameters();
int argIndex = pDispParams->cArgs - 1;
Method::Parameters::const_iterator pParam;
if (wFlags & (DISPATCH_PROPERTYPUT | DISPATCH_PROPERTYPUTREF)) {
VARIANT *pArg = &(pDispParams->rgvarg[argIndex]);
try {
- TclObject value(pArg, pMethod->type(), m_interp);
+ TclObject value(pArg, method.type(), m_interp);
script.lappend(value);
}
catch (_com_error &) {
argIndex = pDispParams->cArgs - 1;
for (pParam = parameters.begin(); pParam != parameters.end();
++pParam, --argIndex) {
- if (pParam->flags() & PARAMFLAG_FOUT) {
+ VARIANT *pArg = &(pDispParams->rgvarg[argIndex]);
+ if ((pParam->flags() & PARAMFLAG_FOUT) && (V_VT(pArg) & VT_BYREF)) {
// Get name of Tcl variable that holds out value.
TclObject varName = getOutVariableName(*pParam);
// Copy variable value to out argument.
TclObject value;
if (getVariable(varName, value) == TCL_OK) {
- putOutVariant(
- m_interp,
- &pDispParams->rgvarg[argIndex],
- value,
- pParam->type());
+ putOutVariant(m_interp, pArg, value, pParam->type());
}
}
}
// Convert return value.
- if (pReturnValue != 0 && pMethod->type().vartype() != VT_VOID) {
+ if (pReturnValue != 0 && method.type().vartype() != VT_VOID) {
// Must increment reference count of interface pointers returned
// from methods.
- result.toVariant(pReturnValue, pMethod->type(), m_interp, true);
+ result.toVariant(pReturnValue, method.type(), m_interp, true);
}
}
catch (_com_error &e) {
return hresult;
}
+#ifdef TCOM_VTBL_SERVER
+
// Convert the native value that the va_list points to into a Tcl object.
// Returns a va_list pointing to the next argument.
interp);
break;
+ case VT_SAFEARRAY:
+ tclObject = TclObject(
+ byRef ? *va_arg(pArg, SAFEARRAY **) : va_arg(pArg, SAFEARRAY *),
+ type,
+ interp);
+ break;
+
default:
tclObject = Tcl_NewLongObj(
byRef ? *va_arg(pArg, int *) : va_arg(pArg, int));
}
break;
+ case VT_SAFEARRAY:
+ *static_cast<SAFEARRAY **>(pDest) =
+ tclObject.getSafeArray(type.elementType(), interp);
+ break;
+
default:
*static_cast<int *>(pDest) = tclObject.getLong();
}
va_end(pArg);
}
+
+#endif
-// $Id: ComObject.h,v 1.15 2002/10/22 22:07:55 cthuang Exp $
+// $Id: ComObject.h 13 2005-04-18 12:24:14Z cthuang $
#ifndef COMOBJECT_H
#define COMOBJECT_H
SupportedInterfaceMap m_supportedInterfaceMap;
// collection of implemented interface adapters
- typedef HashTable<IID, InterfaceAdapter *> IidToAdapterMap;
+ typedef HashTable<IID, void *> IidToAdapterMap;
IidToAdapterMap m_iidToAdapterMap;
// implements default interface
- InterfaceAdapter *m_pDefaultAdapter;
+ void *m_pDefaultAdapter;
// implements ISupportErrorInfo
SupportErrorInfo m_supportErrorInfo;
// implements IDispatch
- InterfaceAdapter *m_pDispatch;
+ void *m_pDispatch;
// token returned from RegisterActiveObject
unsigned long m_activeObjectHandle;
void operator=(const ComObject &); // not implemented
// Create an adapter which implements the specified interface.
- InterfaceAdapter *implementInterface(const Interface &interfaceDesc);
+ void *implementInterface(const Interface &interfaceDesc);
// Convert IDispatch argument to Tcl value.
TclObject getArgument(VARIANT *pArg, const Parameter ¶m);
// IDispatch implementation
HRESULT invoke(
- InterfaceAdapter *pThis,
- DISPID dispidMember,
- REFIID riid,
+ const Method &method,
+ bool isProperty,
+ REFIID iid,
LCID lcid,
WORD wFlags,
- DISPPARAMS *pdispparams,
- VARIANT *pvarResult,
- EXCEPINFO *pexcepinfo,
- UINT *puArgErr);
+ DISPPARAMS *pDispParams,
+ VARIANT *pReturnValue,
+ EXCEPINFO *pExcepInfo,
+ UINT *pArgErr);
};
#endif
-// $Id: ComObjectFactory.cpp,v 1.17 2002/05/31 04:03:06 cthuang Exp $
+// $Id: ComObjectFactory.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include "ComModule.h"
#include "ComObject.h"
-// $Id: ComObjectFactory.h,v 1.11 2002/04/13 03:53:56 cthuang Exp $
+// $Id: ComObjectFactory.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef COMOBJECTFACTORY_H
#define COMOBJECTFACTORY_H
--- /dev/null
+// $Id: DispatchAdapter.cpp 14 2005-04-18 14:14:12Z cthuang $
+#pragma warning(disable: 4786)
+#include "DispatchAdapter.h"
+#include <stdexcept>
+#include "ComObject.h"
+#include "Reference.h"
+#include "Extension.h"
+
+// Implement IUnknown methods
+
+STDMETHODIMP
+DispatchAdapter::QueryInterface (REFIID iid, void **ppvObj)
+{
+ return m_dispatchImpl.object().queryInterface(iid, ppvObj);
+}
+
+STDMETHODIMP_(ULONG)
+DispatchAdapter::AddRef ()
+{
+ return m_dispatchImpl.object().addRef();
+}
+
+STDMETHODIMP_(ULONG)
+DispatchAdapter::Release ()
+{
+ return m_dispatchImpl.object().release();
+}
+
+// Implement IDispatch methods
+
+STDMETHODIMP
+DispatchAdapter::GetTypeInfoCount (UINT *pCount)
+{
+ *pCount = 1;
+ return S_OK;
+}
+
+STDMETHODIMP
+DispatchAdapter::GetTypeInfo (UINT index, LCID, ITypeInfo **ppTypeInfo)
+{
+ if (index != 0) {
+ *ppTypeInfo = 0;
+ return DISP_E_BADINDEX;
+ }
+
+ ITypeInfo *pTypeInfo = m_dispatchImpl.typeInfo();
+ pTypeInfo->AddRef();
+ *ppTypeInfo = pTypeInfo;
+ return S_OK;
+}
+
+STDMETHODIMP
+DispatchAdapter::GetIDsOfNames (
+ REFIID,
+ OLECHAR **rgszNames,
+ UINT cNames,
+ LCID,
+ DISPID *rgDispId)
+{
+ ITypeInfo *pTypeInfo = m_dispatchImpl.typeInfo();
+ return pTypeInfo->GetIDsOfNames(rgszNames, cNames, rgDispId);
+}
+
+STDMETHODIMP
+DispatchAdapter::Invoke (
+ DISPID dispid,
+ REFIID iid,
+ LCID lcid,
+ WORD wFlags,
+ DISPPARAMS *pDispParams,
+ VARIANT *pReturnValue,
+ EXCEPINFO *pExcepInfo,
+ UINT *pArgErr)
+{
+ return m_dispatchImpl.invoke(
+ dispid,
+ iid,
+ lcid,
+ wFlags,
+ pDispParams,
+ pReturnValue,
+ pExcepInfo,
+ pArgErr);
+}
--- /dev/null
+// $Id: DispatchAdapter.h 14 2005-04-18 14:14:12Z cthuang $
+#ifndef DISPATCHADAPTER_H
+#define DISPATCHADAPTER_H
+
+#include "tcomApi.h"
+#include "DispatchImpl.h"
+
+// This class implements an IDispatch interface and delegates the operations to
+// the ComObject class.
+
+class TCOM_API DispatchAdapter: public IDispatch
+{
+ // provides IDispatch implementation
+ DispatchImpl m_dispatchImpl;
+
+ // not implemented
+ DispatchAdapter(const DispatchAdapter &);
+ void operator=(const DispatchAdapter &);
+
+public:
+ DispatchAdapter (
+ ComObject &object,
+ const Interface &interfaceDesc):
+ m_dispatchImpl(object, interfaceDesc)
+ { }
+
+ // IUnknown functions
+ STDMETHODIMP QueryInterface(REFIID iid, void **ppvObj);
+ STDMETHODIMP_(ULONG) AddRef();
+ STDMETHODIMP_(ULONG) Release();
+
+ // IDispatch functions
+ STDMETHODIMP GetTypeInfoCount(UINT *pctinfo);
+ STDMETHODIMP GetTypeInfo(UINT itinfo, LCID lcid, ITypeInfo **pptinfo);
+ STDMETHODIMP GetIDsOfNames(
+ REFIID iid,
+ OLECHAR **rgszNames,
+ UINT cNames,
+ LCID lcid,
+ DISPID *rgdispid);
+ STDMETHODIMP Invoke(
+ DISPID dispidMember,
+ REFIID iid,
+ LCID lcid,
+ WORD flags,
+ DISPPARAMS *pParams,
+ VARIANT *pResult,
+ EXCEPINFO *pExcepInfo,
+ UINT *pArgErr);
+};
+
+#endif
--- /dev/null
+// $Id: DispatchImpl.cpp 14 2005-04-18 14:14:12Z cthuang $
+#pragma warning(disable: 4786)
+#include "DispatchImpl.h"
+#include <stdexcept>
+#include "ComObject.h"
+
+DispatchImpl::DispatchImpl (
+ ComObject &object,
+ const Interface &interfaceDesc):
+ m_object(object),
+ m_interface(interfaceDesc)
+{
+ // Initialize dispatch member ID to method description map.
+ const Interface::Methods &methods = m_interface.methods();
+ for (Interface::Methods::const_iterator pMethod = methods.begin();
+ pMethod != methods.end(); ++pMethod) {
+ m_dispIdToMethodMap.insert(DispIdToMethodMap::value_type(
+ pMethod->memberid(), &(*pMethod)));
+ }
+
+ // Initialize set of property dispatch member ID's.
+ const Interface::Properties &properties = m_interface.properties();
+ for (Interface::Properties::const_iterator pProp = properties.begin();
+ pProp != properties.end(); ++pProp) {
+ m_propertyDispIds.insert(pProp->memberid());
+ }
+}
+
+const Method *
+DispatchImpl::findDispatchMethod (DISPID dispid)
+{
+ DispIdToMethodMap::const_iterator p = m_dispIdToMethodMap.find(dispid);
+ if (p == m_dispIdToMethodMap.end()) {
+ return 0;
+ }
+ return p->second;
+}
+
+HRESULT
+DispatchImpl::invoke (
+ DISPID dispid,
+ REFIID iid,
+ LCID lcid,
+ WORD wFlags,
+ DISPPARAMS *pDispParams,
+ VARIANT *pReturnValue,
+ EXCEPINFO *pExcepInfo,
+ UINT *pArgErr)
+{
+ // Get the method description for method being invoked.
+ const Method *pMethod = findDispatchMethod(dispid);
+ if (pMethod == 0) {
+ return DISP_E_MEMBERNOTFOUND;
+ }
+
+ return m_object.invoke(
+ *pMethod,
+ isProperty(dispid),
+ iid,
+ lcid,
+ wFlags,
+ pDispParams,
+ pReturnValue,
+ pExcepInfo,
+ pArgErr);
+}
--- /dev/null
+// $Id: DispatchImpl.h 14 2005-04-18 14:14:12Z cthuang $
+#ifndef DISPATCHIMPL_H
+#define DISPATCHIMPL_H
+
+#include <map>
+#include <set>
+#include "tcomApi.h"
+#include "TypeInfo.h"
+
+class TCOM_API ComObject;
+
+// This class implements an IDispatch interface and delegates the operations to
+// the ComObject class.
+
+class TCOM_API DispatchImpl
+{
+ // delegate operations to this object
+ ComObject &m_object;
+
+ // description of the interface to implement
+ const Interface &m_interface;
+
+ // dispatch member ID to method description map
+ typedef std::map<DISPID, const Method *> DispIdToMethodMap;
+ DispIdToMethodMap m_dispIdToMethodMap;
+
+ // dispatch member ID's which are actually properties
+ typedef std::set<DISPID> DispIdSet;
+ DispIdSet m_propertyDispIds;
+
+ // not implemented
+ DispatchImpl(const DispatchImpl &);
+ void operator=(const DispatchImpl &);
+
+ // Get dispatch method description.
+ const Method *findDispatchMethod(DISPID dispid);
+
+ // Return true if the dispatch member ID identifies a property.
+ bool isProperty (DISPID dispid) const
+ { return m_propertyDispIds.count(dispid) != 0; }
+
+public:
+ DispatchImpl(
+ ComObject &object,
+ const Interface &interfaceDesc);
+
+ // Get object for delegating operations.
+ ComObject &object () const
+ { return m_object; }
+
+ // Get ITypeInfo for the interface that is implemented.
+ ITypeInfo *typeInfo () const
+ { return m_interface.typeInfo(); }
+
+ // Implement IDispatch::Invoke function.
+ HRESULT invoke(
+ DISPID dispidMember,
+ REFIID iid,
+ LCID lcid,
+ WORD flags,
+ DISPPARAMS *pParams,
+ VARIANT *pResult,
+ EXCEPINFO *pExcepInfo,
+ UINT *pArgErr);
+};
+
+#endif
-// $Id: Extension.cpp,v 1.3 2003/04/02 22:46:51 cthuang Exp $
+// $Id: Extension.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include "Extension.h"
#include "ComModule.h"
-// $Id: Extension.h,v 1.5 2003/04/02 22:46:51 cthuang Exp $
+// $Id: Extension.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef EXTENSION_H
#define EXTENSION_H
-// $Id: HandleSupport.cpp,v 1.19 2003/07/17 22:33:31 cthuang Exp $
+// $Id: HandleSupport.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "HandleSupport.h"
#include <sstream>
#include "ThreadLocalStorage.h"
-// $Id: HandleSupport.h,v 1.29 2003/07/17 22:33:31 cthuang Exp $
+// $Id: HandleSupport.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef HANDLESUPPORT_H
#define HANDLESUPPORT_H
-// $Id: HashTable.h,v 1.22 2003/07/17 22:33:31 cthuang Exp $
+// $Id: HashTable.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef HASHTABLE_H
#define HASHTABLE_H
-// $Id: InterfaceAdapter.cpp,v 1.3 2002/02/27 01:58:45 cthuang Exp $
+// $Id: InterfaceAdapter.cpp 16 2005-04-19 14:47:52Z cthuang $
+#ifdef TCOM_VTBL_SERVER
+
#pragma warning(disable: 4786)
-#include "ComObject.h"
#include "InterfaceAdapter.h"
+#include "ComObject.h"
InterfaceAdapter::InterfaceAdapter (
ComObject &object,
const Interface &interfaceDesc,
bool forceDispatch):
- m_object(object),
- m_interface(interfaceDesc)
+ m_dispatchImpl(object, interfaceDesc)
{
// Initialize virtual function index to method description map.
- const Interface::Methods &methods = m_interface.methods();
+ const Interface::Methods &methods = interfaceDesc.methods();
for (Interface::Methods::const_iterator p = methods.begin();
p != methods.end(); ++p) {
m_vtblIndexToMethodMap.insert(VtblIndexToMethodMap::value_type(
p->vtblIndex(), &(*p)));
}
- if (m_interface.dispatchable() || forceDispatch) {
- m_pVtbl = dispatchVtbl;
-
- // Initialize dispatch member ID to method description map.
- const Interface::Methods &methods = m_interface.methods();
- for (Interface::Methods::const_iterator pMethod = methods.begin();
- pMethod != methods.end(); ++pMethod) {
- m_dispIdToMethodMap.insert(DispIdToMethodMap::value_type(
- pMethod->memberid(), &(*pMethod)));
- }
-
- // Initialize set of property dispatch member ID's.
- const Interface::Properties &properties = m_interface.properties();
- for (Interface::Properties::const_iterator pProp = properties.begin();
- pProp != properties.end(); ++pProp) {
- m_propertyDispIds.insert(pProp->memberid());
- }
-
+ if (interfaceDesc.dispatchable() || forceDispatch) {
+ m_pVtbl = dualVtbl;
} else {
- m_pVtbl = unknownVtbl;
+ m_pVtbl = customVtbl;
}
}
return p->second;
}
-const Method *
-InterfaceAdapter::findDispatchMethod (DISPID dispid)
-{
- DispIdToMethodMap::const_iterator p = m_dispIdToMethodMap.find(dispid);
- if (p == m_dispIdToMethodMap.end()) {
- return 0;
- }
- return p->second;
-}
-
// Implement IUnknown methods
STDMETHODIMP
InterfaceAdapter::QueryInterface (
InterfaceAdapter *pThis, REFIID iid, void **ppvObj)
{
- return pThis->m_object.queryInterface(iid, ppvObj);
+ return pThis->m_dispatchImpl.object().queryInterface(iid, ppvObj);
}
STDMETHODIMP_(ULONG)
InterfaceAdapter::AddRef (InterfaceAdapter *pThis)
{
- return pThis->m_object.addRef();
+ return pThis->m_dispatchImpl.object().addRef();
}
STDMETHODIMP_(ULONG)
InterfaceAdapter::Release (InterfaceAdapter *pThis)
{
- return pThis->m_object.release();
+ return pThis->m_dispatchImpl.object().release();
}
// Implement IDispatch methods
return DISP_E_BADINDEX;
}
- ITypeInfo *pTypeInfo = pThis->m_interface.typeInfo();
+ ITypeInfo *pTypeInfo = pThis->m_dispatchImpl.typeInfo();
pTypeInfo->AddRef();
*ppTypeInfo = pTypeInfo;
return S_OK;
LCID,
DISPID *rgDispId)
{
- ITypeInfo *pTypeInfo = pThis->m_interface.typeInfo();
+ ITypeInfo *pTypeInfo = pThis->m_dispatchImpl.typeInfo();
return pTypeInfo->GetIDsOfNames(rgszNames, cNames, rgDispId);
}
EXCEPINFO *pExcepInfo,
UINT *pArgErr)
{
- return pThis->m_object.invoke(
- pThis,
+ return pThis->m_dispatchImpl.invoke(
dispid,
iid,
lcid,
pExcepInfo,
pArgErr);
}
+
+#endif
-// $Id: InterfaceAdapter.h,v 1.3 2002/02/27 01:58:45 cthuang Exp $
+// $Id: InterfaceAdapter.h 16 2005-04-19 14:47:52Z cthuang $
#ifndef INTERFACEADAPTER_H
#define INTERFACEADAPTER_H
#include <map>
#include <set>
#include "tcomApi.h"
-#include "TypeInfo.h"
+#include "DispatchImpl.h"
class TCOM_API ComObject;
const void *m_pVtbl;
// delegate operations to this object
- ComObject &m_object;
-
- // description of the interface to implement
- const Interface &m_interface;
+ DispatchImpl m_dispatchImpl;
// virtual function index to method description map
typedef std::map<short, const Method *> VtblIndexToMethodMap;
VtblIndexToMethodMap m_vtblIndexToMethodMap;
- // dispatch member ID to method description map
- typedef std::map<DISPID, const Method *> DispIdToMethodMap;
- DispIdToMethodMap m_dispIdToMethodMap;
-
- // dispatch member ID's which are actually properties
- typedef std::set<DISPID> DispIdSet;
- DispIdSet m_propertyDispIds;
-
- // virtual function table for IUnknown derived interfaces
- static const void *unknownVtbl[];
+ // virtual function table for custom (IUnknown derived) interfaces
+ static const void *customVtbl[];
- // virtual function table for IDispatch derived interfaces
- static const void *dispatchVtbl[];
+ // virtual function table for dual (IDispatch derived) interfaces
+ static const void *dualVtbl[];
- InterfaceAdapter(const InterfaceAdapter &); // not implemented
- void operator=(const InterfaceAdapter &); // not implemented
+ // not implemented
+ InterfaceAdapter(const InterfaceAdapter &);
+ void operator=(const InterfaceAdapter &);
public:
InterfaceAdapter(
// Get delegate object.
ComObject &object () const
- { return m_object; }
+ { return m_dispatchImpl.object(); }
// Get COM method description.
const Method *findComMethod(int funcIndex);
- // Get dispatch method description.
- const Method *findDispatchMethod(DISPID dispid);
-
- // Return true if the dispatch member ID identifies a property.
- bool isProperty (DISPID dispid) const
- { return m_propertyDispIds.count(dispid) != 0; }
-
// IUnknown implementation
static STDMETHODIMP QueryInterface(
InterfaceAdapter *pThis, REFIID iid, void **ppvObj);
-// $Id: InterfaceAdapterVtbl.cpp,v 1.3 2001/10/13 17:56:14 Administrator Exp $
+// $Id: InterfaceAdapterVtbl.cpp 16 2005-04-19 14:47:52Z cthuang $
+#ifdef TCOM_VTBL_SERVER
+
#pragma warning(disable: 4786)
#include "InterfaceAdapter.h"
#include "ComObject.h"
FUNCTION_ENTRY_POINT(1022)
FUNCTION_ENTRY_POINT(1023)
-const void *InterfaceAdapter::unknownVtbl[] = {
+const void *InterfaceAdapter::customVtbl[] = {
InterfaceAdapter::QueryInterface,
InterfaceAdapter::AddRef,
InterfaceAdapter::Release,
function_1023
};
-const void *InterfaceAdapter::dispatchVtbl[] = {
+const void *InterfaceAdapter::dualVtbl[] = {
InterfaceAdapter::QueryInterface,
InterfaceAdapter::AddRef,
InterfaceAdapter::Release,
function_1022,
function_1023
};
+
+#endif
-# $Id: Makefile,v 1.12 2003/07/24 22:46:35 cthuang Exp $
+# $Id: Makefile 5 2005-02-16 14:57:24Z cthuang $
debug:
tclsh &&|
--- /dev/null
+// $Id: NativeValue.cpp 5 2005-02-16 14:57:24Z cthuang $
+#include "NativeValue.h"
+
+void
+NativeValue::fixInvalidVariantType ()
+{
+ if (vt == VT_I8 || vt == VT_UI8) {
+ // 64-bit integers are not valid VARIANT types. Change the VARIANT
+ // type to something valid so VariantClear does not return an error.
+ vt = VT_EMPTY;
+ }
+}
--- /dev/null
+// $Id: NativeValue.h 5 2005-02-16 14:57:24Z cthuang $
+#ifndef NATIVEVALUE_H
+#define NATIVEVALUE_H
+
+#include <comdef.h>
+
+// This is a value in the native machine format.
+
+class NativeValue: public _variant_t
+{
+public:
+ NativeValue ()
+ { }
+
+ ~NativeValue ()
+ { fixInvalidVariantType(); }
+
+ NativeValue &operator= (const _variant_t &rhs)
+ { _variant_t::operator=(rhs); return *this; }
+
+ // Change the variant type if it is invalid.
+ void fixInvalidVariantType();
+};
+
+#endif
-// $Id: Reference.cpp,v 1.73 2003/11/06 15:29:01 cthuang Exp $
+// $Id: Reference.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include <string.h>
#include "ComObject.h"
if (hr == DISP_E_EXCEPTION) {
throwDispatchException(excepInfo);
+ } else if (hr == DISP_E_TYPEMISMATCH || hr == DISP_E_PARAMNOTFOUND) {
+ throw InvokeException(hr, pParams->cArgs - argErr);
}
return hr;
if (hr == DISP_E_EXCEPTION) {
throwDispatchException(excepInfo);
+ } else if (hr == DISP_E_TYPEMISMATCH || hr == DISP_E_PARAMNOTFOUND) {
+ throw InvokeException(hr, arguments.dispParams()->cArgs - argErr);
}
}
-// $Id: Reference.h,v 1.42 2003/11/06 15:29:01 cthuang Exp $
+// $Id: Reference.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef REFERENCE_H
#define REFERENCE_H
{ return m_description; }
};
+// Throw this exception when invoke returns error about an argument.
+
+class InvokeException
+{
+ HRESULT m_hresult;
+ unsigned m_argIndex;
+
+public:
+ InvokeException (HRESULT hresult, unsigned argIndex):
+ m_hresult(hresult),
+ m_argIndex(argIndex)
+ { }
+
+ HRESULT hresult () const
+ { return m_hresult; }
+
+ unsigned argIndex () const
+ { return m_argIndex; }
+};
+
// This class holds an interface pointer and the interface description needed
// to invoke methods on it.
-// $Id: RegistryKey.cpp,v 1.6 2001/11/28 16:10:57 cthuang Exp $
+// $Id: RegistryKey.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "RegistryKey.h"
void
-// $Id: RegistryKey.h,v 1.5 2001/11/28 16:10:57 cthuang Exp $
+// $Id: RegistryKey.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef REGISTRYKEY_H
#define REGISTRYKEY_H
-// $Id: Singleton.h,v 1.9 2002/04/13 03:53:56 cthuang Exp $
+// $Id: Singleton.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef SINGLETON_H
#define SINGLETON_H
-// $Id: SupportErrorInfo.cpp,v 1.3 2001/07/17 02:24:08 cthuang Exp $
+// $Id: SupportErrorInfo.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "ComObject.h"
#include "SupportErrorInfo.h"
-// $Id: SupportErrorInfo.h,v 1.3 2001/07/17 02:24:08 cthuang Exp $
+// $Id: SupportErrorInfo.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef SUPPORTERRORINFO_H
#define SUPPORTERRORINFO_H
-// $Id: TclInterp.cpp,v 1.12 2002/04/13 03:53:56 cthuang Exp $
+// $Id: TclInterp.cpp 5 2005-02-16 14:57:24Z cthuang $
#include <sstream>
#include "RegistryKey.h"
#include "TclObject.h"
-// $Id: TclInterp.h,v 1.8 2002/04/13 03:53:56 cthuang Exp $
+// $Id: TclInterp.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef TCLINTERP_H
#define TCLINTERP_H
-// $Id: TclModule.cpp,v 1.5 2002/04/13 03:53:56 cthuang Exp $
+// $Id: TclModule.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include "TclObject.h"
#include "TclModule.h"
-// $Id: TclModule.h,v 1.4 2002/04/13 03:53:56 cthuang Exp $
+// $Id: TclModule.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef TCLMODULE_H
#define TCLMODULE_H
-// $Id: TclObject.cpp,v 1.35 2003/05/12 23:30:43 cthuang Exp $
+// $Id: TclObject.cpp 18 2005-05-03 00:40:40Z cthuang $
#include "TclObject.h"
#include <vector>
#ifdef WIN32
static Tcl_Obj *
convertFromSafeArray (
SAFEARRAY *psa,
- VARTYPE vt,
+ VARTYPE elementType,
unsigned dim,
long *pIndices,
const Type &type,
pResult = Tcl_NewListObj(0, 0);
for (long i = lowerBound; i <= upperBound; ++i) {
pIndices[dim - 1] = i;
- Tcl_Obj *pElement =
- convertFromSafeArray(psa, vt, dim + 1, pIndices, type, interp);
+ Tcl_Obj *pElement = convertFromSafeArray(
+ psa, elementType, dim + 1, pIndices, type, interp);
Tcl_ListObjAppendElement(interp, pResult, pElement);
}
return pResult;
}
- if (vt == VT_UI1 && SafeArrayGetDim(psa) == 1) {
+ if (elementType == VT_UI1 && SafeArrayGetDim(psa) == 1) {
unsigned char *pData;
hr = SafeArrayAccessData(psa, reinterpret_cast<void **>(&pData));
if (FAILED(hr)) {
// Create list of Tcl values.
pResult = Tcl_NewListObj(0, 0);
for (long i = lowerBound; i <= upperBound; ++i) {
- _variant_t elementVar;
+ NativeValue elementVar;
pIndices[dim - 1] = i;
- if (vt == VT_VARIANT) {
+ if (elementType == VT_VARIANT) {
hr = SafeArrayGetElement(psa, pIndices, &elementVar);
} else {
// I hope the element can be contained in a VARIANT.
- V_VT(&elementVar) = vt;
+ V_VT(&elementVar) = elementType;
hr = SafeArrayGetElement(psa, pIndices, &elementVar.punkVal);
}
if (FAILED(hr)) {
} else {
for (int i = 0; i < numElements; ++i) {
TclObject element(pElements[i]);
- _variant_t elementVar;
- element.toVariant(&elementVar, Type::variant(), interp, addRef);
+ NativeValue elementVar;
+ element.toNativeValue(&elementVar, Type::variant(), interp, addRef);
pIndices[dim1] = i;
hr = SafeArrayPutElement(psa, pIndices, &elementVar);
}
}
+static Tcl_Obj *
+convertFromUnknown (IUnknown *pUnknown, REFIID iid, Tcl_Interp *interp)
+{
+ if (pUnknown == 0) {
+ return Tcl_NewObj();
+ }
+
+ const Interface *pInterface = InterfaceManager::instance().find(iid);
+ return Extension::referenceHandles.newObj(
+ interp,
+ Reference::newReference(pUnknown, pInterface));
+}
+
TclObject::TclObject (VARIANT *pSrc, const Type &type, Tcl_Interp *interp)
{
- if (V_VT(pSrc) & VT_ARRAY) {
- SAFEARRAY *psa = V_ARRAY(pSrc);
- VARTYPE vt = V_VT(pSrc) & VT_TYPEMASK;
+ if (V_ISARRAY(pSrc)) {
+ SAFEARRAY *psa = V_ISBYREF(pSrc) ? *V_ARRAYREF(pSrc) : V_ARRAY(pSrc);
+ VARTYPE elementType = V_VT(pSrc) & VT_TYPEMASK;
unsigned numDimensions = SafeArrayGetDim(psa);
std::vector<long> indices(numDimensions);
m_pObj = convertFromSafeArray(
- psa, vt, 1, &indices[0], type, interp);
+ psa, elementType, 1, &indices[0], type, interp);
} else if (vtMissing == pSrc) {
m_pObj = Extension::newNaObj();
m_pObj = Tcl_NewBooleanObj(V_BOOL(pSrc));
break;
+ case VT_ERROR:
+ m_pObj = Tcl_NewLongObj(V_ERROR(pSrc));
+ break;
+
case VT_I1:
case VT_UI1:
m_pObj = Tcl_NewLongObj(V_I1(pSrc));
m_pObj = Tcl_NewLongObj(V_I4(pSrc));
break;
+#ifdef V_I8
+ case VT_I8:
+ case VT_UI8:
+ m_pObj = Tcl_NewWideIntObj(V_I8(pSrc));
+ break;
+#endif
+
case VT_R4:
m_pObj = Tcl_NewDoubleObj(V_R4(pSrc));
break;
break;
case VT_DISPATCH:
- if (V_DISPATCH(pSrc) == 0) {
- m_pObj = Tcl_NewObj();
- } else {
- const Interface *pInterface =
- InterfaceManager::instance().find(type.iid());
- m_pObj = Extension::referenceHandles.newObj(
- interp,
- Reference::newReference(V_DISPATCH(pSrc), pInterface));
- }
+ m_pObj = convertFromUnknown(V_DISPATCH(pSrc), type.iid(), interp);
+ break;
+
+ case VT_DISPATCH | VT_BYREF:
+ m_pObj = convertFromUnknown(
+ (V_DISPATCHREF(pSrc) != 0) ? *V_DISPATCHREF(pSrc) : 0,
+ type.iid(),
+ interp);
break;
case VT_UNKNOWN:
- if (V_UNKNOWN(pSrc) == 0) {
- m_pObj = Tcl_NewObj();
- } else {
- const Interface *pInterface =
- InterfaceManager::instance().find(type.iid());
- m_pObj = Extension::referenceHandles.newObj(
- interp,
- Reference::newReference(V_UNKNOWN(pSrc), pInterface));
- }
+ m_pObj = convertFromUnknown(V_UNKNOWN(pSrc), type.iid(), interp);
+ break;
+
+ case VT_UNKNOWN | VT_BYREF:
+ m_pObj = convertFromUnknown(
+ (V_UNKNOWNREF(pSrc) != 0) ? *V_UNKNOWNREF(pSrc) : 0,
+ type.iid(),
+ interp);
break;
case VT_NULL:
m_pObj = Tcl_NewStringObj(
const_cast<char *>(uuid.toString().c_str()), -1);
} else {
+ if (V_VT(pSrc) == (VT_VARIANT | VT_BYREF)) {
+ pSrc = V_VARIANTREF(pSrc);
+ }
+
_bstr_t str(pSrc);
#if TCL_MINOR_VERSION >= 2
// Uses Unicode function introduced in Tcl 8.2.
Tcl_IncrRefCount(m_pObj);
}
+TclObject::TclObject (const _bstr_t &src)
+{
+ if (src.length() > 0) {
+#if TCL_MINOR_VERSION >= 2
+ // Uses Unicode functions introduced in Tcl 8.2.
+ m_pObj = Tcl_NewUnicodeObj(src, -1);
+#else
+ m_pObj = Tcl_NewStringObj(src, -1);
+#endif
+ } else {
+ m_pObj = Tcl_NewObj();
+ }
+
+ Tcl_IncrRefCount(m_pObj);
+}
+
+TclObject::TclObject (
+ SAFEARRAY *psa, const Type &type, Tcl_Interp *interp)
+{
+ unsigned numDimensions = SafeArrayGetDim(psa);
+ std::vector<long> indices(numDimensions);
+ m_pObj = convertFromSafeArray(
+ psa, type.elementType().vartype(), 1, &indices[0], type, interp);
+
+ Tcl_IncrRefCount(m_pObj);
+}
+
BSTR
TclObject::getBSTR () const
{
}
#endif
+SAFEARRAY *
+TclObject::getSafeArray (const Type &elementType, Tcl_Interp *interp) const
+{
+ SAFEARRAY *psa;
+
+ if (elementType.vartype() == VT_UI1) {
+ psa = newByteSafeArray(m_pObj);
+ } else {
+ // Convert Tcl list to SAFEARRAY.
+ int numElements;
+ Tcl_Obj **pElements;
+ if (Tcl_ListObjGetElements(interp, m_pObj, &numElements, &pElements)
+ != TCL_OK) {
+ _com_issue_error(E_INVALIDARG);
+ }
+
+ psa = SafeArrayCreateVector(elementType.vartype(), 0, numElements);
+ if (psa == 0) {
+ _com_issue_error(E_OUTOFMEMORY);
+ }
+
+ void *pData;
+ HRESULT hr;
+ hr = SafeArrayAccessData(psa, &pData);
+ if (FAILED(hr)) {
+ _com_issue_error(hr);
+ }
+
+ for (int i = 0; i < numElements; ++i) {
+ TclObject value(pElements[i]);
+
+ switch (elementType.vartype()) {
+ case VT_BOOL:
+ static_cast<VARIANT_BOOL *>(pData)[i] =
+ value.getBool() ? VARIANT_TRUE : VARIANT_FALSE;
+ break;
+
+ case VT_I2:
+ case VT_UI2:
+ static_cast<short *>(pData)[i] = value.getLong();
+ break;
+
+ case VT_R4:
+ static_cast<float *>(pData)[i] =
+ static_cast<float>(value.getDouble());
+ break;
+
+ case VT_R8:
+ static_cast<double *>(pData)[i] = value.getDouble();
+ break;
+
+ case VT_BSTR:
+ static_cast<BSTR *>(pData)[i] = value.getBSTR();
+ break;
+
+ case VT_VARIANT:
+ {
+ VARIANT *pDest = static_cast<VARIANT *>(pData) + i;
+ VariantInit(pDest);
+ value.toVariant(pDest, elementType, interp);
+ }
+ break;
+
+ default:
+ static_cast<int *>(pData)[i] = value.getLong();
+ }
+ }
+
+ hr = SafeArrayUnaccessData(psa);
+ if (FAILED(hr)) {
+ _com_issue_error(hr);
+ }
+ }
+
+ return psa;
+}
+
void
TclObject::toVariant (VARIANT *pDest,
const Type &type,
V_UNKNOWN(pDest) = pUnknown;
} else if (vt == VT_SAFEARRAY) {
- SAFEARRAY *psa;
- const Type &elementType = type.elementType();
-
- if (elementType.vartype() == VT_UI1) {
- psa = newByteSafeArray(m_pObj);
- } else {
- // Convert Tcl list to SAFEARRAY.
- int numElements;
- Tcl_Obj **pElements;
- if (Tcl_ListObjGetElements(interp, m_pObj, &numElements, &pElements)
- != TCL_OK) {
- _com_issue_error(E_INVALIDARG);
- }
-
- psa = SafeArrayCreateVector(elementType.vartype(), 0, numElements);
- if (psa == 0) {
- _com_issue_error(E_OUTOFMEMORY);
- }
-
- void *pData;
- HRESULT hr;
- hr = SafeArrayAccessData(psa, &pData);
- if (FAILED(hr)) {
- _com_issue_error(hr);
- }
-
- for (int i = 0; i < numElements; ++i) {
- TclObject value(pElements[i]);
-
- switch (elementType.vartype()) {
- case VT_BOOL:
- static_cast<VARIANT_BOOL *>(pData)[i] =
- value.getBool() ? VARIANT_TRUE : VARIANT_FALSE;
- break;
-
- case VT_R4:
- static_cast<float *>(pData)[i] =
- static_cast<float>(value.getDouble());
- break;
-
- case VT_R8:
- static_cast<double *>(pData)[i] = value.getDouble();
- break;
-
- case VT_BSTR:
- static_cast<BSTR *>(pData)[i] = value.getBSTR();
- break;
-
- case VT_VARIANT:
- {
- VARIANT *pDest = static_cast<VARIANT *>(pData) + i;
- VariantInit(pDest);
- value.toVariant(pDest, elementType, interp);
- }
- break;
-
- default:
- static_cast<int *>(pData)[i] = value.getLong();
- }
- }
-
- hr = SafeArrayUnaccessData(psa);
- if (FAILED(hr)) {
- _com_issue_error(hr);
- }
- }
+ const Type &elementType = type.elementType();
V_VT(pDest) = VT_ARRAY | elementType.vartype();
- V_ARRAY(pDest) = psa;
+ V_ARRAY(pDest) = getSafeArray(elementType, interp);
} else if (m_pObj->typePtr == TclTypes::listType()) {
// Convert Tcl list to array of VARIANT.
}
}
+
+void
+TclObject::toNativeValue (NativeValue *pDest,
+ const Type &type,
+ Tcl_Interp *interp,
+ bool addRef)
+{
+#ifdef V_I8
+ VARTYPE vt = type.vartype();
+ if (vt == VT_I8 || vt == VT_UI8) {
+ pDest->fixInvalidVariantType();
+ VariantClear(pDest);
+ V_VT(pDest) = vt;
+ Tcl_GetWideIntFromObj(interp, m_pObj, &V_I8(pDest));
+ return;
+ }
+#endif
+
+ pDest->fixInvalidVariantType();
+ toVariant(pDest, type, interp, addRef);
+}
+
#endif
-// $Id: TclObject.h,v 1.12 2002/04/12 02:55:28 cthuang Exp $
+// $Id: TclObject.h 16 2005-04-19 14:47:52Z cthuang $
#ifndef TCLOBJECT_H
#define TCLOBJECT_H
#ifdef WIN32
#include "TypeInfo.h"
+#include "NativeValue.h"
#endif
#include <tcl.h>
#include <string>
TclObject &lappend(Tcl_Obj *pElement);
#ifdef WIN32
- // Construct Tcl object from VARIANT value.
+ // Construct Tcl object from native machine value.
TclObject(
- VARIANT *pSrc, // VARIANT value to convert from
+ VARIANT *pSrc, // value to convert from
const Type &type, // expected type for interface pointers
Tcl_Interp *interp);
+ // Construct Tcl object from _bstr_t.
+ TclObject(const _bstr_t &src);
+
+ // Construct Tcl object from SAFEARRAY.
+ TclObject(
+ SAFEARRAY *psa, // value to convert from
+ const Type &type, // array type
+ Tcl_Interp *interp);
+
// Convert Tcl object to VARIANT value.
void toVariant(
VARIANT *pDest, // converted value put here
Tcl_Interp *interp,
bool addRef=false); // call AddRef on interface pointer
+ // Convert Tcl object to native machine value.
+ void toNativeValue(
+ NativeValue *pDest, // converted value put here
+ const Type &type, // desired data type
+ Tcl_Interp *interp,
+ bool addRef=false); // call AddRef on interface pointer
+
// Get BSTR representation. Caller is responsible for freeing the
// returned BSTR.
BSTR getBSTR() const;
+
+ // Get SAFEARRAY representation. Caller is responsible for freeing the
+ // returned array.
+ SAFEARRAY *getSafeArray(const Type &elementType, Tcl_Interp *interp) const;
#endif
};
-// $Id: TclScript.cpp,v 1.12 2003/04/02 22:46:51 cthuang Exp $
+// $Id: TclScript.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "ActiveScriptError.h"
#include "Reference.h"
#include "TypeInfo.h"
-// $Id: TclScriptVersion.rc,v 1.3 2002/04/27 18:15:24 cthuang Exp $
+// $Id: TclScriptVersion.rc 5 2005-02-16 14:57:24Z cthuang $
#include <winres.h>
#include "version.h"
#include "buildNumber.h"
-// $Id: ThreadLocalStorage.h,v 1.1 2002/04/20 15:43:57 cthuang Exp $
+// $Id: ThreadLocalStorage.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef THREADLOCALSTORAGE_H
#define THREADLOCALSTORAGE_H
-// $Id: TypeInfo.cpp,v 1.58 2002/04/20 06:11:32 cthuang Exp $
+// $Id: TypeInfo.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include <sstream>
#include <map>
{ VT_DATE, "DATE" },
{ VT_BSTR, "BSTR" },
{ VT_DISPATCH, "DISPATCH" },
- { VT_ERROR, "ERROR" },
+ { VT_ERROR, "SCODE" },
{ VT_BOOL, "BOOL" },
{ VT_VARIANT, "VARIANT" },
{ VT_UNKNOWN, "UNKNOWN" },
-// $Id: TypeInfo.h,v 1.41 2002/04/20 06:11:32 cthuang Exp $
+// $Id: TypeInfo.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef TYPEINFO_H
#define TYPEINFO_H
-// $Id: TypeLib.cpp,v 1.29 2002/03/09 16:40:24 cthuang Exp $
+// $Id: TypeLib.cpp 9 2005-04-07 14:14:37Z cthuang $
#pragma warning(disable: 4786)
#include <sstream>
#include "RegistryKey.h"
ITypeLibPtr pTypeLib;
HRESULT hr = LoadRegTypeLib(
- libid, majorVersion, minorVersion, LOCALE_USER_DEFAULT, &pTypeLib);
+ libid, majorVersion, minorVersion, LOCALE_NEUTRAL, &pTypeLib);
if (FAILED(hr)) {
_com_issue_error(hr);
}
-// $Id: TypeLib.h,v 1.21 2002/03/09 16:40:24 cthuang Exp $
+// $Id: TypeLib.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef TYPELIB_H
#define TYPELIB_H
-// $Id: Uuid.cpp,v 1.2 2000/04/20 18:37:40 chuang Exp $
+// $Id: Uuid.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "Uuid.h"
std::string
-// $Id: Uuid.h,v 1.3 2000/04/28 19:37:53 chuang Exp $
+// $Id: Uuid.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef UUID_H
#define UUID_H
-// $Id: bindCmd.cpp,v 1.53 2003/04/02 22:46:51 cthuang Exp $
+// $Id: bindCmd.cpp 13 2005-04-18 12:24:14Z cthuang $
#pragma warning(disable: 4786)
#include "Extension.h"
#include "Reference.h"
-#define BUILD_NUMBER 28
+#define BUILD_NUMBER 33
-// $Id: configureCmd.cpp,v 1.7 2002/04/13 03:53:57 cthuang Exp $
+// $Id: configureCmd.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include "Extension.h"
-// $Id: dllmain.cpp,v 1.16 2002/07/14 18:42:57 cthuang Exp $
+// $Id: dllmain.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include "Uuid.h"
#include "HandleSupport.h"
# 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 "DLLSERVER_EXPORTS" /YX /FD /c
-# ADD CPP /nologo /MD /W3 /GX /Zi /Od /I "\tcl\include" /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "DLLSERVER_EXPORTS" /D "TCL_THREADS" /D "USE_TCL_STUBS" /D "USE_NON_CONST" /YX /FD /c
+# ADD CPP /nologo /MD /W3 /GX /Zi /Od /I "\tcl\include" /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /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"
# PROP Ignore_Export_Lib 0
# PROP Target_Dir ""
# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "DLLSERVER_EXPORTS" /YX /FD /GZ /c
-# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "\tcl\include" /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "DLLSERVER_EXPORTS" /D "TCL_THREADS" /D "USE_TCL_STUBS" /D "USE_NON_CONST" /YX /FD /GZ /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "\tcl\include" /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "TCL_THREADS" /D "USE_TCL_STUBS" /D "USE_NON_CONST" /YX /FD /GZ /c
# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
# ADD BASE RSC /l 0x409 /d "_DEBUG"
-// $Id: dllserverVersion.rc,v 1.5 2002/04/27 18:15:24 cthuang Exp $
+// $Id: dllserverVersion.rc 5 2005-02-16 14:57:24Z cthuang $
#include <winres.h>
#include "version.h"
#include "buildNumber.h"
-// $Id: exemain.cpp,v 1.12 2002/07/14 18:42:57 cthuang Exp $
+// $Id: exemain.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include "TclModule.h"
#include "tclRunTime.h"
-// $Id: exeserverVersion.rc,v 1.5 2002/04/27 18:15:24 cthuang Exp $
+// $Id: exeserverVersion.rc 5 2005-02-16 14:57:24Z cthuang $
#include <winres.h>
#include "version.h"
#include "buildNumber.h"
-// $Id: foreachCmd.cpp,v 1.10 2002/05/31 04:03:06 cthuang Exp $
+// $Id: foreachCmd.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "Extension.h"
#include <sstream>
#include "Reference.h"
-// $Id: importCmd.cpp,v 1.26 2002/05/31 04:03:06 cthuang Exp $
+// $Id: importCmd.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include "Extension.h"
#include <sstream>
-// $Id: infoCmd.cpp,v 1.31 2002/04/13 03:53:57 cthuang Exp $
+// $Id: infoCmd.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "Extension.h"
#include "TclObject.h"
#include "Reference.h"
-// $Id: main.cpp,v 1.70 2002/07/14 18:42:57 cthuang Exp $
+// $Id: main.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include "ComModule.h"
#include "Extension.h"
-// $Id: mutex.h,v 1.7 2002/04/13 03:53:57 cthuang Exp $
+// $Id: mutex.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef MUTEX_H
#define MUTEX_H
-// $Id: naCmd.cpp,v 1.7 2003/03/07 00:17:30 cthuang Exp $
+// $Id: naCmd.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "Extension.h"
#include <string.h>
-// $Id: nullCmd.cpp,v 1.10 2003/03/07 00:17:30 cthuang Exp $
+// $Id: nullCmd.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "Extension.h"
#include <string.h>
-// $Id: objectCmd.cpp,v 1.31 2003/03/07 00:24:04 cthuang Exp $
+// $Id: objectCmd.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include "Extension.h"
#include <sstream>
-// $Id: refCmd.cpp,v 1.46 2003/11/06 15:29:01 cthuang Exp $
+// $Id: refCmd.cpp 16 2005-04-19 14:47:52Z cthuang $
#pragma warning(disable: 4786)
#include "Extension.h"
#include <sstream>
static int referenceObjCmd(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []);
HandleSupport<Reference> Extension::referenceHandles(referenceObjCmd);
+static const char unknownErrorDescription[] = "Unknown error";
+
// Check if the object implements ISupportErrorInfo. If it does, get the
// error information. Return true if successful.
return GetErrorInfo(0, ppErrorInfo) == S_OK;
}
+// Get description text for an HRESULT.
+
+static Tcl_Obj *
+formatMessage (HRESULT hresult)
+{
+#if TCL_MINOR_VERSION >= 2
+ // Uses Unicode functions introduced in Tcl 8.2.
+ wchar_t *pMessage;
+ DWORD nLen = FormatMessageW(
+ FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
+ NULL,
+ hresult,
+ 0,
+ reinterpret_cast<LPWSTR>(&pMessage),
+ 0,
+ NULL);
+#else
+ char *pMessage;
+ DWORD nLen = FormatMessageA(
+ FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
+ NULL,
+ hresult,
+ 0,
+ reinterpret_cast<LPSTR>(&pMessage),
+ 0,
+ NULL);
+#endif
+
+ Tcl_Obj *pDescription;
+ if (nLen > 0) {
+ if (nLen > 1 && pMessage[nLen - 1] == '\n') {
+ --nLen;
+ if (nLen > 1 && pMessage[nLen - 1] == '\r') {
+ --nLen;
+ }
+ }
+ pMessage[nLen] = '\0';
+
+
+#if TCL_MINOR_VERSION >= 2
+ // Uses Unicode functions introduced in Tcl 8.2.
+ pDescription = Tcl_NewUnicodeObj(pMessage, nLen);
+#else
+ pDescription = Tcl_NewStringObj(pMessage, nLen);
+#endif
+ } else {
+ pDescription = Tcl_NewStringObj(unknownErrorDescription, -1);
+ }
+ LocalFree(pMessage);
+
+ return pDescription;
+}
+
// Set the Tcl errorCode variable and the Tcl interpreter result.
// Returns TCL_ERROR.
setErrorCodeAndResult (
Tcl_Interp *interp,
HRESULT hresult,
- const _bstr_t &description,
+ Tcl_Obj *pDescription,
const char *file,
int line)
{
result.lappend(hrObj);
// Append description.
- const wchar_t *pWide = static_cast<const wchar_t *>(description);
- if (pWide == 0) {
- pWide = L"Unknown error";
- }
- TclObject descriptionObj(pWide);
- errorCode.lappend(descriptionObj);
- result.lappend(descriptionObj);
+ errorCode.lappend(pDescription);
+ result.lappend(pDescription);
#ifndef NDEBUG
// Append file and line number.
return TCL_ERROR;
}
+static int
+setErrorCodeAndResult (
+ Tcl_Interp *interp,
+ HRESULT hresult,
+ const _bstr_t &description,
+ const char *file,
+ int line)
+{
+ TclObject descriptionObj;
+ int length;
+ Tcl_GetStringFromObj(descriptionObj, &length);
+ if (length == 0) {
+ descriptionObj = Tcl_NewStringObj(unknownErrorDescription, -1);
+ }
+ return setErrorCodeAndResult(interp, hresult, descriptionObj, file, line);
+}
+
int
Extension::setComErrorResult (
Tcl_Interp *interp, _com_error &e, const char *file, int line)
{
- // Get description.
- _bstr_t description;
-
-#if TCL_MINOR_VERSION >= 2
- // Uses Unicode functions introduced in Tcl 8.2.
- wchar_t *pMessage;
- DWORD nLen = FormatMessageW(
- FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM,
- NULL,
- e.Error(),
- 0,
- reinterpret_cast<LPWSTR>(&pMessage),
- 0,
- NULL);
-
- if (nLen > 0) {
- if (nLen > 1 && pMessage[nLen - 1] == '\n') {
- --nLen;
- if (nLen > 1 && pMessage[nLen - 1] == '\r') {
- --nLen;
- }
- }
- pMessage[nLen] = '\0';
-
- description = _bstr_t(pMessage);
- } else {
- // FormatMessageW doesn't seem to work on Windows 95/98.
- description = _bstr_t(e.ErrorMessage());
- }
- LocalFree(pMessage);
-#else
- description = _bstr_t(e.ErrorMessage());
-#endif
-
- return setErrorCodeAndResult(interp, e.Error(), description, file, line);
+ return setErrorCodeAndResult(
+ interp, e.Error(), formatMessage(e.Error()), file, line);
}
// Invoke a method or property.
WORD dispatchFlags)
{
// Set up return value.
- _variant_t returnValue;
+ NativeValue returnValue;
VARIANT *pReturnValue = (pMethod->type().vartype() == VT_VOID)
? 0 : &returnValue;
}
// Set up return value.
- _variant_t varReturnValue;
+ NativeValue varReturnValue;
VARIANT *pReturnValue =
(dispatchFlags & DISPATCH_PROPERTYPUT) ? 0 : &varReturnValue;
int i = 1;
for (; i < objc; ++i) {
static char *options[] = {
- "-get", "-method", "-namedarg", "-set", NULL
+ "-call", "-get", "-method", "-namedarg", "-set", NULL
};
enum OptionEnum {
- OPTION_GET, OPTION_METHOD, OPTION_NAMEDARG, OPTION_SET
+ OPTION_CALL, OPTION_GET, OPTION_METHOD, OPTION_NAMEDARG, OPTION_SET
};
int index;
}
switch (index) {
- case OPTION_GET:
- dispatchFlags = DISPATCH_PROPERTYGET;
- break;
+ case OPTION_CALL:
case OPTION_METHOD:
dispatchFlags = DISPATCH_METHOD;
break;
+ case OPTION_GET:
+ dispatchFlags = DISPATCH_PROPERTYGET;
+ break;
case OPTION_NAMEDARG:
namedArgOpt = true;
break;
result = setErrorCodeAndResult(
interp, e.scode(), e.description(), __FILE__, __LINE__);
}
+ catch (InvokeException &e) {
+ std::ostringstream argOut;
+ argOut << "Argument " << e.argIndex() << ": ";
+ TclObject descriptionObj(argOut.str());
+
+ TclObject messageObj(formatMessage(e.hresult()));
+ Tcl_AppendObjToObj(descriptionObj, messageObj);
+
+ result = setErrorCodeAndResult(
+ interp, e.hresult(), descriptionObj, __FILE__, __LINE__);
+ }
+
return result;
}
-// $Id: shortPathNameCmd.cpp,v 1.3 2002/04/13 03:53:57 cthuang Exp $
+// $Id: shortPathNameCmd.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "Extension.h"
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
-// $Id: tclRunTime.h,v 1.1 2002/07/15 04:03:54 cthuang Exp $
+// $Id: tclRunTime.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef TCLRUNTIME_H
#define TCLRUNTIME_H
# 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 "TCL_THREADS" /D "USE_TCL_STUBS" /D "USE_NON_CONST" /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 BASE MTL /nologo /D "NDEBUG" /mktyplib203 /win32
# ADD MTL /nologo /D "NDEBUG" /mktyplib203 /win32
# ADD BASE RSC /l 0x409 /d "NDEBUG"
# PROP Ignore_Export_Lib 0
# PROP Target_Dir ""
# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /ZI /Od /D "WIN32" /D "_DEBUG" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "TCOM_EXPORTS" /YX /FD /GZ /c
-# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "\tcl\include" /D "_DEBUG" /D "_WIN32_DCOM" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "TCOM_EXPORTS" /D "TCL_THREADS" /D "USE_TCL_STUBS" /D "USE_NON_CONST" /YX /FD /GZ /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "\tcl\include" /D "_DEBUG" /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 /GZ /c
# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
# ADD BASE RSC /l 0x409 /d "_DEBUG"
# PROP Ignore_Export_Lib 0
# PROP Target_Dir ""
# ADD BASE CPP /nologo /MT /W3 /GX /O2 /I "e:\tcl\include" /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "TCOM_EXPORTS" /D "_WIN32_DCOM" /YX /FD /c
-# ADD CPP /nologo /MD /W3 /GX /Zi /O2 /I "\tcl\include" /D "NDEBUG" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "TCOM_EXPORTS" /D "TCL_THREADS" /D "USE_TCL_STUBS" /D "USE_NON_CONST" /YX /FD /c
+# ADD CPP /nologo /MD /W3 /GX /Zi /O2 /I "\tcl\include" /D "NDEBUG" /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"
# PROP Ignore_Export_Lib 0
# PROP Target_Dir ""
# ADD BASE CPP /nologo /MTd /W3 /Gm /GX /ZI /Od /I "c:\tcl\include" /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "TCOM_EXPORTS" /D "_WIN32_DCOM" /YX /FD /GZ /c
-# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "\tcl\include" /D "_DEBUG" /D "WIN32" /D "_WINDOWS" /D "_MBCS" /D "_USRDLL" /D "TCOM_EXPORTS" /D "TCL_THREADS" /D "USE_TCL_STUBS" /D "USE_NON_CONST" /YX /FD /GZ /c
+# ADD CPP /nologo /MDd /W3 /Gm /GX /Zi /Od /I "\tcl\include" /D "_DEBUG" /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 /GZ /c
# ADD BASE MTL /nologo /D "_DEBUG" /mktyplib203 /win32
# ADD MTL /nologo /D "_DEBUG" /mktyplib203 /win32
# ADD BASE RSC /l 0x409 /d "_DEBUG"
# End Source File
# Begin Source File
+SOURCE=.\DispatchAdapter.cpp
+# End Source File
+# Begin Source File
+
+SOURCE=.\DispatchImpl.cpp
+# End Source File
+# Begin Source File
+
SOURCE=.\Extension.cpp
# End Source File
# Begin Source File
# End Source File
# Begin Source File
+SOURCE=.\NativeValue.cpp
+# End Source File
+# Begin Source File
+
SOURCE=.\nullCmd.cpp
# End Source File
# Begin Source File
# End Source File
# Begin Source File
+SOURCE=.\DispatchAdapter.h
+# End Source File
+# Begin Source File
+
+SOURCE=.\DispatchImpl.h
+# End Source File
+# Begin Source File
+
SOURCE=.\Extension.h
# End Source File
# Begin Source File
# End Source File
# Begin Source File
+SOURCE=.\NativeValue.h
+# End Source File
+# Begin Source File
+
SOURCE=.\Reference.h
# End Source File
# Begin Source File
-// $Id: tcomApi.h,v 1.1 2000/04/22 21:39:36 chuang Exp $
+// $Id: tcomApi.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef TCOMAPI_H
#define TCOMAPI_H
-// $Id: tcomVersion.rc,v 1.5 2002/04/27 18:15:24 cthuang Exp $
+// $Id: tcomVersion.rc 5 2005-02-16 14:57:24Z cthuang $
#include <winres.h>
#include "version.h"
#include "buildNumber.h"
-// $Id: typelibCmd.cpp,v 1.29 2002/04/13 03:53:57 cthuang Exp $
+// $Id: typelibCmd.cpp 5 2005-02-16 14:57:24Z cthuang $
#pragma warning(disable: 4786)
#include "Extension.h"
#include "TypeLib.h"
-// $Id: variantCmd.cpp,v 1.1 2003/05/29 03:33:08 cthuang Exp $
+// $Id: variantCmd.cpp 5 2005-02-16 14:57:24Z cthuang $
#include "Extension.h"
#include <string.h>
-// $Id: version.h,v 1.4 2002/10/01 21:51:32 cthuang Exp $
+// $Id: version.h 5 2005-02-16 14:57:24Z cthuang $
#ifndef VERSION_H
#define VERSION_H
#define PACKAGE_MAJOR_VERSION 3
-#define PACKAGE_MINOR_VERSION 9
+#define PACKAGE_MINOR_VERSION 10
#define MAKE_VERSION_STRING0(MAJOR,MINOR) #MAJOR "." #MINOR
#define MAKE_VERSION_STRING(MAJOR,MINOR) MAKE_VERSION_STRING0(MAJOR,MINOR)
-# $Id: all.tcl,v 1.1 2002/03/16 04:53:17 cthuang Exp $
+# $Id: all.tcl 5 2005-02-16 14:57:24Z cthuang $
#
# This file contains a top-level script to run all of the tests.
-# $Id: array.test,v 1.1 2003/05/12 23:31:03 cthuang Exp $
+# $Id: array.test 5 2005-02-16 14:57:24Z cthuang $
#
-# This file contains tests for the passing arrays
+# This file contains tests for passing arrays.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
-# $Id: eval.test,v 1.2 2003/04/02 22:57:35 cthuang Exp $
+# $Id: eval.test 5 2005-02-16 14:57:24Z cthuang $
#
-# This file contains tests the robustness of handles under eval.
+# This file tests the robustness of handles under eval.
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
-# $Id: foreach.test,v 1.2 2003/03/07 00:01:40 cthuang Exp $
+# $Id: foreach.test 5 2005-02-16 14:57:24Z cthuang $
#
# This file contains tests for the ::tcom::foreach command.
-# $Id: namedarg.test,v 1.2 2003/04/02 22:57:35 cthuang Exp $
+# $Id: namedarg.test 5 2005-02-16 14:57:24Z cthuang $
#
# This file contains tests invoking methods through IDispatch with named
# arguments.
-# $Id: ref.test,v 1.2 2002/06/29 15:44:21 cthuang Exp $
+# $Id: ref.test 13 2005-04-18 12:24:14Z cthuang $
#
# This file contains tests for the ::tcom::ref command.
package require tcom
set bank [::tcom::ref createobject "Banking.Bank"]
+# set bank [::tcom::ref querydispatch $bank]
set account [$bank CreateAccount]
+# set account [::tcom::ref querydispatch $account]
$account Deposit 30
$account Withdraw 20
$account Balance
projects / tcom / commitdiff