david
d99a44999f
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@7 b6239004-a887-0f4b-9937-50029ccdca16
425 lines
14 KiB
ObjectPascal
425 lines
14 KiB
ObjectPascal
unit uRODLToPascalInvk;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - CodeGen }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$IFDEF LINUX}
|
|
{$I ../RemObjects.inc}
|
|
{$ELSE}
|
|
{$I ..\RemObjects.inc}
|
|
{$ENDIF LINUX}
|
|
|
|
interface
|
|
|
|
uses uRODL;
|
|
|
|
type { TRODLToInvk }
|
|
TRODLToInvk = class(TRODLConverter)
|
|
private
|
|
fIntfUnitName : string;
|
|
|
|
procedure WriteInvokerDeclaration(const aService: TRODLService; aLibrary : TRODLLibrary);
|
|
procedure WriteOperationImplementation(const aService : TRODLService;
|
|
const anOperation : TRODLOperation;
|
|
aLibrary : TRODLLibrary);
|
|
|
|
protected
|
|
procedure IntConvert(const aLibrary : TRODLLibrary; const aTargetEntity : string = ''); override;
|
|
|
|
public
|
|
class function GetTargetFileName(const aLibrary : TRODLLibrary; const aTargetEntity : string = ''): string; override;
|
|
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses SysUtils, uRODLGenTools, uROTypes, uRODLToPascalImpl, uRODLToPascalIntf, Dialogs, uRODLToPascal;
|
|
|
|
{ TRODLToInvk }
|
|
|
|
procedure TRODLToInvk.IntConvert(const aLibrary: TRODLLIbrary; const aTargetEntity : string = '');
|
|
var i, k : integer;
|
|
s,t,actualname : string;
|
|
begin
|
|
fIntfUnitName := ChangeFileExt(TRODLToIntf.GetTargetFileName(aLibrary), '');
|
|
|
|
Write(Format('unit %s;', [ChangeFileExt(GetTargetFileName(aLibrary), '')]));
|
|
WriteEmptyLine;
|
|
|
|
WriteLines(IntfInvkNotice);
|
|
WriteEmptyLine;
|
|
|
|
Write('{$I Remobjects.inc}');
|
|
WriteEmptyLine;
|
|
|
|
Write('interface');
|
|
WriteEmptyLine;
|
|
|
|
Write('uses');
|
|
Write('{vcl:} Classes,' ,PASCAL_INDENTATION_LEVEL_1);
|
|
Write('{RemObjects:} uROXMLIntf, uROServer, uROServerIntf, uROTypes, uROClientIntf,' ,PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
if aLibrary.UseCount > 0 then begin
|
|
|
|
s := '';
|
|
t := '';
|
|
for i := 0 to aLibrary.UseCount-1 do begin
|
|
|
|
if aLibrary.Use[i].LoadedRodlLibraryName <> '' then
|
|
actualname := aLibrary.Use[i].LoadedRodlLibraryName
|
|
else
|
|
actualname := ChangeFileExt(ExtractFilename(aLibrary.Use[i].RodlFile),'');
|
|
|
|
if (Pos(actualname+'_Intf', s)<=0) then begin
|
|
if s <> '' then s := s+', ';
|
|
s := s+actualname+'_Intf';
|
|
end;
|
|
|
|
if (Pos(actualname+'_Invk', t)<=0) then begin
|
|
if t <> '' then t := t+', ';
|
|
t := t+actualname+'_Invk';
|
|
end;
|
|
end; { for }
|
|
|
|
if (s<>'') then begin
|
|
s := s+',';
|
|
Write('{Used RODL Intf''s:} '+s,PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
|
|
if (t<>'') then begin
|
|
t := t+',';
|
|
Write('{Used RODL Invk''s:} '+t,PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
end;
|
|
|
|
Write(Format('{Generated:} %s_Intf;', [aLibrary.Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
|
|
if aLibrary.ServiceCount > 0 then Write('type');
|
|
|
|
with aLibrary.CalcServiceOrder() do begin
|
|
for i := 0 to (Count-1) do //if (not aLibrary.Services[i].IsFromUsedRodl) then
|
|
WriteInvokerDeclaration(Objects[i] as TRODLService, aLibrary);
|
|
end;
|
|
|
|
{for i := 0 to (aLibrary.ServiceCount-1) do if (not aLibrary.Services[i].IsFromUsedRodl) then
|
|
WriteInvokerDeclaration(aLibrary.Services[i], aLibrary); }
|
|
|
|
Write('implementation');
|
|
WriteEmptyLine;
|
|
|
|
//s := '';
|
|
{for i := 0 to (aLibrary.ServiceCount-1) do begin
|
|
//s := s+ChangeFileExt(TRODLToImpl.GetTargetFileName(aLibrary, aLibrary.Services[i].Info.Name),'');
|
|
s := s+aLibrary.Services[i].Info.Name+'_Impl';
|
|
if (i<aLibrary.ServiceCount-1) then s := s+', ';
|
|
end;}
|
|
|
|
Write('uses');
|
|
(*if (Trim(s)<>'')
|
|
then Write(Format('{RemObjects:} uRORes, %s;', [s]),PASCAL_INDENTATION_LEVEL_1)
|
|
else *)Write(Format('{RemObjects:} uRORes, uROClient;', []),PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine;
|
|
|
|
for i := 0 to (aLibrary.ServiceCount-1) do if (not aLibrary.Services[i].IsFromUsedRodl) then begin
|
|
//WriteInvokerHandleMessage(aLibrary.Services[i]);
|
|
|
|
if not Assigned(aLibrary.Services[i].Default) then Continue;
|
|
|
|
if aLibrary.Services[i].Default.Count > 0 then begin
|
|
Write('{ T'+aLibrary.Services[i].Info.Name+'_Invoker }');
|
|
WriteEmptyLine;
|
|
end;
|
|
|
|
for k := 0 to (aLibrary.Services[i].Default.Count-1) do
|
|
{s := Format('aaa %s ', ['mmm']);
|
|
Buffer.Add(s);
|
|
//} WriteOperationImplementation(aLibrary.Services[i], aLibrary.Services[i].Default.Items[k], aLibrary);
|
|
|
|
end;
|
|
|
|
for i := 0 to (aLibrary.ServiceCount-1) do ;
|
|
|
|
Write('end.');
|
|
end;
|
|
|
|
procedure TRODLToInvk.WriteInvokerDeclaration(const aService : TRODLService; aLibrary : TRODLLibrary);
|
|
var i : integer;
|
|
begin
|
|
Write('{$M+}', PASCAL_INDENTATION_LEVEL_1);
|
|
if aService.Ancestor <> '' then begin
|
|
Write(Format('T%s_Invoker = class(T%s_Invoker)', [aService.Info.Name,aService.Ancestor]), PASCAL_INDENTATION_LEVEL_1);
|
|
end
|
|
else begin
|
|
Write(Format('T%s_Invoker = class(TROInvoker)', [aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
Write('private', PASCAL_INDENTATION_LEVEL_1);
|
|
Write('protected', PASCAL_INDENTATION_LEVEL_1);
|
|
Write('published', PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
for i := 0 to (aService.Default.Count-1) do begin
|
|
Write(Format('procedure Invoke_%s(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);', [aService.Default.Items[i].Info.Name]), PASCAL_INDENTATION_LEVEL_2);
|
|
end;
|
|
|
|
Write('end;', PASCAL_INDENTATION_LEVEL_1);
|
|
Write('{$M-}', PASCAL_INDENTATION_LEVEL_1);
|
|
WriteEmptyLine();
|
|
end;
|
|
|
|
procedure TRODLToInvk.WriteOperationImplementation(
|
|
const aService : TRODLService;
|
|
const anOperation: TRODLOperation; aLibrary : TRODLLibrary);
|
|
const resultname = 'return';
|
|
var i : integer;
|
|
lHasObjectDisposer: Boolean;
|
|
pars, s, sa : string;
|
|
typname : string;
|
|
begin
|
|
Write(Format('procedure T%s_Invoker.Invoke_%s(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);',
|
|
[aService.Info.Name, anOperation.Info.Name]));
|
|
|
|
Write(Format('{ %s }', [GetOperationDefinition(anOperation)]));
|
|
|
|
with anOperation do begin
|
|
|
|
{ Determine if we need an ObjectDisposer }
|
|
lHasObjectDisposer := False;
|
|
for i := 0 to (Count-1) do with Items[i] do begin
|
|
if IsImplementedAsClass(DataType, aLibrary) then begin
|
|
lHasObjectDisposer := true;
|
|
break;
|
|
end;
|
|
end;
|
|
if Assigned(Result) and IsImplementedAsClass(Result.DataType, aLibrary) then
|
|
lHasObjectDisposer := true;
|
|
|
|
//ShowMessage('1');
|
|
|
|
{ Write local variables }
|
|
if (Count>0) or Assigned(Result) or lHasObjectDisposer then Write('var');
|
|
for i := 0 to (Count-1) do begin
|
|
|
|
typname := GetDataType(Items[i].DataType);
|
|
if IsUserDefinedType(typname,aLibrary) then begin
|
|
typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
|
|
end;
|
|
|
|
Write(Format('%s: %s;', [Items[i].Name, typname]),PASCAL_INDENTATION_LEVEL_1);
|
|
if (Items[i].Flag = fInOut) and IsImplementedAsClass(Items[i].DataType, aLibrary) then
|
|
Write(Format('__in_%s: %s;', [Items[i].Name, typname]),PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
|
|
//ShowMessage('2');
|
|
|
|
if Assigned(Result) then begin
|
|
typname := GetDataType(Result.DataType);
|
|
if IsUserDefinedType(typname,aLibrary) then begin
|
|
typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
|
|
end;
|
|
Write(Format('lResult: %s;', [ typname]),PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
|
|
|
|
if lHasObjectDisposer then
|
|
Write('__lObjectDisposer: TROObjectDisposer;',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
{ if Assigned(Result)
|
|
then Write(' %s: %s;', [resultname, Result.DataType]);}
|
|
|
|
//ShowMessage('3');
|
|
|
|
Write('begin');
|
|
sa := GetAttributes(anOperation.Info.Attributes, aService.Info.Attributes, aLibrary.Info.Attributes, 4);
|
|
if sa <> '' then
|
|
Write(' __Message.SetAttributes(__Transport, '+sa +');');
|
|
|
|
if (Count>0) then begin
|
|
for i := 0 to (Count-1) do begin
|
|
with Items[i] do begin
|
|
if IsImplementedAsClass(DataType, aLibrary) then begin
|
|
Write(Format('%s := nil;', [Items[i].Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
if (Flag = fInOut) then
|
|
Write(Format('__in_%s := nil;', [Items[i].Name]),PASCAL_INDENTATION_LEVEL_1);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
if Assigned(Result) then
|
|
if IsImplementedAsClass(Result.DataType, aLibrary) then
|
|
Write('lResult := nil;',PASCAL_INDENTATION_LEVEL_1);
|
|
|
|
Write(' try');
|
|
|
|
//ShowMessage('4');
|
|
|
|
for i := 0 to (Count-1) do
|
|
if IsInputFlag(Items[i].Flag) then begin
|
|
|
|
if (StrToDataType(Items[i].DataType)=rtDateTime)
|
|
then sa := '[paIsDateTime]'
|
|
else sa := '[]';
|
|
|
|
typname := GetDataType(Items[i].DataType);
|
|
if IsUserDefinedType(typname,aLibrary) then begin
|
|
typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
|
|
end;
|
|
|
|
Write(Format('__Message.Read(''%s'', TypeInfo(%s), %s, %s);',[Items[i].Name, typname, Items[i].Name, sa]),PASCAL_INDENTATION_LEVEL_2);
|
|
if (Items[i].Flag = fInOut) and IsImplementedAsClass(Items[i].DataType, aLibrary) then begin
|
|
Write(Format('__in_%s := %s;',[Items[i].Name, Items[i].Name]),PASCAL_INDENTATION_LEVEL_2)
|
|
end;
|
|
end;
|
|
|
|
if (Count>0) then WriteEmptyLine;
|
|
s := ' ';
|
|
if Assigned(Result) then s := s+'lResult := ';
|
|
s := s+Format('(__Instance as I%s).%s', [aService.Name, anOperation.Name]);
|
|
|
|
//ShowMessage('5');
|
|
|
|
if (Count>0) then begin
|
|
pars := '';
|
|
for i := 0 to (Count-1) do begin
|
|
if (Items[i].Flag=fResult) then Continue;
|
|
pars := pars+Items[i].Name+', ';
|
|
end;
|
|
|
|
if pars<>'' then s := s+'('+Copy(pars, 1, Length(pars)-2)+')';
|
|
end;
|
|
|
|
s := s+';';
|
|
Write(s);
|
|
|
|
WriteEmptyLine;
|
|
(* if anOperation.Info.Attributes.Values['OutputMessageName'] <> '' then
|
|
Write(Format(' __Message.InitializeResponseMessage(__Transport, ''%s'', ''%s'', ''%s'');',[aLibrary.Name, aService.Name, anOperation.Info.Attributes.Values['OutputMessageName']]))
|
|
else *)
|
|
|
|
Write(Format(' __Message.InitializeResponseMessage(__Transport, ''%s'', ''%s'', ''%sResponse'');',[aLibrary.Name, aService.Name, Name]));
|
|
|
|
|
|
//ShowMessage('6');
|
|
|
|
if Assigned(Result) then begin
|
|
if (StrToDataType(Result.DataType)=rtDateTime) then
|
|
sa := '[paIsDateTime]'
|
|
else
|
|
sa := '[]';
|
|
|
|
typname := GetDataType(Result.DataType);
|
|
if IsUserDefinedType(typname,aLibrary) then begin
|
|
typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
|
|
end;
|
|
|
|
Write(Format(' __Message.Write(''%s'', TypeInfo(%s), lResult, %s);',
|
|
[Result.Name, typname, sa]));
|
|
end;
|
|
|
|
//ShowMessage('7');
|
|
|
|
for i := 0 to (Count-1) do
|
|
if IsOutputFlag(Items[i].Flag) then begin
|
|
|
|
if (StrToDataType(Items[i].DataType)=rtDateTime)
|
|
then sa := '[paIsDateTime]'
|
|
else sa := '[]';
|
|
|
|
typname := GetDataType(Items[i].DataType);
|
|
if IsUserDefinedType(typname,aLibrary) then begin
|
|
typname := GetFullyQualifiedTypeName(typname,aLibrary,fIntfUnitName);
|
|
end;
|
|
|
|
Write(Format(' __Message.Write(''%s'', TypeInfo(%s), %s, %s);',
|
|
[Items[i].Name, typname, Items[i].Name, sa]));
|
|
end;
|
|
|
|
{if Assigned(Result) then begin
|
|
Write(Format(' __Message.Write(''%s'', TypeInfo(%s), @%s);', [resultname, Result.DataType, resultname]))
|
|
end;}
|
|
Write(' __Message.Finalize;');
|
|
if sa <> '' then
|
|
Write(' __Message.UnsetAttributes(__Transport);');
|
|
WriteEmptyLine;
|
|
|
|
if not NeedsAsyncRetrieveOperationDefinition(anOperation) then begin
|
|
Write(' __oResponseOptions := [roNoResponse];');
|
|
WriteEmptyLine;
|
|
end;
|
|
|
|
Write(' finally');
|
|
|
|
//ShowMessage('8');
|
|
|
|
if lHasObjectDisposer then begin
|
|
Write(' __lObjectDisposer := TROObjectDisposer.Create(__Instance);');
|
|
Write(' try');
|
|
|
|
for i := 0 to (Count-1) do with Items[i] do begin
|
|
if IsImplementedAsClass(DataType, aLibrary) then begin
|
|
if Items[i].Flag = fInOut then begin
|
|
Write(Format(' __lObjectDisposer.Add(__in_%s);', [Items[i].Name]));
|
|
end;
|
|
Write(Format(' __lObjectDisposer.Add(%s);', [Items[i].Name]));
|
|
end;
|
|
end;
|
|
if Assigned(Result) then begin
|
|
if IsImplementedAsClass(Result.DataType, aLibrary) then begin
|
|
Write(' __lObjectDisposer.Add(lResult);');
|
|
end;
|
|
end;
|
|
|
|
Write(' finally');
|
|
Write(' __lObjectDisposer.Free();');
|
|
Write(' end;');
|
|
end;
|
|
Write(' end;');
|
|
Write('end;');
|
|
|
|
|
|
{ ToDo: passing an incomig reference to an out param will blow, as both will
|
|
be freed (so the same object si freed twice. we need to add better
|
|
logic to catch this:
|
|
|
|
currently
|
|
|
|
finally
|
|
if (Param1 <> Result) then Param1.Free;
|
|
Result.Free;
|
|
end;
|
|
|
|
better:
|
|
|
|
finally
|
|
if (Param1 <> Result) then Param1.Free;
|
|
Result.Free;
|
|
end;
|
|
}
|
|
|
|
{finally
|
|
if (Param1 <> Result) then Param1.Free;
|
|
Result.Free;
|
|
end;}
|
|
|
|
|
|
|
|
end;
|
|
WriteEmptyLine;
|
|
end;
|
|
|
|
class function TRODLToInvk.GetTargetFileName(const aLibrary: TRODLLIbrary; const aTargetEntity: string): string;
|
|
begin
|
|
result := aLibrary.Name+'_Invk.pas';
|
|
end;
|
|
|
|
end.
|