This article shows by example how to implement COM objects in Tcl with the tcom extension. It shows how an object can be implemented by an [incr Tcl] class or in just plain Tcl.
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.
The file Banking.idl contains the MIDL specification for the COM interfaces and classes. The interfaces can be declared dual because tcom can implement objects whose operations are invoked through the IDispatch interface or the virtual function table.
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;
};
};
Run this command to generate a type library file Banking.tlb from the MIDL specification.
midl Banking.idl
The tcom 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.
Create a directory for the package by making a subdirectory named Banking under one of the directories in the auto_path variable. Create a pkgIndex.tcl file in the package directory.
package ifneeded Banking 1.0 [list source [file join $dir server.itcl]]
Copy the Banking.tlb type library file into the package directory.
Create the following server.itcl file in the package directory. This file defines [incr Tcl] classes that implement the IBank and IAccount interfaces.
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
On line 1, the ::tcom::object create 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 _get_ and _set_ to the property name. When the last reference to the COM object is released, tcom invokes the delete object command with the [incr Tcl] object handle as an additional argument to clean up the [incr Tcl] object.
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 BankImpl #auto command which creates a BankImpl [incr Tcl] object and returns a handle to that object. To clean up when the COM object is destroyed, tcom invokes the delete object command with the [incr Tcl] object handle as an additional argument.
Run these Tcl commands to create entries in the Windows registry required by COM and the tcom server implementation.
package require tcom ::tcom::server register Banking.tlb
The client.tcl 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.
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]
You can implement objects in plain Tcl. The servant command passed to the ::tcom::object create command can be the name of any object-style command. Similarly, the factory command passed to the ::tcom::object registerfactory command can return the name of any object-style command. The following Tcl script defines the procedures accountImpl and bankImpl, which have parameters in the style of a method name followed by any arguments.
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}