sqldriverediteh.pas

最新的 DBGRIDEH4.0

    function ShowPopup(Source: TObject; Coord: TPoint; Params: TServicePopupParams): Integer;
    procedure TableEditorDrop(Sender, Source: TObject; X, Y: Integer);
    procedure OnPopupClick(Sender: TObject);

    property OnNodeDragDrop: TDragDropEvent read FOnNodeDragDrop write FOnNodeDragDrop;
    property NodeDropMenuParams: TServicePopupParams read FNodeDropMenuParams write FNodeDropMenuParams;

    property NodesSQLClassName: String read FNodesSQLClassName write FNodesSQLClassName;
    property MasterTemplateName: String read FMasterTemplateName write FMasterTemplateName;
    property NodesMemTableName: String read fNodesMemTableName write FNodesMemTableName;
//    property Params: array of Variant read FParams write FParams;
    property ObjIdFieldName: String read FObjIdFieldName write FObjIdFieldName;
    property InTreeTextFieldName: String read FInTreeTextFieldName write FInTreeTextFieldName;
    property HasNodes: Boolean read FHasNodes write FHasNodes;
    property NodesFilter: String read FNodesFilter write FNodesFilter;
//    property NodesFieldsInGrid: String read FNodesFieldsInGrid write FNodesFieldsInGrid;
    property ColumnAttributesStr: String read FColumnAttributesStr write SetColumnAttributes;
    property AdditionalLoadSQL: String read FAdditionalLoadSQL write FAdditionalLoadSQL;
    property AdditionalFielsInfo: String read FAdditionalFielsInfo write FAdditionalFielsInfo;

  end;

{ TDesignUpdateParamsEh }

  TDesignUpdateParamsEh = class(TPersistent)
  private
    FIncremenField: String;
    FIncremenObject: String;
    FTableName: String;
    FKeyFields: TStrings;
    FUpdateFields: TStrings;
    FSelectSQL: TStrings;
    procedure SetKeyFields(const Value: TStrings);
    procedure SetUpdateFields(const Value: TStrings);
    procedure SetSelectSQL(const Value: TStrings);
  public
    constructor Create;
    destructor Destroy; override;
    property TableName: String read FTableName write FTableName;
    property IncremenField: String read FIncremenField write FIncremenField;
    property IncremenObject: String read FIncremenObject write FIncremenObject;
    property KeyFields: TStrings read FKeyFields write SetKeyFields;
    property UpdateFields: TStrings read FUpdateFields write SetUpdateFields;
    property SelectSQL: TStrings read FSelectSQL write SetSelectSQL;
  end;

{ TDesignUpdateInfoEh }

  TDesignUpdateInfoEh = class(TPersistent)
  private
    FTableName: String;
    FDeleteSQL: TStrings;
    FGetRecSQL: TStrings;
    FUpdateSQL: TStrings;
    FInsertSQL: TStrings;
    FSpecParams: TStrings;
    FUpdateFields: TStrings;
    FKeyFields: TStrings;
    procedure SetDeleteSQL(const Value: TStrings);
    procedure SetGetRecSQL(const Value: TStrings);
    procedure SetUpdateSQL(const Value: TStrings);
    procedure SetInsertSQL(const Value: TStrings);
    procedure SetSpecParams(const Value: TStrings);
    procedure SetKeyFields(const Value: TStrings);
    procedure SetUpdateFields(const Value: TStrings);
  public
    constructor Create;
    destructor Destroy; override;
    property TableName: String read FTableName write FTableName;
    property DeleteSQL: TStrings read FDeleteSQL write SetDeleteSQL;
    property InsertSQL: TStrings read FInsertSQL write SetInsertSQL;
    property UpdateSQL: TStrings read FUpdateSQL write SetUpdateSQL;
    property GetRecSQL: TStrings read FGetRecSQL write SetGetRecSQL;
    property SpecParams: TStrings read FSpecParams write SetSpecParams;
    property UpdateFields: TStrings read FUpdateFields write SetUpdateFields;
    property KeyFields: TStrings read FKeyFields write SetKeyFields;
  end;

