1 unit uROPSServerLink;
2 
3 interface
4 uses
5   SysUtils, Classes, uPSCompiler, uPSUtils, uPSRuntime,
6   uROServer, uROClient, uRODL{$IFDEF WIN32},
7   Windows{$ELSE}, Types{$ENDIF}, uROTypes, uROClientIntf,
8   uROSerializer, uPSComponent;
9 
10 type
11 
12   TPSROModule = class
13   protected
14     class procedure ExecImp(exec: TPSExec; ri: TPSRuntimeClassImporter); virtual;
15     class procedure CompImp(comp: TPSPascalCompiler); virtual;
16   end;
17   TPSROModuleClass = class of TPSROModule;
18   TPSRemObjectsSdkPlugin = class;
19   TPSROModuleLoadEvent = procedure (Sender: TPSRemObjectsSdkPlugin) of object;
20 
21   TPSRemObjectsSdkPlugin = class(TPSPlugin)
22   private
23     FRodl: TRODLLibrary;
24     FModules: TList;
25     FOnLoadModule: TPSROModuleLoadEvent;
26 
27     FEnableIndyTCP: Boolean;
28     FEnableIndyHTTP: Boolean;
29     FEnableBinary: Boolean;
GetHaveRodlnull30     function GetHaveRodl: Boolean;
MkStructNamenull31     function MkStructName(Struct: TRODLStruct): string;
32   public
33     procedure CompileImport1(CompExec: TPSScript); override;
34     procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
35   protected
36     procedure Loaded; override;
37   public
38 
39     procedure RODLLoadFromFile(const FileName: string);
40 
41     procedure RODLLoadFromResource;
42 
43     procedure RODLLoadFromStream(S: TStream);
44 
45     procedure ClearRodl;
46 
47     property HaveRodl: Boolean read GetHaveRodl;
48 
49     constructor Create(AOwner: TComponent); override;
50 
51     destructor Destroy; override;
52 
53 
54     procedure ReloadModules;
55 
56     procedure RegisterModule(Module: TPSROModuleClass);
57   published
58     property OnLoadModule: TPSROModuleLoadEvent read FOnLoadModule write FOnLoadModule;
59 
60     property EnableIndyTCP: Boolean read FEnableIndyTCP write FEnableIndyTCP default true;
61 
62     property EnableIndyHTTP: Boolean read FEnableIndyHTTP write FEnableIndyHTTP default true;
63 
64     property EnableBinary: Boolean read FEnableBinary write FEnableBinary default true;
65   end;
66 
67 implementation
68 uses
69   uRODLToXML, uROPSImports;
70 
71 procedure SIRegisterTROTRANSPORTCHANNEL(CL: TPSPascalCompiler);
72 Begin
73 With cl.AddClassN(cl.FindClass('TComponent'), 'TROTRANSPORTCHANNEL') do
74   begin
75   end;
76 end;
77 
78 procedure SIRegisterTROMESSAGE(CL: TPSPascalCompiler);
79 Begin
80 With cl.AddClassN(cl.FindClass('TComponent'),'TROMESSAGE') do
81   begin
82   RegisterProperty('MESSAGENAME', 'STRING', iptrw);
83   RegisterProperty('INTERFACENAME', 'STRING', iptrw);
84   end;
85 end;
86 
87 procedure TROMESSAGEINTERFACENAME_W(Self: TROMESSAGE; const T: STRING);
88 begin Self.INTERFACENAME := T; end;
89 
90 procedure TROMESSAGEINTERFACENAME_R(Self: TROMESSAGE; var T: STRING);
91 begin T := Self.INTERFACENAME; end;
92 
93 procedure TROMESSAGEMESSAGENAME_W(Self: TROMESSAGE; const T: STRING);
94 begin Self.MESSAGENAME := T; end;
95 
96 procedure TROMESSAGEMESSAGENAME_R(Self: TROMESSAGE; var T: STRING);
97 begin T := Self.MESSAGENAME; end;
98 
99 procedure RIRegisterTROTRANSPORTCHANNEL(Cl: TPSRuntimeClassImporter);
100 Begin
101 with Cl.Add(TROTRANSPORTCHANNEL) do
102   begin
103   RegisterVirtualConstructor(@TROTRANSPORTCHANNEL.CREATE, 'CREATE');
104   end;
105 end;
106 
107 procedure RIRegisterTROMESSAGE(Cl: TPSRuntimeClassImporter);
108 Begin
109 with Cl.Add(TROMESSAGE) do
110   begin
111   RegisterVirtualConstructor(@TROMESSAGE.CREATE, 'CREATE');
112   RegisterPropertyHelper(@TROMESSAGEMESSAGENAME_R,@TROMESSAGEMESSAGENAME_W,'MESSAGENAME');
113   RegisterPropertyHelper(@TROMESSAGEINTERFACENAME_R,@TROMESSAGEINTERFACENAME_W,'INTERFACENAME');
114   end;
115 end;
116 
117 
118 (*----------------------------------------------------------------------------*)
119 procedure SIRegister_TROBinaryMemoryStream(CL: TPSPascalCompiler);
120 begin
121   //with RegClassS(CL,'TMemoryStream', 'TROBinaryMemoryStream') do
122   with CL.AddClassN(CL.FindClass('TMemoryStream'),'TROBinaryMemoryStream') do
123   begin
124     RegisterMethod('Constructor Create2( const iString : Ansistring);');
125     RegisterMethod('Constructor Create;');
126     RegisterMethod('Procedure Assign( iSource : TStream)');
127     RegisterMethod('Function Clone : TROBinaryMemoryStream');
128     RegisterMethod('Procedure LoadFromString( const iString : Ansistring)');
129     RegisterMethod('Procedure LoadFromHexString( const iString : Ansistring)');
130     RegisterMethod('Function ToString : AnsiString');
131     RegisterMethod('Function ToHexString : Ansistring');
132     RegisterMethod('Function ToReadableString : Ansistring');
133     RegisterMethod('Function WriteAnsiString( AString : AnsiString) : integer');
134     RegisterProperty('CapacityIncrement', 'integer', iptrw);
135   end;
136 end;
137 
138 (*----------------------------------------------------------------------------*)
139 procedure SIRegister_uROClasses(CL: TPSPascalCompiler);
140 begin
141   SIRegister_TROBinaryMemoryStream(CL);
142 end;
143 
144 (* === run-time registration functions === *)
145 (*----------------------------------------------------------------------------*)
146 procedure TROBinaryMemoryStreamCapacityIncrement_W(Self: TROBinaryMemoryStream; const T: integer);
147 begin Self.CapacityIncrement := T; end;
148 
149 (*----------------------------------------------------------------------------*)
150 procedure TROBinaryMemoryStreamCapacityIncrement_R(Self: TROBinaryMemoryStream; var T: integer);
151 begin T := Self.CapacityIncrement; end;
152 
153 (*----------------------------------------------------------------------------*)
TROBinaryMemoryStreamCreate_Pnull154 Function TROBinaryMemoryStreamCreate_P(Self: TClass; CreateNewInstance: Boolean):TObject;
155 Begin Result := TROBinaryMemoryStream.Create; END;
156 
157 (*----------------------------------------------------------------------------*)
TROBinaryMemoryStreamCreate2_Pnull158 Function TROBinaryMemoryStreamCreate2_P(Self: TClass; CreateNewInstance: Boolean;  const iString : Ansistring):TObject;
159 Begin Result := TROBinaryMemoryStream.Create(iString); END;
160 
161 (*----------------------------------------------------------------------------*)
162 procedure RIRegister_TROBinaryMemoryStream(CL: TPSRuntimeClassImporter);
163 begin
164   with CL.Add(TROBinaryMemoryStream) do
165   begin
166     RegisterConstructor(@TROBinaryMemoryStreamCreate2_P, 'Create2');
167     RegisterConstructor(@TROBinaryMemoryStreamCreate_P, 'Create');
168     RegisterMethod(@TROBinaryMemoryStream.Assign, 'Assign');
169     RegisterMethod(@TROBinaryMemoryStream.Clone, 'Clone');
170     RegisterMethod(@TROBinaryMemoryStream.LoadFromString, 'LoadFromString');
171     RegisterMethod(@TROBinaryMemoryStream.LoadFromHexString, 'LoadFromHexString');
172     RegisterMethod(@TROBinaryMemoryStream.ToString, 'ToString');
173     RegisterMethod(@TROBinaryMemoryStream.ToHexString, 'ToHexString');
174     RegisterMethod(@TROBinaryMemoryStream.ToReadableString, 'ToReadableString');
175     RegisterMethod(@TROBinaryMemoryStream.WriteAnsiString, 'WriteAnsiString');
176     RegisterPropertyHelper(@TROBinaryMemoryStreamCapacityIncrement_R,@TROBinaryMemoryStreamCapacityIncrement_W,'CapacityIncrement');
177   end;
178 end;
179 
180 (*----------------------------------------------------------------------------*)
181 procedure RIRegister_uROClasses(CL: TPSRuntimeClassImporter);
182 begin
183   RIRegister_TROBinaryMemoryStream(CL);
184 end;
185 
186 
187 
188 (*----------------------------------------------------------------------------*)
189 
190 type
191   TRoObjectInstance = class;
192   {   }
193   IROClass = interface
194     ['{246B5804-461F-48EC-B2CA-FBB7B69B0D64}']
SLFnull195     function SLF: TRoObjectInstance;
196   end;
197   TRoObjectInstance = class(TInterfacedObject, IROClass)
198   private
199     FMessage: IROMessage;
200     FChannel: IROTransportChannel;
201   public
202     constructor Create;
SLFnull203     function SLF: TRoObjectInstance;
204     property Message: IROMessage read FMessage write FMessage;
205     property Channel: IROTransportChannel read FChannel write FChannel;
206   end;
207 
208 
209 
CreateProcnull210 function CreateProc(Caller: TPSExec; p: PIFProcRec; Global, Stack: TPSStack): Boolean;
211 var
212   temp, res: TPSVariantIFC;
213   Chan: TROTransportChannel;
214   Msg: TROMessage;
215   NewRes: TRoObjectInstance;
216 begin
217   res := NewTPSVariantIFC(Stack[Stack.count -1], True);
218   if (Res.Dta = nil) or (res.aType.BaseType <> btInterface) then
219   begin
220     Caller.CMD_Err2(erCustomError, 'RO Invoker: Invalid Parameters');
221     Result := False;
222     exit;
223   end;
224   IUnknown(Res.Dta^) := nil;
225 
226   NewRes := TRoObjectInstance.Create;
227 
228   temp := NewTPSVariantIFC(Stack[Stack.Count -4], True);
229 
230   if (temp.aType <> nil) and (temp.Dta <> nil) and (Temp.aType.BaseType = btClass) and (TObject(Temp.Dta^) is TROTransportChannel) then
231     Chan := TROTransportChannel(temp.dta^)
232   else
233     Chan := nil;
234   temp := NewTPSVariantIFC(Stack[Stack.Count -3], True);
235   if (temp.aType <> nil) and (temp.Dta <> nil) and (Temp.aType.BaseType = btClass) and (TObject(Temp.Dta^) is TROMessage) then
236     Msg := TROMessage(temp.dta^)
237   else
238     Msg := nil;
239   if (msg = nil) or (chan = nil) then
240   begin
241     Chan.free;
242     msg.Free;
243 
244     NewRes.Free;
245     Result := false;
246     Caller.CMD_Err2(erCustomError, 'Could not create message');
247     exit;
248   end;
249 
250   IRoClass(Res.Dta^) := NewRes;
251 
252   NewRes.Message := Msg;
253   NewRes.Channel := Chan;
254   Result := True;
255 end;
256 
NilProcnull257 function NilProc(Caller: TPSExec; p: PIFProcRec; Global, Stack: TPSStack): Boolean;
258 var
259   n: TPSVariantIFC;
260 begin
261   n := NewTPSVariantIFC(Stack[Stack.count -1], True);
262   if (n.Dta = nil) or (n.aType = nil) or (n.aType.BaseType <> btInterface) then
263   begin
264     Caller.CMD_Err2(erCustomError, 'RO Invoker: Cannot free');
265     Result := False;
266     exit;
267   end;
268   IUnknown(n.Dta^) := nil;
269   Result := True;
270 end;
271 
272 type
273   TROStructure = class(TPersistent, IROCustomStreamableType, IROCustomStreamableStruct)
274   private
275     FVar: TPSVariantIFC;
276     FExec: TPSExec;
277   protected
GetTypeNamenull278     function GetTypeName: string;
279     procedure SetTypeName(const s: string);
280     procedure Write(Serializer: TROSerializer; const Name: string);
281     procedure Read(Serializer: TROSerializer; const Name: string);
_AddRefnull282     function _AddRef: Integer; stdcall;
_Releasenull283     function _Release: Integer; stdcall;
QueryInterfacenull284     function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
CanImplementTypenull285     function CanImplementType(const aName: string):boolean;
286     procedure SetNull(b: Boolean);
IsNullnull287     function IsNull: Boolean;
288   public
289     constructor Create(aVar: TPSVariantIfc; Exec: TPSExec);
290   end;
291   TROArray = class(TROStructure, IROCustomStreamableType, IROCustomStreamableStruct, IROCustomStreamableArray)
292   protected
GetCountnull293     function GetCount: Longint;
294      procedure SetCount(l: Longint);
295   end;
296 
297 procedure WriteUserDefined(Exec: TPSExec; const Msg: IROMessage; const Name: string; const n: TPSVariantIfc);
298 var
299   obj: TROStructure;
300 begin
301   if n.aType.BaseType = btArray then
302     obj := TROArray.Create(n, exec)
303   else if n.aType.BaseType = btRecord then
304     obj := TROStructure.Create(n, exec)
305   else
306     raise Exception.Create('Unknown custom type');
307   try
308     Msg.Write(Name, obj.ClassInfo, obj, []);
309   finally
310     obj.Free;
311   end;
312 end;
313 
314 procedure ReadUserDefined(Exec: TPSExec; const Msg: IROMessage;  const Name: string; const n: TPSVariantIfc);
315 var
316   obj: TROStructure;
317 begin
318   if n.aType.BaseType = btArray then
319     obj := TROArray.Create(n, exec)
320   else if n.aType.BaseType = btRecord then
321     obj := TROStructure.Create(n, exec)
322   else
323     raise Exception.Create('Unknown custom type');
324   try
325     Msg.Read(Name, obj.ClassInfo, obj, []);
326   finally
327     obj.Free;
328   end;
329 end;
330 
RoProcnull331 function RoProc(Caller: TPSExec; p: TIFExternalProcRec; Global, Stack: TIfList): Boolean;
332 var
333   s, s2: string;
334   res, n: TPSVariantIFC;
335   aType: TRODataType;
336   aMode: TRODLParamFlag;
337   StartOffset, I: Longint;
338   __request, __response : TMemoryStream;
339   Inst:  TRoObjectInstance;
340 
341 begin
342   s := p.Decl;
343 
344   if s[1] = #255 then
345   begin
346     n := NewTPSVariantIFC(Stack[Stack.Count -1], True);
347     res.Dta := nil;
348     res.aType := nil;
349     StartOffset := Stack.Count -2;
350   end
351   else
352   begin
353     n := NewTPSVariantIFC(Stack[Stack.Count -2], True);
354     res := NewTPSVariantIFC(Stack[Stack.Count -1], True);
355     StartOffset := Stack.Count -3;
356   end;
357 
358   if (n.Dta = nil) or (N.aType = nil) or (n.aType.BaseType <> btInterface) or (Longint(n.Dta^) = 0) then
359   begin
360     Caller.CMD_Err2(erCustomError, 'RO Invoker: Invalid Parameters');
361     Result := False;
362     exit;
363   end;
364 
365   Inst := IROClass(n.dta^).Slf;
366   Delete(s, 1, 1);
367   i := StartOffset;
368   try
369     Inst.SLF.Message.InitializeRequestMessage(Inst.Channel, '', Copy(p.Name,1,pos('.', p.Name) -1), Copy(p.Name, pos('.', p.Name)+1, MaxInt));
370     while Length(s) > 0 do
371     begin
372       s2 := copy(s, 2, ord(s[1]));
373       aMode := TRODLParamFlag(ord(s[length(s2)+2]));
374       aType := TRODataType(ord(s[length(s2)+3]));
375       Delete(s, 1, length(s2)+3);
376       n := NewTPSVariantIFC(Stack[i], True);
377       Dec(I);
378       if ((aMode = fIn) or (aMode = fInOut)) and (n.Dta <> nil) then
379       begin
380         case aType of
381           rtInteger: Inst.Message.Write(s2, TypeInfo(Integer),  Integer(n.Dta^), []);
382           rtDateTime: Inst.Message.Write(s2, TypeInfo(DateTime), Double(n.Dta^), []);
383           rtDouble: Inst.Message.Write(s2, TypeInfo(Double), Double(n.Dta^), []);
384           rtCurrency: Inst.Message.Write(s2, TypeInfo(Double), Double(n.Dta^), []);
385           rtWideString: Inst.Message.Write(s2, TypeInfo(WideString), WideString(n.Dta^), []);
386           rtString: Inst.Message.Write(s2, TypeInfo(String), String(n.Dta^), []);
387           rtInt64: Inst.Message.Write(s2, TypeInfo(Int64), Int64(n.Dta^), []);
388           rtBoolean: Inst.Message.Write(s2, TypeInfo(Boolean), Byte(n.Dta^), []);
389           rtUserDefined: WriteUserDefined(Caller, Inst.Message, s2, n);
390         end;
391       end;
392     end;
393     __request := TMemoryStream.Create;
394     __response := TMemoryStream.Create;
395     try
396       Inst.Message.WriteToStream(__request);
397       Inst.Channel.Dispatch(__request, __response);
398       Inst.Message.ReadFromStream(__response);
399     finally
400       __request.Free;
401       __response.Free;
402     end;
403     s := p.Decl;
404     Delete(s, 1, 1);
405     i := StartOffset;
406     while Length(s) > 0 do
407     begin
408       s2 := copy(s, 2, ord(s[1]));
409       aMode := TRODLParamFlag(ord(s[length(s2)+2]));
410       aType := TRODataType(ord(s[length(s2)+3]));
411       Delete(s, 1, length(s2)+3);
412       n := NewTPSVariantIFC(Stack[i], True);
413       Dec(I);
414       if ((aMode = fOut) or (aMode = fInOut)) and (n.Dta <> nil) then
415       begin
416         case aType of
417           rtInteger: Inst.Message.Read(s2, TypeInfo(Integer), Longint(n.Dta^), []);
418           rtDateTime: Inst.Message.Read(s2, TypeInfo(DateTime), double(n.dta^), []);
419           rtDouble: Inst.Message.Read(s2, TypeInfo(Double), double(n.dta^), []);
420           rtCurrency: Inst.Message.Read(s2, TypeInfo(Double), double(n.dta^), []);
421           rtWideString: Inst.Message.Read(s2, TypeInfo(WideString), widestring(n.Dta^), []);
422           rtString: Inst.Message.Read(s2, TypeInfo(String), string(n.dta^), []);
423           rtInt64: Inst.Message.Read(s2, TypeInfo(Int64), Int64(n.Dta^), []);
424           rtBoolean: Inst.Message.Read(s2, TypeInfo(Boolean), Boolean(n.Dta^), []);
425           rtUserDefined: ReadUserDefined(Caller, Inst.Message, s2, n);
426         end;
427       end;
428     end;
429     aType := TRODataType(p.Decl[1]);
430     case aType of
431       rtInteger: Inst.Message.Read('Result', TypeInfo(Integer), Longint(res.Dta^), []);
432       rtDateTime: Inst.Message.Read('Result', TypeInfo(DateTime), Double(res.dta^), []);
433       rtDouble: Inst.Message.Read('Result', TypeInfo(Double), Double(res.Dta^), []);
434       rtCurrency: Inst.Message.Read('Result', TypeInfo(Double), double(res.Dta^), []);
435       rtWideString: Inst.Message.Read('Result', TypeInfo(WideString), WideString(res.Dta^), []);
436       rtString: Inst.Message.Read('Result', TypeInfo(String), String(res.Dta^), []);
437       rtInt64: Inst.Message.Read('Result', TypeInfo(Int64), Int64(res.dta^), []);
438       rtBoolean: Inst.Message.Read('Result', TypeInfo(Boolean), Boolean(res.dta^), []);
439       rtUserDefined: ReadUserDefined(Caller, Inst.Message, 'Result', res);
440     end;
441   except
442     on e: Exception do
443     begin
444       Caller.CMD_Err2(erCustomError, e.Message);
445       Result := False;
446       exit;
447     end;
448   end;
449   Result := True;
450 end;
451 
SProcImportnull452 function SProcImport(Sender: TPSExec; p: TIFExternalProcRec; Tag: Pointer): Boolean;
453 var
454   s: string;
455 begin
456   s := p.Decl;
457   Delete(s, 1, pos(':', s));
458   if s[1] = '-' then
459     p.ProcPtr := @NilProc
460   else if s[1] = '!' then
461   begin
462     P.ProcPtr := @CreateProc;
463     p.Decl := Copy(s, 2, MaxInt);
464   end else
465   begin
466     Delete(s, 1, 1);
467     p.Name := Copy(S,1,pos('!', s)-1);
468     Delete(s, 1, pos('!', s));
469     p.Decl := s;
470     p.ProcPtr := @RoProc;
471   end;
472   Result := True;
473 end;
474 
475 
476 type
477   TMYComp = class(TPSPascalCompiler);
478   TRoClass = class(TPSExternalClass)
479   private
480     FService: TRODLService;
481     FNilProcNo: Cardinal;
482     FCompProcno: Cardinal;
CreateParameterStringnull483     function CreateParameterString(l: TRODLOperation): string;
GetDTnull484     function GetDT(DataType: string): TRODataType;
485     procedure MakeDeclFor(Dest: TPSParametersDecl; l: TRODLOperation);
486   public
487     constructor Create(Se: TPSPascalCompiler; Service: TRODLService; Const Typeno: TPSType);
488 
SelfTypenull489     function SelfType: TPSType; override;
Func_Findnull490     function Func_Find(const Name: tbtstring; var Index: Cardinal): Boolean; override;
Func_Callnull491     function Func_Call(Index: Cardinal; var ProcNo: Cardinal): Boolean; override;
SetNilnull492     function SetNil(var ProcNo: Cardinal): Boolean; override;
493 
ClassFunc_Findnull494     function ClassFunc_Find(const Name: tbtstring; var Index: Cardinal): Boolean; override;
ClassFunc_Callnull495     function ClassFunc_Call(Index: Cardinal; var ProcNo: Cardinal): Boolean; override;
IsCompatibleWithnull496     function IsCompatibleWith(Cl: TPSExternalClass): Boolean; override;
497   end;
498 
499 { TROPSLink }
500 procedure TPSRemObjectsSdkPlugin.RODLLoadFromFile(const FileName: string);
501 var
502   f: TFileStream;
503 begin
504   f := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
505   try
506     RODLLoadFromStream(f);
507   finally
508     f.Free;
509   end;
510 end;
511 
512 procedure TPSRemObjectsSdkPlugin.RODLLoadFromResource;
513 var
514   rs: TResourceStream;
515 begin
516   rs := TResourceStream.Create(HInstance, 'RODLFILE', RT_RCDATA);
517   try
518     RODLLoadFromStream(rs);
519   finally
520     rs.Free;
521   end;
522 end;
523 
524 procedure TPSRemObjectsSdkPlugin.RODLLoadFromStream(S: TStream);
525 begin
526   FreeAndNil(FRodl);
527   with TXMLToRODL.Create do
528   begin
529     try
530       FRodl := Read(S);
531     finally
532       Free;
533     end;
534   end;
535 end;
536 
537 
538 destructor TPSRemObjectsSdkPlugin.Destroy;
539 begin
540   FreeAndNil(FRodl);
541   FModules.Free;
542   inherited Destroy;
543 end;
544 
545 { TRoClass }
546 
547 constructor TRoClass.Create(Se: TPSPascalCompiler; Service: TRODLService; Const Typeno: TPSType);
548 begin
549   inherited Create(SE, TypeNo);
550   FService := Service;
551   FNilProcNo := Cardinal(-1);
552   FCompProcNo := Cardinal(-1);
553 end;
554 
TRoClass.GetDTnull555 function TRoClass.GetDT(DataType: string): TRODataType;
556 begin
557   DataType := LowerCase(DataType);
558   if DataType = 'integer' then
559     Result := rtInteger
560   else if DataType = 'datetime' then
561     Result := rtDateTime
562   else if DataType = 'double' then
563     Result := rtDouble
564   else if DataType = 'currency' then
565     Result := rtCurrency
566   else if DataType = 'widestring' then
567     Result := rtWidestring
568   else if DataType = 'string' then
569     Result := rtString
570   else if DataType = 'int64' then
571     Result := rtInt64
572   else if DataType = 'boolean' then
573     Result := rtBoolean
574   else if DataType = 'variant' then
575     Result := rtVariant
576   else if DataType = 'binary' then
577     Result := rtBinary
578   else
579     Result := rtUserDefined;
580 end;
581 
CreateParameterStringnull582 function TRoClass.CreateParameterString(l: TRODLOperation): string;
583 var
584   i: Longint;
585 begin
586   if L.Result = nil then
587   begin
588     Result := #$FF;
589   end else
590   begin
591     Result := Chr(Ord(GetDT(l.Result.DataType)));
592   end;
593   for i := 0 to l.Count -1 do
594   begin
595     if l.Items[i].Flag = fResult then Continue;
596     Result := Result + Chr(Length(l.Items[i].Info.Name))+ l.Items[i].Info.Name + Chr(Ord(l.Items[i].Flag)) + Chr(Ord(GetDT(l.Items[i].DataType)));
597   end;
598 end;
599 
600 procedure TRoClass.MakeDeclFor(Dest: TPSParametersDecl; l: TRODLOperation);
601 var
602   i: Longint;
603   dd: TPSParameterDecl;
604 begin
605   if l.Result <> nil then
606   begin
607     Dest.Result := TMyComp(SE).at2ut(SE.FindType(l.Result.DataType));
608   end;
609   for i := 0 to l.Count -1 do
610   begin
611     if l.Items[i].Flag = fResult then Continue;
612     dd := Dest.AddParam;
613     if l.Items[i].Flag = fIn then
614       dd.mode := pmIn
615     else
616       dd.Mode := pmInOut;
617     dd.OrgName := l.Items[i].Info.Name;
618     dd.aType := TMyComp(SE).at2ut(SE.FindType(l.Items[i].DataType));
619   end;
620 end;
621 
Func_Callnull622 function TRoClass.Func_Call(Index: Cardinal; var ProcNo: Cardinal): Boolean;
623 var
624   h, i: Longint;
625   s, e: string;
626   P: TPSProcedure;
627   p2: TPSExternalProcedure;
628 begin
629     s := 'roclass:_'+FService.Info.Name + '.' + FService.Default.Items[Index].Info.Name;
630   h := MakeHash(s);
631   for i := 0 to TMyComp(SE).FProcs.Count -1 do
632   begin
633     P := TMyComp(SE).FProcs[i];
634     if (p is TPSExternalProcedure) then
635     begin
636       p2 := TPSExternalProcedure(p);
637       if (p2.RegProc.NameHash = h) and (Copy(p2.RegProc.ImportDecl, 1, pos(tbtchar('!'), p2.RegProc.ImportDecl)) = s) then
638       begin
639         Procno := I;
640         Result := True;
641         Exit;
642       end;
643     end;
644   end;
645   e := CreateParameterString(FService.Default.Items[Index]);
646   s := s + '!' + e;
647   ProcNo := TMyComp(SE).AddUsedFunction2(P2);
648   p2.RegProc := TPSRegProc.Create;
649   TMYComp(SE).FRegProcs.Add(p2.RegProc);
650   p2.RegProc.Name := '';
651   p2.RegProc.ExportName := True;
652   MakeDeclFor(p2.RegProc.Decl, FService.Default.Items[Index]);
653   p2.RegProc.ImportDecl := s;
654   Result := True;
655 end;
656 
TRoClass.Func_Findnull657 function TRoClass.Func_Find(const Name: tbtstring; var Index: Cardinal): Boolean;
658 var
659   i: Longint;
660 begin
661   for i := 0 to FService.Default.Count -1 do
662   begin
663     if CompareText(FService.Default.Items[i].Info.Name, Name) = 0 then
664     begin
665       Index := i;
666       Result := True;
667       Exit;
668     end;
669   end;
670   Result := False;
671 end;
672 
673 const
674   PSClassType = '!ROClass';
675   MyGuid: TGuid = '{CADCCF37-7FA0-452E-971D-65DA691F7648}';
676 
SelfTypenull677 function TRoClass.SelfType: TPSType;
678 begin
679   Result := SE.FindType(PSClassType);
680   if Result = nil then
681   begin
682     Result := se.AddInterface(se.FindInterface('IUnknown'), MyGuid, PSClassType).aType;
683   end;
684 end;
685 
TRoClass.SetNilnull686 function TRoClass.SetNil(var ProcNo: Cardinal): Boolean;
687 var
688   P: TPSExternalProcedure;
689 begin
690   if FNilProcNo <> Cardinal(-1) then
691     ProcNo:= FNilProcNo
692   else
693   begin
694     ProcNo := TMyComp(SE).AddUsedFunction2(P);
695     p.RegProc := TPSRegProc.Create;
696     TMyComp(SE).FRegProcs.Add(p.RegProc);
697     p.RegProc.Name := '';
698     p.RegProc.ExportName := True;
699     with p.RegProc.Decl.AddParam do
700     begin
701       OrgName := 'VarNo';
702       aType := TMYComp(Se).at2ut(SelfType);
703     end;
704     p.RegProc.ImportDecl := 'roclass:-';
705     FNilProcNo := Procno;
706   end;
707   Result := True;
708 end;
709 
TRoClass.ClassFunc_Callnull710 function TRoClass.ClassFunc_Call(Index: Cardinal;
711   var ProcNo: Cardinal): Boolean;
712 var
713   P: TPSExternalProcedure;
714 begin
715   if FCompProcNo <> Cardinal(-1) then
716   begin
717     Procno := FCompProcNo;
718     Result := True;
719     Exit;
720   end;
721   ProcNo := TMyComp(SE).AddUsedFunction2(P);
722   p.RegProc := TPSRegProc.Create;
723   TMyComp(SE).FRegProcs.Add(p.RegProc);
724   p.RegProc.ExportName := True;
725   p.RegProc.Decl.Result := TMyComp(SE).at2ut(SelfType);
726   with p.RegProc.Decl.AddParam do
727   begin
728     Orgname := 'Message';
729     aType :=TMyComp(SE).at2ut(SE.FindType('TROMESSAGE'));
730   end;
731   with p.RegProc.Decl.AddParam do
732   begin
733     Orgname := 'Channel';
734     aType :=TMyComp(SE).at2ut(SE.FindType('TROTRANSPORTCHANNEL'));
735   end;
736   p.RegProc.ImportDecl := 'roclass:!';
737   FCompProcNo := Procno;
738   Result := True;
739 end;
740 
ClassFunc_Findnull741 function TRoClass.ClassFunc_Find(const Name: tbtstring;
742   var Index: Cardinal): Boolean;
743 begin
744   if Name = 'CREATE' then
745   begin
746     Result := True;
747     Index := 0;
748   end else
749     result := False;
750 end;
751 
TRoClass.IsCompatibleWithnull752 function TRoClass.IsCompatibleWith(Cl: TPSExternalClass): Boolean;
753 begin
754   Result := Cl is TRoClass;
755 end;
756 
757 { TRoObjectInstance }
758 
TRoObjectInstance.SLFnull759 function TRoObjectInstance.SLF: TRoObjectInstance;
760 begin
761   Result := Self;
762 end;
763 
764 constructor TRoObjectInstance.Create;
765 begin
766   FRefCount := 1;
767 end;
768 
769 
MkStructNamenull770 function TPSRemObjectsSdkPlugin.MkStructName(Struct: TRODLStruct): string;
771 var
772   i: Longint;
773 begin
774   Result := '!ROStruct!'+Struct.Info.Name+ ',';
775   for i := 0 to Struct.Count -1 do
776   begin
777     Result := Result + Struct.Items[i].Info.Name+ ',';
778   end;
779 end;
780 
CompareStructItemnull781 function CompareStructItem(const S1, S2: TRODLTypedEntity): Integer;
782 begin
783   Result := CompareText(S1.Info.Name, S2.Info.Name);
784 end;
785 
786 procedure SortStruct(struct: TRODLStruct; First, Last: Longint);
787 var
788   l, r, Pivot: Integer;
789 begin
790   while First < Last do
791   begin
792     Pivot := (First + Last) div 2;
793     l := First - 1;
794     r := Last + 1;
795     repeat
796       repeat inc(l); until CompareStructItem(Struct.Items[l], Struct.Items[Pivot]) >= 0;
797       repeat dec(r); until CompareStructItem(Struct.Items[r], Struct.Items[Pivot]) <= 0;
798       if l >= r then break;
799       Struct.Exchange(l, r);
800     until false;
801     if First < r then SortStruct(Struct, First, r);
802     First := r+1;
803   end;
804 end;
805 
806 procedure TPSRemObjectsSdkPlugin.CompileImport1(CompExec: TPSScript);
807 var
808   i, i1: Longint;
809   Enum: TRODLEnum;
810   TempType: TPSType;
811   Struct: TRODLStruct;
812   Arr: TRODLArray;
813   RecType: TPSRecordFieldTypeDef;
814   Service: TRODLService;
815 begin
816   if FRODL = nil then exit;
817   if CompExec.Comp.FindType('TDateTime') = nil then
818     raise Exception.Create('Please register the DateUtils library first');
819   if CompExec.Comp.FindType('TStream') = nil then
820     raise Exception.Create('Please register the sysutils/classes library first');
821   SIRegisterTROTRANSPORTCHANNEL(CompExec.Comp);
822   SIRegisterTROMESSAGE(CompExec.Comp);
823   SIRegister_uROClasses(CompExec.Comp);
824   CompExec.Comp.AddTypeCopyN('Binary', 'TROBinaryMemoryStream');
825   if CompExec.Comp.FindType('DateTime') = nil then
826     CompExec.Comp.AddTypeCopyN('DateTime', 'TDateTime');
827   if CompExec.Comp.FindType('Currency') = nil then
828     CompExec.Comp.AddTypeCopyN('Currency', 'Double'); // for now
829   for i := 0 to FRodl.EnumCount -1 do
830   begin
831     Enum := FRodl.Enums[i];
832     TempType := CompExec.Comp.AddType(Enum.Info.Name, btEnum);
833     for i1 := 0 to Enum.Count -1 do
834     begin
835       CompExec.Comp.AddConstant(Enum.Items[i1].Info.Name, TempType).SetUInt(i1);
836     end;
837   end;
838   for i := 0 to FRodl.StructCount -1 do
839   begin
840     Struct := FRodl.Structs[i];
841     SortStruct(Struct, 0, Struct.Count-1);
842     TempType := CompExec.Comp.AddType('', btRecord);
843     TempType.ExportName := True;
844     TempType.Name := MkStructName(Struct);
845     for i1 := 0 to Struct.Count -1 do
846     begin
847       RecType := TPSRecordType(TempType).AddRecVal;
848       RecType.FieldOrgName := Struct.Items[i1].Info.Name;
849       RecType.aType := CompExec.Comp.FindType(Struct.Items[i1].DataType);
850       if RecType.aType = nil then begin
851         Arr := fRodl.FindArray(Struct.Items[i1].DataType);
852         if Arr <> nil then begin
853           RecType.aType := CompExec.Comp.AddType(Arr.Info.Name, btArray);
854           TPSArrayType(RecType.aType).ArrayTypeNo := CompExec.Comp.FindType(Arr.ElementType);
855         end;
856       end;
857     end;
858     CompExec.Comp.AddTypeCopy(Struct.Info.Name, TempType);
859   end;
860   for i := 0 to FRodl.ArrayCount -1 do
861   begin
862     Arr := FRodl.Arrays[i];
863     TempType := CompExec.Comp.FindType(Arr.Info.Name);
864     if TempType <> nil then begin
865       if not (TempType is TPSArrayType) then begin
866         CompExec.Comp.MakeError('ROPS', ecDuplicateIdentifier, Arr.Info.Name);
867       end;
868     end else begin
869       TempType := CompExec.Comp.AddType(Arr.Info.Name, btArray);
870     end;
871     TPSArrayType(TempType).ArrayTypeNo := CompExec.Comp.FindType(Arr.ElementType);
872   end;
873   for i := 0 to FRodl.ServiceCount -1 do
874   begin
875     Service := FRodl.Services[i];
876     TempType := CompExec.Comp.AddType(Service.Info.Name, btExtClass);
877     TPSUndefinedClassType(TempType).ExtClass := TRoClass.Create(CompExec.Comp, Service, TempType);
878   end;
879   for i := 0 to FModules.Count -1 do
880     TPSROModuleClass(FModules[i]).CompImp(CompExec.Comp);
881 end;
882 
TPSRemObjectsSdkPlugin.GetHaveRodlnull883 function TPSRemObjectsSdkPlugin.GetHaveRodl: Boolean;
884 begin
885   Result := FRodl <> nil;
886 end;
887 
888 procedure TPSRemObjectsSdkPlugin.ClearRodl;
889 begin
890   FRodl.Free;
891   FRodl := nil;
892 end;
893 
894 procedure TPSRemObjectsSdkPlugin.ExecImport1(CompExec: TPSScript;
895   const ri: TPSRuntimeClassImporter);
896 var
897   i: Longint;
898 begin
899   if FRODL = nil then exit;
900   CompExec.Exec.AddSpecialProcImport('roclass', SProcImport, nil);
901   RIRegisterTROTRANSPORTCHANNEL(ri);
902   RIRegisterTROMESSAGE(ri);
903   RIRegister_TROBinaryMemoryStream(ri);
904   for i := 0 to FModules.Count -1 do
905     TPSROModuleClass(FModules[i]).ExecImp(CompExec.Exec, ri);
906 end;
907 
908 constructor TPSRemObjectsSdkPlugin.Create(AOwner: TComponent);
909 begin
910   inherited Create(AOwner);
911   FModules := TList.Create;
912   //FEnableSOAP := True;
913   FEnableBinary := True;
914   FEnableIndyTCP := True;
915   FEnableIndyHTTP := True;
916 end;
917 
918 procedure TPSRemObjectsSdkPlugin.Loaded;
919 begin
920   inherited Loaded;
921   ReloadModules;
922 end;
923 
924 procedure TPSRemObjectsSdkPlugin.RegisterModule(
925   Module: TPSROModuleClass);
926 begin
927   FModules.Add(Module);
928 end;
929 
930 procedure TPSRemObjectsSdkPlugin.ReloadModules;
931 begin
932   FModules.Clear;
933   if FEnableIndyTCP then RegisterModule(TPSROIndyTCPModule);
934   if FEnableIndyHTTP then RegisterModule(TPSROIndyHTTPModule);
935   //if FEnableSOAP then RegisterModule(TPSROSoapModule);
936   if FEnableBinary then RegisterModule(TPSROBinModule);
937   if assigned(FOnLoadModule) then
938     FOnLoadModule(Self);
939 end;
940 
941 { TPSROModule }
942 
943 class procedure TPSROModule.CompImp(comp: TPSPascalCompiler);
944 begin
945   // do nothing
946 end;
947 
948 class procedure TPSROModule.ExecImp(exec: TPSExec;
949   ri: TPSRuntimeClassImporter);
950 begin
951   // do nothing
952 end;
953 
954 procedure IntRead(Exec: TPSExec; Serializer: TROSerializer;
955   const Name: string; aVar: TPSVariantIFC; arridx: Longint);
956 var
957   i: Longint;
958   s, s2: string;
959   r: TROStructure;
960 begin
961   case aVar.aType.BaseType of
962     btS64: Serializer.Read(Name, TypeInfo(int64), Int64(avar.Dta^), arridx);
963     btu32: Serializer.Read(Name, TypeInfo(cardinal), Cardinal(avar.Dta^), arridx);
964     bts32: Serializer.Read(Name, TypeInfo(longint), Longint(avar.Dta^), arridx);
965     btu16: Serializer.Read(Name, TypeInfo(word), Word(aVar.Dta^), arridx);
966     btS16: Serializer.Read(Name, TypeInfo(smallint), Smallint(aVar.Dta^), arridx);
967     btu8: Serializer.Read(Name, TypeInfo(byte), Byte(aVar.Dta^), arridx);
968     btS8: Serializer.Read(Name, TypeInfo(shortint), Shortint(aVar.Dta^), arridx);
969     btDouble:
970       begin
971         if aVar.aType.ExportName = 'TDATETIME' then
972           Serializer.Read(Name, TypeInfo(datetime), Double(avar.Dta^), arridx)
973         else
974           Serializer.Read(Name, TypeInfo(double), Double(aVar.Dta^), arridx);
975       end;
976     btSingle: Serializer.Read(Name, TypeInfo(single), Single(avar.Dta^), arridx);
977     btExtended: Serializer.Read(Name, TypeInfo(extended), Extended(avar.dta^), arridx);
978     btWideString: Serializer.Read(Name, TypeInfo(widestring), widestring(avar.dta^), arridx);
979     btString: Serializer.Read(Name, TypeInfo(string), string(avar.dta^), arridx);
980     btArray:
981       begin
982         if (TPSTypeRec_Array(avar.aType).ArrayType.BaseType = btRecord) then
983         begin
984           for i := 0 to PSDynArrayGetLength(Pointer(aVar.Dta^), aVar.aType) -1 do
985           begin
986             r := TROStructure.Create(PSGetArrayField(avar, i), Exec);
987             try
988               Serializer.Read(Name, typeinfo(TROArray), r, i);
989             finally
990               r.Free;
991             end;
992           end;
993         end else if (TPSTypeRec_Array(avar.aType).ArrayType.BaseType = btArray) then
994         begin
995           for i := 0 to PSDynArrayGetLength(Pointer(aVar.Dta^), aVar.aType) -1 do
996           begin
997             r := TROArray.Create(PSGetArrayField(avar, i), Exec);
998             try
999               Serializer.Read(Name, typeinfo(TROArray), r, i);
1000             finally
1001               r.Free;
1002             end;
1003           end;
1004         end else begin
1005           for i := 0 to PSDynArrayGetLength(Pointer(aVar.Dta^), aVar.aType) -1 do
1006           begin
1007             IntRead(Exec, Serializer, Name, PSGetArrayField(avar, i), i);
1008           end;
1009         end;
1010       end;
1011     btRecord:
1012       begin
1013         s := avar.aType.ExportName;
1014         if copy(s,1, 10) <> '!ROStruct!' then
1015           raise Exception.Create('Invalid structure: '+s);
1016         Delete(s,1,pos(',',s));
1017         for i := 0 to TPSTypeRec_Record(aVar.aType).FieldTypes.Count -1 do
1018         begin
1019           s2 := copy(s,1,pos(',',s)-1);
1020           delete(s,1,pos(',',s));
1021           if (TPSTypeRec(TPSTypeRec_Record(aVar.aType).FieldTypes[i]).BaseType = btRecord) then
1022           begin
1023 
1024             r := TROStructure.Create(PSGetRecField(aVar, i), Exec);
1025             try
1026               Serializer.Read(s2, typeinfo(TROStructure), r, -1);
1027             finally
1028               r.Free;
1029             end;
1030           end else if (TPSTypeRec(TPSTypeRec_Record(aVar.aType).FieldTypes[i]).BaseType = btArray)  then
1031           begin
1032             r := TROArray.Create(PSGetRecField(aVar, i), Exec);
1033             try
1034               Serializer.Read(s2, typeinfo(TROArray), r, -1);
1035             finally
1036               r.Free;
1037             end;
1038           end else
1039             IntRead(Exec, Serializer, s2, PSGetRecField(aVar, i), -1);
1040         end;
1041       end;
1042   else
1043     raise Exception.Create('Unable to read type');
1044 
1045   end;
1046 end;
1047 
1048 procedure IntWrite(Exec: TPSExec; Serializer: TROSerializer;
1049   const Name: string; aVar: TPSVariantIFC; arridx: Longint);
1050 var
1051   i: Longint;
1052   s, s2: string;
1053   r: TROStructure;
1054 begin
1055   case aVar.aType.BaseType of
1056     btS64: Serializer.Write(Name, TypeInfo(int64), Int64(avar.Dta^), arridx);
1057     btu32: Serializer.Write(Name, TypeInfo(cardinal), Cardinal(avar.Dta^), arridx);
1058     bts32: Serializer.Write(Name, TypeInfo(longint), Longint(avar.Dta^), arridx);
1059     btu16: Serializer.Write(Name, TypeInfo(word), Word(avar.Dta^), arridx);
1060     btS16: Serializer.Write(Name, TypeInfo(smallint), Smallint(aVar.Dta^), arridx);
1061     btu8: Serializer.Write(Name, TypeInfo(byte), Byte(aVar.Dta^), arridx);
1062     btS8: Serializer.Write(Name, TypeInfo(shortint), ShortInt(aVar.Dta^), arridx);
1063     btDouble:
1064       begin
1065         if aVar.aType.ExportName = 'TDATETIME' then
1066           Serializer.Write(Name, TypeInfo(datetime), Double(aVar.Dta^), arridx)
1067         else
1068           Serializer.Write(Name, TypeInfo(double), Double(aVar.Dta^), arridx);
1069       end;
1070     btSingle: Serializer.Write(Name, TypeInfo(single), Single(aVar.Dta^), arridx);
1071     btExtended: Serializer.Write(Name, TypeInfo(extended), Extended(aVar.Dta^), arridx);
1072     btWideString: Serializer.Write(Name, TypeInfo(widestring), WideString(aVar.Dta^), arridx);
1073     btString: Serializer.Write(Name, TypeInfo(string), String(aVar.Dta^), arridx);
1074     btArray:
1075       begin
1076         if (TPSTypeRec_Array(avar.aType).ArrayType.BaseType = btRecord) then
1077         begin
1078           for i := 0 to PSDynArrayGetLength(Pointer(aVar.Dta^), aVar.aType) -1 do
1079           begin
1080             r := TROStructure.Create(PSGetArrayField(aVar, i), Exec);
1081             try
1082               Serializer.Write(Name, typeinfo(TROArray), r, i);
1083             finally
1084               r.Free;
1085             end;
1086           end;
1087         end else if (TPSTypeRec_Array(avar.aType).ArrayType.BaseType = btArray) then
1088         begin
1089           for i := 0 to PSDynArrayGetLength(Pointer(aVar.Dta^), aVar.aType) -1 do
1090           begin
1091             r := TROArray.Create(PSGetArrayField(aVar, i), Exec);
1092             try
1093               Serializer.Write(Name, typeinfo(TROArray), r, i);
1094             finally
1095               r.Free;
1096             end;
1097           end;
1098         end else begin
1099           for i := 0 to PSDynArrayGetLength(Pointer(aVar.Dta^), aVar.aType) -1 do
1100           begin
1101             IntWrite(Exec, Serializer, Name, PSGetArrayField(aVar, i), i);
1102           end;
1103         end;
1104       end;
1105     btRecord:
1106       begin
1107         s := avar.aType.ExportName;
1108         if copy(s,1, 10) <> '!ROStruct!' then
1109           raise Exception.Create('Invalid structure: '+s);
1110         Delete(s,1,pos(',',s));
1111         for i := 0 to TPSTypeRec_Record(aVar.aType).FieldTypes.Count -1 do
1112         begin
1113           s2 := copy(s,1,pos(',',s)-1);
1114           delete(s,1,pos(',',s));
1115           if (TPSTypeRec(TPSTypeRec_Record(aVar.aType).FieldTypes[i]).BaseType = btRecord) then
1116           begin
1117             r := TROStructure.Create(PSGetRecField(aVar, i), Exec);
1118             try
1119               Serializer.Write(s2, typeinfo(TROStructure), r, -1);
1120             finally
1121               r.Free;
1122             end;
1123           end else if (TPSTypeRec(TPSTypeRec_Record(aVar.aType).FieldTypes[i]).BaseType = btArray)  then
1124           begin
1125             r := TROArray.Create(PSGetRecField(aVar, i), Exec);
1126             try
1127               Serializer.Write(s2, typeinfo(TROArray), r, -1);
1128             finally
1129               r.Free;
1130             end;
1131           end else
1132             IntWrite(Exec, Serializer, s2, PSGetRecField(aVar, i), -1);
1133         end;
1134       end;
1135   else
1136     raise Exception.Create('Unable to read type');
1137 
1138   end;
1139 end;
1140 
1141 { TROStructure }
1142 
1143 constructor TROStructure.Create(aVar: TPSVariantIfc; Exec: TPSExec);
1144 begin
1145   inherited Create;
1146   FVar := aVar;
1147   FExec := Exec;
1148 end;
1149 
TROStructure.IsNullnull1150 function TROStructure.IsNull: Boolean;
1151 begin
1152   Result := False;
1153 end;
1154 
TROStructure.QueryInterfacenull1155 function TROStructure.QueryInterface(const IID: TGUID;
1156   out Obj): HResult;
1157 begin
1158   if GetInterface(IID, Obj) then
1159     Result := 0
1160   else
1161     Result := E_NOINTERFACE;
1162 end;
1163 
1164 procedure TROStructure.Read(Serializer: TROSerializer;
1165   const Name: string);
1166 begin
1167   IntRead(FExec, Serializer, Name, FVar, -1);
1168 end;
1169 
1170 procedure TROStructure.SetNull(b: Boolean);
1171 begin
1172   // null not supported
1173 end;
1174 
TROStructure.GetTypeNamenull1175 function TROStructure.GetTypeName: string;
1176 var
1177   s: string;
1178 begin
1179   s := fvar.atype.ExportName;
1180   delete(s,1,1);
1181   delete(s,1,pos('!', s));
1182   result := copy(s,1,pos(',',s)-1);
1183 end;
1184 
1185 procedure TROStructure.Write(Serializer: TROSerializer;
1186   const Name: string);
1187 begin
1188   IntWrite(FExec, Serializer, Name, FVar, -1);
1189 end;
1190 
1191 
TROStructure._AddRefnull1192 function TROStructure._AddRef: Integer;
1193 begin
1194   // do nothing
1195   Result := 1;
1196 end;
1197 
_Releasenull1198 function TROStructure._Release: Integer;
1199 begin
1200   // do nothing
1201   Result := 1;
1202 end;
1203 
CanImplementTypenull1204 function TROStructure.CanImplementType(const aName: string): boolean;
1205 begin
1206   if SameText(aName, Self.GetTypeName) then
1207     Result := True
1208   else
1209     Result := False;
1210 end;
1211 
1212 procedure TROStructure.SetTypeName(const s: string);
1213 begin
1214   // Do nothing
1215 end;
1216 
1217 { TROArray }
1218 
GetCountnull1219 function TROArray.GetCount: Longint;
1220 begin
1221 
1222   // we should have an array in pVar now so assume that's true
1223   Result := PSDynArrayGetLength(Pointer(fVar.Dta^), fvar.aType);
1224 end;
1225 
1226 procedure TROArray.SetCount(l: Integer);
1227 begin
1228   PSDynArraySetLength(Pointer(fVAr.Dta^), fVar.aType, l);
1229 end;
1230 
1231 end.
1232