This is an excerpt from Delphi 4 Unleashed. It is a very rough draft of a section of a chapter on MTS. The focus of this section of the chapter is MTS transactions. To fully understand this excerpt from the book, you probably need to have a little experience with MTS, though not much. In other words, I talked a lot about MTS basics before getting to this section of the chapter. Getting transactions to work correctly was the hardest part of MTS for me, so I am providing this section of the chapter to help you get up to speed on this material. Remember, this is a very rough draft, provided as a service for people who are having trouble with MTS transactions.

In this section of the chapter you will get a look at working with transactions and MTS. In particular, I will create a simple server and client pair that will show you how to create transactions, roll them back, or commit them. The program is designed to let you experiment with the technology. Later in the chapter I will show you a complete program that will allow you to use transactions in a more real world setting.

To get started, you should be sure you have MTS set up properly. After you install Delphi, your copy of MTS should have a package in it called BDE-MTS. In the MTS Explorer, Select this package, open it, and highlight the Components folder. Choose View | Transactions, and you should be able to see the PROG_ID, Transaction, and DLL properties for the BDEMTSDispenser, as shown in Figure 0.3. Check this listing and make sure that transactions are supported, and that the DLL path points at a valid instance of DISP.DLL.

After you have checked to be sure that the BDEMTSDispenser is properly installed, open of the BDE Administrator from the Start Menu or from inside the SQL Explorer. Check to make sure that MTS Pooling is turned on. You can do this by turning to the configuration page, and selecting System | Init. This same key is in the registry at the following address:

'HKEY_LOCAL_MACHINE\SOFTWARE\BORLAND\DATABASE ENGINE\SETTINGS\SYSTEM\INIT';

Here is a method, from the MTSPooling demo that ships with the Delphi, that will allow you to toggle the setting:

procedure TForm1.MTSPoolingClick(Sender: TObject);
const
  MTSRegistryKey : PChar = 
    '\SOFTWARE\BORLAND\DATABASE ENGINE\SETTINGS\SYSTEM\INIT';
    
var
  reg : TRegistry;
begin
  // Set the registry value to whatever the flag is
  reg := TRegistry.Create;
  reg.RootKey := HKEY_LOCAL_MACHINE;
  if ( reg.OpenKey( MTSRegistryKey, False) ) then
  begin
    if MTSPooling.Checked then
      reg.WriteString('MTS POOLING', 'TRUE')
   else
      reg.WriteString('MTS POOLING', 'FALSE');
    reg.CloseKey;
  end;
  reg.Destroy;
end;

If MTS Pooling is turned on, then transactions and pooling of databases connections will be available. If MTS Pooling is turned off, then you will have no support for transactions.

Now create a simple server that will allow you to test MTS transactions. To do this, go to the File | New | Multi-Tier page and choose MTS Data Module. Give your module a name, and accept all the defaults.

Drop down a TDatabase object on the MTS data module and connect it to the D4Unleashed alias, discussed in the readme on the CD for this book. (Or, if you want, just connect to the DBDEMOS alias, and use the Country table. The data you use here is not important.) Drop down a TTable object, and connect it to this alias, and hook it up to the RocketGadget.db table from the CD that accompanies this book (or connect it to the Country table). Drop down a TProvider component, hook it up to the table, and export it from the datamodule by creating a method called GetGadgets in the type library:

function TPDXGadgetObject.GetGadgets: OleVariant;
begin
  Result := GadgetProvider.Data;
end;

Remember, you don't directly export a Provider object from an MTS server because you must have stateless code. So, instead of exporting the provider, just export the data from the provider, as shown in the GetGadgets method.

Please note: you must use a TDatabase object or this program will not work. If you don't have MTS Pooling turned on, and if you don't use a TDatabase object, then you will get no joy from this process. If you need help setting things up, look at the example in the PDXRockets\GadgetMTS directory on the CD that accompanies this book (or in the example source that comes with this excerpt from my book.)

In the type library for this server, you will need to create a number of different methods, as shown in Figure 0.4. These methods should look as follows when declared in your program:

  function GetGadgets: OleVariant; safecall;
  function GetName: WideString; safecall;
  procedure AddStandardGadget; safecall;
  procedure DeleteStandardGadget; safecall;
  procedure CallAbort; safecall;
  procedure CallComplete; safecall;

You are now ready to create the server. When you are done, your code should look like sample shown in

//////////////////////////////////////
//    File: MainServerIMPL.pas
// Project: PDXGadgetServer
// Copyright (c) 1998 by Charlie Calvert
//
unit MainServerIMPL;

interface

