david
2a98435b14
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@68 b6239004-a887-0f4b-9937-50029ccdca16
1639 lines
51 KiB
ObjectPascal
1639 lines
51 KiB
ObjectPascal
unit uDADataAbstractEditors;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - IDE Library }
|
|
{ }
|
|
{ compiler: Delphi 6 and up, Kylix 3 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the Data Abstract }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
{$I ..\DataAbstract.inc}
|
|
{$ELSE}
|
|
{$I ../DataAbstract.inc}
|
|
{$ENDIF}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF MSWINDOWS}Windows,{$ENDIF}
|
|
{$IFDEF FPC}ComponentEditors, PropEdits, {$ELSE}DesignIntf, DesignEditors, ColnEdit,{$ENDIF}
|
|
SysUtils, Classes,
|
|
uROClient, uRODL,uRORemoteService,
|
|
uDAClasses, uDARes, uDADataTable, uDARemoteDataAdapter, uDADataAdapter, uDALocalHelpers;
|
|
|
|
type { TDADriverManagerEditor }
|
|
TDADriverManagerEditor = class(TComponentEditor)
|
|
private
|
|
public
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
function GetVerb(Index: Integer): string; override;
|
|
function GetVerbCount: Integer; override;
|
|
end;
|
|
|
|
{ TDAConnectionManagerEditor }
|
|
TDAConnectionManagerEditor = class(TComponentEditor)
|
|
private
|
|
public
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
function GetVerb(Index: Integer): string; override;
|
|
function GetVerbCount: Integer; override;
|
|
end;
|
|
|
|
{ TDADataDictionaryEditor }
|
|
TDADataDictionaryEditor = class(TComponentEditor)
|
|
private
|
|
public
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
function GetVerb(Index: Integer): string; override;
|
|
function GetVerbCount: Integer; override;
|
|
end;
|
|
|
|
{ TDASchemaEditor }
|
|
TDASchemaEditor = class(TComponentEditor)
|
|
protected
|
|
public
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
function GetVerb(Index: Integer): string; override;
|
|
function GetVerbCount: Integer; override;
|
|
end;
|
|
|
|
{ TDADesigntimeCallEditor }
|
|
TDADesigntimeCallEditor = class(TComponentEditor)
|
|
protected
|
|
public
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
function GetVerb(Index: Integer): string; override;
|
|
function GetVerbCount: Integer; override;
|
|
end;
|
|
|
|
{ TDADataRequestCallMethodNameEditor }
|
|
TDADataRequestCallMethodNameEditor = class(TStringProperty)
|
|
private
|
|
function RetrieveLibrary: TRODLLibrary;
|
|
|
|
protected
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
procedure SetValue(const Value: string); override;
|
|
end;
|
|
|
|
{ TDALoginAwareComponentEditor }
|
|
TDALoginAwareComponentEditor = class(TComponentEditor)
|
|
protected
|
|
fRemoteService: TRORemoteService;
|
|
function GetAdapterSchema(aAdapter: TDABaseDataAdapter): TDASchema;
|
|
procedure OnLoginNeeded(Sender: TROTransportChannel; anException: Exception; var aRetry: Boolean);
|
|
end;
|
|
|
|
{ TDADataTableEditor }
|
|
TDADataTableEditor = class(TDALoginAwareComponentEditor)
|
|
protected
|
|
public
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
function GetVerb(Index: Integer): string; override;
|
|
function GetVerbCount: Integer; override;
|
|
end;
|
|
|
|
{ TDABaseDataAdapterEditor }
|
|
TDABaseDataAdapterEditor = class(TDALoginAwareComponentEditor)
|
|
protected
|
|
fDataTables: TStringList;
|
|
function HookUpDataTables: boolean;
|
|
procedure GetDataTables(const aName: string);
|
|
public
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
function GetVerb(Index: Integer): string; override;
|
|
function GetVerbCount: Integer; override;
|
|
end;
|
|
|
|
{ TDARemoteDataAdapterEditor }
|
|
TDARemoteDataAdapterEditor = class(TDABaseDataAdapterEditor )
|
|
public
|
|
procedure ExecuteVerb(Index: Integer); override;
|
|
function GetVerb(Index: Integer): string; override;
|
|
function GetVerbCount: Integer; override;
|
|
end;
|
|
|
|
{ TDADataTableMasterDetailProps }
|
|
TDADataTableMasterDetailProps = class(TStringProperty)
|
|
protected
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure Edit; override;
|
|
end;
|
|
|
|
{ TDABusinessProcessorCommandProperty }
|
|
TDABusinessProcessorCommandProperty = class(TStringProperty)
|
|
protected
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
end;
|
|
|
|
{ TDABusinessProcessorRefDatasetProperty }
|
|
TDABusinessProcessorRefDatasetProperty = class(TStringProperty)
|
|
protected
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
TCollectionProperty = TCollectionPropertyEditor;
|
|
{$ENDIF FPC}
|
|
{ TDACollectionProperty }
|
|
TDACollectionProperty = class(TCollectionProperty)
|
|
private
|
|
protected
|
|
public
|
|
procedure Edit; override;
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
end;
|
|
|
|
|
|
{ TDADataTableLogicalNameEditor }
|
|
TDADataTableLogicalNameEditor = class(TStringProperty)
|
|
private
|
|
function GetSchema: TDASchema;
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
end;
|
|
|
|
{ TDACollectionItemDatasetNameEditor }
|
|
TDACollectionItemDatasetNameEditor = class(TStringProperty)
|
|
private
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
end;
|
|
|
|
{ TDADataTableLocalConnection }
|
|
TDADataTableLocalConnection = class(TStringProperty)
|
|
private
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
end;
|
|
|
|
{ TDADriverManagerDirectory }
|
|
TDADriverManagerDirectory = class(TStringProperty)
|
|
private
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
procedure SetValue(const Value: string); override;
|
|
end;
|
|
|
|
{ TDADataTableReferenceDataTable }
|
|
TDADataTableReferenceDataTable = class(TComponentProperty)
|
|
public
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
end;
|
|
|
|
{ TDALookupSourceProperty }
|
|
TDALookupSourceProperty = class(TStringProperty)
|
|
private
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
end;
|
|
|
|
{ TDALookupDestProperty }
|
|
TDALookupDestProperty = class(TStringProperty)
|
|
private
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
end;
|
|
|
|
{ TDALookupResultFieldProperty }
|
|
TDALookupResultFieldProperty = class(TDALookupDestProperty)
|
|
private
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure SetValue(const Value: string); override;
|
|
end;
|
|
|
|
{ TDALocalDataAdapterServiceEditor }
|
|
TDALocalDataAdapterServiceEditor = class(TStringProperty)
|
|
private
|
|
function GetRODL: TRODLLibrary;
|
|
public
|
|
function GetAttributes: TPropertyAttributes; override;
|
|
procedure GetValues(Proc: TGetStrProc); override;
|
|
end;
|
|
|
|
function GetServiceInstance(aServiceName: string): IDataAbstractLocalServiceAccess;
|
|
procedure SetDefaultConnection(aServiceName: string);
|
|
|
|
implementation
|
|
|
|
uses
|
|
|
|
{$IFDEF FPC}
|
|
uDADataTableMasterLinkWizardForm_laz, uROIDETools_laz,uDAIDEMenu_laz,
|
|
uEWOTAHelpers_laz,ProjectIntf,LazIDEIntf,
|
|
{$ELSE}
|
|
uROIDETools, uROIDEMenu, uROPleaseWaitForm,
|
|
uDAIDEMenu, uDAPleaseWaitForm,
|
|
ToolsAPI,uEWOTAHelpers,
|
|
uDADataTableMasterLinkWizardForm,ShellAPI,
|
|
{$ENDIF}
|
|
uDAIDEData,uDASchemaUnitsGenerator,
|
|
uROLoginNeededForm,
|
|
Dialogs, Graphics, Controls,
|
|
{$WARN UNIT_PLATFORM OFF}
|
|
FileCtrl,
|
|
{$WARN UNIT_PLATFORM ON}
|
|
TypInfo, Forms, ClipBrd, DB,
|
|
uROTypes,
|
|
uDAUtils, uDADriverManager, uDADriverInfo, uDASupportClasses,
|
|
uROClasses,
|
|
uRODLToXML, uDAInterfaces, uDABusinessProcessor, uDAIDERes,
|
|
IniFiles, Registry, uDADesigntimeCall, uDASelectDataTablesForm,
|
|
uRODynamicRequest, {$IFDEF USE_LOCALDATAADAPTER}uDALocalDataAdapter,{$ENDIF} uDADataTableWizards,
|
|
DataAbstractService_Impl;
|
|
|
|
{$IFNDEF FPC}
|
|
function FindProjectByActiveModule: IOTAProject;
|
|
var
|
|
services: IOTAModuleServices;
|
|
lProject: IOTAProject;
|
|
lcurModule: IOTAModule;
|
|
i,j: Integer;
|
|
begin
|
|
Result:= CurrentProject;
|
|
services := ModuleServices;
|
|
if (services = nil) then Exit;
|
|
lcurModule := services.CurrentModule;
|
|
for I := 0 to (services.ModuleCount - 1) do begin
|
|
if Services.Modules[i].QueryInterface(IOTAProject, lProject) = S_OK then begin
|
|
for j := 0 to lProject.GetModuleCount-1 do begin
|
|
if SameText(lProject.GetModule(j).FileName,lcurModule.FileName) then begin
|
|
result := lProject;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{ TDASchemaEditor }
|
|
|
|
const
|
|
COMMAND_INDEX_EDIT = 0;
|
|
COMMAND_INDEX_PUBLISH = 1;
|
|
COMMAND_INDEX_SEPARATOR_1 = 2;
|
|
COMMAND_INDEX_SAVE = 3;
|
|
COMMAND_INDEX_LOAD = 4;
|
|
COMMAND_INDEX_SEPARATOR_2 = 5;
|
|
COMMAND_INDEX_GENCODE = 6;
|
|
COMMAND_INDEX_GENCONSTS = 7;
|
|
|
|
procedure TDASchemaEditor.ExecuteVerb(Index: Integer);
|
|
var
|
|
schema :TDASchema;
|
|
connmgr : TDAConnectionManager;
|
|
{$IFDEF DELPHI2009UP}
|
|
lSchemaAge, lAge: TDateTime;
|
|
{$ELSE}
|
|
lSchemaAge: integer;
|
|
{$ENDIF}
|
|
sfname,
|
|
cmfname, dadname,diagramname :string;
|
|
i, x : integer;
|
|
s : string;
|
|
lDesigner:IDesignerNotify;
|
|
params: TStringList;
|
|
{$IFNDEF FPC}
|
|
loldCurrentProject, lproject: IOTAProject;
|
|
{$ENDIF}
|
|
begin
|
|
schema := GetComponent as TDASchema;
|
|
connmgr := schema.ConnectionManager;
|
|
|
|
if (Index=COMMAND_INDEX_GENCONSTS) then begin
|
|
params := TStringList.Create;
|
|
with schema do try
|
|
params.Sorted := TRUE;
|
|
|
|
s := '';
|
|
if Datasets.Count>0 then begin
|
|
s := Format(' { Dataset names contained in schema "%s" }',[schema.Name])+#13#10;
|
|
for i := 0 to (Datasets.Count-1) do begin
|
|
s := s+Format(' ds_%s = ''%s'';', [MakeValidIdentifier(Datasets[i].Name), Datasets[i].Name])+#13#10;
|
|
end;
|
|
end;
|
|
|
|
if Commands.Count>0 then begin
|
|
s := s+#13#10+Format(' { Command names contained in schema "%s"}',[schema.Name])+#13#10;
|
|
for i := 0 to (Commands.Count-1) do begin
|
|
s := s+Format(' cmd_%s = ''%s'';', [MakeValidIdentifier(Commands[i].Name), Commands[i].Name])+#13#10;
|
|
end;
|
|
end;
|
|
|
|
s := s+' { Dataset and command parameters }'+#13#10;
|
|
for i := 0 to (Datasets.Count-1) do begin
|
|
for x := 0 to (Datasets[i].Params.Count-1) do begin
|
|
// Checks for duplicates
|
|
if params.IndexOf(UpperCase(Datasets[i].Params[x].Name))<0
|
|
then params.Add(UpperCase(Datasets[i].Params[x].Name))
|
|
else Continue;
|
|
|
|
s := s+Format(' par_%s = ''%s'';', [Datasets[i].Params[x].Name, Datasets[i].Params[x].Name])+#13#10;
|
|
end;
|
|
end;
|
|
|
|
for i := 0 to (Commands.Count-1) do begin
|
|
for x := 0 to (Commands[i].Params.Count-1) do begin
|
|
// Checks for duplicates
|
|
if params.IndexOf(UpperCase(Commands[i].Params[x].Name))<0
|
|
then params.Add(UpperCase(Commands[i].Params[x].Name))
|
|
else Continue;
|
|
|
|
s := s+Format(' par_%s = ''%s'';', [Commands[i].Params[x].Name, Commands[i].Params[x].Name])+#13#10;
|
|
end;
|
|
end;
|
|
finally
|
|
params.Free;
|
|
end;
|
|
|
|
Clipboard.AsText := s;
|
|
Exit;
|
|
end
|
|
else if Index = COMMAND_INDEX_SAVE then begin
|
|
sfname := schema.Name;
|
|
if not PromptForFileName(sfname, 'Data Abstract Schema (*'+daFileExtSchemaFile+')|*'+daFileExtSchemaFile+'|All Files (*.*)|*.*', daFileExtSchemaFile, 'Save Schema '+schema.Name, '', TRUE) then Exit;
|
|
|
|
schema.SaveToFile(sfname, pfXML);
|
|
// in COMMAND_INDEX_LOAD we load only schema so we will save also schema only
|
|
{
|
|
if Assigned(schema.ConnectionManager) then
|
|
schema.ConnectionManager.SaveToFile(ChangeFileExt(sfname, daFileExtConnectionMgrFile), pfXML);
|
|
|
|
if Assigned(schema.DataDictionary) then
|
|
schema.DataDictionary.SaveToFile(ChangeFileExt(sfname, daFileExtDataDictionaryFile), pfXML);
|
|
|
|
if Assigned(schema.Diagrams) then
|
|
schema.Diagrams.SaveToFile(ChangeFileExt(sfname, DAFileExtDiagramsFile));
|
|
}
|
|
end
|
|
else if (Index<>COMMAND_INDEX_LOAD) and (Index<>COMMAND_INDEX_GENCODE) then begin
|
|
Check(connmgr=NIL, 'The schema doesn''t have a connection manager associated. Cannot launch Schema Modeler');
|
|
|
|
if (Index=COMMAND_INDEX_SAVE) then begin
|
|
sfname := schema.Name;
|
|
if not PromptForFileName(sfname, 'Data Abstract Schema (*'+daFileExtSchemaFile+')|*'+daFileExtSchemaFile+'|All Files (*.*)|*.*', daFileExtSchemaFile, 'Save Schema '+schema.Name, '', TRUE)
|
|
then Exit;
|
|
end
|
|
else begin
|
|
sfname := GetTempFileName(daFileExtSchemaFile);
|
|
end;
|
|
|
|
schema.SaveToFile(sfname, pfXML);
|
|
{$IFDEF DELPHI2009UP}
|
|
FileAge(sfname, lSchemaAge);
|
|
{$ELSE}
|
|
lSchemaAge := FileAge(sfname);
|
|
{$ENDIF}
|
|
|
|
cmfname := ChangeFileExt(sfname, daFileExtConnectionMgrFile);
|
|
connmgr.SaveToFile(cmfname, pfXML);
|
|
|
|
dadname := '';
|
|
if Assigned(schema.DataDictionary) then begin
|
|
dadname := ChangeFileExt(sfname, daFileExtDataDictionaryFile);
|
|
schema.DataDictionary.SaveToFile(dadname, pfXML);
|
|
end;
|
|
|
|
diagramname := '';
|
|
if Assigned(schema.Diagrams) then begin
|
|
diagramname := ChangeFileExt(sfname, DAFileExtDiagramsFile);
|
|
schema.Diagrams.SaveToFile(diagramname);
|
|
end;
|
|
|
|
if (Index=COMMAND_INDEX_LOAD) then Exit; // Only wants to save!
|
|
|
|
case Index of
|
|
COMMAND_INDEX_EDIT: begin
|
|
{$IFDEF FPC}
|
|
ShowMessage('Not implemented');
|
|
{$ELSE}
|
|
try
|
|
with CreatePleaseWaitForm('Running the Schema Modeler...') do try
|
|
Show();
|
|
ExecuteAndWait(GetSchemaModelerPath, '/ns /platform:Delphi /projectname:"'+GetComponent().Name+'" /autosave /schemafile:"'+sfname+'"');
|
|
Hide();
|
|
finally
|
|
Free();
|
|
end;
|
|
|
|
{$IFDEF DELPHI2009UP}
|
|
FileAge(sfname, lAge);
|
|
if lSchemaAge < lAge then begin
|
|
{$ELSE}
|
|
if lSchemaAge < FileAge(sfname) then begin
|
|
{$ENDIF}
|
|
schema.LoadFromFile(sfname, pfXML);
|
|
Designer.Modified();
|
|
|
|
connmgr.LoadFromFile(cmfname, pfXML);
|
|
lDesigner := FindRootDesigner(connmgr);
|
|
if Assigned(lDesigner) then lDesigner.Modified();
|
|
|
|
if dadname <> '' then begin
|
|
schema.DataDictionary.LoadFromFile(dadname, pfXML);
|
|
lDesigner := FindRootDesigner(schema.DataDictionary);
|
|
if Assigned(lDesigner) then lDesigner.Modified();
|
|
end;
|
|
|
|
if diagramname <> '' then begin
|
|
schema.Diagrams.LoadFromFile(diagramname);
|
|
lDesigner := FindRootDesigner(schema.DataDictionary);
|
|
if Assigned(lDesigner) then lDesigner.Modified();
|
|
end;
|
|
|
|
end;
|
|
|
|
finally
|
|
DeleteFile(sfname);
|
|
DeleteFile(cmfname);
|
|
if dadname <> '' then DeleteFile(dadname);
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
COMMAND_INDEX_PUBLISH: begin
|
|
{$IFDEF FPC}
|
|
ShowMessage('Don''t implemented');
|
|
{$ELSE}
|
|
// search project for current unit
|
|
loldCurrentProject := CurrentProject;
|
|
// lproject
|
|
lproject := FindProjectByActiveModule;
|
|
SetActiveProject(lproject);
|
|
try
|
|
with CreatePleaseWaitForm('Running the Service Builder...') do try
|
|
Show();
|
|
{$IFDEF SB2}
|
|
LaunchServiceBuilderForCurrentProject('/dataabstract-import-schema /schemafile:"'+sfname+'" /schemacomponentname:"'+schema.Name+'" /ServiceName:"'+schema.Owner.Name+'"',true,true);
|
|
{$ELSE}
|
|
LaunchServiceBuilderForCurrentProject('/execute:"DataAbstract.PublishSchemaWizard" /execute-options:"Schema='+sfname+';ServiceName='+schema.Owner.Name+';SchemaComponentName='+schema.Name+'"',true,true);
|
|
{$ENDIF}
|
|
Hide();
|
|
finally
|
|
Free();
|
|
end;
|
|
finally
|
|
DeleteFile(sfname);
|
|
DeleteFile(cmfname);
|
|
if dadname <> '' then DeleteFile(dadname);
|
|
if diagramname <> '' then DeleteFile(diagramname);
|
|
if loldCurrentProject <> CurrentProject then SetActiveProject(loldCurrentProject);
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
COMMAND_INDEX_SAVE: exit;
|
|
end;
|
|
end
|
|
else if (Index=COMMAND_INDEX_GENCODE) then begin
|
|
GenerateSchemaUnits(schema);
|
|
end
|
|
else begin
|
|
if PromptForFileName(sfname, 'Data Abstract Schema (*'+daFileExtSchemaFile+')|*'+daFileExtSchemaFile+'|All Files (*.*)|*.*', daFileExtSchemaFile, 'Load Schema') then begin
|
|
schema.LoadFromFile(sfname, pfXML);
|
|
Designer.Modified;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDASchemaEditor.GetVerb(Index: Integer): string;
|
|
begin
|
|
case Index of
|
|
COMMAND_INDEX_SEPARATOR_1,
|
|
COMMAND_INDEX_SEPARATOR_2 : result := '-';
|
|
COMMAND_INDEX_EDIT : result := 'Edit '+GetComponent.Name;
|
|
COMMAND_INDEX_PUBLISH : result := 'Publish '+GetComponent.Name+'...';
|
|
COMMAND_INDEX_SAVE : result := 'Save '+GetComponent.Name+' to Disk...';
|
|
COMMAND_INDEX_LOAD : result := 'Load '+GetComponent.Name+' from Disk...';
|
|
COMMAND_INDEX_GENCODE : result := 'Generate '+GetComponent.Name+' strongly-typed access units...';
|
|
COMMAND_INDEX_GENCONSTS : result := 'Copy Dataset and Command Names to Clipboard';
|
|
end;
|
|
end;
|
|
|
|
function TDASchemaEditor.GetVerbCount: Integer;
|
|
begin
|
|
result := 8;
|
|
end;
|
|
|
|
{ TDADriverManagerEditor }
|
|
|
|
procedure TDADriverManagerEditor.ExecuteVerb(Index: Integer);
|
|
var
|
|
s : string;
|
|
i: Integer;
|
|
sl : IROStrings;
|
|
dm : TDADriverManager;
|
|
begin
|
|
dm := TDADriverManager(GetComponent);
|
|
s := '';
|
|
|
|
case Index of
|
|
0 : ShowDriverInfo(dm);
|
|
|
|
1: begin
|
|
if (dm.DriverCount=0) then begin
|
|
MessageDlg('No drivers to unload.', mtWarning, [mbOK], 0);
|
|
end
|
|
else begin
|
|
dm.UnloadAllDrivers;
|
|
MessageDlg('Drivers unloaded.', mtInformation, [mbOK], 0);
|
|
end;
|
|
end;
|
|
|
|
2 : begin
|
|
if (dm.DriverDirectory='') then begin
|
|
MessageDlg('DriverDirectory is empty. Cannot load drivers.', mtWarning, [mbOK], 0);
|
|
end
|
|
else begin
|
|
dm.ListDrivers(dm.DriverDirectory, sl);
|
|
if (sl.Count=0) then begin
|
|
MessageDlg('No drivers were found', mtInformation, [mbOK], 0);
|
|
end
|
|
else begin
|
|
{$IFNDEF FPC}
|
|
with CreatePleaseWaitForm('Loading Drivers...') do try
|
|
{$ENDIF}
|
|
for i := 0 to sl.Count-1 do try
|
|
{$IFNDEF FPC}
|
|
Show(Format('Loading %s...',[ExtractFileName(sl[i])]));
|
|
{$ENDIF}
|
|
dm.LoadDriver(sl[i]);
|
|
except
|
|
on E:EDADriverAlreadyLoaded do;
|
|
on E:EDASchemaModelerOnly do;
|
|
on E:Exception do begin
|
|
{$IFNDEF FPC}
|
|
Hide();
|
|
{$ENDIF}
|
|
ShowMessageFmt('There was an error loading the %s driver:'#13#13'%s: %s',[ExtractFileName(sl[i]),E.ClassName,E.Message]);
|
|
end;
|
|
end; { for }
|
|
{$IFNDEF FPC}
|
|
finally
|
|
free;
|
|
end;
|
|
{$ENDIF}
|
|
MessageDlg(IntToStr(dm.DriverCount)+' Drivers loaded.', mtInformation, [mbOK], 0);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDADriverManagerEditor.GetVerb(Index: Integer): string;
|
|
var dir : string;
|
|
begin
|
|
case Index of
|
|
0 : result := 'Display Driver Information...';
|
|
1 : result := 'Unload All Drivers';
|
|
2 : begin
|
|
dir := TranslateFileName(TDADriverManager(GetComponent).DriverDirectory);
|
|
if (dir='')
|
|
then dir := '<DriverDirectory property is empty!>';
|
|
result := 'Load Drivers in '+dir;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDADriverManagerEditor.GetVerbCount: Integer;
|
|
begin
|
|
result := 3;
|
|
end;
|
|
|
|
{ TDAConnectionManagerEditor }
|
|
|
|
procedure TDAConnectionManagerEditor.ExecuteVerb(Index: Integer);
|
|
var connmgr : TDAConnectionManager;
|
|
sfname : string;
|
|
begin
|
|
connmgr := GetComponent as TDAConnectionManager;
|
|
sfname := connmgr.Name+daFileExtConnectionMgrFile;
|
|
|
|
case Index of
|
|
0:begin
|
|
{$IFDEF FPC}
|
|
EditCollection(connmgr, connmgr.Connections, 'Connections');
|
|
{$ELSE}
|
|
ShowCollectionEditor(Designer, connmgr, connmgr.Connections, 'Connections');
|
|
{$ENDIF}
|
|
end;
|
|
|
|
1 : {separator};
|
|
|
|
2 : begin
|
|
if not PromptForFileName(sfname, 'Data Abstract Connections (*'+daFileExtConnectionMgrFile+')|*'+daFileExtConnectionMgrFile+'|All Files (*.*)|*.*', daFileExtConnectionMgrFile, 'Save Connections '+connmgr.Name, '', TRUE)
|
|
then Exit;
|
|
|
|
connmgr.SaveToFile(sfname, pfXML);
|
|
end;
|
|
|
|
3: begin
|
|
if not PromptForFileName(sfname, 'Data Abstract Connections (*'+daFileExtConnectionMgrFile+')|*'+daFileExtConnectionMgrFile+'|All Files (*.*)|*.*', DAFileExtConnectionMgrFile, 'Load Connections '+connmgr.Name, '')
|
|
then Exit;
|
|
|
|
connmgr.LoadFromFile(sfname, pfXML);
|
|
Designer.Modified;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDAConnectionManagerEditor.GetVerb(Index: Integer): string;
|
|
begin
|
|
case Index of
|
|
0 : result := 'Connection List Editor';
|
|
1 : result := '-';
|
|
2 : result := 'Save '+GetComponent.Name+' To Disk...';
|
|
3 : result := 'Load '+GetComponent.Name+' From Disk...';
|
|
end;
|
|
end;
|
|
|
|
function TDAConnectionManagerEditor.GetVerbCount: Integer;
|
|
begin
|
|
result := 4;
|
|
end;
|
|
|
|
{ TDADataRequestAccessParamEditor }
|
|
|
|
procedure CheckCondition(InvalidSituation : boolean; const anErrorMessage : string);
|
|
begin
|
|
if InvalidSituation then begin
|
|
MessageDlg(anErrorMessage, mtError, [mbOK], 0);
|
|
Abort;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TDADataRequestCallMethodNameEditor }
|
|
|
|
function TDADataRequestCallMethodNameEditor.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
result := [paValueList]
|
|
end;
|
|
|
|
function TDADataRequestCallMethodNameEditor.RetrieveLibrary : TRODLLibrary;
|
|
var datamethod : TDARemoteRequest;
|
|
//datatable : TDADataTable;
|
|
//adapter : TDADataAdapter;
|
|
rs : TRORemoteService;
|
|
svcname : string;
|
|
begin
|
|
//result := NIL;
|
|
|
|
// Sets the variable we need
|
|
datamethod := GetComponent(0) as TDARemoteRequest;
|
|
rs := datamethod.RemoteService;
|
|
|
|
CheckCondition(rs=NIL, 'RemoteService must be assigned.');
|
|
|
|
svcname := Trim(rs.ServiceName);
|
|
CheckCondition(svcname='', rs.Name+'.ServiceName must be assigned.');
|
|
|
|
{adapter := datamethod.Owner.Adapter;
|
|
CheckCondition(adapter=NIL, 'The Adpater property is not set');}
|
|
|
|
result := rs.GetRODLLibrary;
|
|
end;
|
|
|
|
procedure TDADataRequestCallMethodNameEditor.GetValues(Proc: TGetStrProc);
|
|
var lib : TRODLLibrary;
|
|
i,j : integer;
|
|
svc : TRODLService;
|
|
svcintf : TRODLServiceInterface;
|
|
svcname : string;
|
|
sl : IROStrings;
|
|
anchestors : TList;
|
|
method: TDARemoteRequest;
|
|
begin
|
|
lib := RetrieveLibrary;
|
|
if not assigned(lib) then
|
|
raise Exception.Create('RODL library could npt be retrieved from server.');
|
|
|
|
anchestors := TList.Create;
|
|
try
|
|
|
|
method := GetComponent(0) as TDARemoteRequest;
|
|
svcname := method.RemoteService.ServiceName;
|
|
|
|
svc := lib.FindService(svcname);
|
|
if not assigned(svc) then raise Exception.Create('Service "'+svcname+'" could not be found in RODL.');
|
|
|
|
repeat
|
|
anchestors.Add(svc.Default);
|
|
if (Trim(svc.Ancestor)<>'') then begin
|
|
svc := lib.FindService(svc.Ancestor);
|
|
if not assigned(svc) then break;
|
|
end
|
|
else break;
|
|
until false;
|
|
|
|
// Methods
|
|
sl := NewROStrings;
|
|
sl.Sorted := TRUE;
|
|
|
|
for i := 0 to anchestors.Count-1 do begin
|
|
svcintf := TRODLServiceInterface(anchestors[i]);
|
|
|
|
for j := 0 to (svcintf.Count-1) do begin
|
|
{if (svcintf.Items[i].Result=NIL) or
|
|
not (StrToDataType(svcintf.Items[i].Result.DataType)=method.Owner.Adapter.TargetDataType)
|
|
then Continue;}
|
|
|
|
sl.Add(svcintf.Items[j].Name);
|
|
end;
|
|
end;
|
|
|
|
for i := 0 to (sl.Count-1)
|
|
do Proc(sl[i]);
|
|
|
|
finally
|
|
anchestors.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TDADataRequestCallMethodNameEditor.SetValue(const Value: string);
|
|
var
|
|
lRemoteRequest: TDARemoteRequest;
|
|
lOldMethodName: String;
|
|
begin
|
|
lRemoteRequest := TDARemoteRequest(GetComponent(0));
|
|
lOldMethodName := lRemoteRequest.MethodName;
|
|
lRemoteRequest.MethodName := Value;
|
|
if (Trim(lOldMethodName) <> Trim(Value)) then begin
|
|
{$IFNDEF FPC}
|
|
Designer.Modified();
|
|
{$ELSE}
|
|
PropertyHook.Modified(lRemoteRequest);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
if (Trim(Value)='') then Exit;
|
|
|
|
if MessageDlg('Do you want to retrieve the parameters of the method '+Value+'?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
|
|
{$IFNDEF FPC}
|
|
with CreatePleaseWaitForm('Retrieving Parameters...') do begin
|
|
{$ENDIF}
|
|
lRemoteRequest.RefreshParams(true);
|
|
{$IFNDEF FPC}
|
|
Hide();
|
|
{$ENDIF}
|
|
{$IFNDEF FPC}
|
|
Designer.Modified();
|
|
{$ELSE}
|
|
PropertyHook.Modified(lRemoteRequest);
|
|
{$ENDIF FPC}
|
|
{$IFNDEF FPC}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
{ TDALoginAwareComponentEditor }
|
|
|
|
procedure TDALoginAwareComponentEditor.OnLoginNeeded(Sender: TROTransportChannel; anException: Exception; var aRetry: Boolean);
|
|
begin
|
|
aRetry := TROLoginNeededForm.Execute(fRemoteService);
|
|
end;
|
|
|
|
function TDALoginAwareComponentEditor.GetAdapterSchema(aAdapter: TDABaseDataAdapter): TDASchema;
|
|
var
|
|
lSaved: TROExceptionEvent;
|
|
begin
|
|
if (aAdapter is TDARemoteDataAdapter) then begin
|
|
if TDARemoteDataAdapter(aAdapter).RemoteService.Channel = nil then
|
|
raise EROException.Create('Channel not assigned');
|
|
lSaved := TDARemoteDataAdapter(aAdapter).RemoteService.Channel.OnLoginNeeded;
|
|
TDARemoteDataAdapter(aAdapter).RemoteService.Channel.OnLoginNeeded := OnLoginNeeded;
|
|
try
|
|
fRemoteService := TDARemoteDataAdapter(aAdapter).RemoteService;
|
|
result := aAdapter.ReadSchema(True);
|
|
finally
|
|
TDARemoteDataAdapter(aAdapter).RemoteService.Channel.OnLoginNeeded := lSaved;
|
|
end;
|
|
end
|
|
else begin
|
|
result := aAdapter.ReadSchema(True);
|
|
end;
|
|
end;
|
|
|
|
{ TDARemoteDataAdapterEditor }
|
|
|
|
procedure TDARemoteDataAdapterEditor.ExecuteVerb(Index: Integer);
|
|
var
|
|
lAdapter: TDARemoteDataAdapter;
|
|
begin
|
|
lAdapter := TDARemoteDataAdapter(GetComponent);
|
|
case Index of
|
|
0: lAdapter.SetupDefaultRequest();
|
|
1: lAdapter.SetupDefaultRequestV3();
|
|
2: exit{ Separator };
|
|
3: if not HookUpDataTables() then exit;
|
|
4: if not TDataTableWizards.CreateDataTables(Designer, lAdapter, GetAdapterSchema(lAdapter), Point(0,0)) then exit;
|
|
end;
|
|
Designer.Modified();
|
|
end;
|
|
|
|
function TDARemoteDataAdapterEditor.GetVerb(Index: Integer): string;
|
|
begin
|
|
case Index of
|
|
0 : result := '&Reset Calls to Default';
|
|
1 : result := 'Reset Calls to Default (Legacy v&3.0)';
|
|
2 : result := '-';
|
|
3 : result := '&Hook up Data Tables...';
|
|
4 : result := '&Create Data Tables...';
|
|
end;
|
|
end;
|
|
|
|
function TDARemoteDataAdapterEditor.GetVerbCount: Integer;
|
|
begin
|
|
result := 5;
|
|
end;
|
|
|
|
{ TDADataTableEditor }
|
|
|
|
procedure TDADataTableEditor.ExecuteVerb(Index: Integer);
|
|
var
|
|
dt: TDADataTable;
|
|
lTempSchema: TDASchema;
|
|
lTempSchemaDataSet: TDADataset;
|
|
s: string;
|
|
lSaved: TROExceptionEvent;
|
|
lDA: TDALocalDataAdapter;
|
|
begin
|
|
dt := TDADataTable(GetComponent);
|
|
|
|
case Index of
|
|
0:begin
|
|
{$IFDEF FPC}
|
|
EditCollection(dt, dt.Fields, 'Fields');
|
|
{$ELSE}
|
|
ShowCollectionEditor(Designer, dt, dt.Fields, 'Fields');
|
|
{$ENDIF}
|
|
end;
|
|
1:{ Seperator };
|
|
2:begin
|
|
if not (MessageDlg('Do you want to retrieve the schema of '+dt.Name+'?'#13+
|
|
'This will overwrite the current field and parameter settings.',
|
|
mtWarning, [mbYes, mbNo], 0)=mrYes) then Exit;
|
|
|
|
if dt.LogicalName = '' then
|
|
raise Exception.Create('LogicalName must be set.');
|
|
|
|
if dt.RemoteFetchEnabled then begin
|
|
if assigned(dt.RemoteDataAdapter) then begin
|
|
(dt.RemoteDataAdapter as TDABaseDataAdapter).CheckProperties();
|
|
if dt.RemoteDataAdapter is TDARemoteDataAdapter then begin
|
|
fRemoteService := (dt.RemoteDataAdapter as TDARemoteDataAdapter).RemoteService;
|
|
lSaved := fRemoteService.Channel.OnLoginNeeded;
|
|
fRemoteService.Channel.OnLoginNeeded := OnLoginNeeded;
|
|
(dt.RemoteDataAdapter as TDARemoteDataAdapter).FlushSchema;
|
|
try
|
|
dt.LoadSchema(true, true);
|
|
finally
|
|
fRemoteService.Channel.OnLoginNeeded := lSaved;
|
|
end;
|
|
end
|
|
else if dt.RemoteDataAdapter is TDALocalDataAdapter then begin
|
|
lDA := TDALocalDataAdapter(dt.RemoteDataAdapter);
|
|
lDA.ServiceInstance := GetServiceInstance(lDA.ServiceName);
|
|
try
|
|
dt.LoadSchema(true, true);
|
|
finally
|
|
lDA.ServiceInstance := nil;
|
|
end;
|
|
end;
|
|
end
|
|
else begin
|
|
MessageDlg('RemoteDataAdapter must be assigned.', mtError, [mbOK], 0);
|
|
Exit;
|
|
end;
|
|
end
|
|
else begin
|
|
if assigned(dt.LocalSchema) and assigned(dt.LocalDataStreamer) then begin
|
|
dt.loadschema(True, True);
|
|
//ds := dt.LocalSchema.Datasets.DatasetByName(dt.LogicalName);
|
|
//dt.Fields.AssignFieldCollection(ds.Fields);
|
|
//dt.Params.AssignParamCollection(ds.Params);
|
|
end
|
|
else begin
|
|
MessageDlg('LocalSchema/LocalDataStreamer must be assigned.', mtError, [mbOK], 0);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
s := 'Schema loaded successfully. '+IntToStr(dt.Fields.Count)+' fields';
|
|
if (dt.Params.Count>0) then s := s+' and '+IntToStr(dt.Params.Count)+' params';
|
|
s := s+' have been created. Original lookup- and client calculated fields have been preserved.';
|
|
|
|
MessageDlg(s, mtInformation, [mbOK], 0);
|
|
|
|
Designer.Modified;
|
|
end;
|
|
|
|
3: if TDADataTableMasterLinkWizard.ExecuteWizard(dt,{$IFDEF FPC}Designer.PropertyEditorHook{$ELSE} Designer {$ENDIF}) then
|
|
Designer.Modified();
|
|
4:{ Seperator };
|
|
5:begin
|
|
lTempSchema := TDASchema.Create(NIL);
|
|
try
|
|
lTempSchema.Name := MakeValidIdentifier(dt.LogicalName);
|
|
if lTempSchema.Name = '' then lTempSchema.Name := dt.Name;
|
|
|
|
lTempSchemaDataSet := lTempSchema.Datasets.Add();
|
|
lTempSchemaDataSet.Name := lTempSchema.Name;
|
|
lTempSchemaDataSet.Fields.AssignFieldCollection(dt.Fields);
|
|
GenerateSchemaUnits(lTempSchema);
|
|
finally
|
|
lTempSchema.Free;
|
|
end;
|
|
end;
|
|
6:{ Seperator };
|
|
7:begin
|
|
with TDAIdeData.Create(nil) do try
|
|
if dlg_OpenBriefcase.Execute then begin
|
|
dt.LoadFromFile(dlg_OpenBriefcase.Filename);
|
|
Designer.Modified();
|
|
end;
|
|
finally
|
|
Free();
|
|
end;
|
|
end;
|
|
8:begin
|
|
if not dt.Active then
|
|
raise Exception.Create('DataTable is not active.');
|
|
|
|
with TDAIdeData.Create(nil) do try
|
|
if dlg_SaveBriefcase.Execute then begin
|
|
dt.SaveToFile(dlg_SaveBriefcase.Filename);
|
|
end;
|
|
finally
|
|
Free();
|
|
end;
|
|
end;
|
|
10:begin
|
|
if dt.LogicalName = '' then
|
|
raise Exception.Create('LogicalName must be set.');
|
|
|
|
if dt.RemoteFetchEnabled then
|
|
if assigned(dt.RemoteDataAdapter) then begin
|
|
(dt.RemoteDataAdapter as TDABaseDataAdapter).CheckProperties();
|
|
if dt.RemoteDataAdapter is TDARemoteDataAdapter then begin
|
|
fRemoteService := (dt.RemoteDataAdapter as TDARemoteDataAdapter).RemoteService;
|
|
lSaved := fRemoteService.Channel.OnLoginNeeded;
|
|
fRemoteService.Channel.OnLoginNeeded := OnLoginNeeded;
|
|
try
|
|
dt.Open();
|
|
finally
|
|
fRemoteService.Channel.OnLoginNeeded := lSaved;
|
|
end;
|
|
end
|
|
else if dt.RemoteDataAdapter is TDALocalDataAdapter then begin
|
|
lDA := TDALocalDataAdapter(dt.RemoteDataAdapter);
|
|
SetDefaultConnection(lDA.ServiceName);
|
|
lDA.ServiceInstance := GetServiceInstance(lDA.ServiceName);
|
|
try
|
|
dt.Open();
|
|
finally
|
|
lDA.ServiceInstance := nil;
|
|
end;
|
|
end;
|
|
end
|
|
else if assigned(dt.LocalSchema) and assigned(dt.LocalDataStreamer) then begin
|
|
dt.Open();
|
|
end;
|
|
Designer.Modified;
|
|
end;
|
|
|
|
end; { case }
|
|
end;
|
|
|
|
function TDADataTableEditor.GetVerb(Index: Integer): string;
|
|
begin
|
|
case Index of
|
|
0 : result := 'Field Collection Editor';
|
|
1 : result := '-';
|
|
//2 : result := 'Dynamic Method Binding Setup Wizard (Legacy v3.0)';
|
|
//3 : result := '-';
|
|
2 : result := 'Retrieve DataTable Schema';
|
|
3 : result := 'Master/Detail Wizard';
|
|
4 : result := '-';
|
|
5 : result := 'Generate Business Class...';
|
|
6 : result := '-';
|
|
7 : result := 'Load Data from briefcase file...';
|
|
8 : result := 'Save Data to briefcase file...';
|
|
9 : result := '-';
|
|
10 : result := 'Get Design-Time Data';
|
|
end;
|
|
end;
|
|
|
|
function TDADataTableEditor.GetVerbCount: Integer;
|
|
begin
|
|
result := 9;
|
|
if not TDADataTable(GetComponent).Active and (assigned(TDADataTable(GetComponent).RemoteDataAdapter)) then inc(result,2);
|
|
end;
|
|
|
|
{ TDABusinessProcessorCommandProperty }
|
|
|
|
function TDABusinessProcessorCommandProperty.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
result := [paValueList, paSortList]
|
|
end;
|
|
|
|
procedure TDABusinessProcessorCommandProperty.GetValues(Proc: TGetStrProc);
|
|
var biz : TDABusinessProcessor;
|
|
i : integer;
|
|
list : IROStrings;
|
|
begin
|
|
biz := GetComponent(0) as TDABusinessProcessor;
|
|
if (biz.Schema=NIL) then Exit;
|
|
|
|
list := NewROStrings;
|
|
for i := 0 to (biz.Schema.Commands.Count-1) do
|
|
list.Add(biz.Schema.Commands[i].Name);
|
|
|
|
list.Sorted := TRUE;
|
|
|
|
for i := 0 to (list.Count-1) do
|
|
Proc(list[i]);
|
|
end;
|
|
|
|
type
|
|
TPersistentCracker = class(TPersistent);
|
|
{ TDACollectionProperty }
|
|
|
|
procedure TDACollectionProperty.Edit;
|
|
var coll : TCollection;
|
|
begin
|
|
coll := GetObjectProp(GetComponent(0), GetName) as TCollection;
|
|
|
|
if (coll=NIL) then ShowMessage('no way!')
|
|
else showmessage(GetName+' has #'+INtToSTr(coll.count)+' '+TComponent(integer(coll.Owner)).ClassName);
|
|
{$IFDEF FPC}
|
|
EditCollection(TComponent(GetComponent(0)),coll, GetName);
|
|
{$ELSE}
|
|
ShowCollectionEditor(Designer, TComponent(GetComponent(0)), coll, GetName);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDACollectionProperty.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
result := [paDialog, paReadOnly];
|
|
end;
|
|
{ TDABusinessProcessorRefDatasetProperty }
|
|
|
|
function TDABusinessProcessorRefDatasetProperty.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
result := [paValueList, paSortList]
|
|
end;
|
|
|
|
procedure TDABusinessProcessorRefDatasetProperty.GetValues( Proc: TGetStrProc);
|
|
var biz : TDABusinessProcessor;
|
|
i : integer;
|
|
list : IROStrings;
|
|
begin
|
|
biz := GetComponent(0) as TDABusinessProcessor;
|
|
if (biz.Schema=NIL) then Exit;
|
|
|
|
list := NewROStrings;
|
|
for i := 0 to (biz.Schema.Datasets.Count-1) do
|
|
list.Add(biz.Schema.Datasets[i].Name);
|
|
|
|
list.Sorted := TRUE;
|
|
|
|
for i := 0 to (list.Count-1) do
|
|
Proc(list[i]);
|
|
end;
|
|
|
|
{ TDADataTableLogicalNameEditor }
|
|
|
|
function TDADataTableLogicalNameEditor.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
result := [paValueList, paSortList]
|
|
end;
|
|
|
|
function TDADataTableLogicalNameEditor.GetSchema: TDASchema;
|
|
var
|
|
lda: TDALocalDataAdapter;
|
|
begin
|
|
Result:=nil;
|
|
try
|
|
with TDADataTable(GetComponent(0)) do
|
|
if not RemoteFetchEnabled then
|
|
Result := LocalSchema
|
|
else if (RemoteDataAdapter <> nil) then begin
|
|
if (RemoteDataAdapter is TDARemoteDataAdapter) then
|
|
Result:= (RemoteDataAdapter as TDARemoteDataAdapter).Schema
|
|
else if (RemoteDataAdapter is TDALocalDataAdapter) then begin
|
|
lda := (RemoteDataAdapter as TDALocalDataAdapter);
|
|
lda.ServiceInstance := GetServiceInstance(lda.ServiceName);
|
|
try
|
|
Result:= (RemoteDataAdapter as TDALocalDataAdapter).Schema;
|
|
finally
|
|
lda.ServiceInstance := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
except
|
|
// hide exception, when RDA can't receive SCHEMA
|
|
end;
|
|
end;
|
|
|
|
procedure TDADataTableLogicalNameEditor.GetValues(Proc: TGetStrProc);
|
|
var i : integer;
|
|
_Schema: TDASchema;
|
|
begin
|
|
_Schema:= GetSchema;
|
|
if _Schema <> nil then begin
|
|
for i := 0 to (_Schema.Datasets.Count-1) do
|
|
if _Schema.Datasets[i].IsPublic then Proc(_Schema.Datasets[i].Name);
|
|
for i := 0 to (_Schema.UnionDataTables.Count-1) do
|
|
if _Schema.UnionDataTables[i].IsPublic then Proc(_Schema.UnionDataTables[i].Name);
|
|
for i := 0 to (_Schema.JoinDataTables.Count-1) do
|
|
if _Schema.JoinDataTables[i].IsPublic then Proc(_Schema.JoinDataTables[i].Name);
|
|
end;
|
|
end;
|
|
|
|
{ TDADataTableLocalConnection }
|
|
|
|
function TDADataTableLocalConnection.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
if (TDADataTable(GetComponent(0)).LocalSchema<>NIL) and (TDADataTable(GetComponent(0)).LocalSchema.ConnectionManager<>NIL)
|
|
then result := [paValueList]
|
|
else result := []
|
|
end;
|
|
|
|
procedure TDADataTableLocalConnection.GetValues(Proc: TGetStrProc);
|
|
var i : integer;
|
|
begin
|
|
with TDADataTable(GetComponent(0)) do begin
|
|
if (LocalSchema=NIL) or (LocalSchema.ConnectionManager=NIL) then Exit;
|
|
|
|
for i := 0 to (LocalSchema.ConnectionManager.Connections.Count-1) do
|
|
Proc(LocalSchema.ConnectionManager.Connections[i].Name);
|
|
end;
|
|
end;
|
|
|
|
{ TDADriverManagerDirectory }
|
|
|
|
function TDADriverManagerDirectory.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
result := [paValueList]
|
|
end;
|
|
|
|
const SelectDirOption = '<Select directory>';
|
|
|
|
procedure TDADriverManagerDirectory.GetValues(Proc: TGetStrProc);
|
|
begin
|
|
inherited;
|
|
|
|
Proc(alias_ModuleDir);
|
|
Proc(alias_System);
|
|
Proc(SelectDirOption);
|
|
end;
|
|
|
|
procedure TDADriverManagerDirectory.SetValue(const Value: string);
|
|
var dir : string;
|
|
begin
|
|
if (Value=SelectDirOption) then begin
|
|
if SelectDirectory(dir, [sdPrompt, sdAllowCreate], 0)
|
|
then inherited SetValue(dir);
|
|
end
|
|
|
|
else if (Value=alias_DABinDir) then begin
|
|
dir := IncludeTrailingPathDelimiter(Copy(GetDllPath, 1, Length(GetDLLPath)-7))+'Bin';
|
|
inherited SetValue(dir);
|
|
end
|
|
|
|
else inherited;
|
|
end;
|
|
|
|
{ TDADataDictionaryEditor }
|
|
|
|
procedure TDADataDictionaryEditor.ExecuteVerb(Index: Integer);
|
|
var
|
|
dict: TDADataDictionary;
|
|
sfname: string;
|
|
begin
|
|
inherited;
|
|
|
|
dict := GetComponent as TDADataDictionary;
|
|
sfname := dict.Name+DAFileExtDataDictionaryFile;
|
|
|
|
case Index of
|
|
0: {$IFDEF FPC}
|
|
EditCollection(GetComponent(), dict.Fields, 'Fields');
|
|
{$ELSE}
|
|
ShowCollectionEditor(Designer, GetComponent(), dict.Fields, 'Fields');
|
|
{$ENDIF}
|
|
1:{separater};
|
|
2:if PromptForFileName(sfname, 'Data Abstract DataDictionaries (*'+DAFileExtDataDictionaryFile+')|*'+DAFileExtDataDictionaryFile+'|All Files (*.*)|*.*', DAFileExtDataDictionaryFile, 'Save DataDictionary '+dict.Name, '', TRUE) then
|
|
dict.SaveToFile(sfname, pfXML);
|
|
3:if PromptForFileName(sfname, 'Data Abstract DataDictionaries (*'+DAFileExtDataDictionaryFile+')|*'+DAFileExtDataDictionaryFile+'|All Files (*.*)|*.*', DAFileExtDataDictionaryFile, 'Load DataDictionary '+dict.Name, '') then begin
|
|
dict.LoadFromFile(sfname, pfXML);
|
|
Designer.Modified;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDADataDictionaryEditor.GetVerb(Index: Integer): string;
|
|
begin
|
|
case Index of
|
|
0:result := 'DataDictionary Editor';
|
|
1:result := '-';
|
|
2: result := 'Save '+GetComponent.Name+' to Disk...';
|
|
3: result := 'Load '+GetComponent.Name+' from Disk...';
|
|
end;
|
|
end;
|
|
|
|
function TDADataDictionaryEditor.GetVerbCount: Integer;
|
|
begin
|
|
result := 4;
|
|
end;
|
|
|
|
{ TDAClientDataModuleEditor }
|
|
|
|
{ TDADataTableMasterDetailProps }
|
|
|
|
procedure TDADataTableMasterDetailProps.Edit;
|
|
begin
|
|
{$IFDEF FPC}
|
|
if TDADataTableMasterLinkWizard.ExecuteWizard(TDADataTable(GetComponent(0)), PropertyHook) then
|
|
Modified;
|
|
{$ELSE}
|
|
if TDADataTableMasterLinkWizard.ExecuteWizard(TDADataTable(GetComponent(0)), Designer) then
|
|
Designer.Modified();
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TDADataTableMasterDetailProps.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
result := [paDialog]
|
|
end;
|
|
|
|
|
|
{ TDACollectionItemDatasetNameEditor }
|
|
|
|
function TDACollectionItemDatasetNameEditor.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
result := [paValueList, paSortList]
|
|
end;
|
|
|
|
procedure TDACollectionItemDatasetNameEditor.GetValues(Proc: TGetStrProc);
|
|
var schema : TDASchema;
|
|
i : integer;
|
|
begin
|
|
schema := TSearcheableCollection(TCollectionItem(GetComponent(0)).Collection).Owner as TDASchema;
|
|
for i := 0 to schema.Datasets.Count-1 do begin
|
|
Proc(schema.Datasets[i].Name);
|
|
end;
|
|
end;
|
|
|
|
{ TDADesigntimeCallEditor }
|
|
|
|
procedure TDADesigntimeCallEditor.ExecuteVerb(Index: Integer);
|
|
begin
|
|
inherited;
|
|
(GetComponent as TDADesigntimeCall).MakeRequest;
|
|
ShowMessage('The call to the server was executed.');
|
|
end;
|
|
|
|
function TDADesigntimeCallEditor.GetVerb(Index: Integer): string;
|
|
begin
|
|
result := 'Make Call';
|
|
end;
|
|
|
|
function TDADesigntimeCallEditor.GetVerbCount: Integer;
|
|
begin
|
|
result := 1;
|
|
end;
|
|
|
|
{ TDADataTableReferenceDataTable }
|
|
|
|
procedure TDADataTableReferenceDataTable.GetValues(Proc: TGetStrProc);
|
|
begin
|
|
{$IFDEF FPC}
|
|
with PropertyHook do
|
|
{$ELSE}
|
|
With Designer do
|
|
{$ENDIF}
|
|
begin
|
|
GetComponentNames(GetTypeData(TypeInfo(TDADataTable)), Proc);
|
|
GetComponentNames(GetTypeData(TypeInfo(TDataset)), Proc);
|
|
end;
|
|
end;
|
|
|
|
{ TDALookupSourceProperty }
|
|
|
|
function TDALookupSourceProperty.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
result := [paValueList, paSortList, paMultiSelect];
|
|
end;
|
|
|
|
procedure TDALookupSourceProperty.GetValues(Proc: TGetStrProc);
|
|
var
|
|
i: integer;
|
|
begin
|
|
with GetComponent(0) as TDAField do
|
|
for i := 0 to (FieldCollection.Count - 1) do
|
|
Proc(FieldCollection[i].Name);
|
|
end;
|
|
|
|
{ TDALookupDestProperty }
|
|
|
|
function TDALookupDestProperty.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
result := [paValueList, paSortList, paMultiSelect];
|
|
end;
|
|
|
|
procedure TDALookupDestProperty.GetValues(Proc: TGetStrProc);
|
|
var
|
|
lValues: TStringList;
|
|
i: Integer;
|
|
begin
|
|
lValues := TStringList.Create;
|
|
with GetComponent(0) as TDAField do try
|
|
if Assigned(LookupSource) and Assigned(LookupSource.Dataset) then begin
|
|
LookupSource.DataSet.GetFieldNames(lValues);
|
|
for i := 0 to lValues.Count - 1 do
|
|
Proc(lValues[i]);
|
|
end;
|
|
finally
|
|
lValues.free;
|
|
end;
|
|
end;
|
|
|
|
{ TDALookupResultFieldProperty }
|
|
|
|
function TDALookupResultFieldProperty.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
result := [paValueList, paSortList];
|
|
end;
|
|
|
|
procedure TDALookupResultFieldProperty.SetValue(const Value: string);
|
|
var
|
|
lResultField, lLookupField: TDAField;
|
|
begin
|
|
lResultField := GetComponent(0) as TDAField;
|
|
if Assigned(lResultField.LookupSource) then begin
|
|
with TDADataSource(lResultField.LookupSource).DataTable do
|
|
lLookupField := FindField(Value);
|
|
if Assigned(lLookupField) then begin
|
|
lResultField.DataType := lLookupField.DataType;
|
|
lResultField.Size := lLookupField.Size;
|
|
end;
|
|
end;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
{ TDABaseDataAdapterEditor }
|
|
|
|
procedure TDABaseDataAdapterEditor.ExecuteVerb(Index: Integer);
|
|
var
|
|
lAdapter: TDABaseDataAdapter;
|
|
begin
|
|
lAdapter := TDABaseDataAdapter(GetComponent);
|
|
if lAdapter is TDALocalDataAdapter then TDALocalDataAdapter(lAdapter).ServiceInstance := GetServiceInstance(TDALocalDataAdapter(lAdapter).ServiceName);
|
|
try
|
|
case Index of
|
|
0: if not HookUpDataTables() then exit;
|
|
1: if not TDataTableWizards.CreateDataTables(Designer, lAdapter, GetAdapterSchema(lAdapter), Point(0,0)) then exit;
|
|
end;
|
|
finally
|
|
if lAdapter is TDALocalDataAdapter then TDALocalDataAdapter(lAdapter).ServiceInstance := nil;
|
|
end;
|
|
Designer.Modified();
|
|
end;
|
|
|
|
procedure TDABaseDataAdapterEditor.GetDataTables(
|
|
const aName: string);
|
|
begin
|
|
fDataTables.Add(aName);
|
|
end;
|
|
|
|
function TDABaseDataAdapterEditor.GetVerb(Index: Integer): string;
|
|
begin
|
|
case Index of
|
|
0 : result := '&Hook up Data Tables...';
|
|
1 : result := '&Create Data Tables...';
|
|
end;
|
|
end;
|
|
|
|
function TDABaseDataAdapterEditor.GetVerbCount: Integer;
|
|
begin
|
|
result := 2;
|
|
end;
|
|
|
|
function TDABaseDataAdapterEditor.HookUpDataTables: boolean;
|
|
var
|
|
lForm: TDASelectDataTablesForm;
|
|
i: integer;
|
|
{$IFDEF FPC}
|
|
ldesigner: TPropertyEditorHook;
|
|
{$ELSE}
|
|
ldesigner: IDesigner;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF FPC}
|
|
ldesigner:= Designer.PropertyEditorHook;
|
|
{$ELSE}
|
|
ldesigner := Designer;
|
|
{$ENDIF}
|
|
fDataTables := TStringList.Create;
|
|
try
|
|
fDataTables.Sorted := true;
|
|
lDesigner.GetComponentNames(GetTypeData(TypeInfo(TDADataTable)), GetDataTables);
|
|
if fDataTables.Count > 0 then begin
|
|
lForm := TDASelectDataTablesForm.Create(nil);
|
|
try
|
|
for i := 0 to fDataTables.Count - 1 do begin
|
|
lForm.lb_DataTables.Items.AddObject(fDataTables[i], nil);
|
|
lForm.lb_DataTables.Checked[lForm.lb_DataTables.Items.Count-1] := not assigned((lDesigner.GetComponent(fDataTables[i]) as TDADataTable).RemoteDataAdapter);
|
|
end;
|
|
lForm.UpdateCheckBoxState();
|
|
lForm.OkButtonCaption := '&Hook Up';
|
|
result := (lForm.ShowModal() = mrOk);
|
|
if result then begin
|
|
for i := 0 to lForm.lb_DataTables.Items.Count - 1 do
|
|
if lForm.lb_DataTables.Checked[i] then
|
|
(lDesigner.GetComponent(lForm.lb_DataTables.Items[i]) as TDADataTable).RemoteDataAdapter := TDABaseDataAdapter(GetComponent);
|
|
end;
|
|
finally
|
|
FreeAndNil(lForm);
|
|
end;
|
|
end
|
|
else begin
|
|
result := false;
|
|
ShowMessage('No data tables were found on module.')
|
|
end;
|
|
finally
|
|
FreeAndNil(fDataTables);
|
|
end;
|
|
end;
|
|
|
|
{ TDALocalDataAdapterServiceEditor }
|
|
|
|
function TDALocalDataAdapterServiceEditor.GetRODL: TRODLLibrary;
|
|
var prj : {$IFDEF FPC}TLazProject{$ELSE}IOTAProject{$ENDIF};
|
|
fname,
|
|
src: string;
|
|
lReader: TXMLToRODL;
|
|
begin
|
|
result := nil;
|
|
prj := CurrentProject;
|
|
if Assigned(prj) then begin
|
|
src := ReadModuleSource({$IFDEF FPC}prj.MainFile{$ELSE}prj{$ENDIF});
|
|
fname := ExtractRODLFileName(src);
|
|
if fname <> '' then
|
|
begin
|
|
fname := ModuleDir(prj)+fname;
|
|
lReader := TXMLToRODL.Create;
|
|
try
|
|
result := lReader.ReadFromFile(fname);
|
|
finally
|
|
lReader.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDALocalDataAdapterServiceEditor.GetAttributes: TPropertyAttributes;
|
|
begin
|
|
result := [paValueList, paSortList];
|
|
end;
|
|
|
|
procedure TDALocalDataAdapterServiceEditor.GetValues(Proc: TGetStrProc);
|
|
var
|
|
lRODL: TRODLLibrary;
|
|
i: integer;
|
|
begin
|
|
lRODL := GetRODL;
|
|
if lRODL <> nil then
|
|
for i := 0 to lRODL.ServiceCount - 1 do
|
|
Proc(lRODL.Services[i].Name);
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
function FindDataAbstractService(aServiceName: string): TDataAbstractService;
|
|
{
|
|
var
|
|
prj : TLazProject;
|
|
lModule: TLazProjectFile;
|
|
lDComp: TComponent;
|
|
i, j: integer;
|
|
lDAService: TDataAbstractService;
|
|
Des: TIDesigner;
|
|
ceDes: TComponentEditorDesigner;
|
|
peh: TPropertyEditorHook;
|
|
}
|
|
begin
|
|
Result := nil;
|
|
{
|
|
prj := CurrentProject;
|
|
lModule := nil;
|
|
for i := 0 to prj.FileCount-1 do begin
|
|
if SameText(ExtractFileName(prj.Files[i].Filename), aServiceName+'_impl.pas') then begin
|
|
lModule := prj.Files[i];
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
if lModule = nil then begin
|
|
Exit;
|
|
end;
|
|
Des := LazarusIDE.GetDesignerWithProjectFile(lModule,True);
|
|
if Des = nil then begin
|
|
showMessage('Des = nil');
|
|
Exit;
|
|
end;
|
|
}
|
|
end;
|
|
|
|
{$ELSE}
|
|
function FindDataAbstractService(aServiceName: string): TDataAbstractService;
|
|
var
|
|
prj : IOTAProject;
|
|
lModuleInf: IOTAModuleInfo;
|
|
lModule: IOTAModule;
|
|
lSrv: IOTAModuleServices;
|
|
lFormEditor: IOTAFormEditor;
|
|
lComp: IOTAComponent;
|
|
lNComp: INTAComponent;
|
|
lDComp: TComponent;
|
|
i, j: integer;
|
|
lDAService: TDataAbstractService;
|
|
begin
|
|
Result := nil;
|
|
prj := CurrentProject;
|
|
if Supports(BorlandIDEServices, IOTAModuleServices, lSrv) then
|
|
for i := 0 to prj.GetModuleCount - 1 do begin
|
|
lModuleInf := prj.GetModule(i);
|
|
if lModuleInf.FileName <> '' then begin
|
|
try
|
|
lModule := FindModuleByUnitName(prj, lModuleInf.FileName);
|
|
except
|
|
Continue;
|
|
end;
|
|
for j := 0 to lModule.ModuleFileCount - 1 do
|
|
if Supports(lModule.ModuleFileEditors[j], IOTAFormEditor, lFormEditor) then begin
|
|
lComp := lFormEditor.GetRootComponent;
|
|
if Supports(lComp, INTAComponent, lNComp) then begin
|
|
lDComp := lNComp.GetComponent;
|
|
if lDComp.InheritsFrom(TDataAbstractService) then begin
|
|
lDAService := TDataAbstractService(lDComp);
|
|
if SameText(lDAService.Name, aServiceName) then begin
|
|
Result := lDAService;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function GetServiceInstance(aServiceName: string): IDataAbstractLocalServiceAccess;
|
|
var
|
|
lDAService: TDataAbstractService;
|
|
begin
|
|
Result := nil;
|
|
lDAService := FindDataAbstractService(aServiceName);
|
|
if (lDAService <> nil) then
|
|
if not Supports(lDAService, IDataAbstractLocalServiceAccess, Result) then Result := nil;
|
|
end;
|
|
|
|
procedure SetDefaultConnection(aServiceName: string);
|
|
var
|
|
lDAService: TDataAbstractService;
|
|
begin
|
|
lDAService := FindDataAbstractService(aServiceName);
|
|
if (lDAService <> nil) then begin
|
|
if not Assigned(lDAService.ServiceSchema) then
|
|
raise Exception.Create('For service "' + lDAService.Name + '" schema isn''t assigned');
|
|
if not Assigned(lDAService.ServiceSchema.ConnectionManager) then
|
|
raise Exception.Create('For service "' + lDAService.Name + '" schema doesn''t have connection manager');
|
|
lDAService.Connection :=
|
|
lDAService.ServiceSchema.ConnectionManager.NewConnection(lDAService.ServiceSchema.ConnectionManager.GetDefaultConnectionName);
|
|
end;
|
|
end;
|
|
|
|
end.
|