{ TCustomDBService }

  TCustomDBService = class(TPersistent)
  private
    FMTList: TStringList;
    FTempateList: TStringList;
    FSQLRoot: TSQLTreeNode;
    FSQLClassListNames: TStringList;
    FSQLClassListTexts: TStringList;
    FLoadedSQLClasses: TStringList;
  protected
    FDesignDB: TDesignDataBaseEh;
    FIncrementObjectsList: TStrings;
    SelectedIndex: Integer;
//    function CreateNode: IGetSQLTreeNode; virtual;
    function CreateNode: TSQLTreeNode; virtual;
    function CreateReader(SQL: String; FParams: TParamsArr): TDataSet; virtual;
    function GetMemTable(TableName: String): TMemTableEh;
    function GetTemplate(TemplateName: String): TSQLTreeNodeTemplate;
    function LoadText(TextName: String): String;
    function LoadMemTable(MemTable: TMemTableEh; Source: TDataSet; Mode: TLoadMode; Fetch: Boolean): Integer; virtual;
    function SQLClassTextByName(ClassName: String): String;
    procedure AddTemplate(Template: TSQLTreeNodeTemplate);
    procedure OnPopupClick(Sender: TObject);
    procedure AddSQLClass(Name, SQLText: String);
    procedure MemTableBuildStruct(MemTable: TMemTableEh; Source: TDataSet); virtual;
    procedure GenWhereClause(DesignUpdateParams: TDesignUpdateParamsEh; SQL: TStrings); virtual;
    procedure GenInsertSQL(DesignUpdateParams: TDesignUpdateParamsEh;
      DesignUpdateInfo: TDesignUpdateInfoEh); virtual;
    procedure GenModifySQL(DesignUpdateParams: TDesignUpdateParamsEh;
      DesignUpdateInfo: TDesignUpdateInfoEh); virtual;
    procedure GenDeleteSQL(DesignUpdateParams: TDesignUpdateParamsEh;
      DesignUpdateInfo: TDesignUpdateInfoEh); virtual;
    procedure GenGetRecSQL(DesignUpdateParams: TDesignUpdateParamsEh;
      DesignUpdateInfo: TDesignUpdateInfoEh); virtual;
  public
    constructor Create(ADesignDB: TDesignDataBaseEh); virtual;
    destructor Destroy; override;
    function CheckSqlTextFile: Boolean;
    function CreateRootNodes: TList; virtual;
//    function CreateNodes(Parent: IGetSQLTreeNode): TList; virtual;
    function CreateNodes(Parent: TSQLTreeNode): TList; virtual;
    function ShowPopup(Source: TObject; Coord: TPoint; Params: TServicePopupParams): Integer; virtual;
    function GetSpecParamsList: String; virtual;
    function GetIncrementObjectsList: TStrings; virtual;
    function GetUpdateSQLCommand(DesignUpdateParams: TDesignUpdateParamsEh;
      DesignUpdateInfo: TDesignUpdateInfoEh): Boolean; virtual;
    procedure GenGetSpecParams(DesignUpdateParams: TDesignUpdateParamsEh;
      DesignUpdateInfo: TDesignUpdateInfoEh); virtual;
    class function GetDBServiceName: String; virtual;
//    procedure MemTablePutRecord(MemTable: TMemTableEh; DataSet: TDataSet); virtual;
//    procedure MemTablePutFieldValue(MemTable: TMemTableEh; DataSet: TDataSet; MemTableField: TField; Rec: TMemoryRecordEh); virtual;
  end;

{ TInterbaseDBService }

  TInterbaseDBService = class(TCustomDBService)
  public
    constructor Create(ADesignDB: TDesignDataBaseEh); override;
    function GetSpecParamsList: String; override;
    function GetIncrementObjectsList: TStrings; override;
    procedure GenInsertSQL(DesignUpdateParams: TDesignUpdateParamsEh;
      DesignUpdateInfo: TDesignUpdateInfoEh); override;
    procedure GenGetSpecParams(DesignUpdateParams: TDesignUpdateParamsEh;
      DesignUpdateInfo: TDesignUpdateInfoEh); override;
    class function GetDBServiceName: String; override;
//    procedure TableEditorDrop(Sender, Source: TObject; X, Y: Integer);
  end;

