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