home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Source / Vcl / CORBASTD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  13.9 KB  |  320 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1999 Inprise Corporation          }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit CorbaStd;
  11.  
  12. interface
  13.  
  14. {$H+,X+}
  15.  
  16. uses Classes, ActiveX, Midas, Forms, CorbaObj, OrbPas;
  17.  
  18. type
  19.  
  20.   { TAppServerSkeleton }
  21.  
  22.   TAppServerSkeleton = class(TCorbaSkeleton)
  23.   private
  24.     FIntf: IAppServer;
  25.   public
  26.     constructor Create(const InstanceName: string; const Impl: IUnknown); override;
  27.     procedure GetImplementation(out Impl: IUnknown); override; stdcall;
  28.   published
  29.     procedure AS_ApplyUpdates(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  30.     procedure AS_GetRecords(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  31.     procedure AS_DataRequest(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  32.     procedure AS_GetProviderNames(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  33.     procedure AS_GetParams(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  34.     procedure AS_RowRequest(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  35.     procedure AS_Execute(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  36.   end;
  37.  
  38.   { TAppServerStub }
  39.  
  40.   TAppServerStub = class(TCorbaDispatchStub, IAppServer)
  41.   public
  42.     function AS_ApplyUpdates {SC:Y, (5/6) CALL:0, INV:1, DBG:7}(const ProviderName: {VT:8:0}(*VT_8:0*)WideString;
  43.                                                                 Delta: {VT:12:0}(*VT_12:0*)OleVariant;
  44.                                                                 MaxErrors: {VT:3:0}(*VT_3:0*)Integer;
  45.                                                                 out ErrorCount: {VT:3:1}(*VT_3:0*)Integer;
  46.                                                                 var OwnerData: {VT:12:1}(*VT_12:0*)OleVariant): (*VT_12:0*)OleVariant; safecall;
  47.     function AS_GetRecords {SC:Y, (6/7) CALL:0, INV:1, DBG:7}(const ProviderName: {VT:8:0}(*VT_8:0*)WideString;
  48.                                                               Count: {VT:3:0}(*VT_3:0*)Integer;
  49.                                                               out RecsOut: {VT:3:1}(*VT_3:0*)Integer;
  50.                                                               Options: {VT:3:0}(*VT_3:0*)Integer;
  51.                                                               const CommandText: {VT:8:0}(*VT_8:0*)WideString;
  52.                                                               var Params: {VT:12:1}(*VT_12:0*)OleVariant; 
  53.                                                               var OwnerData: {VT:12:1}(*VT_12:0*)OleVariant): (*VT_12:0*)OleVariant; safecall;
  54.     function AS_DataRequest {SC:Y, (2/3) CALL:0, INV:1, DBG:7}(const ProviderName: {VT:8:0}(*VT_8:0*)WideString; 
  55.                                                                Data: {VT:12:0}(*VT_12:0*)OleVariant): (*VT_12:0*)OleVariant; safecall;
  56.     function AS_GetProviderNames {SC:Y, (0/1) CALL:0, INV:1, DBG:7}: (*VT_12:0*)OleVariant; safecall;
  57.     function AS_GetParams {SC:Y, (2/3) CALL:0, INV:1, DBG:7}(const ProviderName: {VT:8:0}(*VT_8:0*)WideString;
  58.                                                              var OwnerData: {VT:12:1}(*VT_12:0*)OleVariant): (*VT_12:0*)OleVariant; safecall;
  59.     function AS_RowRequest {SC:Y, (4/5) CALL:0, INV:1, DBG:7}(const ProviderName: {VT:8:0}(*VT_8:0*)WideString;
  60.                                                               Row: {VT:12:0}(*VT_12:0*)OleVariant; 
  61.                                                               RequestType: {VT:3:0}(*VT_3:0*)Integer;
  62.                                                               var OwnerData: {VT:12:1}(*VT_12:0*)OleVariant): (*VT_12:0*)OleVariant; safecall;
  63.     procedure AS_Execute {SC:Y, (3/3) CALL:0, INV:1, DBG:7}(const ProviderName: {VT:8:0}(*VT_8:0*)WideString;
  64.                                                             const CommandText: {VT:8:0}(*VT_8:0*)WideString;
  65.                                                             var Params: {VT:12:1}(*VT_12:0*)OleVariant; 
  66.                                                             var OwnerData: {VT:12:1}(*VT_12:0*)OleVariant); safecall;
  67.   end;
  68.  
  69.  
  70. implementation
  71.  
  72.  
  73. { TAppServerSkeleton }
  74.  
  75. constructor TAppServerSkeleton.Create(const InstanceName: string; const Impl: IUnknown);
  76. begin
  77.   inherited;
  78.   inherited InitSkeleton('AppServer', InstanceName, 'IDL:Project1/IAppServer:1.0', tmMultiThreaded, True);
  79.   FIntf := Impl as IAppServer;
  80. end;
  81.  
  82. procedure TAppServerSkeleton.GetImplementation(out Impl: IUnknown);
  83. begin
  84.   Impl := FIntf;
  85. end;
  86.  
  87. procedure TAppServerSkeleton.AS_ApplyUpdates(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  88. var
  89.   OutBuf: IMarshalOutBuffer;
  90.   Retval: (*VT_12:0*)OleVariant;
  91.   ProviderName: (*VT_8:0*)WideString;
  92.   Delta: (*VT_12:0*)OleVariant;
  93.   MaxErrors: (*VT_3:0*)Integer;
  94.   ErrorCount: (*VT_3:0*)Integer;
  95.   OwnerData: (*VT_12:0*)OleVariant;
  96. begin
  97.   ProviderName := UnmarshalWideText(InBuf);
  98.   Delta := UnmarshalAny(InBuf);
  99.   MaxErrors := InBuf.GetLong;
  100.   Retval := FIntf.AS_ApplyUpdates(ProviderName, Delta, MaxErrors, ErrorCount, OwnerData);
  101.   FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  102.   MarshalAny(OutBuf, Retval);
  103.   OutBuf.PutLong(ErrorCount);
  104.   MarshalAny(OutBuf, OwnerData);
  105. end;
  106.  
  107. procedure TAppServerSkeleton.AS_GetRecords(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  108. var
  109.   OutBuf: IMarshalOutBuffer;
  110.   Retval: (*VT_12:0*)OleVariant;
  111.   ProviderName: (*VT_8:0*)WideString;
  112.   Count: (*VT_3:0*)Integer;
  113.   RecsOut: (*VT_3:0*)Integer;
  114.   Options: (*VT_3:0*)Integer;
  115.   CommandText: (*VT_8:0*)WideString;
  116.   Params: (*VT_12:0*)OleVariant;
  117.   OwnerData: (*VT_12:0*)OleVariant;
  118. begin
  119.   ProviderName := UnmarshalWideText(InBuf);
  120.   Count := InBuf.GetLong;
  121.   Options := InBuf.GetLong;
  122.   CommandText := UnmarshalWideText(InBuf);
  123.   Retval := FIntf.AS_GetRecords(ProviderName, Count, RecsOut, Options, CommandText, Params, OwnerData);
  124.   FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  125.   MarshalAny(OutBuf, Retval);
  126.   OutBuf.PutLong(RecsOut);
  127.   MarshalAny(OutBuf, Params);
  128.   MarshalAny(OutBuf, OwnerData);
  129. end;
  130.  
  131. procedure TAppServerSkeleton.AS_DataRequest(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  132. var
  133.   OutBuf: IMarshalOutBuffer;
  134.   Retval: (*VT_12:0*)OleVariant;
  135.   ProviderName: (*VT_8:0*)WideString;
  136.   Data: (*VT_12:0*)OleVariant;
  137. begin
  138.   ProviderName := UnmarshalWideText(InBuf);
  139.   Data := UnmarshalAny(InBuf);
  140.   Retval := FIntf.AS_DataRequest(ProviderName, Data);
  141.   FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  142.   MarshalAny(OutBuf, Retval);
  143. end;
  144.  
  145. procedure TAppServerSkeleton.AS_GetProviderNames(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  146. var
  147.   OutBuf: IMarshalOutBuffer;
  148.   Retval: (*VT_12:0*)OleVariant;
  149. begin
  150.   Retval := FIntf.AS_GetProviderNames;
  151.   FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  152.   MarshalAny(OutBuf, Retval);
  153. end;
  154.  
  155. procedure TAppServerSkeleton.AS_GetParams(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  156. var
  157.   OutBuf: IMarshalOutBuffer;
  158.   Retval: (*VT_12:0*)OleVariant;
  159.   ProviderName: (*VT_8:0*)WideString;
  160.   OwnerData: (*VT_12:0*)OleVariant;
  161. begin
  162.   ProviderName := UnmarshalWideText(InBuf);
  163.   Retval := FIntf.AS_GetParams(ProviderName, OwnerData);
  164.   FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  165.   MarshalAny(OutBuf, Retval);
  166.   MarshalAny(OutBuf, OwnerData);
  167. end;
  168.  
  169. procedure TAppServerSkeleton.AS_RowRequest(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  170. var
  171.   OutBuf: IMarshalOutBuffer;
  172.   Retval: (*VT_12:0*)OleVariant;
  173.   ProviderName: (*VT_8:0*)WideString;
  174.   Row: (*VT_12:0*)OleVariant;
  175.   RequestType: (*VT_3:0*)Integer;
  176.   OwnerData: (*VT_12:0*)OleVariant;
  177. begin
  178.   ProviderName := UnmarshalWideText(InBuf);
  179.   Row := UnmarshalAny(InBuf);
  180.   RequestType := InBuf.GetLong;
  181.   Retval := FIntf.AS_RowRequest(ProviderName, Row, RequestType, OwnerData);
  182.   FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  183.   MarshalAny(OutBuf, Retval);
  184.   MarshalAny(OutBuf, OwnerData);
  185. end;
  186.  
  187. procedure TAppServerSkeleton.AS_Execute(const InBuf: IMarshalInBuffer; Cookie: Pointer);
  188. var
  189.   OutBuf: IMarshalOutBuffer;
  190.   ProviderName: (*VT_8:0*)WideString;
  191.   CommandText: (*VT_8:0*)WideString;
  192.   Params: (*VT_12:0*)OleVariant;
  193.   OwnerData: (*VT_12:0*)OleVariant;
  194. begin
  195.   ProviderName := UnmarshalWideText(InBuf);
  196.   CommandText := UnmarshalWideText(InBuf);
  197.   FIntf.AS_Execute(ProviderName, CommandText, Params, OwnerData);
  198.   FSkeleton.GetReplyBuffer(Cookie, OutBuf);
  199.   MarshalAny(OutBuf, Params);
  200.   MarshalAny(OutBuf, OwnerData);
  201. end;
  202.  
  203. { TAppServerStub }
  204.  
  205. function TAppServerStub.AS_ApplyUpdates {SC:Y, (5/6) CALL:0, INV:1, DBG:7}(const ProviderName: {VT:8:0}(*VT_8:0*)WideString;
  206.                                                                            Delta: {VT:12:0}(*VT_12:0*)OleVariant;
  207.                                                                            MaxErrors: {VT:3:0}(*VT_3:0*)Integer;
  208.                                                                            out ErrorCount: {VT:3:1}(*VT_3:0*)Integer;
  209.                                                                            var OwnerData: {VT:12:1}(*VT_12:0*)OleVariant): (*VT_12:0*)OleVariant;
  210. var
  211.   OutBuf: IMarshalOutBuffer;
  212.   InBuf: IMarshalInBuffer;
  213. begin
  214.   FStub.CreateRequest('AS_ApplyUpdates', True, OutBuf);
  215.   OutBuf.PutWideText(PWideChar(Pointer(ProviderName)));
  216.   MarshalAny(OutBuf, Delta);
  217.   OutBuf.PutLong(MaxErrors);
  218.   FStub.Invoke(OutBuf, InBuf);
  219.   Result := UnmarshalAny(InBuf);
  220.   ErrorCount := InBuf.GetLong;
  221.   OwnerData := UnmarshalAny(InBuf);
  222. end;
  223.  
  224. function TAppServerStub.AS_GetRecords {SC:Y, (6/7) CALL:0, INV:1, DBG:7}(const ProviderName: {VT:8:0}(*VT_8:0*)WideString;
  225.                                                                          Count: {VT:3:0}(*VT_3:0*)Integer; 
  226.                                                                          out RecsOut: {VT:3:1}(*VT_3:0*)Integer; 
  227.                                                                          Options: {VT:3:0}(*VT_3:0*)Integer;
  228.                                                                          const CommandText: {VT:8:0}(*VT_8:0*)WideString;
  229.                                                                          var Params: {VT:12:1}(*VT_12:0*)OleVariant; 
  230.                                                                          var OwnerData: {VT:12:1}(*VT_12:0*)OleVariant): (*VT_12:0*)OleVariant;
  231. var
  232.   OutBuf: IMarshalOutBuffer;
  233.   InBuf: IMarshalInBuffer;
  234. begin
  235.   FStub.CreateRequest('AS_GetRecords', True, OutBuf);
  236.   OutBuf.PutWideText(PWideChar(Pointer(ProviderName)));
  237.   OutBuf.PutLong(Count);
  238.   OutBuf.PutLong(Options);
  239.   OutBuf.PutWideText(PWideChar(Pointer(CommandText)));
  240.   FStub.Invoke(OutBuf, InBuf);
  241.   Result := UnmarshalAny(InBuf);
  242.   RecsOut := InBuf.GetLong;
  243.   Params := UnmarshalAny(InBuf);
  244.   OwnerData := UnmarshalAny(InBuf);
  245. end;
  246.  
  247. function TAppServerStub.AS_DataRequest {SC:Y, (2/3) CALL:0, INV:1, DBG:7}(const ProviderName: {VT:8:0}(*VT_8:0*)WideString;
  248.                                                                           Data: {VT:12:0}(*VT_12:0*)OleVariant): (*VT_12:0*)OleVariant;
  249. var
  250.   OutBuf: IMarshalOutBuffer;
  251.   InBuf: IMarshalInBuffer;
  252. begin
  253.   FStub.CreateRequest('AS_DataRequest', True, OutBuf);
  254.   OutBuf.PutWideText(PWideChar(Pointer(ProviderName)));
  255.   MarshalAny(OutBuf, Data);
  256.   FStub.Invoke(OutBuf, InBuf);
  257.   Result := UnmarshalAny(InBuf);
  258. end;
  259.  
  260. function TAppServerStub.AS_GetProviderNames {SC:Y, (0/1) CALL:0, INV:1, DBG:7}: (*VT_12:0*)OleVariant;
  261. var
  262.   OutBuf: IMarshalOutBuffer;
  263.   InBuf: IMarshalInBuffer;
  264. begin
  265.   FStub.CreateRequest('AS_GetProviderNames', True, OutBuf);
  266.   FStub.Invoke(OutBuf, InBuf);
  267.   Result := UnmarshalAny(InBuf);
  268. end;
  269.  
  270. function TAppServerStub.AS_GetParams {SC:Y, (2/3) CALL:0, INV:1, DBG:7}(const ProviderName: {VT:8:0}(*VT_8:0*)WideString; 
  271.                                                                         var OwnerData: {VT:12:1}(*VT_12:0*)OleVariant): (*VT_12:0*)OleVariant;
  272. var
  273.   OutBuf: IMarshalOutBuffer;
  274.   InBuf: IMarshalInBuffer;
  275. begin
  276.   FStub.CreateRequest('AS_GetParams', True, OutBuf);
  277.   OutBuf.PutWideText(PWideChar(Pointer(ProviderName)));
  278.   FStub.Invoke(OutBuf, InBuf);
  279.   Result := UnmarshalAny(InBuf);
  280.   OwnerData := UnmarshalAny(InBuf);
  281. end;
  282.  
  283. function TAppServerStub.AS_RowRequest {SC:Y, (4/5) CALL:0, INV:1, DBG:7}(const ProviderName: {VT:8:0}(*VT_8:0*)WideString;
  284.                                                                          Row: {VT:12:0}(*VT_12:0*)OleVariant; 
  285.                                                                          RequestType: {VT:3:0}(*VT_3:0*)Integer; 
  286.                                                                          var OwnerData: {VT:12:1}(*VT_12:0*)OleVariant): (*VT_12:0*)OleVariant;
  287. var
  288.   OutBuf: IMarshalOutBuffer;
  289.   InBuf: IMarshalInBuffer;
  290. begin
  291.   FStub.CreateRequest('AS_RowRequest', True, OutBuf);
  292.   OutBuf.PutWideText(PWideChar(Pointer(ProviderName)));
  293.   MarshalAny(OutBuf, Row);
  294.   OutBuf.PutLong(RequestType);
  295.   FStub.Invoke(OutBuf, InBuf);
  296.   Result := UnmarshalAny(InBuf);
  297.   OwnerData := UnmarshalAny(InBuf);
  298. end;
  299.  
  300. procedure TAppServerStub.AS_Execute {SC:Y, (3/3) CALL:0, INV:1, DBG:7}(const ProviderName: {VT:8:0}(*VT_8:0*)WideString; 
  301.                                                                        const CommandText: {VT:8:0}(*VT_8:0*)WideString; 
  302.                                                                        var Params: {VT:12:1}(*VT_12:0*)OleVariant;
  303.                                                                        var OwnerData: {VT:12:1}(*VT_12:0*)OleVariant);
  304. var
  305.   OutBuf: IMarshalOutBuffer;
  306.   InBuf: IMarshalInBuffer;
  307. begin
  308.   FStub.CreateRequest('AS_Execute', True, OutBuf);
  309.   OutBuf.PutWideText(PWideChar(Pointer(ProviderName)));
  310.   OutBuf.PutWideText(PWideChar(Pointer(CommandText)));
  311.   FStub.Invoke(OutBuf, InBuf);
  312.   Params := UnmarshalAny(InBuf);
  313.   OwnerData := UnmarshalAny(InBuf);
  314. end;
  315.  
  316. initialization
  317.   CORBASkeletonManager.RegisterSkeleton(IAppServer, TAppServerSkeleton);
  318.   CORBAStubManager.RegisterStub(IAppServer, TAppServerStub);
  319. end.
  320.