{ TInformixDBService }

  TInformixDBService = class(TCustomDBService)
  public
    constructor Create(ADesignDB: TDesignDataBaseEh); override;
    function GetSpecParamsList: String; override;
    procedure TableEditorDrop(Sender, Source: TObject; X, Y: Integer);
    procedure MemTableBuildStruct(MemTable: TMemTableEh; Source: TDataSet); override;
    procedure GenGetSpecParams(DesignUpdateParams: TDesignUpdateParamsEh;
      DesignUpdateInfo: TDesignUpdateInfoEh); override;
    class function GetDBServiceName: String; override;
  end;

{ TMSAccessDBService }

  TMSAccessDBService = class(TCustomDBService)
  public
    constructor Create(ADesignDB: TDesignDataBaseEh); override;
    function GetSpecParamsList: String; override;
    procedure GenGetSpecParams(DesignUpdateParams: TDesignUpdateParamsEh;
      DesignUpdateInfo: TDesignUpdateInfoEh); override;
    class function GetDBServiceName: String; override;
  end;

{ TOracleDBService }

  TOracleDBService = class(TCustomDBService)
  public
    constructor Create(ADesignDB: TDesignDataBaseEh); override;
    function GetSpecParamsList: String; override;
    procedure GenGetSpecParams(DesignUpdateParams: TDesignUpdateParamsEh;
      DesignUpdateInfo: TDesignUpdateInfoEh); override;
    class function GetDBServiceName: String; override;
  end;

{ TMSSQLDBService }

  TMSSQLDBService = class(TCustomDBService)
  public
    constructor Create(ADesignDB: TDesignDataBaseEh); override;
    function GetSpecParamsList: String; override;
    procedure GenGetSpecParams(DesignUpdateParams: TDesignUpdateParamsEh;
      DesignUpdateInfo: TDesignUpdateInfoEh); override;
    class function GetDBServiceName: String; override;
  end;

(*{ TCustomDBService }

  TCustomDBService = class(TObject)
  private
    FDesignDataBase: TDesignDataBaseEh;
  public
    constructor Create(DesignDataBase: TDesignDataBaseEh);
    function BuildObjectTree(TreeView: TTreeView): Boolean; virtual; abstract;
  end;

  TInterbaseDBService = class(TCustomDBService)
  public
    function BuildObjectTree(TreeView: TTreeView): Boolean; override;
  end;

  TMySQLDBService = class(TCustomDBService)
  public
    function BuildObjectTree(TreeView: TTreeView): Boolean; override;
  end;
*)

{ DesignDataBase unils }

procedure RegisterDesignDataBaseClass(EngineName: String; DesignDBClass: TDesignDataBaseClassEh);
procedure UnregisterDesignDataBaseClass(EngineName: String);
function GetDesignDataBaseClassByName(EngineName: String): TDesignDataBaseClassEh;
function GUISelectDesignDataBaseClass: TDesignDataBaseClassEh;

type
  TSelectDBService = class(TObject)
    DBServiceClass: TCustomDBServiceClass;
    AccessEngine: TAccessEngineEh;
    DBName: String;
  end;

{ Engines unils }

var
  AccessEngineList: TStringList = nil;

procedure RegisterAccessEngine(EngineName: String; Engine: TAccessEngineEh);
procedure UnregisterAccessEngine(EngineName: String);
function GetAccessEngineByName(EngineName: String): TAccessEngineEh;
function GUISelectAccessEngine(SelectDBService: TSelectDBService): Boolean;

//function GUISelectAccessEngine: TAccessEngineEh;

{ DBService unils }

function GetDBServiceList: TStringList;
procedure RegisterDBService(ServerName: String; DBService: TCustomDBServiceClass);
procedure UnregisterDBService(ServerName: String);
function GetDBServiceByName(ServerName: String): TCustomDBServiceClass;
function GUISelectDBService(SelectDBService: TSelectDBService): Boolean;
procedure RegisterDefaultDBService;

{ DBServiceEngines unils }

type
  TDBServiceItem = class
    AccessEngine: TAccessEngineEh;
    DBService: TCustomDBServiceClass;
  end;

