sdreg.pas

SQLDirect Component Library is a light-weight Borland Database Engine replacement for Borland Delphi

{*******************************************************}
{							}
{       Delphi SQLDirect Component Library		}
{       SQLDirect Components Registration		}
{                                                       }
{       Copyright (c) 1997,2005 by Yuri Sheino		}
{                                                       }
{*******************************************************}
{$I SqlDir.inc}
unit SDReg {$IFDEF SD_CLR}platform{$ENDIF};

interface

uses
  Windows, Messages, SysUtils, Classes,
{$IFDEF SD_VCL6}
 {$IFDEF SD_CLR}
  WinUtils, 
  Borland.Vcl.Design.DesignIntf, Borland.Vcl.Design.DesignEditors, Borland.Vcl.Design.TreeIntf,
 {$ELSE}
  DesignIntf, DesignEditors, TreeIntf, {$IFNDEF SD_VCL9} DiagramSupport, {$ENDIF}
 {$ENDIF}
{$ELSE}
  DsgnIntf,
{$ENDIF}
{$IFDEF SD_VCL5}
 {$IFDEF SD_CLR}
  Borland.Vcl.Design.FldProp, Borland.Vcl.Design.DsnDBCst, Borland.Vcl.Design.FldLinks,
 {$ELSE}
  DBReg, DsnDB, FldLinks,
 {$ENDIF}
 {$IFNDEF SD_VCL6}
  ParentageSupport, DataModelSupport,
 {$ENDIF}
{$ENDIF}
{$IFDEF SD_CLR}
  Borland.Vcl.Design.DSDesign,
{$ELSE}
  DSDesign,
{$ENDIF}
  Dialogs, TypInfo,
  StdCtrls, Controls, Graphics, Forms,
  Db, SDEngine;

type

  { TSDStringProperty }
  TSDStringProperty = class(TStringProperty)
    procedure GetValueList(List: TStrings); virtual; abstract;
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;


  { TSDSessionNameProperty }
  TSDSessionNameProperty = class(TSDStringProperty)
    procedure GetValueList(List: TStrings); override;
  end;

  { TSDDatabaseNameProperty }
  TSDDatabaseNameProperty = class(TSDStringProperty)
    procedure GetValueList(List: TStrings); override;
  end;

  { TSDStoredProcNameProperty }
  TSDStoredProcNameProperty = class(TSDStringProperty)
    procedure GetValueList(List: TStrings); override;
  end;


  { TSDParamsProperty }
  TSDParamsProperty = class(TPropertyEditor)
  public
    function GetValue: string; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

  { TSDQueryParamsProperty }
  TSDQueryParamsProperty = class(TSDParamsProperty)
    procedure Edit; override;
  end;

  { TSDStoredProcParamsProperty }
  TSDStoredProcParamsProperty = class(TSDParamsProperty)
    procedure Edit; override;
  end;

{ TSDTableNameProperty }
  TSDTableNameProperty = class(TSDStringProperty)
  public
    function AutoFill: Boolean; {$IFDEF SD_VCL4} override; {$ENDIF}
    procedure GetValueList(AList: TStrings); override;
  end;


{ TSDDefaultEditor }

  TSDDefaultEditor = class(TComponentEditor)
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

{$IFDEF SD_VCL5}

{ TSDTableFieldLinkProperty }

  TSDTableFieldLinkProperty = class(TFieldLinkProperty)
  private
    FTable: TSDTable;
  protected
    procedure GetFieldNamesForIndex(List: TStrings); override;
    function GetIndexBased: Boolean; override;
    function GetIndexDefs: TIndexDefs; override;
    function GetIndexFieldNames: string; override;
    function GetIndexName: string; override;
    function GetMasterFields: string; override;
    procedure SetIndexFieldNames(const Value: string); override;
    procedure SetIndexName(const Value: string); override;
    procedure SetMasterFields(const Value: string); override;
  public
    property IndexBased: Boolean read GetIndexBased;
    property IndexDefs: TIndexDefs read GetIndexDefs;
    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
    property IndexName: string read GetIndexName write SetIndexName;
    property MasterFields: string read GetMasterFields write SetMasterFields;

    procedure Edit; override;
  end;