uses
  Windows, Messages, SysUtils,
  Classes, Graphics, Controls,
  Forms, Dialogs, ComServ,
  ComObj, VCLCom, StdVcl,
  BdeProv, BdeMts, DataBkr,
  DBClient, MtsRdm, Mtx,
  PDXGadgetServer_TLB, Provider, Db,
  DBTables;

type
  TPDXGadgetObject = class(TMtsDataModule, IPDXGadgetObject)
    GadgetTable: TTable;
    GadgetProvider: TProvider;
    Database1: TDatabase;
    procedure PDXGadgetObjectCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  protected
    function GetGadgets: OleVariant; safecall;
    function GetName: WideString; safecall;
    procedure AddStandardGadget; safecall;
    procedure DeleteStandardGadget; safecall;
    procedure CallAbort; safecall;
    procedure CallComplete; safecall;
  end;

const
  AFileName = 'c:\mtsGadgetPDX.txt';

var
  DebugFile: TextFile;
  PDXGadgetObject: TPDXGadgetObject;

implementation

{$R *.DFM}

procedure AddInfo(S: string);
begin
  AssignFile(DebugFile, AFileName);
  Append(DebugFile);
  WriteLn(DebugFile, S + ': ' + DateTimeToStr(Now));
  CloseFile(DebugFile);
end;

procedure InTransaction(ObjectContext: IObjectContext);
begin
  if ObjectContext.IsInTransaction then
    AddInfo('In Transaction: ' + DateTimeToStr(Now))
  else
    AddInfo('Not In Tranaction: ' + DateTimeToStr(Now))
end;

function TPDXGadgetObject.GetGadgets: OleVariant;
begin
  Result := GadgetProvider.Data;
end;

function TPDXGadgetObject.GetName: WideString;
begin
  Result := 'TPDXGadgetObject';
end;

procedure TPDXGadgetObject.AddStandardGadget;
begin
  AddInfo('AddStandardGadget called');
  InTransaction(ObjectContext);
  try
    GadgetTable.Open;
    GadgetTable.Append;
    GadgetTable.FieldByName('Name').Value := 'Gadget';
    GadgetTable.FieldByName('Description').Value := 'A Big Gadget';
    GadgetTable.Post;
    GadgetTable.Close;
    AddInfo('Set complete called');
  except
    SetAbort;
    AddInfo('Set abort called');
  end;
end;

procedure TPDXGadgetObject.DeleteStandardGadget;
begin
  AddInfo('DeleteStandardGadget called');
  InTransaction(ObjectContext);
  try
    GadgetTable.Open;
    GadgetTable.Delete;
    GadgetTable.Close;
  except
    SetAbort;
    AddInfo('SetAbort called');
    raise;
  end;
end;

procedure TPDXGadgetObject.CallAbort;
begin
  SetAbort;
end;

procedure TPDXGadgetObject.CallComplete;
begin
  SetComplete;
end;

procedure TPDXGadgetObject.PDXGadgetObjectCreate(Sender: TObject);
begin
  AddInfo('   -    ');
  AddInfo('----------------');
  AddInfo('OnCreate called');
end;

initialization
AssignFile(DebugFile, AFileName);
  try
    Append(DebugFile);
  except
    ReWrite(DebugFile);
  end;
  WriteLn(DebugFile);
  WriteLn(DebugFile, '--------------------');
  WriteLn(DebugFile, 'GadgetMTS Initialization called: ' + DateTimeToStr(Now));
  CloseFile(DebugFile);
  TComponentFactory.Create(ComServer, TPDXGadgetObject,
    Class_PDXGadgetObject, ciMultiInstance, tmApartment);
end.

To use this program, you should first compile it. Then open up the MTS Transaction Explorer, and create or use the Package called D4Unleashed. Now install your new component into the package.

Note: Here is a note from an earlier section of the chapter that explains how to create a package and install a component.

In the MTS Explorer, choose Console Root | Computers | My Computer | Packages Installed in the tree view control on the left of the program. Right click on Packages Installed and create a new package by choosing Create an Empty Package. Call your package D4Unleashed, or name it after yourself, by giving it a name like Charlie's Package.

Open up the tree view node for your package. Find the Components node and right click on it to create a new component. Select Install New Component and browse for the DLL you created. When you select it, your package will be automatically registered on the server. To make sure it is registered properly, open up the tree view nodes for you component in the Transaction Server Explorer and see if you can find the methods for your server. These methods should include the standard IDispatch routines such as Invoke and GetIDsOfNames. Among these standard methods should also be the routines you have created explicitly, which in this case include the methods called CallComplete and CallAbort.

