350 lines
12 KiB
ObjectPascal
350 lines
12 KiB
ObjectPascal
|
unit uRODLToPascalImpl;
|
||
|
|
|
||
|
|
{----------------------------------------------------------------------------}
|
||
|
|
{ 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 { TRODLToImpl }
|
||
|
|
TRODLToImpl = class(TRODLConverter)
|
||
|
|
private
|
||
|
|
fService : TRODLService;
|
||
|
|
fAncestorService:TRODLService;
|
||
|
|
fServerClassName: string;
|
||
|
|
fRequiredUnits: string;
|
||
|
|
|
||
|
|
procedure WriteServiceDeclaration(const aService: TRODLService);
|
||
|
|
procedure WriteOperationImplementation(const anOperation : TRODLOperation);
|
||
|
|
procedure SetServerClassName(const Value: string);
|
||
|
|
function GetWriteDataModule: boolean;
|
||
|
|
|
||
|
|
protected
|
||
|
|
procedure IntConvert(const aLibrary : TRODLLIbrary; const aTargetEntity : string = ''); override;
|
||
|
|
function ValidateTargetEntity(const aLibrary : TRODLLIbrary; const aTargetEntity : string) : boolean; override;
|
||
|
|
|
||
|
|
public
|
||
|
|
class function GetTargetFileName(const aLibrary : TRODLLIbrary; const aTargetEntity : string = ''): string; override;
|
||
|
|
|
||
|
|
property WriteDataModule : boolean read GetWriteDataModule;
|
||
|
|
procedure WriteDFM(const aLibrary: TRODLLIbrary; const aTargetEntity: string; const aFilename: string);
|
||
|
|
|
||
|
|
property ServerClassName : string read fServerClassName write SetServerClassName;
|
||
|
|
property RequiredUnits : string read fRequiredUnits write fRequiredUnits;
|
||
|
|
end;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses SysUtils, Dialogs, Classes,
|
||
|
|
{$IFDEF HYDRA_DESIGNTIME}
|
||
|
|
uROIDETools, uEWOTAHelpers,
|
||
|
|
{$ENDIF HYDRA_DESIGNTIME}
|
||
|
|
uRODLGenTools, uRODLToPascalInvk, uRODLToPascal, uROServer;
|
||
|
|
|
||
|
|
function IsHydraModule : boolean;
|
||
|
|
{$IFDEF HYDRA_DESIGNTIME}
|
||
|
|
var
|
||
|
|
lSource: string;
|
||
|
|
{$ENDIF HYDRA_DESIGNTIME}
|
||
|
|
begin
|
||
|
|
result := FALSE;
|
||
|
|
{$IFDEF HYDRA_DESIGNTIME}
|
||
|
|
if (CurrentProject<>NIL) then begin
|
||
|
|
lSource := UpperCase(ReadModuleSource(CurrentProject));
|
||
|
|
result := Pos('{#HYDRAMODULE}', lSource)>0;
|
||
|
|
end;
|
||
|
|
{$ENDIF HYDRA_DESIGNTIME}
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TRODLToImpl }
|
||
|
|
procedure TRODLToImpl.WriteDFM(const aLibrary: TRODLLIbrary; const aTargetEntity: string; const aFilename: string);
|
||
|
|
var svc : TRODLService;
|
||
|
|
begin
|
||
|
|
with TStringList.Create do try
|
||
|
|
svc := aLibrary.ItemByName(aTargetEntity) as TRODLService;
|
||
|
|
|
||
|
|
if (Trim(svc.Ancestor)='') then Add(Format('object %s: T%s', [aTargetEntity, aTargetEntity]))
|
||
|
|
else Add(Format('inherited %s: T%s', [aTargetEntity, aTargetEntity]));
|
||
|
|
Add(' OldCreateOrder = True');
|
||
|
|
Add(' Left = 200');
|
||
|
|
Add(' Top = 200');
|
||
|
|
Add(' Height = 300');
|
||
|
|
Add(' Width = 300');
|
||
|
|
Add('end');
|
||
|
|
finally
|
||
|
|
SaveToFile(aFilename);
|
||
|
|
Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRODLToImpl.IntConvert(const aLibrary: TRODLLIbrary; const aTargetEntity : string = '');
|
||
|
|
var i : integer;
|
||
|
|
s, s2 : string;
|
||
|
|
lIsHydraModule : boolean;
|
||
|
|
begin
|
||
|
|
if not Assigned(fService) or not Assigned(fService.Default) then exit;
|
||
|
|
if ServerClassName = '' then begin
|
||
|
|
ServerClassName := 'TRORemoteDataModule';
|
||
|
|
if (copy(RequiredUnits, Length(RequiredUnits), 1) <> ',') and (RequiredUnits <> '') then
|
||
|
|
RequiredUnits := RequiredUnits + ',';
|
||
|
|
RequiredUnits := RequiredUnits + 'uRORemoteDataModule';
|
||
|
|
end;
|
||
|
|
|
||
|
|
Write(Format('unit %s;', [ChangeFileExt(GetTargetFileName(aLibrary, TargetEntity), '')]));
|
||
|
|
WriteEmptyLine;
|
||
|
|
|
||
|
|
WriteLines(ImplNotice);
|
||
|
|
WriteEmptyLine;
|
||
|
|
|
||
|
|
write('{$I Remobjects.inc}');
|
||
|
|
WriteEmptyLine;
|
||
|
|
|
||
|
|
Write('interface');
|
||
|
|
WriteEmptyLine;
|
||
|
|
|
||
|
|
Write('uses');
|
||
|
|
Write('{vcl:} Classes, SysUtils, ' ,PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
Write('{RemObjects:} uROXMLIntf, uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions,' ,PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
|
||
|
|
{
|
||
|
|
handled via RequiredUnits
|
||
|
|
if WriteDataModule then begin
|
||
|
|
s := Copy(ServerClassName,2,MaxInt);
|
||
|
|
if (s<>'') // For inherited ones...
|
||
|
|
then Write(Format(' u%s,', [s]),PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
end;}
|
||
|
|
|
||
|
|
if (RequiredUnits<>'') then begin
|
||
|
|
s := Trim(RequiredUnits);
|
||
|
|
if (s[Length(s)]<>',') then s := s+',';
|
||
|
|
Write('{Required:} '+s ,PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{TODO: -cRO3 RequiredUnits, and UsedRODLs might overlap if (for example) using the DARemoteService
|
||
|
|
ancestor was chosen not in SB but from the IDE. Check these and create a unique list
|
||
|
|
for RO3. }
|
||
|
|
|
||
|
|
if fService.Ancestor <> '' then begin
|
||
|
|
fAncestorService := aLibrary.FindService(fService.Ancestor);
|
||
|
|
if Assigned(fAncestorService) and (fAncestorService.ImplUnit <> '') then
|
||
|
|
Write('{Ancestor Implementation:} '+fAncestorService.ImplUnit+',',PASCAL_INDENTATION_LEVEL_1)
|
||
|
|
else
|
||
|
|
Write('{Ancestor Implementation:} '+fService.Ancestor+'_Impl,',PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
end;
|
||
|
|
|
||
|
|
if aLibrary.UseCount > 0 then begin
|
||
|
|
s := '';
|
||
|
|
for i := 0 to aLibrary.UseCount-1 do begin
|
||
|
|
if aLibrary.Use[i].LoadedRodlLibraryName <> '' then
|
||
|
|
s2 := aLibrary.Use[i].LoadedRodlLibraryName + '_Intf'
|
||
|
|
else
|
||
|
|
s2 := ChangeFileExt(ExtractFilename(aLibrary.Use[i].RodlFile),'')+'_Intf';
|
||
|
|
if Pos(s2, s) <= 0 then begin
|
||
|
|
if s <> '' then
|
||
|
|
s := s+', ';
|
||
|
|
s := s+s2;
|
||
|
|
end;
|
||
|
|
end; { for }
|
||
|
|
s := s+',';
|
||
|
|
|
||
|
|
Write('{Used RODLs:} '+s,PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
end;
|
||
|
|
|
||
|
|
Write(Format('{Generated:} %s_Intf;', [aLibrary.Info.Name]),PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
WriteEmptyLine;
|
||
|
|
|
||
|
|
Write('type');
|
||
|
|
|
||
|
|
WriteServiceDeclaration(fService);
|
||
|
|
|
||
|
|
{WriteEmptyLine;
|
||
|
|
Write(Format('// Returns an I%s instance in case you need direct access to it from inside your server application',
|
||
|
|
[fService.Info.Name]));
|
||
|
|
Write(Format('function New%s(const aClientID : TGUID; UseClassFactory : boolean = TRUE) : I%s;', [fService.Info.Name, fService.Info.Name]));}
|
||
|
|
|
||
|
|
WriteEmptyLine;
|
||
|
|
|
||
|
|
Write('implementation');
|
||
|
|
WriteEmptyLine;
|
||
|
|
if WriteDataModule
|
||
|
|
then Write('{$R *.dfm}');
|
||
|
|
|
||
|
|
Write('uses');
|
||
|
|
|
||
|
|
(*)if aLibrary.UseCount > 0 then begin
|
||
|
|
s := '';
|
||
|
|
for i := 0 to aLibrary.UseCount-1 do begin
|
||
|
|
if s <> '' then s := s+', ';
|
||
|
|
s := s+ChangeFileExt(ExtractFilename(aLibrary.Use[i].RodlFile),'')+'_Invk';
|
||
|
|
end; { for }
|
||
|
|
s := s+',';
|
||
|
|
|
||
|
|
Write('{Ansestor Invokers:} '+s,PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
end; *)
|
||
|
|
if fService.IsFromUsedRodl then begin
|
||
|
|
s := ChangeFileExt(ExtractFilename(fService.LocatedInRodlUse.RodlFile),'')+'_Invk';
|
||
|
|
end
|
||
|
|
else begin
|
||
|
|
s := ChangeFileExt(TRODLToInvk.GetTargetFileName(aLibrary),'');
|
||
|
|
end;
|
||
|
|
|
||
|
|
lIsHydraModule := IsHydraModule;
|
||
|
|
if lIsHydraModule then begin
|
||
|
|
Write(Format('{Hydra:} uHYRes, uHYIntf, uHYROFactory,', [s]),PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
end;
|
||
|
|
|
||
|
|
Write(Format('{Generated:} %s;', [s]),PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
|
||
|
|
WriteEmptyLine;
|
||
|
|
|
||
|
|
Write(Format('procedure Create_%s(out anInstance : IUnknown);', [fService.Info.Name]));
|
||
|
|
Write('begin');
|
||
|
|
if WriteDataModule
|
||
|
|
then Write(Format(' anInstance := T%s.Create(nil);', [fService.Info.Name]))
|
||
|
|
else Write(Format(' anInstance := T%s.Create;', [fService.Info.Name]));
|
||
|
|
Write('end;');
|
||
|
|
WriteEmptyLine;
|
||
|
|
|
||
|
|
Write(Format('{ %s }', [fService.Info.Name]));
|
||
|
|
{ Write(Format('function New%s(const aClientID : TGUID; UseClassFactory : boolean = TRUE) : I%s;', [fService.Info.Name, fService.Info.Name]));
|
||
|
|
Write('var');
|
||
|
|
Write(' lUnknown: IUnknown;');
|
||
|
|
Write(' lClassFactorty: IROClassFactory;');
|
||
|
|
Write('begin');
|
||
|
|
Write(' result := nil;');
|
||
|
|
Write(' if UseClassFactory then begin');
|
||
|
|
Write(Format(' lClassFactorty := FindClassFactory(''%s'');', [fService.Info.Name]));
|
||
|
|
Write(' lClassFactorty.CreateInstance(aClientID, lUnknown);');
|
||
|
|
Write(' end');
|
||
|
|
Write(Format(' else Create_%s(lUnknown);', [fService.Info.Name]));
|
||
|
|
WriteEmptyLine;
|
||
|
|
Write(Format(' result := lUnknown as I%s;', [fService.Info.Name]));
|
||
|
|
Write('end;');
|
||
|
|
|
||
|
|
WriteEmptyLine;}
|
||
|
|
|
||
|
|
if Assigned(fService.Default) then begin
|
||
|
|
for i := 0 to fService.Default.Count-1 do
|
||
|
|
WriteOperationImplementation(fService.Default.Items[i]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
Write('initialization');
|
||
|
|
s := fService.Info.Name;
|
||
|
|
|
||
|
|
if lIsHydraModule then begin
|
||
|
|
Write(' THYROFactory.Create(HInstance,');
|
||
|
|
end;
|
||
|
|
|
||
|
|
s := Format(' TROClassFactory.Create(''%s'', Create_%s, T%s_Invoker)', [s,s,s]);
|
||
|
|
if lIsHydraModule then s := s+' ' else s := s+';';
|
||
|
|
Write(s);
|
||
|
|
|
||
|
|
if lIsHydraModule then
|
||
|
|
Write(' );');
|
||
|
|
|
||
|
|
WriteEmptyLine;
|
||
|
|
|
||
|
|
Write('finalization');
|
||
|
|
WriteEmptyLine;
|
||
|
|
|
||
|
|
Write('end.');
|
||
|
|
s := buffer.Text;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRODLToImpl.WriteServiceDeclaration(const aService : TRODLService);
|
||
|
|
var i : integer;
|
||
|
|
begin
|
||
|
|
Write(Format('{ T%s }', [aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
if aService.Ancestor <> '' then begin
|
||
|
|
if Assigned(fAncestorService) and (fAncestorService.ImplClass <> '') then
|
||
|
|
Write(Format('T%s = class(%s, I%s)', [aService.Info.Name, fAncestorService.ImplClass, aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1)
|
||
|
|
else
|
||
|
|
Write(Format('T%s = class(T%s, I%s)', [aService.Info.Name, aService.Ancestor, aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
end
|
||
|
|
else begin
|
||
|
|
if WriteDataModule then
|
||
|
|
Write(Format('T%s = class(%s, I%s)', [aService.Info.Name, ServerClassName, aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1)
|
||
|
|
else
|
||
|
|
Write(Format('T%s = class(TRORemotable, I%s)', [aService.Info.Name, aService.Info.Name]), PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
end;
|
||
|
|
|
||
|
|
Write('private',PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
Write('protected',PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
Write(Format('{ I%s methods }', [aService.Info.Name]), PASCAL_INDENTATION_LEVEL_2);
|
||
|
|
for i := 0 to (aService.Default.Count-1) do
|
||
|
|
Write(Format(GetOperationDefinition(aService.Default.Items[i]), []), PASCAL_INDENTATION_LEVEL_2);
|
||
|
|
|
||
|
|
Write('end;', PASCAL_INDENTATION_LEVEL_1);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TRODLToImpl.ValidateTargetEntity(
|
||
|
|
const aLibrary: TRODLLIbrary; const aTargetEntity: string): boolean;
|
||
|
|
var i : integer;
|
||
|
|
begin
|
||
|
|
result := FALSE;
|
||
|
|
|
||
|
|
for i := 0 to (aLibrary.ServiceCount-1) do
|
||
|
|
if (CompareText(aLibrary.Services[i].Info.Name, aTargetEntity)=0) then begin
|
||
|
|
fService := aLibrary.Services[i]; // Will be used later
|
||
|
|
result := TRUE;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRODLToImpl.WriteOperationImplementation(const anOperation: TRODLOperation);
|
||
|
|
var
|
||
|
|
i : integer;
|
||
|
|
lCode:TStrings;
|
||
|
|
begin
|
||
|
|
Write(GetOperationDefinition(anOperation, 'T'+fService.Info.Name));
|
||
|
|
lCode := anOperation.CodeBodies['Delphi'];
|
||
|
|
if Assigned(lCode) then begin
|
||
|
|
WriteLines(lCode.Text);
|
||
|
|
end
|
||
|
|
else begin
|
||
|
|
Write('begin');
|
||
|
|
Write('end;');
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
for i := 0 to (anOperation.Count-1) do begin
|
||
|
|
end;
|
||
|
|
|
||
|
|
WriteEmptyLine;
|
||
|
|
end;
|
||
|
|
|
||
|
|
class function TRODLToImpl.GetTargetFileName(
|
||
|
|
const aLibrary: TRODLLIbrary; const aTargetEntity: string): string;
|
||
|
|
begin
|
||
|
|
result := aTargetEntity+'_Impl.pas';
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRODLToImpl.SetServerClassName(const Value: string);
|
||
|
|
begin
|
||
|
|
fServerClassName := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TRODLToImpl.GetWriteDataModule: boolean;
|
||
|
|
begin
|
||
|
|
result := (fServerClassName <> TRORemotable.ClassName);
|
||
|
|
end;
|
||
|
|
|
||
|
|
end.
|
||
|
|
|