{$IFDEF SD_VCL6}
  TSDComponentSprig 	= TComponentSprig;
  TSDSprigAtRoot	= TComponentSprig;
{$ELSE}
  TSDComponentSprig 	= TSprig;
  TSDSprigAtRoot	= TSprigAtRoot;
{$ENDIF}
(*
  TSDSessionSprig = class(TSDSprigAtRoot)
  public
    function Name: string; override;
    function Caption: string; override;
    function AnyProblems: Boolean; override;
  end;

  TSDDatabaseSprig = class(TSDComponentSprig)
  public
    function Name: string; override;
    function Caption: string; override;
    function AnyProblems: Boolean; override;
{    procedure FigureParent; override;
    function DragDropTo(AItem: TSprig): Boolean; override;
    function DragOverTo(AItem: TSprig): Boolean; override;
    class function PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean; override;}
  end;

  TSDUpdateSQLSprig = class(TSDSprigAtRoot)
  public
    function AnyProblems: Boolean; override;
  end;

  TSDDataSetSprig = class(TDataSetSprig)
  public
    function AnyProblems: Boolean; override;
{    procedure FigureParent; override;
    procedure Reparent; override;
    function DragDropTo(AItem: TSprig): Boolean; override;
    function DragOverTo(AItem: TSprig): Boolean; override;
    class function PaletteOverTo(AParent: TSprig; AClass: TClass): Boolean; override;}
  end;

  TSDTableSprig = class(TSDDataSetSprig)
  public
    function AnyProblems: Boolean; override;
    function Caption: string; override;
  end;

  TSDQuerySprig = class(TSDDataSetSprig)
  public
    function AnyProblems: Boolean; override;
  end;

  TSDStoredProcSprig = class(TSDDataSetSprig)
  public
    function AnyProblems: Boolean; override;
    function Caption: string; override;
  end;

  TSDDataSetIsland = class(TDataSetIsland)
  end;

  TSDQueryIsland = class(TSDDataSetIsland)
  end;

  TSDTableIsland = class(TSDDataSetIsland)
  end;

  TSDQueryMasterDetailBridge = class(TMasterDetailBridge)
  public
    class function RemoveMasterFieldsAsWell: Boolean; override;
    class function OmegaIslandClass: TIslandClass; override;
    class function GetOmegaSource(AItem: TPersistent): TDataSource; override;
    class procedure SetOmegaSource(AItem: TPersistent; ADataSource: TDataSource); override;
    function Caption: string; override;
  end;

  TSDTableMasterDetailBridge = class(TMasterDetailBridge)
  public
    function CanEdit: Boolean; override;
    class function OmegaIslandClass: TIslandClass; override;
    class function GetOmegaSource(AItem: TPersistent): TDataSource; override;
    class procedure SetOmegaSource(AItem: TPersistent; ADataSource: TDataSource); override;
    function Caption: string; override;
    function Edit: Boolean; override;
  end;
 *)
{$ENDIF}

{ TSDDataSetEditor }

  TSDDataSetEditor = class(
{$IFDEF SD_VCL5}      TDataSetEditor
{$ELSE}               TComponentEditor
{$ENDIF} )
  public
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

