home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Source / Vcl / MTX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  10.1 KB  |  315 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Runtime Library                  }
  5. {       MS Transaction Server Interface Unit            }
  6. {                                                       }
  7. {       Copyright (c) 1999 Inprise Corporation          }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Mtx;
  12.  
  13. {$H+,X+}
  14.  
  15. interface
  16.  
  17. uses Windows;
  18.  
  19. //(*$HPPEMIT '#include <mtxspm.h>' *) // WIN2K
  20. //(*$HPPEMIT '#include <txctx.h>' *) // WIN2K
  21. (*$HPPEMIT '#include <comsvcs.h>' *) // WIN2K
  22.  
  23. const
  24.  
  25. { Trappable Error Codes }
  26.  
  27.   mtsErrCtxAborted         = $8004E002;
  28.   {$EXTERNALSYM  mtsErrCtxAborted}
  29.   mtsErrCtxAborting        = $8004E003;
  30.   {$EXTERNALSYM mtsErrCtxAborting}
  31.   mtsErrCtxNoContext       = $8004E004;
  32.   {$EXTERNALSYM mtsErrCtxNoContext}
  33.   mtsErrCtxNotRegistered   = $8004E005;
  34.   {$EXTERNALSYM mtsErrCtxNotRegistered}
  35.   mtsErrCtxActivityTimeout = $8004E006;
  36.   {$EXTERNALSYM mtsErrCtxActivityTimeout}
  37.   mtsErrCtxOldReference    = $8004E007;
  38.   {$EXTERNALSYM mtsErrCtxOldReference}
  39.   mtsErrCtxRoleNotFound    = $8004E00C;
  40.   {$EXTERNALSYM mtsErrCtxRoleNotFound}
  41.   mtsErrCtxNoSecurity      = $8004E00D;
  42.   {$EXTERNALSYM mtsErrCtxNoSecurity}
  43.   mtsErrCtxWrongThread     = $8004E00E;
  44.   {$EXTERNALSYM mtsErrCtxWrongThread}
  45.   mtsErrCtxTMNotAvailable  = $8004E00F;
  46.   {$EXTERNALSYM mtsErrCtxTMNotAvailable}
  47.  
  48. { Component class GUIDs }
  49.  
  50.   CLASS_TransactionContext: TGUID = '{7999FC25-D3C6-11CF-ACAB-00A024A55AEF}';
  51.   {$EXTERNALSYM CLASS_TransactionContext}
  52.   CLASS_TransactionContextEx: TGUID = '{5CB66670-D3D4-11CF-ACAB-00A024A55AEF}';
  53.   {$EXTERNALSYM CLASS_TransactionContextEx}
  54.   CLASS_SharedPropertyGroupManager: TGUID = '{2A005C11-A5DE-11CF-9E66-00AA00A3F464}';
  55.   {$EXTERNALSYM CLASS_SharedPropertyGroupManager}
  56.  
  57. const
  58.   LockSetGet = $00000000;
  59.   {$EXTERNALSYM LockSetGet}
  60.   LockMethod = $00000001;
  61.   {$EXTERNALSYM LockMethod}
  62.  
  63.   Standard = $00000000;
  64.   {$EXTERNALSYM Standard}
  65.   Process  = $00000001;
  66.   {$EXTERNALSYM Process}
  67.  
  68. type
  69.  
  70. { Forward declarations: Interfaces }
  71.   IObjectContext = interface;
  72.   {$EXTERNALSYM IObjectContext}
  73.   IGetContextProperties = interface;
  74.   {$EXTERNALSYM IGetContextProperties}
  75.   IEnumNames = interface;
  76.   {$EXTERNALSYM IEnumNames}
  77.   ISecurityProperty = interface;
  78.   {$EXTERNALSYM ISecurityProperty}
  79.   IObjectControl = interface;
  80.   {$EXTERNALSYM IObjectControl}
  81.   IObjectContextActivity = interface;
  82.   {$EXTERNALSYM IObjectContextActivity}
  83.  
  84.   ITransactionContext = interface;
  85.   {$EXTERNALSYM ITransactionContext}
  86.   ITransactionContextEx = interface;
  87.   {$EXTERNALSYM ITransactionContextEx}
  88.  
  89.   ISharedProperty = interface;
  90.   {$EXTERNALSYM ISharedProperty}
  91.   ISharedPropertyGroup = interface;
  92.   {$EXTERNALSYM ISharedPropertyGroup}
  93.   ISharedPropertyGroupManager = interface;
  94.   {$EXTERNALSYM ISharedPropertyGroupManager}
  95.  
  96. { IObjectContext }
  97.  
  98.   IObjectContext = interface(IUnknown)
  99.     ['{51372AE0-CAE7-11CF-BE81-00AA00A2FA25}']
  100.     function CreateInstance(const cid, rid: TGUID; out pv): HResult; stdcall;
  101.     procedure SetComplete; safecall;
  102.     procedure SetAbort; safecall;
  103.     procedure EnableCommit; safecall;
  104.     procedure DisableCommit; safecall;
  105.     function IsInTransaction: Bool; stdcall;
  106.     function IsSecurityEnabled: Bool; stdcall;
  107.     function IsCallerInRole(const bstrRole: WideString): Bool; safecall;
  108.   end;
  109.   {$EXTERNALSYM IObjectContext}
  110.  
  111. { IGetContextProperties }
  112.  
  113.   IGetContextProperties = interface(IUnknown)  //!! Make these all safecall???
  114.     ['{51372AF4-CAE7-11CF-BE81-00AA00A2FA25}']
  115.     function Count: Integer; safecall;
  116.     function GetProperty(const name: WideString): OleVariant; safecall;
  117.     function EnumNames: IEnumNames; safecall;
  118.   end;
  119.    {$EXTERNALSYM IGetContextProperties}
  120.  
  121. { IEnumNames }
  122.  
  123.   IEnumNames = interface(IUnknown)
  124.     ['{51372AF2-CAE7-11CF-BE81-00AA00A2FA25}']
  125.     function Next(celt: UINT; out rgname: WideString;
  126.       out pceltFetched: UINT): HResult; stdcall;
  127.     function Skip(celt: UINT): HResult; stdcall;
  128.     function Reset: HResult; stdcall;
  129.     function Clone(out enm: IEnumNames): HResult; stdcall;
  130.   end;
  131.   {$EXTERNALSYM IEnumNames}
  132.  
  133. { ISecurityProperty }
  134.  
  135.   ISecurityProperty = interface(IUnknown)  
  136.     ['{51372AEA-CAE7-11CF-BE81-00AA00A2FA25}']
  137.     function GetDirectCreatorSID(out sid: PSID): HResult; stdcall;  
  138.     function GetOriginalCreatorSID(out sid: PSID): HResult; stdcall;
  139.     function GetDirectCallerSID(out sid: PSID): HResult; stdcall;
  140.     function GetOriginalCallerSID(out sid: PSID): HResult; stdcall;
  141.     function ReleaseSID(sid: PSID): HResult; stdcall;
  142.   end;
  143.   {$EXTERNALSYM ISecurityProperty}
  144.  
  145. { IObjectControl }
  146.  
  147.   IObjectControl = interface(IUnknown)
  148.     ['{51372AEC-CAE7-11CF-BE81-00AA00A2FA25}']
  149.     procedure Activate; safecall;
  150.     procedure Deactivate; stdcall;
  151.     function CanBePooled: Bool; stdcall;
  152.   end;
  153.    {$EXTERNALSYM IObjectControl}
  154.  
  155. { IObjectContextActivity }
  156.  
  157.   IObjectContextActivity = interface(IUnknown)
  158.     ['{51372AFC-CAE7-11CF-BE81-00AA00A2FA25}']
  159.     function GetActivityId: TGuid; safecall;
  160.   end;
  161.    {$EXTERNALSYM IObjectContextActivity}
  162.  
  163. { ITransactionContext }
  164.  
  165.   ITransactionContext = interface(IDispatch)
  166.     ['{7999FC21-D3C6-11CF-ACAB-00A024A55AEF}']
  167.     function CreateInstance(const pszProgId: WideString): OleVariant; safecall;
  168.     procedure Commit; safecall;
  169.     procedure Abort; safecall;
  170.   end;
  171.    {$EXTERNALSYM ITransactionContext}
  172.  
  173. { ITransactionContextEx }
  174.  
  175.   ITransactionContextEx = interface(IUnknown)
  176.     ['{7999FC22-D3C6-11CF-ACAB-00A024A55AEF}']
  177.     function CreateInstance(const cid, rid: TGUID; out pv): HRESULT; stdcall;
  178.     function Commit: HResult; stdcall;
  179.     function Abort: HResult; stdcall;
  180.   end;
  181.    {$EXTERNALSYM ITransactionContextEx}
  182.  
  183. { ISharedProperty }
  184.  
  185.   ISharedProperty = interface(IDispatch)
  186.     ['{2A005C01-A5DE-11CF-9E66-00AA00A3F464}']
  187.     function Get_Value: OleVariant; safecall;
  188.     procedure Set_Value(pVal: OleVariant); safecall;
  189.     property Value: OleVariant read Get_Value write Set_Value;
  190.   end;
  191.   {$EXTERNALSYM ISharedProperty}
  192.  
  193. { ISharedPropertyGroup }
  194.  
  195.   ISharedPropertyGroup = interface(IDispatch)
  196.     ['{2A005C07-A5DE-11CF-9E66-00AA00A3F464}']
  197.     function CreatePropertyByPosition(Index: Integer{!! SYSINT}; out fExists: WordBool): ISharedProperty; safecall;
  198.     function Get_PropertyByPosition(Index: Integer{!! SYSINT}): ISharedProperty; safecall;
  199.     function CreateProperty(const Name: WideString; out fExists: WordBool): ISharedProperty; safecall;
  200.     function Get_PropertyByName(const Name: WideString): ISharedProperty; safecall;
  201.     property PropertyByPosition[Index: Integer{!! SYSINT}]: ISharedProperty read Get_PropertyByPosition;
  202.     property PropertyByName[const Name: WideString]: ISharedProperty read Get_PropertyByName;
  203.   end;
  204.    {$EXTERNALSYM ISharedPropertyGroup}
  205.  
  206. { ISharedPropertyGroupManager }
  207.  
  208.   ISharedPropertyGroupManager = interface(IDispatch)
  209.     ['{2A005C0D-A5DE-11CF-9E66-00AA00A3F464}']
  210.     function CreatePropertyGroup(const Name: WideString; var LockMode: Integer;
  211.       var RelMode: Integer; out fExists: WordBool): ISharedPropertyGroup; safecall;
  212.     function Get_Group(const Name: WideString): ISharedPropertyGroup; safecall;
  213.     function Get__NewEnum: IUnknown; safecall;
  214.     property Group[const Name: WideString]: ISharedPropertyGroup read Get_Group;
  215.     property _NewEnum: IUnknown read Get__NewEnum;
  216.   end;
  217.    {$EXTERNALSYM ISharedPropertyGroupManager}
  218.  
  219. { Object APIs }
  220.  
  221. function GetObjectContext: IObjectContext;
  222.  {$EXTERNALSYM GetObjectContext}
  223. function SafeRef(const rid: TGUID; Unk: IUnknown): Pointer;
  224.  {$EXTERNALSYM SafeRef}
  225.  
  226. { Client APIs }
  227.  
  228.  (*$HPPEMIT 'DECLARE_DINTERFACE_TYPE(ITransactionContext);' *)
  229.  (*$HPPEMIT 'DECLARE_DINTERFACE_TYPE(ITransactionContextEx);' *)
  230. function CreateTransactionContext: ITransactionContext;
  231. function CreateTransactionContextEx: ITransactionContextEx;
  232.  
  233. { Server APIs }
  234.  
  235.  (*$HPPEMIT 'DECLARE_DINTERFACE_TYPE(ISharedPropertyGroupManager);' *)
  236.  (*$HPPEMIT 'DECLARE_DINTERFACE_TYPE(ISharedPropertyGroup);' *)
  237. function CreateSharedPropertyGroupManager: ISharedPropertyGroupManager;
  238. function CreateSharedPropertyGroup(const Name: WideString): ISharedPropertyGroup;
  239.  
  240. implementation
  241.  
  242. uses ComObj;
  243.  
  244. type
  245.   TGetObjectContextProc = function(var ObjectContext: IObjectContext): HRESULT; cdecl;
  246.   TSafeRefProc = function(const rid: TGUID; Unk: IUnknown): Pointer; cdecl;
  247. var
  248.   GetObjectContextProc: TGetObjectContextProc = nil;
  249.   SafeRefProc: TSafeRefProc = nil;
  250.   MtsProcsLoaded: Boolean = False;
  251.  
  252. procedure LoadMtsProcs;
  253. var
  254.   Mtxdll: HModule;
  255. begin
  256.   if MtsProcsLoaded then Exit;
  257.   MtsProcsLoaded := True;
  258.   Mtxdll := GetModuleHandle('mtxex.dll');
  259.   if mtxdll <> 0 then
  260.   begin
  261.     @GetObjectContextProc := GetProcAddress(Mtxdll, 'GetObjectContext');
  262.     @SafeRefProc := GetProcAddress(Mtxdll, 'SafeRef');
  263.   end;
  264. end;
  265.  
  266. function GetObjectContext: IObjectContext;
  267. begin
  268.   LoadMtsProcs;
  269.   if Assigned(GetObjectContextProc) then
  270.     OleCheck(GetObjectContextProc(Result))
  271.   else
  272.     Result := nil;
  273. end;
  274.  
  275. function SafeRef(const rid: TGUID; Unk: IUnknown): Pointer;
  276. begin
  277.   LoadMtsProcs;
  278.   if Assigned(SafeRefProc) then
  279.     Result := SafeRefProc(rid, Unk)
  280.   else
  281.   begin
  282.     Unk._AddRef;
  283.     Result := Pointer(Unk);
  284.   end;
  285. end;
  286.  
  287. function CreateTransactionContext: ITransactionContext;
  288. begin
  289.   Result := CreateComObject(CLASS_TransactionContext) as ITransactionContext;
  290. end;
  291.  
  292. function CreateTransactionContextEx: ITransactionContextEx;
  293. begin
  294.   Result := CreateComObject(CLASS_TransactionContextEx) as ITransactionContextEx;
  295. end;
  296.  
  297. function CreateSharedPropertyGroupManager: ISharedPropertyGroupManager;
  298. begin
  299.   Result := CreateComObject(CLASS_SharedPropertyGroupManager) as ISharedPropertyGroupManager;
  300. end;
  301.  
  302. function CreateSharedPropertyGroup(const Name: WideString): ISharedPropertyGroup;
  303. var
  304.   Exists: WordBool;
  305.   LockMode: Integer;
  306.   RelMode: Integer; 
  307. begin
  308.   LockMode := LockSetGet;
  309.   RelMode := Process;
  310.   with CreateSharedPropertyGroupManager do
  311.     Result := CreatePropertyGroup(Name, LockMode, RelMode, Exists);
  312. end;
  313.  
  314. end.
  315.