oleserver.pp 5.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205
  1. {$mode objfpc}
  2. unit OleServer;
  3. interface
  4. uses Windows, Messages, ActiveX, SysUtils, Classes, ComObj;
  5. type
  6. TVariantArray = Array of OleVariant;
  7. TOleServer = class;
  8. TConnectKind = (ckRunningOrNew,
  9. ckNewInstance,
  10. ckRunningInstance,
  11. ckRemote,
  12. ckAttachToInterface);
  13. TServerEventDispatch = class(TObject, IUnknown, IDispatch)
  14. private
  15. FServer : TOleServer;
  16. protected
  17. function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  18. function _AddRef: Integer; stdcall;
  19. function _Release: Integer; stdcall;
  20. function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  21. function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  22. function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  23. NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  24. function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  25. Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  26. property Server: TOleServer read FServer;
  27. function ServerDisconnect :Boolean;
  28. public
  29. constructor Create(aServer: TOleServer);
  30. end;
  31. PServerData = ^TServerData;
  32. TServerData = record
  33. ClassID: TGUID;
  34. IntfIID: TGUID;
  35. EventIID: TGUID;
  36. LicenseKey: Pointer;
  37. Version: Integer;
  38. InstanceCount: Integer;
  39. end;
  40. TOleServer = class(TComponent, IUnknown)
  41. private
  42. FRemoteMachineName: string;
  43. FEventDispatch: TServerEventDispatch;
  44. FServerData: PServerData;
  45. protected
  46. function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; override;
  47. function _AddRef: Integer; stdcall;
  48. function _Release: Integer; stdcall;
  49. procedure Loaded; override;
  50. procedure InitServerData; virtual; abstract;
  51. function GetServer: IUnknown; virtual;
  52. procedure ConnectEvents(const Obj: IUnknown);
  53. procedure DisconnectEvents(const Obj: Iunknown);
  54. procedure InvokeEvent(DispID: TDispID; var Params: TVariantArray); virtual;
  55. function GetConnectKind: TConnectKind;
  56. procedure SetConnectKind(ck: TConnectKind);
  57. function GetAutoConnect: Boolean;
  58. procedure SetAutoConnect(flag: Boolean);
  59. property ServerData: PServerData read FServerData write FServerData;
  60. property EventDispatch: TServerEventDispatch read FEventDispatch write FEventDispatch;
  61. public
  62. constructor Create(AOwner: TComponent); override;
  63. destructor Destroy; override;
  64. procedure Connect; virtual; abstract;
  65. procedure Disconnect; virtual; abstract;
  66. published
  67. property AutoConnect: Boolean read GetAutoConnect write SetAutoConnect;
  68. property ConnectKind: TConnectKind read GetConnectKind write SetConnectKind;
  69. property RemoteMachineName: string read FRemoteMachineName write FRemoteMachineName;
  70. end;
  71. implementation
  72. function TServerEventDispatch.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  73. begin
  74. end;
  75. function TServerEventDispatch._AddRef: Integer; stdcall;
  76. begin
  77. end;
  78. function TServerEventDispatch._Release: Integer; stdcall;
  79. begin
  80. end;
  81. function TServerEventDispatch.GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  82. begin
  83. end;
  84. function TServerEventDispatch.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  85. begin
  86. end;
  87. function TServerEventDispatch.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  88. NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  89. begin
  90. end;
  91. function TServerEventDispatch.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  92. Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
  93. begin
  94. end;
  95. function TServerEventDispatch.ServerDisconnect :Boolean;
  96. begin
  97. end;
  98. constructor TServerEventDispatch.Create(aServer: TOleServer);
  99. begin
  100. end;
  101. function TOleServer.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
  102. begin
  103. end;
  104. function TOleServer._AddRef: Integer; stdcall;
  105. begin
  106. end;
  107. function TOleServer._Release: Integer; stdcall;
  108. begin
  109. end;
  110. procedure TOleServer.Loaded;
  111. begin
  112. end;
  113. function TOleServer.GetServer: IUnknown;
  114. begin
  115. end;
  116. procedure TOleServer.ConnectEvents(const Obj: IUnknown);
  117. begin
  118. end;
  119. procedure TOleServer.DisconnectEvents(const Obj: Iunknown);
  120. begin
  121. end;
  122. procedure TOleServer.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
  123. begin
  124. end;
  125. function TOleServer.GetConnectKind: TConnectKind;
  126. begin
  127. end;
  128. procedure TOleServer.SetConnectKind(ck: TConnectKind);
  129. begin
  130. end;
  131. function TOleServer.GetAutoConnect: Boolean;
  132. begin
  133. end;
  134. procedure TOleServer.SetAutoConnect(flag: Boolean);
  135. begin
  136. end;
  137. constructor TOleServer.Create(AOwner: TComponent);
  138. begin
  139. end;
  140. destructor TOleServer.Destroy;
  141. begin
  142. end;
  143. end.