{ TSDQueryEditor }

  TSDQueryEditor = class(TSDDataSetEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

{ TSDStoredProcEditor }

  TSDStoredProcEditor = class(TSDDataSetEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

{ TSDUpdateSQLEditor }

  TSDUpdateSQLEditor = class(TSDDefaultEditor)
  public
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

{ TSDScriptEditor }

  TSDScriptEditor = class(TSDDefaultEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

procedure Register;

implementation

uses
  SDConsts, SDCommon, SDCsbSrv,
{$IFDEF SD_VCL4}
 {$IFDEF SD_CLR}
  Borland.Vcl.Design.ColnEdit,
 {$ELSE}
  ColnEdit,
 {$ENDIF}
{$ELSE}
  SDQPDlg, SDSpPDlg,
{$ENDIF}
{$IFDEF EVAL}SDRemind,{$ENDIF}
  SDAbout, SDUpdSEd;

{$IFDEF SD_CLR}
  {$R ImagesDotNet\TSDDatabase.bmp}
  {$R ImagesDotNet\TSDMacroQuery.bmp}
  {$R ImagesDotNet\TSDQuery.bmp}
  {$R ImagesDotNet\TSDScript.bmp}
  {$R ImagesDotNet\TSDSession.bmp}
  {$R ImagesDotNet\TSDStoredProc.bmp}
  {$R ImagesDotNet\TSDTable.bmp}
  {$R ImagesDotNet\TSDUpdateSQL.bmp}
  {$R ImagesDotNet\TSDSQLBaseServer.bmp} 
{$ELSE}
  {$R 'SDReg.dcr'}
{$ENDIF}

type
{$IFDEF SD_VCL6}
  TSDHelperDesigner  	= IDesigner;
{$ELSE}
 {$IFDEF SD_VCL5}
  TSDHelperDesigner  	= IFormDesigner;
 {$ELSE}
  {$IFDEF SD_VCL4}
  TSDHelperDesigner  	= IDesigner;
  {$ELSE}
  TSDHelperDesigner  	= TDesigner;
  {$ENDIF}
 {$ENDIF}
{$ENDIF}

function GetAboutVerbName: string;
var
{$IFNDEF SD_CLR}
  sFileName,
{$ENDIF}
  sProductName, sProductVers: string;
begin
  sProductName := SSQLDirectProductName;
{$IFDEF SD_CLR}
        // in Delphi 8 IDE GetModuleFileName returns an empty string and GetLastError returns 0
  sProductVers := SSQLDirectVersion;        
{$ELSE}
  sProductVers := '';

  sFileName := GetModuleFileNameStr(HInstance);

  ReadFileVersInfo(sFileName, sProductName, sProductVers);
{$ENDIF}
  Result := sProductName + ' ' + sProductVers;
end;

function ShowQueryParamsEditor(Designer: TSDHelperDesigner; Query: TSDQuery): Boolean;
{$IFNDEF SD_VCL4}
var
  List: TSDHelperParams;
{$ENDIF}
begin
  Result := False;
{$IFDEF SD_VCL4}
  {$IFDEF SD_CLR}Borland.Vcl.Design.{$ENDIF}ColnEdit.ShowCollectionEditorClass(Designer, TCollectionEditor, Query, Query.Params, 'Params', [] );
{$ELSE}
  List := TSDHelperParams.Create;
  try
    List.Assign(Query.Params);
    if EditQueryParams(Query, List) and not(List.IsEqual(Query.Params)) then begin
      Query.Close;
      Query.Params := List;
      Result := True
    end;
  finally
    List.Free;
  end;
{$ENDIF}
end;

function ShowStoredProcParamsEditor(Designer: TSDHelperDesigner; StoredProc: TSDStoredProc): Boolean;
var
{$IFDEF SD_VCL4}
  db: TSDDatabase;
{$ELSE}
  List: TSDHelperParams;
{$ENDIF}
begin
  Result := False;
{$IFDEF SD_VCL4}
  if (StoredProc.ParamCount = 0) and (not StoredProc.Prepared) then
    StoredProc.Prepare;
  db := StoredProc.Database;    // it is assigned, when Prepared = True
  if not Assigned(db) and (Trim(StoredProc.DatabaseName) <> '') then
    db := Sessions.List[StoredProc.SessionName].FindDatabase(StoredProc.DatabaseName);
  if Assigned(db) and db.Connected and StoredProc.DescriptionsAvailable then
    {$IFDEF SD_CLR}Borland.Vcl.Design.{$ENDIF}ColnEdit.ShowCollectionEditorClass(Designer, TCollectionEditor, StoredProc, StoredProc.Params, 'Params', [] )
  else
    {$IFDEF SD_CLR}Borland.Vcl.Design.{$ENDIF}ColnEdit.ShowCollectionEditorClass(Designer, TCollectionEditor, StoredProc, StoredProc.Params, 'Params', [coAdd, coDelete] );

  if StoredProc.Prepared then
    StoredProc.UnPrepare;
{$ELSE}
  List := TSDHelperParams.Create;
  try
    if (StoredProc.ParamCount > 0) or StoredProc.Prepared or
       (not StoredProc.DescriptionsAvailable)
    then
      List.Assign(StoredProc.Params)
    else begin
      StoredProc.Prepare;
      try
        List.Assign(StoredProc.Params);
      finally
        StoredProc.UnPrepare;
      end;
    end;
    if EditStoredProcParams(StoredProc, List) and
       not(List.IsEqual(StoredProc.Params))
    then begin
      StoredProc.Close;
      StoredProc.Params := List;
      Result := True;
    end;
  finally
    List.Free;
  end;
{$ENDIF}
end;

function ShowUpdateSQLDesigner(Designer: TSDHelperDesigner; AUpdateSQL: TSDUpdateSQL): Boolean;
begin
  Result := False;
  if EditUpdateSQL(AUpdateSQL) then begin
    if Assigned(Designer) then
      Designer.Modified;
    Result := True;
  end;
end;

function IsDatabaseOpen(DataSet: TSDDataSet): Boolean;
var
  Session: TSDSession;
  DB: TSDDatabase;
begin
  Result := False;
  with DataSet do begin
    Session := Sessions.FindSession(SessionName);
    if Session <> nil then begin
      DB := Session.FindDatabase(DatabaseName);
      Result := (DB <> nil) and DB.Connected;
    end;
  end;
end;


{ TSDDefaultEditor }
procedure TSDDefaultEditor.Edit;
begin
  ExecuteVerb(0);
end;

procedure TSDDefaultEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0: ShowAboutBox;
  end;
end;

function TSDDefaultEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := GetAboutVerbName;
  end;
end;

function TSDDefaultEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

{ TSDDataSetEditor }
procedure TSDDataSetEditor.Edit;
begin
  ExecuteVerb(2);
end;

procedure TSDDataSetEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0: ShowAboutBox;
    2:
{$IFDEF SD_VCL5}
       {$IFDEF SD_CLR}Borland.Vcl.Design.{$ENDIF}DSDesign.ShowFieldsEditor(Designer, TSDDataSet(Component), GetDSDesignerClass); // or inherited ExecuteVerb(Index)
{$ELSE}
       DSDesign.ShowDatasetDesigner(Designer, TSDDataSet(Component));
{$ENDIF}
  end;
end;

function TSDDataSetEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := GetAboutVerbName;
    1: Result := '-';
    2: Result := SDatasetDesigner; // // or Result := inherited GetVerb(Index)
  end;
end;

function TSDDataSetEditor.GetVerbCount: Integer;
begin
  Result := 3;
end;


{ TSDQueryEditor }
procedure TSDQueryEditor.ExecuteVerb(Index: Integer);
var
  q: TSDQuery;
begin
  q := Component as TSDQuery;
  case Index of
    0,
    2: inherited ExecuteVerb(Index);
    3: if ShowQueryParamsEditor(Designer, q) and Assigned(Designer) then
         Designer.Modified;
  end;
end;

function TSDQueryEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0,
    1,
    2: Result := inherited GetVerb(Index);
    3: Result := SBindVerb;
  end;
end;

function TSDQueryEditor.GetVerbCount: Integer;
begin
  Result := 4;
end;


{ TSDStoredProcEditor }
procedure TSDStoredProcEditor.ExecuteVerb(Index: Integer);
var
  sp: TSDStoredProc;
begin
  sp := Component as TSDStoredProc;
  case Index of
    0,
    2: inherited ExecuteVerb(Index);
    3: if ShowStoredProcParamsEditor(Designer, sp) and Assigned(Designer) then
         Designer.Modified;
  end;
end;

function TSDStoredProcEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0,
    1,
    2: Result := inherited GetVerb(Index);
    3: Result := SBindVerb;
  end;
end;

function TSDStoredProcEditor.GetVerbCount: Integer;
begin
  Result := 4;
end;