david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
707 lines
22 KiB
ObjectPascal
707 lines
22 KiB
ObjectPascal
unit uRODLTemplateBasedConverterUtils;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - CodeGen2 }
|
|
{ }
|
|
{ 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
|
|
uRODLLineStream, uRODL;
|
|
|
|
const
|
|
COLLECTION_SUFFIX = 'Collection';
|
|
|
|
DEFAULT_STRUCT_ANCESTOR = 'TROComplexType';
|
|
DEFAULT_STRUCT_COLLECTION_ANCESTOR = 'TROCollection';
|
|
DEFAULT_EXCEPTION_ANCESTOR = 'EROException';
|
|
DEFAULT_SERVICE_PROXY_ANCESTOR_NAME = 'TROProxy';
|
|
DEFAULT_SERVICE_INVOKER_ANCESTOR_NAME = 'ROInvoker';
|
|
DEFAULT_EVENT_SINK_WRITER_ANCESTOR_NAME = 'ROEventWriter';
|
|
DEFAULT_EVENT_SINK_INVOKER_ANCESTOR_NAME = 'ROEventInvoker';
|
|
DEFAULT_SERVICE_ASYNC_ANCESTOR_NAME = 'IROAsyncInterface';
|
|
DEFAULT_SERVICE_ASYNC_PROXY_ANCESTOR_NAME = 'TROAsyncProxy';
|
|
|
|
SERVICE_PROXY_SUFFIX = '_Proxy';
|
|
SERVICE_INVOKER_SUFFIX = '_Invoker';
|
|
EVENT_SINK_WRITER_SUFFIX = '_Writer';
|
|
EVENT_SINK_INVOKER_SUFFIX = '_Invoker';
|
|
|
|
DEFAULT_INTF_SUFFIX = '_Intf';
|
|
DEFAULT_INVK_SUFFIX = '_Invk';
|
|
DEFAULT_IMPL_SUFFIX = '_Impl';
|
|
DEFAULT_ASYNC_SUFFIX = '_Async';
|
|
DEFAULT_ASYNC_PROXY_SUFFIX = '_AsyncProxy';
|
|
|
|
IN_FLAGS = [fIn, fInOut];
|
|
OUT_FLAGS = [fOut, fInOut, fResult];
|
|
|
|
function MacroReplace(var Text: string; MacroChar: Char;
|
|
const Macros: array of string; CaseSensitive: Boolean = True): Boolean;
|
|
function SectionStart(const Line: string; SectionName: string): Boolean;
|
|
function SectionEnd(const Line: string; SectionName: string): Boolean;
|
|
function FinishSection(const SectionName: string; SourceTemplate: TLineStream): string; overload;
|
|
procedure FinishSection(const SectionName: string; SourceTemplate: TLineStream; DestTemplate: TLineStream); overload;
|
|
function StrEnsureNoSuffix(const Suffix, Text: string): string;
|
|
function StrEnsureSuffix(const Suffix, Text: string): string;
|
|
|
|
// The functions below should be moved to uRODLGenTools
|
|
function CachedIsImplementedAsClass(const aTypeName: string; aLibrary: TRODLLibrary): Boolean;
|
|
function CachedDataTypeToCSharpType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
function CachedDataTypeToDelphiType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
function CachedDataTypeToDelphiDotNetType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
function CachedDataTypeToCppType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
function CachedArrayExists(const aArrayName: string; aLibrary:TRODLLibrary): Boolean;
|
|
|
|
procedure ClearIsImplementedAsClassCache(aLibrary: TRODLLibrary = nil);
|
|
procedure ClearArrayExistsCache(aLibrary:TRODLLibrary = nil);
|
|
procedure ClearDataTypeCaches(aLibrary: TRODLLibrary = nil);
|
|
procedure ClearAllCaches(aLibrary: TRODLLibrary = nil);
|
|
|
|
function DataTypeToCSharpType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
function DataTypeToCppType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
function DataTypeToDelphiType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
function ArrayExists(const aArrayName: string; aLibrary:TRODLLibrary): Boolean;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils, Classes, Contnrs, IniFiles, uROTypes, uRODLGenTools;
|
|
|
|
type
|
|
TBooleanCacheElement = class
|
|
private
|
|
FLibrary: TRODLLibrary;
|
|
FCachedTypes: {$IFDEF FPC}TStringList{$ELSE}THashedStringList{$ENDIF};
|
|
protected
|
|
function GetUncachedIsSet(const aTypeName: string): Boolean; virtual; abstract;
|
|
public
|
|
constructor Create(aLibrary: TRODLLibrary);
|
|
destructor Destroy; override;
|
|
|
|
function IsSet(const aTypeName: string): Boolean;
|
|
procedure Clear;
|
|
end;
|
|
|
|
TBooleanCacheElementClass = class of TBooleanCacheElement;
|
|
|
|
TBooleanCacheList = class(TObjectList)
|
|
private
|
|
function GetItemByLibrary(
|
|
aLibrary: TRODLLibrary): TBooleanCacheElement;
|
|
function GetItem(Index: Integer): TBooleanCacheElement;
|
|
protected
|
|
function GetElementType: TBooleanCacheElementClass; virtual; abstract;
|
|
public
|
|
property ItemsByLibrary[aLibrary: TRODLLibrary]: TBooleanCacheElement read GetItemByLibrary;
|
|
property Items[Index: Integer]: TBooleanCacheElement read GetItem; default;
|
|
end;
|
|
|
|
TIdentifierTypeCacheList = class;
|
|
TIdentifierTypeCacheElement = class
|
|
private
|
|
FLibrary: TRODLLibrary;
|
|
FCachedTypes: {$IFDEF FPC}TStringList{$ELSE}THashedStringList{$ENDIF};
|
|
FParent: TIdentifierTypeCacheList;
|
|
public
|
|
constructor Create(aParent: TIdentifierTypeCacheList; aLibrary: TRODLLibrary);
|
|
destructor Destroy; override;
|
|
|
|
function TypeIdentifier(const aTypeName: string; const AForNew: Boolean): string;
|
|
procedure Clear;
|
|
end;
|
|
|
|
TGetTypeIdentifier = function (const iType:string; iLibrary:TRODLLibrary=nil; iForNew:boolean=false):string;
|
|
TIdentifierTypeCacheList = class (TObjectList)
|
|
private
|
|
FGetTypeIdentifier: TGetTypeIdentifier;
|
|
|
|
function GetItem(Index: Integer): TIdentifierTypeCacheElement;
|
|
function GetItemByLibrary(
|
|
aLibrary: TRODLLibrary): TIdentifierTypeCacheElement;
|
|
public
|
|
constructor Create(aGetTypeIdentifier: TGetTypeIdentifier; AOwnsObjects: Boolean = True);
|
|
|
|
property ItemsByLibrary[aLibrary: TRODLLibrary]: TIdentifierTypeCacheElement read GetItemByLibrary;
|
|
property Items[Index: Integer]: TIdentifierTypeCacheElement read GetItem; default;
|
|
end;
|
|
|
|
TIsImplementedAsClassCacheElement = class(TBooleanCacheElement)
|
|
protected
|
|
function GetUncachedIsSet(const aTypeName: string): Boolean; override;
|
|
end;
|
|
|
|
TIsImplementedAsClassCacheList = class(TBooleanCacheList)
|
|
protected
|
|
function GetElementType: TBooleanCacheElementClass; override;
|
|
end;
|
|
|
|
TArrayExistsCacheElement = class(TBooleanCacheElement)
|
|
protected
|
|
function GetUncachedIsSet(const aTypeName: string): Boolean; override;
|
|
end;
|
|
|
|
TArrayExistsCacheList = class(TBooleanCacheList)
|
|
protected
|
|
function GetElementType: TBooleanCacheElementClass; override;
|
|
end;
|
|
|
|
var
|
|
FIsImplementedAsClassCache: TIsImplementedAsClassCacheList;
|
|
FArrayExistsCache: TArrayExistsCacheList;
|
|
FDataTypeToCSharpTypeCache: TIdentifierTypeCacheList;
|
|
FDataTypeToDelphiTypeCache: TIdentifierTypeCacheList;
|
|
FDataTypeToDelphiDotNetTypeCache: TIdentifierTypeCacheList;
|
|
FDataTypeToCppTypeCache: TIdentifierTypeCacheList;
|
|
|
|
type
|
|
CmpFunc = function(const Str1, Str2: PChar; MaxLen: {$IFDEF FPC}LongInt{$ELSE}Cardinal{$ENDIF}): Integer;
|
|
|
|
function MacroReplace(var Text: string; MacroChar: Char;
|
|
const Macros: array of string; CaseSensitive: Boolean = True): Boolean;
|
|
const
|
|
Delta = 1024;
|
|
var
|
|
Index, i, Count, Len, SLen, MacroHigh: Integer;
|
|
S: string;
|
|
Found: Boolean;
|
|
Cmp: CmpFunc;
|
|
begin
|
|
Result := False;
|
|
if CaseSensitive then
|
|
Cmp := {$IFDEF FPC}@{$ENDIF}StrLComp
|
|
else
|
|
Cmp := {$IFDEF FPC}@{$ENDIF}StrLIComp;
|
|
|
|
MacroHigh := Length(Macros) div 2 - 1;
|
|
Len := Length(Text);
|
|
i := 1;
|
|
SetLength(S, Delta);
|
|
SLen := 0;
|
|
while i <= Len do
|
|
begin
|
|
Count := 0;
|
|
// add normal chars in one step
|
|
while (i <= Len) and (Text[i] <> MacroChar) do
|
|
begin
|
|
Inc(Count);
|
|
Inc(i);
|
|
end;
|
|
if Count > 0 then
|
|
begin
|
|
if SLen + Count > Length(S) then
|
|
SetLength(S, SLen + Count + Delta);
|
|
Move(Text[i - Count], S[SLen + 1], Count);
|
|
Inc(SLen, Count);
|
|
end;
|
|
|
|
if i <= Len then
|
|
begin
|
|
// replace macros
|
|
Found := False;
|
|
for Index := 0 to MacroHigh do
|
|
begin
|
|
Count := Length(Macros[Index * 2]) + 1; // Plus one to eat the trailing macro char
|
|
if Cmp(PChar(Pointer(Text)) + i, PChar(Macros[Index * 2] + MacroChar), Count) = 0 then
|
|
begin
|
|
Inc(i, Count);
|
|
Count := Length(Macros[Index * 2 + 1]);
|
|
if Count > 0 then
|
|
begin
|
|
if SLen + Count > Length(S) then
|
|
SetLength(S, SLen + Count + Delta);
|
|
Move(Macros[Index * 2 + 1][1], S[SLen + 1], Count);
|
|
Inc(SLen, Count);
|
|
end;
|
|
Result := True;
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
if not Found then
|
|
begin
|
|
// copy macro-text
|
|
if Macros[0][Length(Macros[0])] = MacroChar then
|
|
begin
|
|
Count := 1;
|
|
while (i + Count <= Len) and (Text[i + Count] <> MacroChar) do
|
|
Inc(Count);
|
|
end
|
|
else
|
|
begin
|
|
Count := 0;
|
|
end;
|
|
|
|
Inc(Count);
|
|
if SLen + Count > Length(S) then
|
|
SetLength(S, SLen + Count + Delta);
|
|
Move(Text[i], S[SLen + 1], Count);
|
|
Inc(SLen, Count);
|
|
Inc(i, Count - 1);
|
|
end;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
SetLength(S, SLen);
|
|
Text := S;
|
|
end;
|
|
|
|
function SectionStart(const Line: string; SectionName: string): Boolean;
|
|
begin
|
|
Result := Trim(Line) = '// <%%% START ' + SectionName + ' %%%>';
|
|
end;
|
|
|
|
function SectionEnd(const Line: string; SectionName: string): Boolean;
|
|
begin
|
|
Result := Trim(Line) = '// <%%% END ' + SectionName + ' %%%>';
|
|
end;
|
|
|
|
function FinishSection(const SectionName: string; SourceTemplate: TLineStream): string; overload;
|
|
var
|
|
curLine: string;
|
|
prevLine: string;
|
|
begin
|
|
Result := '';
|
|
prevLine := '';
|
|
curLine := SourceTemplate.ReadLine;
|
|
while not SourceTemplate.Eof and not SectionEnd(curLine, SectionName) do
|
|
begin
|
|
Result := Result + curLine + #13#10;
|
|
prevLine := curLine;
|
|
curLine := SourceTemplate.ReadLine;
|
|
end;
|
|
if SourceTemplate.Eof and not SectionEnd(curLine, SectionName) then
|
|
Result := Result + curLine + #13#10;
|
|
|
|
if Length(prevLine) <> 0 then
|
|
Result := StrEnsureNoSuffix(#13#10, Result);
|
|
end;
|
|
|
|
procedure FinishSection(const SectionName: string; SourceTemplate: TLineStream; DestTemplate: TLineStream); overload;
|
|
var
|
|
content: string;
|
|
begin
|
|
content := FinishSection(SectionName, SourceTemplate);
|
|
|
|
DestTemplate.Position := 0;
|
|
DestTemplate.Size := Length(content);
|
|
DestTemplate.WriteString(content);
|
|
DestTemplate.Position := 0;
|
|
end;
|
|
|
|
// Extracted from the JCL (under MPL licence)
|
|
function StrEnsureNoSuffix(const Suffix, Text: string): string;
|
|
var
|
|
SuffixLen : Integer;
|
|
StrLength : Integer;
|
|
begin
|
|
SuffixLen := Length(Suffix);
|
|
StrLength := Length(Text);
|
|
if Copy(Text, StrLength - SuffixLen + 1, SuffixLen) = Suffix then
|
|
Result := Copy(Text, 1, StrLength - SuffixLen)
|
|
else
|
|
Result := Text;
|
|
end;
|
|
|
|
// Extracted from the JCL (under MPL licence)
|
|
function StrEnsureSuffix(const Suffix, Text: string): string;
|
|
var
|
|
SuffixLen: Integer;
|
|
begin
|
|
SuffixLen := Length(Suffix);
|
|
if Copy(Text, Length(Text) - SuffixLen + 1, SuffixLen) = Suffix then
|
|
Result := Text
|
|
else
|
|
Result := Text + Suffix;
|
|
end;
|
|
|
|
{ TBooleanCacheElement }
|
|
|
|
procedure TBooleanCacheElement.Clear;
|
|
begin
|
|
FCachedTypes.Clear;
|
|
end;
|
|
|
|
constructor TBooleanCacheElement.Create(aLibrary: TRODLLibrary);
|
|
begin
|
|
inherited Create;
|
|
|
|
FLibrary := aLibrary;
|
|
FCachedTypes := {$IFDEF FPC}TStringList{$ELSE}THashedStringList{$ENDIF}.Create;
|
|
FCachedTypes.CaseSensitive := True;
|
|
FCachedTypes.Capacity := 20;
|
|
FCachedTypes.Sorted := True;
|
|
end;
|
|
|
|
destructor TBooleanCacheElement.Destroy;
|
|
begin
|
|
FCachedTypes.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TBooleanCacheElement.IsSet(
|
|
const aTypeName: string): Boolean;
|
|
var
|
|
typeNameIndex: Integer;
|
|
begin
|
|
typeNameIndex := FCachedTypes.IndexOf(aTypeName);
|
|
if typeNameIndex > -1 then
|
|
begin
|
|
Result := Boolean(cardinal(FCachedTypes.Objects[typeNameIndex]));
|
|
end
|
|
else
|
|
begin
|
|
Result := GetUncachedIsSet(aTypeName);
|
|
FCachedTypes.AddObject(aTypeName, TObject(Result));
|
|
end;
|
|
end;
|
|
|
|
{ TBooleanCacheList }
|
|
|
|
function TBooleanCacheList.GetItemByLibrary(
|
|
aLibrary: TRODLLibrary): TBooleanCacheElement;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := 0;
|
|
Result := nil;
|
|
while not Assigned(Result) and (I < Count) do
|
|
begin
|
|
if Items[I].FLibrary = aLibrary then
|
|
Result := Items[I];
|
|
Inc(I);
|
|
end;
|
|
|
|
if not Assigned(Result) then
|
|
begin
|
|
Result := GetElementType.Create(aLibrary);
|
|
Add(Result);
|
|
end;
|
|
end;
|
|
|
|
function TBooleanCacheList.GetItem(
|
|
Index: Integer): TBooleanCacheElement;
|
|
begin
|
|
Result := inherited Items[Index] as TBooleanCacheElement;
|
|
end;
|
|
|
|
{ TIdentifierTypeCacheElement }
|
|
|
|
procedure TIdentifierTypeCacheElement.Clear;
|
|
begin
|
|
FCachedTypes.Clear;
|
|
end;
|
|
|
|
constructor TIdentifierTypeCacheElement.Create(aParent: TIdentifierTypeCacheList; aLibrary: TRODLLibrary);
|
|
begin
|
|
inherited Create;
|
|
|
|
FLibrary := aLibrary;
|
|
FParent := aParent;
|
|
FCachedTypes := {$IFDEF FPC}TStringList{$ELSE}THashedStringList{$ENDIF}.Create;
|
|
FCachedTypes.CaseSensitive := True;
|
|
FCachedTypes.Capacity := 20;
|
|
end;
|
|
|
|
destructor TIdentifierTypeCacheElement.Destroy;
|
|
begin
|
|
FCachedTypes.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TIdentifierTypeCacheElement.TypeIdentifier(
|
|
const aTypeName: string; const AForNew: Boolean): string;
|
|
begin
|
|
Result := FCachedTypes.Values[aTypeName + ',' + BoolToStr(AForNew)];
|
|
|
|
if Length(Result) = 0 then
|
|
begin
|
|
Result := FParent.FGetTypeIdentifier(aTypeName, FLibrary, AForNew);
|
|
FCachedTypes.Values[aTypeName + ',' + BoolToStr(AForNew)] := Result;
|
|
end;
|
|
end;
|
|
|
|
{ TIdentifierTypeCacheList }
|
|
|
|
constructor TIdentifierTypeCacheList.Create(
|
|
aGetTypeIdentifier: TGetTypeIdentifier; AOwnsObjects: Boolean);
|
|
begin
|
|
inherited Create(AOwnsObjects);
|
|
|
|
FGetTypeIdentifier := aGetTypeIdentifier;
|
|
end;
|
|
|
|
function TIdentifierTypeCacheList.GetItem(
|
|
Index: Integer): TIdentifierTypeCacheElement;
|
|
begin
|
|
Result := inherited Items[Index] as TIdentifierTypeCacheElement;
|
|
end;
|
|
|
|
function TIdentifierTypeCacheList.GetItemByLibrary(
|
|
aLibrary: TRODLLibrary): TIdentifierTypeCacheElement;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := 0;
|
|
Result := nil;
|
|
while not Assigned(Result) and (I < Count) do
|
|
begin
|
|
if Items[I].FLibrary = aLibrary then
|
|
Result := Items[I];
|
|
Inc(I);
|
|
end;
|
|
|
|
if not Assigned(Result) then
|
|
begin
|
|
Result := TIdentifierTypeCacheElement.Create(Self, aLibrary);
|
|
Add(Result);
|
|
end;
|
|
end;
|
|
|
|
{ TIsImplementedAsClassCacheElement }
|
|
|
|
function TIsImplementedAsClassCacheElement.GetUncachedIsSet(
|
|
const aTypeName: string): Boolean;
|
|
begin
|
|
Result := IsImplementedAsClass(aTypeName, FLibrary);
|
|
end;
|
|
|
|
{ TIsImplementedAsClassCacheList }
|
|
|
|
function TIsImplementedAsClassCacheList.GetElementType: TBooleanCacheElementClass;
|
|
begin
|
|
Result := TIsImplementedAsClassCacheElement;
|
|
end;
|
|
|
|
{ TArrayExistsCacheElement }
|
|
|
|
function TArrayExistsCacheElement.GetUncachedIsSet(
|
|
const aTypeName: string): Boolean;
|
|
begin
|
|
Result := ArrayExists(aTypeName, FLibrary);
|
|
end;
|
|
|
|
{ TArrayExistsCacheList }
|
|
|
|
function TArrayExistsCacheList.GetElementType: TBooleanCacheElementClass;
|
|
begin
|
|
Result := TArrayExistsCacheElement;
|
|
end;
|
|
|
|
function CachedIsImplementedAsClass(const aTypeName:string; aLibrary:TRODLLibrary):boolean;
|
|
begin
|
|
if not Assigned(FIsImplementedAsClassCache) then
|
|
begin
|
|
FIsImplementedAsClassCache := TIsImplementedAsClassCacheList.Create(True);
|
|
end;
|
|
|
|
Result := FIsImplementedAsClassCache.ItemsByLibrary[aLibrary].IsSet(aTypeName);
|
|
end;
|
|
|
|
procedure ClearIsImplementedAsClassCache(aLibrary: TRODLLibrary);
|
|
begin
|
|
if Assigned(FIsImplementedAsClassCache) then
|
|
begin
|
|
if Assigned(aLibrary) then
|
|
FIsImplementedAsClassCache.ItemsByLibrary[aLibrary].Clear
|
|
else
|
|
FIsImplementedAsClassCache.Clear;
|
|
end;
|
|
end;
|
|
|
|
function CachedDataTypeToCSharpType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
begin
|
|
if not Assigned(FDataTypeToCSharpTypeCache) then
|
|
begin
|
|
FDataTypeToCSharpTypeCache := TIdentifierTypeCacheList.Create(DataTypeToCSharpType, True);
|
|
end;
|
|
|
|
Result := FDataTypeToCSharpTypeCache.ItemsByLibrary[aLibrary].TypeIdentifier(aTypeName, aForNew);
|
|
end;
|
|
|
|
function CachedDataTypeToDelphiType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
begin
|
|
if not Assigned(FDataTypeToDelphiTypeCache) then
|
|
begin
|
|
FDataTypeToDelphiTypeCache := TIdentifierTypeCacheList.Create(DataTypeToDelphiType, True);
|
|
end;
|
|
|
|
Result := FDataTypeToDelphiTypeCache.ItemsByLibrary[aLibrary].TypeIdentifier(aTypeName, aForNew);
|
|
end;
|
|
|
|
function DataTypeToDelphiType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
begin
|
|
case StrToDataType(aTypeName) of
|
|
rtXML: Result:= 'IXmlNode';
|
|
else
|
|
Result := aTypeName;
|
|
end;
|
|
end;
|
|
|
|
function CachedDataTypeToDelphiDotNetType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
begin
|
|
if not Assigned(FDataTypeToDelphiDotNetTypeCache) then
|
|
begin
|
|
FDataTypeToDelphiDotNetTypeCache := TIdentifierTypeCacheList.Create(uRODLGenTools.DataTypeToDelphiDotNetType, True);
|
|
end;
|
|
|
|
Result := FDataTypeToDelphiDotNetTypeCache.ItemsByLibrary[aLibrary].TypeIdentifier(aTypeName, aForNew);
|
|
end;
|
|
|
|
function CachedDataTypeToCppType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
begin
|
|
if not Assigned(FDataTypeToCppTypeCache) then
|
|
begin
|
|
FDataTypeToCppTypeCache := TIdentifierTypeCacheList.Create(DataTypeToCppType, True);
|
|
end;
|
|
|
|
Result := FDataTypeToCppTypeCache.ItemsByLibrary[aLibrary].TypeIdentifier(aTypeName, aForNew);
|
|
end;
|
|
|
|
function DataTypeToCppType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
|
|
const
|
|
CppSimpleTypes: array[TRODataType] of string =
|
|
('int', 'TDateTime', 'double', 'Currency', 'WideString', 'AnsiString', '__int64', 'bool', 'Variant', 'Binary', '_di_IXMLNode', 'TGuidString','TDecimalVariant','');
|
|
|
|
// TRODataType =
|
|
// (rtInteger, rtDateTime, rtDouble, rtCurrency, rtWidestring, rtString, rtInt64, rtBoolean, rtVariant, rtBinary, rtUserDefined);
|
|
|
|
// TODO: Need to finish these if possible - in their proper place - if needed- else we need something
|
|
// in the Macros like %IFCONST% that is replaced by "const" and %IFVAR% and/or %IFOUT% that is replaced with "&"
|
|
// PasFlagNames : array[TRODLParamFlag] of string =
|
|
// ('const', 'out', 'var', 'result');
|
|
|
|
// Also these must be translated to "False" and "True" - case sensitively
|
|
// BoolStr : array[boolean] of string = ('false','true');
|
|
|
|
var
|
|
aType: TRODataType;
|
|
|
|
begin
|
|
for aType := Low(DataTypeNames) to High(DataTypeNames) do
|
|
if SameText(aTypeName, DataTypeNames[aType]) and (aType in [Low(CppSimpletypes)..High(CppSimpleTypes)]) then
|
|
begin
|
|
Result:= CppSimpleTypes[aType];
|
|
exit;
|
|
end;
|
|
|
|
// Not found case
|
|
Result:= aTypeName;
|
|
end;
|
|
|
|
function DataTypeToCSharpType(const aTypeName:string; aLibrary:TRODLLibrary=nil; aForNew:boolean=false):string;
|
|
const
|
|
CSharpSimpleTypes: array[TRODataType] of string =
|
|
('int', 'System.DateTime', 'double', 'decimal', 'string', 'string', 'Int64', 'bool', 'Variant', 'Binary', 'IXMLNode', 'TGuidString','TDecimalVariant', '');
|
|
var
|
|
aType: TRODataType;
|
|
begin
|
|
for aType := Low(DataTypeNames) to High(DataTypeNames) do
|
|
if SameText(aTypeName, DataTypeNames[aType]) and (aType in [Low(CSharpSimpleTypes)..High(CSharpSimpleTypes)]) then
|
|
begin
|
|
Result := CSharpSimpleTypes[aType];
|
|
Exit;
|
|
end;
|
|
|
|
// Not found case
|
|
Result := uRODLGenTools.DataTypeToCSharpType(aTypeName, aLibrary, aForNew);
|
|
end;
|
|
|
|
function ArrayExists(const aArrayName: string; aLibrary:TRODLLibrary): Boolean;
|
|
begin
|
|
Result := Assigned(aLibrary.FindArray(aArrayName));
|
|
end;
|
|
|
|
function CachedArrayExists(const aArrayName: string; aLibrary:TRODLLibrary): Boolean;
|
|
begin
|
|
if not Assigned(FArrayExistsCache) then
|
|
begin
|
|
FArrayExistsCache := TArrayExistsCacheList.Create(True);
|
|
end;
|
|
|
|
Result := FArrayExistsCache.ItemsByLibrary[aLibrary].IsSet(aArrayName);
|
|
end;
|
|
|
|
procedure ClearArrayExistsCache(aLibrary:TRODLLibrary = nil);
|
|
begin
|
|
if Assigned(FArrayExistsCache) then
|
|
begin
|
|
if Assigned(aLibrary) then
|
|
FArrayExistsCache.ItemsByLibrary[aLibrary].Clear
|
|
else
|
|
FArrayExistsCache.Clear;
|
|
end;
|
|
end;
|
|
|
|
procedure ClearDataTypeCaches(aLibrary: TRODLLibrary = nil);
|
|
begin
|
|
if Assigned(FDataTypeToCSharpTypeCache) then
|
|
begin
|
|
if Assigned(aLibrary) then
|
|
FDataTypeToCSharpTypeCache.ItemsByLibrary[aLibrary].Clear
|
|
else
|
|
FDataTypeToCSharpTypeCache.Clear;
|
|
end;
|
|
|
|
if Assigned(FDataTypeToDelphiTypeCache) then
|
|
begin
|
|
if Assigned(aLibrary) then
|
|
FDataTypeToDelphiTypeCache.ItemsByLibrary[aLibrary].Clear
|
|
else
|
|
FDataTypeToDelphiTypeCache.Clear;
|
|
end;
|
|
|
|
if Assigned(FDataTypeToDelphiDotNetTypeCache) then
|
|
begin
|
|
if Assigned(aLibrary) then
|
|
FDataTypeToDelphiDotNetTypeCache.ItemsByLibrary[aLibrary].Clear
|
|
else
|
|
FDataTypeToDelphiDotNetTypeCache.Clear;
|
|
end;
|
|
|
|
if Assigned(FDataTypeToCppTypeCache) then
|
|
begin
|
|
if Assigned(aLibrary) then
|
|
FDataTypeToCppTypeCache.ItemsByLibrary[aLibrary].Clear
|
|
else
|
|
FDataTypeToCppTypeCache.Clear;
|
|
end;
|
|
end;
|
|
|
|
procedure ClearAllCaches(aLibrary: TRODLLibrary = nil);
|
|
begin
|
|
ClearDataTypeCaches(aLibrary);
|
|
ClearIsImplementedAsClassCache(aLibrary);
|
|
ClearArrayExistsCache(aLibrary);
|
|
end;
|
|
|
|
initialization
|
|
|
|
finalization
|
|
FIsImplementedAsClassCache.Free;
|
|
FArrayExistsCache.Free;
|
|
FDataTypeToCSharpTypeCache.Free;
|
|
FDataTypeToDelphiTypeCache.Free;
|
|
FDataTypeToDelphiDotNetTypeCache.Free;
|
|
FDataTypeToCppTypeCache.Free;
|
|
|
|
end.
|