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.
This example defines a bank interface that has a method to create an account. An account has a balance property which can be read, and deposit and withdraw operations which modify the balance. The file Banking.idl contains the MIDL specification for the bank and account interfaces. 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 create")]
HRESULT create([out, retval] IAccount **pAccount);
};
[
uuid(0A0059B8-E0B0-11D2-942A-00C04F7040AB),
version(1.0),
helpstring("Banking 1.0 Type Library")
]
library Banking
{
importlib("stdole32.tlb");
importlib("stdole2.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 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 [::tcom::search_auto_path Banking/Banking.tlb]
class Account {
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 Bank {
public method create {} {
set account [Account #auto]
return [::tcom::object create ::Banking::Account \
::Bank::$account {delete object}] ;# 1
}
}
::tcom::object registerfactory ::Banking::Bank {Bank #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 Bank #auto command which creates a Bank [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 create] puts [$account balance] $account deposit 20 puts [$account balance] $account withdraw 10 puts [$account balance] ::tcom::release $account $bank |
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 account and bank, which have parameters in the style of a method name followed by any arguments.
package provide Banking 1.0
package require tcom
::tcom::import [::tcom::search_auto_path Banking/Banking.tlb]
proc account {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 bank {method args} {
global balance
switch -- $method {
create {
set balance 0
return [::tcom::object create ::Banking::Account account]
}
default {
error "unknown method $method $args"
}
}
}
::tcom::object registerfactory ::Banking::Bank {list bank}
|