david
472097efe5
- Recompilación de todos los paquetes de RO para poner RemObjects_Core_D10 como paquete de runtime/designtime. git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@5 b6239004-a887-0f4b-9937-50029ccdca16
540 lines
18 KiB
ObjectPascal
540 lines
18 KiB
ObjectPascal
unit uRODLGenTools;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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 Classes, uRODL, uRORemoteDataModule;
|
|
|
|
const IntfInvkNotice =
|
|
'{----------------------------------------------------------------------------}'+#13#10+
|
|
'{ This unit was automatically generated by the RemObjects SDK after reading }'+#13#10+
|
|
'{ the RODL file associated with this project . }'+#13#10+
|
|
'{ }'+#13#10+
|
|
'{ Do not modify this unit manually, or your changes will be lost when this }'+#13#10+
|
|
'{ unit is regenerated the next time you compile the project. }'+#13#10+
|
|
'{----------------------------------------------------------------------------}';
|
|
|
|
ImplNotice =
|
|
'{----------------------------------------------------------------------------}'+#13#10+
|
|
'{ This unit was automatically generated by the RemObjects SDK after reading }'+#13#10+
|
|
'{ the RODL file associated with this project . }'+#13#10+
|
|
'{ }'+#13#10+
|
|
'{ This is where you are supposed to code the implementation of your objects. }'+#13#10+
|
|
'{----------------------------------------------------------------------------}';
|
|
|
|
IntfInvkNoticeCSharp =
|
|
'//---------------------------------------------------------------------------'+#13+
|
|
'// This source file was automatically generated by the RemObjects SDK after '+#13+
|
|
'// reading the RODL file associated with this project. '+#13+
|
|
'// '+#13+
|
|
'// Do not modify this file manually, or your changes will be lost when this '+#13+
|
|
'// source file is regenerated the next time you compile the project. '+#13+
|
|
'//---------------------------------------------------------------------------';
|
|
|
|
ImplNoticeCSharp =
|
|
'//---------------------------------------------------------------------------'+#13+
|
|
'// This source file was automatically generated by the RemObjects SDK after '+#13+
|
|
'// reading the RODL file associated with this project. '+#13+
|
|
'// '+#13+
|
|
'// This is where you are supposed to code the implementation of your objects.'+#13+
|
|
'//---------------------------------------------------------------------------';
|
|
|
|
DelphiFlagNames : array[TRODLParamFlag] of string = (
|
|
'const', 'out', 'var', 'result');
|
|
|
|
CSharpFlagNames : array[TRODLParamFlag] of string = (
|
|
'', 'out ', 'ref ', 'result');
|
|
|
|
DelphiAsyncInvokeFlagNames : array[TRODLParamFlag] of string = (
|
|
'const', '[out]', 'const', '[result]');
|
|
|
|
DelphiAsyncRetrieveFlagNames : array[TRODLParamFlag] of string = (
|
|
'[const]', 'out', 'out', 'result');
|
|
|
|
type
|
|
PRODataModuleClass = ^TRODataModuleClass;
|
|
TRODataModuleClass = record
|
|
ClassType : TRORemoteDataModuleClass;
|
|
Alias,
|
|
Description,
|
|
RequiredUnits : string;
|
|
end;
|
|
|
|
// Code generation helpers
|
|
function GetOperationDefinition(
|
|
const anOperation : TRODLOperation;
|
|
const aClassName : string = '';
|
|
const aSuffix : string = '';
|
|
AddSenderGUID : boolean = FALSE) : string;
|
|
|
|
function DataTypeToCSharpType(const iType:string; iLibrary:TRODLLibrary=nil; iForNew:boolean=false):string;
|
|
function DataTypeToDelphiDotNetType(const iType:string; iLibrary:TRODLLibrary=nil; iForNew:boolean=false):string;
|
|
|
|
|
|
function GetOperationDefinitionCSharp(
|
|
const anOperation : TRODLOperation;
|
|
aForInterface:boolean;
|
|
const aSuffix : string = ''; aLibrary: TRODLLibrary= nil) : string;
|
|
|
|
function GetOperationDefinitionDelphiForDotNet(const anOperation : TRODLOperation; aLibrary:TRODLLibrary; const aClassName : string = ''; const aSuffix : string = '') : string;
|
|
|
|
function GetAsyncInvokeOperationDefinition(
|
|
const anOperation : TRODLOperation;
|
|
const aClassName : string = '';
|
|
const aSuffix : string = '') : string;
|
|
|
|
function GetAsyncRetrieveOperationDefinition(
|
|
const anOperation : TRODLOperation;
|
|
const aClassName : string = '';
|
|
const aSuffix : string = '') : string;
|
|
function NeedsAsyncRetrieveOperationDefinition(anOperation:TRODLOperation):boolean;
|
|
|
|
function MessageWrite(const iType, iRodlType, iName, iVariable:string):string;
|
|
function MessageRead(const iType, iRodlType, iName:string):string;
|
|
function TypeToReadWriteFn(const iType:string):string;
|
|
|
|
procedure GetTypeNames(const aLibrary : TRODLLibrary; aResult : TStrings);
|
|
function TypeByName(const aLibrary : TRODLLibrary; const aTypeName : string) : TRODLEntity;
|
|
|
|
// TRORemoteDatamodule registration
|
|
procedure RegisterRODataModuleClass(aClass : TRORemoteDataModuleClass; const anAlias, aDescription, someRequiredUnits : string);
|
|
function GetRODataModuleClass(Index : integer) : TRODataModuleClass;
|
|
function GetRODataModuleClassCount : integer;
|
|
|
|
implementation
|
|
|
|
uses {$IFNDEF LINUX}Windows,{$ENDIF} SysUtils, uRORes, uROTypes, uRODLToPascalIntf;
|
|
|
|
var _datamodules : TStringList;
|
|
|
|
const
|
|
MAX_PARAM_LENGTH = 100;
|
|
|
|
// Code generation helpers
|
|
function GetOperationDefinition(const anOperation : TRODLOperation;
|
|
const aClassName : string = ''; const aSuffix : string = '';
|
|
AddSenderGUID : boolean = FALSE) : string;
|
|
var x : integer;
|
|
lPars, lPars2, s : string;
|
|
lFillStr: string;
|
|
begin
|
|
if not Assigned(anOperation.Result) then s := 'procedure ' else s := 'function ';
|
|
|
|
if aClassName<>''
|
|
then s := s+aClassName+'.'+anOperation.Name
|
|
else s := s+anOperation.Name;
|
|
|
|
if aSuffix<>''
|
|
then s := s+aSuffix;
|
|
|
|
if aClassName = '' then
|
|
SetLength(lFillStr,Length(s)+4+1) { Interface section }
|
|
else
|
|
SetLength(lFillStr,Length(s)+1); { Implementation section }
|
|
FillChar(lFillStr[1],Length(lFillStr),#32);
|
|
|
|
with anOperation do begin
|
|
lPars := '';
|
|
lPars2 := '';
|
|
|
|
if (Count>0) then begin
|
|
for x := 0 to (Count-1) do begin
|
|
with Items[x] do begin
|
|
if (Flag <> fResult) then begin
|
|
if Length(lPars2) > MAX_PARAM_LENGTH then begin
|
|
lPars := lPars+lPars2+#13#10+lFillStr;
|
|
lPars2 := '';
|
|
end;
|
|
lPars2 := lPars2+Format('%s %s: %s; ', [DelphiFlagNames[Flag], Name, GetDataType(DataType)]);
|
|
end;
|
|
end;
|
|
end;
|
|
lPars := lPars+lPars2;
|
|
end;
|
|
|
|
if AddSenderGUID then begin
|
|
lPars2 := 'const __Sender : TGUID';
|
|
if (lPars<>'') then lPars2 := lPars2+'; ';
|
|
|
|
lPars := lPars2+lPars;
|
|
end;
|
|
|
|
if (lPars<>'') then begin
|
|
if Count>0
|
|
then s := s+'('+Copy(lPars,1,Length(lPars)-2)+')'
|
|
else s := s+'('+Copy(lPars,1,Length(lPars))+')'
|
|
end;
|
|
end;
|
|
|
|
if Assigned(anOperation.Result) then s := s+': '+GetDataType(anOperation.Result.DataType);
|
|
s := s+';';
|
|
|
|
result := s;
|
|
end;
|
|
|
|
function DataTypeToCSharpType(const iType:string; iLibrary:TRODLLibrary=nil; iForNew:boolean=false):string;
|
|
var
|
|
lType,lElementType:string;
|
|
begin
|
|
lType := iType;
|
|
if CompareText(iType,'Integer') = 0 then begin
|
|
Result := 'Int32';
|
|
end
|
|
else if CompareText(iType,'WideString') = 0 then begin
|
|
Result := 'String';
|
|
end
|
|
else if CompareText(iType,'DateTime') = 0 then begin
|
|
Result := 'DateTime'; //make sure casing is good
|
|
end
|
|
else if CompareText(iType,'Xml') = 0 then begin
|
|
Result := 'XmlNode';
|
|
end
|
|
else if Assigned(iLibrary) and IsArray(lType,ilibrary,lElementType) then begin
|
|
if iForNew then
|
|
Result := DataTypeToCSharpType(lElementType,iLibrary)+'[0]'
|
|
else
|
|
Result := DataTypeToCSharpType(lElementType,iLibrary)+'[]';
|
|
end
|
|
else if Assigned(iLibrary) then begin
|
|
if IsUserDefinedType(lType,iLibrary) then begin
|
|
result := lType; // IsUserDefinedType() fixed the casing
|
|
end
|
|
else begin
|
|
Result := LowerCase(iType);
|
|
if Length(Result) > 0 then Result[1] := UpCase(Result[1]);
|
|
end;
|
|
end
|
|
else begin
|
|
Result := iType;
|
|
end;
|
|
if iForNew and (Pos('[0]',result) = 0) then result := result+'()';
|
|
end;
|
|
|
|
function DataTypeToDelphiDotNetType(const iType:string; iLibrary:TRODLLibrary=nil; iForNew:boolean=false):string;
|
|
var
|
|
lType:string;
|
|
begin
|
|
lType := iType;
|
|
if CompareText(iType, 'Xml') = 0 then
|
|
result := 'XmlNode'
|
|
else
|
|
if CompareText(iType,'WideString') = 0 then begin
|
|
Result := 'String';
|
|
end
|
|
else if Assigned(iLibrary) then begin
|
|
if IsUserDefinedType(lType,iLibrary) then begin
|
|
result := lType; // IsUserDefinedType() fixed the casing
|
|
end
|
|
else begin
|
|
Result := LowerCase(iType);
|
|
if Length(Result) > 0 then Result[1] := UpCase(Result[1]);
|
|
end;
|
|
end
|
|
else begin
|
|
Result := iType;
|
|
end;
|
|
//if iForNew and (Pos('[0]',result) = 0) then result := result+'()';
|
|
end;
|
|
|
|
function GetOperationDefinitionCSharp(const anOperation : TRODLOperation; aForInterface:Boolean; const aSuffix : string = ''; aLibrary: TRODLLibrary = nil) : string;
|
|
var x : integer;
|
|
pars, s : string;
|
|
begin
|
|
if not Assigned(anOperation.Result) then s := 'void ' else s := DataTypeToCSharpType(anOperation.Result.DataType,aLibrary)+' ';
|
|
if not aForInterface then s := 'public '+s;
|
|
|
|
{if aClassName<>''
|
|
then s := s+aClassName+'.'+anOperation.Name
|
|
else}
|
|
s := s+anOperation.Name;
|
|
|
|
{if aSuffix<>''
|
|
then s := s+aSuffix;}
|
|
|
|
with anOperation do
|
|
if (Count>0) then begin
|
|
pars := '';
|
|
|
|
for x := 0 to (Count-1) do begin
|
|
with Items[x] do begin
|
|
if (Flag<>fresult)
|
|
then pars :=pars+Format('%s%s %s, ', [CSharpFlagNames[Flag], DataTypeToCSharpType(DataType,aLibrary), Name]);
|
|
end;
|
|
end;
|
|
|
|
if (pars<>'') then
|
|
s := s+'('+Copy(pars,1,Length(pars)-2)+')'
|
|
else
|
|
s := s+'()';
|
|
end
|
|
else
|
|
s := s+'()';
|
|
|
|
//if Assigned(anOperation.Result) then s := s+': '+anOperation.Result.DataType;
|
|
//s := s+';';
|
|
if aForInterface then s := s+';';
|
|
|
|
result := s;
|
|
end;
|
|
|
|
function GetOperationDefinitionDelphiForDotNet(const anOperation : TRODLOperation; aLibrary:TRODLLibrary; const aClassName : string = ''; const aSuffix : string = '') : string;
|
|
var x : integer;
|
|
pars, s : string;
|
|
begin
|
|
if not Assigned(anOperation.Result) then s := 'procedure ' else s := 'function ';
|
|
|
|
if aClassName<>''
|
|
then s := s+aClassName+'.'+anOperation.Name
|
|
else s := s+anOperation.Name;
|
|
|
|
if aSuffix<>''
|
|
then s := s+aSuffix;
|
|
|
|
with anOperation do
|
|
if (Count>0) then begin
|
|
pars := '';
|
|
|
|
for x := 0 to (Count-1) do begin
|
|
with Items[x] do begin
|
|
if (Flag<>fresult)
|
|
then pars :=pars+Format('%s %s: %s; ', [DelphiFlagNames[Flag], Name, DataTypeToCSharpType(DataType)]);
|
|
end;
|
|
end;
|
|
|
|
if (pars<>'') then s := s+'('+Copy(pars,1,Length(pars)-2)+')';
|
|
end;
|
|
|
|
if Assigned(anOperation.Result) then s := s+': '+DataTypeToCSharpType(anOperation.Result.DataType);
|
|
s := s+';';
|
|
|
|
result := s;
|
|
end;
|
|
|
|
|
|
function GetAsyncInvokeOperationDefinition(
|
|
const anOperation : TRODLOperation;
|
|
const aClassName : string = '';
|
|
const aSuffix : string = '') : string;
|
|
var x : integer;
|
|
pars, s : string;
|
|
begin
|
|
s := 'procedure ';
|
|
|
|
if aClassName<>''
|
|
then s := s+aClassName+'.'+'Invoke_'+anOperation.Name
|
|
else s := s+'Invoke_'+anOperation.Name;
|
|
|
|
if aSuffix<>''
|
|
then s := s+aSuffix;
|
|
|
|
with anOperation do
|
|
if (Count>0) then begin
|
|
pars := '';
|
|
|
|
for x := 0 to (Count-1) do begin
|
|
with Items[x] do begin
|
|
if not (Flag in [fOut,fResult]) then
|
|
pars :=pars+Format('%s %s: %s; ', [DelphiAsyncInvokeFlagNames[Flag], Name, GetDataType(DataType)]);
|
|
end;
|
|
end;
|
|
|
|
if (pars<>'') then s := s+'('+Copy(pars,1,Length(pars)-2)+')';
|
|
end;
|
|
|
|
//if Assigned(anOperation.Result) then s := s+': '+anOperation.Result.DataType;
|
|
s := s+';';
|
|
|
|
result := s;
|
|
end;
|
|
|
|
function NeedsAsyncRetrieveOperationDefinition(anOperation:TRODLOperation):boolean;
|
|
var
|
|
i:integer;
|
|
begin
|
|
result := Assigned(anOperation.Result) or (anOperation.ForceAsyncResponse);
|
|
if not result then
|
|
for i := 0 to anOperation.Count-1 do with anOperation.Items[i] do
|
|
if (Flag <> fIn) then result := true;
|
|
end;
|
|
|
|
function GetAsyncRetrieveOperationDefinition(
|
|
const anOperation : TRODLOperation;
|
|
const aClassName : string = '';
|
|
const aSuffix : string = '') : string;
|
|
var x : integer;
|
|
pars, s : string;
|
|
begin
|
|
if not Assigned(anOperation.Result) then s := 'procedure ' else s := 'function ';
|
|
|
|
if aClassName<>''
|
|
then s := s+aClassName+'.'+'Retrieve_'+anOperation.Name
|
|
else s := s+'Retrieve_'+anOperation.Name;
|
|
|
|
if aSuffix<>''
|
|
then s := s+aSuffix;
|
|
|
|
with anOperation do
|
|
if (Count>0) then begin
|
|
pars := '';
|
|
|
|
for x := 0 to (Count-1) do begin
|
|
with Items[x] do begin
|
|
if not (Flag in [fIn,fResult]) then
|
|
pars :=pars+Format('%s %s: %s; ', [DelphiAsyncRetrieveFlagNames[Flag], Name, GetDataType(DataType)]);
|
|
end;
|
|
end;
|
|
|
|
if (pars<>'') then s := s+'('+Copy(pars,1,Length(pars)-2)+')';
|
|
end;
|
|
|
|
if Assigned(anOperation.Result) then s := s+': '+GetDataType(anOperation.Result.DataType);
|
|
s := s+';';
|
|
|
|
result := s;
|
|
end;
|
|
|
|
function TypeToReadWriteFn(const iType:string):string;
|
|
begin
|
|
if SameText(iType,'Integer') then begin
|
|
result := 'Int32';
|
|
end
|
|
else if SameText(iType,'Boolean') then begin
|
|
result := 'Boolean';
|
|
end
|
|
else if SameText(iType,'WideString') then begin
|
|
result := 'WideString';
|
|
end
|
|
else if SameText(iType,'String') then begin
|
|
result := 'AnsiString';
|
|
end
|
|
{else if (iType = 'Binary') or (iType = 'Array') then begin
|
|
Result := 'ISerializable';
|
|
end}
|
|
else begin
|
|
Result := '';
|
|
end;
|
|
end;
|
|
|
|
function MessageWrite(const iType, iRodlType, iName, iVariable:string):string;
|
|
var lWriteFn: string;
|
|
begin
|
|
lWriteFn := TypeToReadWriteFn(iRodlType);
|
|
if lWriteFn <> '' then begin
|
|
Result := Format('%s("%s", %s);',
|
|
[lWriteFn, iName, iVariable]);
|
|
end
|
|
else begin
|
|
Result := Format('("%s", %s, typeof(%s));', //typeof(%s),
|
|
[iName, iVariable, iType]); //iType,
|
|
end;
|
|
end;
|
|
|
|
function MessageRead(const iType, iRodlType, iName:string):string;
|
|
var lWriteFn: string;
|
|
begin
|
|
lWriteFn := TypeToReadWriteFn(iRodlType);
|
|
if lWriteFn <> '' then begin
|
|
Result := Format('__Message.Read%s("%s");',
|
|
[lWriteFn, iName]);
|
|
end
|
|
else begin
|
|
Result := Format('(%s)__Message.Read("%s", typeof(%s));',
|
|
[iType, iName, iType]);
|
|
end;
|
|
end;
|
|
|
|
procedure GetTypeNames(const aLibrary : TRODLLibrary; aResult : TStrings);
|
|
var i : integer;
|
|
begin
|
|
with aLibrary do begin
|
|
for i := 0 to StructCount-1 do
|
|
aResult.AddObject(Structs[i].Name, pointer(Structs[i]));
|
|
|
|
for i := 0 to EnumCount-1 do
|
|
aResult.AddObject(Enums[i].Name, pointer(Enums[i]));
|
|
|
|
for i := 0 to ArrayCount-1 do
|
|
aResult.AddObject(Arrays[i].Name, pointer(Arrays[i]));
|
|
end;
|
|
end;
|
|
|
|
function TypeByName(const aLibrary : TRODLLibrary; const aTypeName : string) : TRODLEntity;
|
|
var i : integer;
|
|
begin
|
|
result := NIL;
|
|
|
|
with aLibrary do begin
|
|
for i := 0 to (Count-1) do
|
|
if (CompareText(Items[i].Name, aTypeName)=0) then begin
|
|
result := Items[i];
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// TRORemoteDatamodule registration
|
|
procedure RegisterRODataModuleClass(aClass : TRORemoteDataModuleClass; const anAlias, aDescription, someRequiredUnits : string);
|
|
var idx : integer;
|
|
item : PRODataModuleClass;
|
|
begin
|
|
idx := _datamodules.IndexOf(aClass.ClassName);
|
|
if (idx>=0) then begin
|
|
Dispose(PRODataModuleClass(_datamodules.Objects[idx]));
|
|
_datamodules.Delete(idx);
|
|
end;
|
|
|
|
New(item);
|
|
item.ClassType := aClass;
|
|
item.Alias := anAlias;
|
|
item.Description := aDescription;
|
|
item.RequiredUnits := someRequiredUnits;
|
|
|
|
_datamodules.AddObject(aClass.ClassName, TObject(item));
|
|
end;
|
|
|
|
function GetRODataModuleClass(Index : integer) : TRODataModuleClass;
|
|
begin
|
|
result := PRODataModuleClass(_datamodules.Objects[Index])^
|
|
end;
|
|
|
|
function GetRODataModuleClassCount : integer;
|
|
begin
|
|
result := _datamodules.Count
|
|
end;
|
|
|
|
procedure DisposeModuleClasses;
|
|
var i : integer;
|
|
begin
|
|
for i := 0 to (_datamodules.Count-1) do
|
|
Dispose(PRODataModuleClass(_datamodules.Objects[i]));
|
|
end;
|
|
|
|
initialization
|
|
_datamodules := TStringList.Create;
|
|
{_datamodules.Duplicates := dupError;}
|
|
_datamodules.Sorted := TRUE;
|
|
|
|
finalization
|
|
DisposeModuleClasses();
|
|
FreeAndNIL(_datamodules);
|
|
|
|
end.
|