Once you have installed the server, you should take a moment to make sure you understand how it works. In order to understand this program, you must recall that SetComplete is the method you call to cause a transaction to be committed, while SetAbort is the method you call to rollback a transaction. Notice that in the normal course of operation, neither SetComplete nor SetAbort will be called unless you explicitly call it from the client program. In particular, look at the following method:

procedure TPDXGadgetObject.DeleteStandardGadget;
begin
  AddInfo('DeleteStandardGadget called');
  InTransaction(ObjectContext);
  try
    GadgetTable.Open;
    GadgetTable.Delete;
    GadgetTable.Close;
  except
    SetAbort;
    AddInfo('SetAbort called');
    raise;
  end;
end;

This method will delete the first record from a data set. Unless something goes wrong, neither SetAbort nor SetComplete will be called by this method.

Now notice the following two routines, both of which are exported from the server:

procedure TPDXGadgetObject.CallAbort;
begin
  SetAbort;
end;

procedure TPDXGadgetObject.CallComplete;
begin
  SetComplete;
end;

You can call either of these methods in order to commit or rollback a transaction. This is not the way you would normally proceed in a standard MTS application. However, having this kind of control over the server can be very useful when you are first learning about MTS. In particular, you will be able to either commit or rollback each move you take, thereby allowing yourself to try various combinations of actions, and testing the results of each combination.

Here is the client program that allows you

//////////////////////////////////////
//    File: MainClient.pas
// Project: GadgetClient
// Copyright (c) 1998 by Charlie Calvert
//
unit MainClient;

interface

uses
  Windows, Messages, SysUtils,
  Classes, Graphics, Controls,
  Forms, Dialogs, DBClient,
  MConnect, ExtCtrls, Grids,
  DBGrids, Db, Menus;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ClientDataSet1: TClientDataSet;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    MainMenu1: TMainMenu;
    Connect1: TMenuItem;
    Options1: TMenuItem;
    AddGadget1: TMenuItem;
    DeleteGadget1: TMenuItem;
    N1: TMenuItem;
    TestRollback1: TMenuItem;
    Abort1: TMenuItem;
    Complete1: TMenuItem;
    DCOMConnection1: TDCOMConnection;
    procedure Connect1Click(Sender: TObject);
    procedure AddGadget1Click(Sender: TObject);
    procedure DeleteGadget1Click(Sender: TObject);
    procedure TestRollback1Click(Sender: TObject);
    procedure Abort1Click(Sender: TObject);
    procedure Complete1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Connect1Click(Sender: TObject);
begin
  DCOMConnection1.Connected := True;
  ClientDataSet1.Data := DCOMConnection1.AppServer.GetGadgets;
end;

procedure TForm1.AddGadget1Click(Sender: TObject);
begin
  DCOMConnection1.AppServer.AddStandardGadget;
  ClientDataSet1.Data := DCOMConnection1.AppServer.GetGadgets;
end;

procedure TForm1.DeleteGadget1Click(Sender: TObject);
begin
  DCOMConnection1.AppServer.DeleteStandardGadget;
  ClientDataSet1.Data := DCOMConnection1.AppServer.GetGadgets;
end;

procedure TForm1.TestRollback1Click(Sender: TObject);
begin
  DCOMConnection1.AppServer.AddStandardGadget;
  DCOMConnection1.AppServer.AddStandardGadget;
  DCOMConnection1.AppServer.AddStandardGadget;
  DCOMConnection1.AppServer.CallAbort;
  ClientDataSet1.Data := DCOMConnection1.AppServer.GetGadgets;
end;

procedure TForm1.Abort1Click(Sender: TObject);
begin
  DCOMConnection1.AppServer.CallAbort;
end;

procedure TForm1.Complete1Click(Sender: TObject);
begin
  DCOMConnection1.AppServer.CallComplete;
end;

end.

procedure TForm1.Abort1Click(Sender: TObject);
begin
  DCOMConnection1.AppServer.CallAbort;
end;

procedure TForm1.Complete1Click(Sender: TObject);
begin
  DCOMConnection1.AppServer.CallComplete;
end;

procedure TPDXGadgetObject.PDXGadgetObjectCreate(Sender: TObject);
begin
  AddInfo('   -    ');
  AddInfo('----------------');
  AddInfo('OnCreate called');
end;

const
  AFileName = 'c:\mtsGadgetPDX.txt';

var
  DebugFile: TextFile;

procedure AddInfo(S: string);
begin
  AssignFile(DebugFile, AFileName);
  Append(DebugFile);
  WriteLn(DebugFile, S + ': ' + DateTimeToStr(Now));
  CloseFile(DebugFile);
end;