pfibdsgnviewsqls.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

{************************************************************************}
{ FIBPlus - component library  for direct access  to Interbase  databases}
{    FIBPlus is based in part on the product                             }
{    Free IB Components, written by Gregory H. Deatz for                 }
{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
{                                         Contact:       [e-mail]}
{    Copyright (c) 1998-2001 Serge Buzadzhy                              }
{                                         Contact: [e-mail]          }
{  Please see the file FIBLicense.txt for full license information.      }
{************************************************************************}

unit pFIBDsgnViewSQLs;

interface
{$I FIBPlus.inc}
{$I pFIBPropEd.Inc}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, CheckLst, Db, FIBDataSet, pFIBDataSet, FIBQuery, pFIBQuery,
  ExtCtrls, ComCtrls, Menus, Buttons,clipbrd, FIBDatabase,pFIBDatabase,
  ImgList,  ToolWin,ToolsAPI
  {$IFDEF SQL_NAVIGATOR_SUPPORT_BDE}
    ,dbTables
  {$ENDIF}
  {$IFDEF USE_SYN_EDIT}
   ,SynEditHighlighter, SynHighlighterSQL, SynEdit, SynMemo
  {$ENDIF}

  ;

type
  TFIBSQLOwner=class
  private
    vFIBSQLOwner:TComponent;
    vChecked:boolean;
    procedure SetProp(const PropName:string; Value:TStrings);
    function GetCustomForm:TCustomForm;
  public
   constructor Create(aFIBSQLOwner:TComponent);
  end;

  TOperationOnSQLText=(oSaveSQL,oCheckSQL,oAnalyzeSQL,oClearDescr);

  TfrmSaveSQLs = class(TForm)
    PopupMenu1: TPopupMenu;
    SelectAll1: TMenuItem;
    Unselectall1: TMenuItem;
    SaveDialog1: TSaveDialog;
    FindDialog1: TFindDialog;
    Panel2: TPanel;
    PopupMenu2: TPopupMenu;
    HideSearchResult1: TMenuItem;
    ShowSearchResult1: TMenuItem;
    CopytoClipboard1: TMenuItem;
    GotocurrentComponent1: TMenuItem;
    pFIBDatabase1: TpFIBDatabase;
    pFIBTransaction1: TpFIBTransaction;
    qryCheck: TpFIBQuery;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    GrSearch: TGroupBox;
    PageControl1: TPageControl;
    TabSQL: TTabSheet;
    TabInsertSQL: TTabSheet;
    TabUpdateSQL: TTabSheet;
    TabDeleteSQL: TTabSheet;
    TabRefreshSQL: TTabSheet;
    Splitter3: TSplitter;
    Splitter1: TSplitter;
    ImageList1: TImageList;
    PopupMenu3: TPopupMenu;
    miSaveallSQLs1: TMenuItem;
    SaveonlySelectSQL1: TMenuItem;
    qryBuf: TpFIBQuery;
    qryObjects: TpFIBQuery;
    qryInsObj: TpFIBQuery;
    qryUpdObj: TpFIBQuery;
    qryDescr: TpFIBDataSet;
    qryAllDescr: TpFIBDataSet;
    ToolBar1: TToolBar;
    btnGetForms: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton1: TToolButton;
    ToolButton3: TToolButton;
    ToolButton2: TToolButton;
    ToolButton8: TToolButton;
    ToolButton4: TToolButton;
    ToolButton9: TToolButton;
    ToolButton7: TToolButton;
    Panel3: TPanel;
    ListBox1: TListBox;
    Splitter4: TSplitter;
    MemErrMess: TMemo;
    Panel4: TPanel;
    lstForms: TCheckListBox;
    Splitter2: TSplitter;
    lstQueries: TCheckListBox;
    ToolButton10: TToolButton;
    procedure lstFormsEnter(Sender: TObject);
    procedure lstQueriesClickCheck(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure lstFormsClickCheck(Sender: TObject);
    procedure lstQueriesEnter(Sender: TObject);
    procedure SelectAll1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FindDialog1Find(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure HideSearchResult1Click(Sender: TObject);
    procedure ShowSearchResult1Click(Sender: TObject);
    procedure CopytoClipboard1Click(Sender: TObject);
    procedure GotocurrentComponent1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure btnGetFormsClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure miSaveallSQLs1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ToolButton8Click(Sender: TObject);
    procedure lstQueriesDblClick(Sender: TObject);
    procedure ToolButton10Click(Sender: TObject);
  private
    OI:TForm;
    OldSQLTxt:string;
    function CloseUnFile(const UnName:string) :boolean;
    function GetOI:TForm;
    function GetUnitName(aCmp:TComponent):string;
    {$IFDEF SQL_NAVIGATOR_SUPPORT_BDE}
    procedure DBParamsFromBDEAlias(
     const AliasName:string;var DPB: TStrings
    );
    procedure DBParamsFromBDEDatabase(
         const BDE_DataBase:TDatabase;var DPB: TStrings
    );

    {$ENDIF}
    procedure GetDBParams(cmp:TComponent; DPB:TStrings );
    function  Connect(DPB:TStrings):integer;


  private
    vFullSave:boolean;
    vProjectName:string;
    WindowList: Pointer;
    FSearchResult:TStrings;
    FListOfOpenedForms:TStringList;
    FUnits   :array of string;
    procedure MemoExit(Sender: TObject);
    procedure MemoEnter(Sender: TObject);
    procedure FillQueryList;
    function  PrepareForms(OnlyLoaded:boolean):boolean;
    procedure GetForms;
    procedure SetQueryCheck(Index:integer);
    procedure SetModuleCheck(Index:integer);
    procedure ClearForms;
    procedure ClearSQLs;
    procedure RegisterModule(Module:TComponent; const UnName:string);
    function  SearchContext(const Value:string):boolean;
    function  FindInCmp(cmp:TComponent;const Value:string):boolean;
    function  GetCurrentSQLOwner:TFIBSQLOwner;
    procedure ScanSelObjects(Operation:TOperationOnSQLText);
    procedure SetSearchResVisible(Value:boolean);
    procedure ClearSearch;
    procedure FocusToComponent(cmp:TComponent);

    procedure SaveFIBSQLOwner(var F:Text;aFIBSQLOwner:TComponent);
    function  Analyze(aFIBSQLOwner:TComponent;ResultStrings:TStrings;
     var F:TextFile
    ) :integer;
    function  CheckSQL(aFIBSQLOwner:TComponent):integer;
    function  UnitInProject(const UnitName:string):boolean;
  public
    destructor Destroy; override;
  end;


 procedure  ShowAllSQLs;

var
  frmSaveSQLs: TfrmSaveSQLs;

implementation

{$R *.DFM}
uses StrUtil,SQLTxtRtns,
  {$IFNDEF  D6+}
   DsgnIntf,
  {$ELSE}
   DesignIntf,
  {$ENDIF}
 EditIntf, FIBToolsConsts,
 FIBDataSQLEditor,FIBSQLEditor
, FindCmp;


{$IFDEF VER130}
 type TFormDesigner=IFormDesigner;
      TComponentList=TDesignerSelectionList;
{$ELSE}
 {$IFDEF D6+}
  type TFormDesigner=IDesigner;
 {$ELSE}
 {$IFDEF VER120}
  type TFormDesigner=IFormDesigner;
 {$ENDIF}
 {$ENDIF}
{$ENDIF}




var
 {$IFDEF USE_SYN_EDIT}
  SynSQLSyn1: TSynSQLSyn;
  memSQL      :TSynMemo;
  memInsertSQL:TSynMemo;
  memUpdateSQL:TSynMemo;
  memDeleteSQL:TSynMemo;
  memRefreshSQL:TSynMemo;
 {$ELSE}
  memSQL      :TMemo;
  memInsertSQL:TMemo;
  memUpdateSQL:TMemo;
  memDeleteSQL:TMemo;
  memRefreshSQL:TMemo;
 {$ENDIF}

  CurrentComponent:TComponent;

{$IFDEF D9+}
{$REGION 'Notificator code'}
{$ENDIF}
type
     TNotificator=class (TComponent,IOTAIDENotifier)
     private
      procedure FileNotification(NotifyCode: TOTAFileNotification;
        const FileName: string; var Cancel: Boolean);
      procedure AfterSave;
      procedure BeforeSave;
      procedure Destroyed;
      procedure Modified;
      procedure BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);overload;
      procedure AfterCompile(Succeeded: Boolean); overload;
     public
      destructor Destroy; override;
     end;

      destructor TNotificator.Destroy;
      begin
       inherited Destroy;
      end;

      procedure TNotificator.BeforeCompile(const Project: IOTAProject; var Cancel: Boolean);
      begin
      end;

      procedure TNotificator.AfterCompile(Succeeded: Boolean);
      begin
      end;

      procedure TNotificator.AfterSave;
      begin
      end;
      procedure TNotificator.BeforeSave;
      begin
      end;

      procedure TNotificator.Destroyed;
      begin
      end;

      procedure TNotificator.Modified;
      begin
      end;

      procedure TNotificator.FileNotification(NotifyCode: TOTAFileNotification;
        const FileName: string; var Cancel: Boolean);
      var
         i:integer;
         j:integer;
      begin
        if NotifyCode=ofnFileClosing then
        if Assigned(frmSaveSQLs) then
        with frmSaveSQLs do
        begin
          i:=0;
          while i<Length(FUnits) do
          begin
            if FUnits[i]=FileName then
            begin
              if lstForms.ItemIndex=i then
              begin
                lstQueries.Items.Clear;
                ClearSQLs
              end;
              lstForms.Items.Objects[i].Free;
              lstForms.Items.Delete(i);
              if lstForms.ItemIndex=i then
              begin
                ClearSQLs;
                lstFormsEnter(lstForms);
              end;
              for j:=i+1 to Length(FUnits)-1 do
               FUnits[j-1]:=FUnits[j];
              SetLength(FUnits,Length(FUnits)-1);
              Exit;
            end;
            Inc(i);
          end;
        end;
      end;


var  Notificator:TNotificator;
{$IFDEF D9+}
{$ENDREGION }
{$ENDIF}
procedure  ShowAllSQLs;
begin
 if not Assigned(frmSaveSQLs) then
  frmSaveSQLs:= TfrmSaveSQLs.Create(nil);
 with frmSaveSQLs do
 begin
    vProjectName:=GetActiveProjectShortName;
    Caption:=Caption+' :'+vProjectName;
    OI :=GetOI;
    FormStyle:=fsStayOnTop;
    if WindowState=wsMinimized then
     WindowState:=wsNormal;
    Show;
 end;
end;

function ExistCheckedItems(CheckListBox:TCheckListBox):boolean;
var i:integer;
begin
 Result:=false;
 with CheckListBox do
  for i:=0 to Pred(Items.Count) do begin
   Result:= Checked[i];
   if Result then Exit;
  end;
end;

constructor TFIBSQLOwner.Create(aFIBSQLOwner:TComponent);
begin
 vFIBSQLOwner:=aFIBSQLOwner;
 vChecked    :=false;
end;


function TFIBSQLOwner.GetCustomForm:TCustomForm;
var tmpCmp:TComponent;
begin
 Result:=nil;
 tmpCmp:=vFIBSQLOwner;
 while (tmpCmp.Owner<>nil) and not (tmpCmp is TCustomForm) do
  tmpCmp:=tmpCmp.Owner;
 if tmpCmp is TCustomForm then
  Result:=TCustomForm(tmpCmp);
end;


procedure TFIBSQLOwner.SetProp(const PropName: string; Value: TStrings);
var
 Form:TCustomForm;
begin
 if vFIBSQLOwner is TFIBDataSet then
 with TFIBDataSet(vFIBSQLOwner) do
 begin
  if (PropName='SQL') or (PropName='SelectSQL') then
   SelectSQL.Assign(Value)
  else
  if (PropName='InsertSQL') then
   InsertSQL.Assign(Value)
  else
  if (PropName='UpdateSQL') then
   UpdateSQL.Assign(Value)
  else
  if (PropName='DeleteSQL') then
   DeleteSQL.Assign(Value)
  else
  if (PropName='RefreshSQL') then
   RefreshSQL.Assign(Value);
 end
 else
 if vFIBSQLOwner is TFIBQuery then
 with TFIBQuery(vFIBSQLOwner) do
 begin
  if (PropName='SQL') or (PropName='SelectSQL') then
   SQL.Assign(Value)
 end
{$IFDEF SQL_NAVIGATOR_SUPPORT_BDE}
 else
 if vFIBSQLOwner is TQuery then
 with  TQuery(vFIBSQLOwner) do
 begin
  if (PropName='SQL') or (PropName='SelectSQL') then
   SQL.Assign(Value)
 end
 else
 if vFIBSQLOwner is TUpdateSql then
 with TUpdateSql(vFIBSQLOwner) do
 begin
  if (PropName='InsertSQL') then
   InsertSQL.Assign(Value)
  else
  if (PropName='UpdateSQL') then
   ModifySQL.Assign(Value)
  else
  if (PropName='DeleteSQL') then
   DeleteSQL.Assign(Value);
 end
{$ENDIF}
;
  Form:=GetCustomForm;
  if Form<>nil then
    Form.Designer.Modified;
end;

type
     TFakeCmp =class(TComponent)
     protected
      procedure Notification(AComponent: TComponent; Operation: TOperation);override;
     end;


procedure TFakeCmp.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if Operation =opRemove then
   if AComponent=CurrentComponent then CurrentComponent:=nil;
  inherited Notification(AComponent,Operation)
end;

var FakeCmp:TFakeCmp;

{ TfrmSaveSQLs }

destructor TfrmSaveSQLs.Destroy;
begin
  ClearForms;
  FListOfOpenedForms.Free;
  FListOfOpenedForms:=nil;
  FSearchResult.Free;
  FSearchResult:=nil;  
  inherited Destroy;
end;

procedure TfrmSaveSQLs.GetForms;
var i,j,k:integer;
    UnName:string;
    Found :boolean;
{$IFDEF D6+}
    tmpCmp:TComponent;
{$ENDIF}

function IsValidFrame(Frame:TFrame) :boolean;
var k:integer;
begin
  Result := False;
  with Frame do
   for k:=0 to Pred(ComponentCount) do
   begin
      if (Components[k] is TFIBQuery) or
        (Components[k] is TFIBCustomDataSet)
{$IFDEF SQL_NAVIGATOR_SUPPORT_BDE}
     or (Components[k] is TQuery)
     or (Components[k] is TUpdateSQL)
{$ENDIF}

      then
      begin