procedure RegisterDBServiceEngine(AccessEngine: TAccessEngineEh; DBService: TCustomDBServiceClass);
procedure UnregisterDBServiceEngine(DBService: TCustomDBServiceClass);

 { DesignDataBaseList }

var
  DesignDataBaseList: TObjectList = nil;

function GetDesignDataBaseList: TObjectList;
function GetDBServiceEngineList: TObjectList;

const
  SSelect = 'select'; { Do not localize }
  SFrom = 'from'; { Do not localize }

var
  SQLDataEditWin: TSQLDataEditWin;
  SqlTextPathFileName: String = 'C:\Program Files\Common Files\Borland Shared\Data\sql_text.sql';
  LibraryRegKey: String = 'EhLib';

function EditSQLDataDriverEh(DataDriver: TCustomSQLDataDriverEh): Integer;

procedure ReleaseDesignDataBaseList;

implementation

{$R *.dfm}

uses
{$IFDEF EH_LIB_6} Types,  {$ENDIF}
  FormSelectFromList, DesignConnectionListEh, ToolCtrlsEh,
{$IFDEF DESIGNTIME}
{$IFDEF EH_LIB_6}
{$IFDEF CIL}
  Borland.Vcl.Design.ComponentDesigner,
{$ELSE}
  ComponentDesigner,
{$ENDIF}
{$ELSE}
  LibIntf,
{$ENDIF}
{$ENDIF}
  Registry;


{ DBService unils }

var
  DBServiceList: TStringListEh = nil;

procedure InitDBServiceList();
begin
  if DBServiceList = nil then
  begin
    DBServiceList := TStringListEh.Create;
    DBServiceList.CaseSensitive := False;
  end;
end;

function GetDBServiceList: TStringList;
begin
  InitDBServiceList;
  Result := DBServiceList;
end;

procedure ReleaseDBServiceList;
//var
//  i: Integer;
begin
  if DBServiceList <> nil then
    FreeAndNil(DBServiceList);
//  begin
{    for i := 0 to DBServiceList.Count-1 do
    begin
      TCustomDBService(DBServiceList).Free;
    end;}
//  end;
end;

procedure RegisterDBService(ServerName: String; DBService: TCustomDBServiceClass);
var
  OldDBService: TCustomDBServiceClass;
begin
  InitDBServiceList();
  OldDBService := GetDBServiceByName(ServerName);
  if OldDBService <> nil then
    UnregisterDBService(ServerName);
  DBServiceList.AddObject(ServerName, TObject(DBService));
end;

procedure UnregisterDBService(ServerName: String);
var
  DBServiceInx: Integer;
begin
  if DBServiceList = nil then
    Exit;
  DBServiceInx := DBServiceList.IndexOf(ServerName);
  if DBServiceInx > -1 then
  begin
//    DBServiceList.Objects[DBServiceInx].Free; Does not need to delete ref Class.
    DBServiceList.Delete(DBServiceInx);
  end;
end;

function GetDBServiceByName(ServerName: String): TCustomDBServiceClass;
var
  DBServiceInx: Integer;
begin
  Result := nil;
  if DBServiceList = nil then
    Exit;
  DBServiceInx := DBServiceList.IndexOf(ServerName);
  if DBServiceInx >= 0 then
    Result := TCustomDBServiceClass(DBServiceList.Objects[DBServiceInx]);
end;

function GUISelectDBService(SelectDBService: TSelectDBService): Boolean;
//function GUISelectDBService: TCustomDBServiceClass;
var
//  Index: Integer;
  f: TfSelectFromList;
begin
  Result := False;
  f := TfSelectFromList.Create(Application);
  f.cbEngine.Items := DBServiceList;
  f.cbDBService.Items := AccessEngineList;
  f.eDataBaseName.Text := SelectDBService.DBName;
  if f.ShowModal = mrOk then
  begin
    if f.cbEngine.ItemIndex >= 0
      then SelectDBService.AccessEngine := TAccessEngineEh(AccessEngineList.Objects[f.cbEngine.ItemIndex])
      else SelectDBService.AccessEngine := nil;
    if f.cbDBService.ItemIndex >= 0
      then SelectDBService.DBServiceClass := TCustomDBServiceClass(DBServiceList.Objects[f.cbEngine.ItemIndex])