|
ActiveTcl User Guide |
 |
COM Object Implementation in Tcl
Introduction
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.
Write MIDL Specification
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;
};
};
|
Create Type Library
Run this command to generate a type library file
Banking.tlb from the MIDL specification.
Create Tcl Package
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.
Register Server
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
|
Implement Client
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]
|
Implement Objects In Plain Tcl
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}
|
|
