home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / wisql.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-07-24  |  45.5 KB  |  1,526 lines
  1. {
  2.  * The contents of this file are subject to the InterBase Public License
  3.  * Version 1.0 (the "License"); you may not use this file except in
  4.  * compliance with the License.
  5.  * 
  6.  * You may obtain a copy of the License at http://www.Inprise.com/IPL.html.
  7.  * 
  8.  * Software distributed under the License is distributed on an "AS IS"
  9.  * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
  10.  * the License for the specific language governing rights and limitations
  11.  * under the License.  The Original Code was created by Inprise
  12.  * Corporation and its predecessors.
  13.  * 
  14.  * Portions created by Inprise Corporation are Copyright (C) Inprise
  15.  * Corporation. All Rights Reserved.
  16.  * 
  17.  * Contributor(s): ______________________________________.
  18. }
  19.  
  20. unit wisql;
  21.  
  22. interface
  23.  
  24. uses
  25.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  26.   Menus, ComCtrls, ToolWin, ExtCtrls, StdCtrls, RichEditX, Grids, DBGrids,
  27.   Db, ImgList, StdActns, ActnList, zluibcClasses, IB, IBDatabase, IBCustomDataset,
  28.   zluSQL;
  29.  
  30. type
  31.  
  32.   TCreateDBEvent = procedure (var Database: TIBDatabase) of Object;
  33.   TConnectDBEvent = procedure (const Server: String; const Database: TIBDatabase) of Object;
  34.   TServerConnectEvent = procedure (const ServerName: String) of Object;
  35.   TDisconnectDBEvent = procedure (const Database: TIBDatabase) of Object;
  36.   TUpdateObjectEvent = procedure (const Database: TIBDatabase;
  37.                                   const ObjectType: integer) of Object;
  38.   TDropDBEvent = procedure of Object;
  39.  
  40.   TQryList = class
  41.   private
  42.     FAtLast,
  43.     FAtFirst: boolean;
  44.     FCurrQuery: integer;
  45.     FQueryArray: array of TStringList;
  46.   public
  47.     function GetNextQuery: TStrings;
  48.     function GetPrevQuery: TStrings;
  49.     function AtLastQuery: boolean;
  50.     function AtFirstQuery: boolean;
  51.     procedure ClearList;
  52.     procedure AddQueryList(const Query: TStrings);
  53.     destructor Destroy; override;
  54.     constructor Create;
  55.   end;
  56.  
  57.   TdlgWisql = class(TForm)
  58.     pgcOutput: TPageControl;
  59.     TabData: TTabSheet;
  60.     dbgSQLResults: TDBGrid;
  61.     TabResults: TTabSheet;
  62.     reSqlOutput: TRichEditX;
  63.     splISQLHorizontal: TSplitter;
  64.     GridSource: TDataSource;
  65.     pmClientDialect: TPopupMenu;
  66.     Dialect1: TMenuItem;
  67.     Dialect2: TMenuItem;
  68.     Dialect3: TMenuItem;
  69.     MainMenu1: TMainMenu;
  70.     Transactions1: TMenuItem;
  71.     File1: TMenuItem;
  72.     Edit1: TMenuItem;
  73.     QueryLoadScript1: TMenuItem;
  74.     QueryNext1: TMenuItem;
  75.     QueryPrevious1: TMenuItem;
  76.     QueryPrevious2: TMenuItem;
  77.     QuerySaveScript1: TMenuItem;
  78.     SaveOutput1: TMenuItem;
  79.     N1: TMenuItem;
  80.     N2: TMenuItem;
  81.     Commit1: TMenuItem;
  82.     Rollback1: TMenuItem;
  83.     Database1: TMenuItem;
  84.     Disconnect1: TMenuItem;
  85.     Create1: TMenuItem;
  86.     Drop1: TMenuItem;
  87.     N5: TMenuItem;
  88.     Connect1: TMenuItem;
  89.     pnlEnterSQL: TPanel;
  90.     reSqlInput: TRichEditX;
  91.     stbISQL: TStatusBar;
  92.     Print1: TMenuItem;
  93.     Close1: TMenuItem;
  94.     TransactionActions: TActionList;
  95.     TransactionCommit: TAction;
  96.     TransactionRollback: TAction;
  97.     DialectActions: TActionList;
  98.     DialectAction1: TAction;
  99.     DialectAction2: TAction;
  100.     DialectAction3: TAction;
  101.     QueryActions: TActionList;
  102.     QueryPrevious: TAction;
  103.     QueryNext: TAction;
  104.     QueryExecute: TAction;
  105.     QueryLoadScript: TAction;
  106.     QuerySaveScript: TAction;
  107.     QueryOptions: TAction;
  108.     QuerySaveOutput: TAction;
  109.     pmLastFiles: TPopupMenu;
  110.     FileActions: TActionList;
  111.     FileOptions: TAction;
  112.     FileClose: TAction;
  113.     QueryPrepare: TAction;
  114.     EditFind: TAction;
  115.     sbData: TStatusBar;
  116.     EditFont: TAction;
  117.     Help1: TMenuItem;
  118.     SQLReference1: TMenuItem;
  119.     N7: TMenuItem;
  120.     About1: TMenuItem;
  121.     N6: TMenuItem;
  122.     Options1: TMenuItem;
  123.     N8: TMenuItem;
  124.     mnuEdit1: TMenuItem;
  125.     Undo2: TMenuItem;
  126.     N9: TMenuItem;
  127.     mnuEdCopy1: TMenuItem;
  128.     Cut2: TMenuItem;
  129.     Paste2: TMenuItem;
  130.     SelectAll2: TMenuItem;
  131.     mnuEdN1: TMenuItem;
  132.     mnuEdFind1: TMenuItem;
  133.     Font2: TMenuItem;
  134.     EditCopy1: TEditCopy;
  135.     EditCut1: TEditCut;
  136.     EditPaste1: TEditPaste;
  137.     EditSelectAll1: TEditSelectAll;
  138.     EditUndo1: TEditUndo;
  139.     lblFileName: TLabel;
  140.     Windows1: TMenuItem;
  141.     TabStats: TTabSheet;
  142.     lvStats: TListView;
  143.     Prepare1: TMenuItem;
  144.     DatabaseActions: TActionList;
  145.     DatabaseConnectAs: TAction;
  146.     DatabaseDisconnect: TAction;
  147.     DatabaseCreate: TAction;
  148.     DatabaseDrop: TAction;
  149.     ToolBar3: TToolBar;
  150.     ToolButton7: TToolButton;
  151.     ToolButton8: TToolButton;
  152.     ToolButton9: TToolButton;
  153.     ToolButton5: TToolButton;
  154.     ToolButton10: TToolButton;
  155.     ToolButton2: TToolButton;
  156.     ToolButton3: TToolButton;
  157.     ToolButton4: TToolButton;
  158.     ToolButton11: TToolButton;
  159.     ToolButton12: TToolButton;
  160.     ToolButton13: TToolButton;
  161.     ToolButton20: TToolButton;
  162.     procedure QueryExecuteExecute(Sender: TObject);
  163.     procedure QueryLoadScriptExecute(Sender: TObject);
  164.     procedure QuerySaveScriptExecute(Sender: TObject);
  165.     procedure QueryPreviousExecute(Sender: TObject);
  166.     procedure QueryNextExecute(Sender: TObject);
  167.     procedure QuerySaveOutputExecute(Sender: TObject);
  168.     procedure DialectChange(Sender: TObject);
  169.     procedure DialectUpdate(Sender: TObject);
  170.     procedure UpdateCursor(Sender: TObject);
  171.     procedure reSqlInputKeyPress(Sender: TObject; var Key: Char);
  172.     procedure reSqlInputKeyDown(Sender: TObject; var Key: Word;
  173.       Shift: TShiftState);
  174.     procedure TransactionExecute(Sender: TObject);
  175.     procedure cbServersChange(Sender: TObject);
  176.     procedure FileOptionsExecute(Sender: TObject);
  177.     procedure EditFindExecute(Sender: TObject);
  178.     procedure EditFindUpdate(Sender: TObject);
  179.     procedure QueryUpdate(Sender: TObject);
  180.     procedure QueryPrepareExecute(Sender: TObject);
  181.     procedure dbgSQLResultsCellClick(Column: TColumn);
  182.     procedure dbgSQLResultsDrawColumnCell(Sender: TObject;
  183.       const Rect: TRect; DataCol: Integer; Column: TColumn;
  184.       State: TGridDrawState);
  185.     procedure dbgSQLResultsEditButtonClick(Sender: TObject);
  186.     procedure EditFontExecute(Sender: TObject);
  187.     procedure SQLReference1Click(Sender: TObject);
  188.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  189.     procedure FileCloseExecute(Sender: TObject);
  190.     procedure Print1Click(Sender: TObject);
  191.     procedure Drop1Click(Sender: TObject);
  192.     procedure Disconnect1Click(Sender: TObject);
  193.     procedure Connect1Click(Sender: TObject);
  194.     procedure Create1Click(Sender: TObject);
  195.     procedure FormResize(Sender: TObject);
  196.     procedure Windows1Click(Sender: TObject);
  197.     procedure QueryPreviousUpdate(Sender: TObject);
  198.     procedure QueryNextUpdate(Sender: TObject);
  199.     procedure FormShow(Sender: TObject);
  200.     procedure QuerySaveOutputUpdate(Sender: TObject);
  201.     procedure DatabaseDisconnectUpdate(Sender: TObject);
  202.     procedure DatabaseConnectAsUpdate(Sender: TObject);
  203.   private
  204.     { Private declarations }
  205.     FDatabase: TIBDatabase;
  206.     FDefaultTransaction: TIBTransaction;
  207.     FDDLTransaction: TIBTransaction;
  208.     FQryDataSet: TIBDataset;
  209.  
  210.     FOnCreateDB: TCreateDBEvent;
  211.     FOnConnectDB: TConnectDBEvent;
  212.     FOnServerConnect: TServerConnectEvent;
  213.     FOnCreateObject: TUpdateObjectEvent;
  214.     FOnDropDatabase: TDropDBEvent;
  215.     FOnDropObject: TUpdateObjectEvent;
  216.     FServerList: TStringList;
  217.     FDefaultTransIdx,
  218.     FDDLTransIDX,
  219.     FServerIndex,
  220.     FCurrSQLDialect: integer;
  221.     FConnected: boolean;
  222.     FAutoDDL: boolean;
  223.     FQueryBuffer: TQryList;
  224.  
  225.     procedure UpdateConnectStatus(const Connected: boolean);
  226.     procedure UpdateTransactionStatus (const active: boolean);
  227.     procedure UpdateOutputWindow (const Data: String);
  228.     procedure ProcessISQLEvent (const ISQLEvent: TSQLEvent; const SubEvent: TSQLSubEvent;
  229.                                 const Data: Variant; const Database: TIBDatabase);
  230.     procedure SetAutoDDL(const Value: boolean);
  231.     procedure SetClientDialect(const Value: integer);
  232.     procedure ShowStatistics(const Stats: TStringList);
  233.     procedure CheckDisconnect(Sender: TObject);
  234.     procedure SaveOutput;
  235.  
  236.   public
  237.     { Public declarations }
  238.     constructor Create(AOwner: TComponent); override;
  239.     destructor Destroy; override;
  240.     procedure ShowDialog;
  241.     function CheckTransactionStatus(const Closing: boolean): boolean;
  242.   published
  243.     property OnCreateDatabase: TCreateDBEvent read FOnCreateDB write FOnCreateDB;
  244.     property OnConnectDatabase: TConnectDBEvent read FOnConnectDB write FOnConnectDB;
  245.     property OnCreateObject: TUpdateObjectEvent read FOnCreateObject write FOnCreateObject;
  246.     property OnDropDatabase: TDropDBEvent read FOnDropDatabase write FOnDropDatabase;
  247.     property OnDropObject: TUpdateObjectEvent read FOnDropObject write FOnDropObject;
  248.     property OnServerConnect: TServerConnectEvent read FOnServerConnect write FOnServerConnect;
  249.     property ServerList: TStringList read FServerList write FServerList;
  250.     property Database: TIBDatabase read FDatabase write FDatabase;
  251.     property ServerIndex: integer read FServerIndex write FServerIndex;
  252.     property AutoDDL: boolean read FAutoDDL write SetAutoDDL;
  253.     property Dialect: integer read FCurrSQLDialect write SetClientDialect;
  254.   end;
  255.  
  256. implementation
  257.  
  258. uses frmuMessage, zluGlobal, frmuSQLOptions, frmuDisplayBlob,
  259.      frmuDispMemo, zluContextHelp, Printers, fileCtrl, zluUtility, Registry,
  260.      frmuMain, IBSQL;
  261.  
  262. type
  263.   TWinState = record
  264.     _Top,
  265.     _Left,
  266.     _Height,
  267.     _Width: integer;
  268.     _State: TWindowState;
  269.     _Read: boolean;
  270.   end;
  271.   
  272. const
  273.   OBJECTNAME = '\ISQL';
  274. {$R *.DFM}
  275.  
  276. ///////////////////////////////////////////////////////////////
  277. procedure TdlgWisql.UpdateTransactionStatus(const active: boolean);
  278. begin
  279.   if active then
  280.   begin
  281.     stbISQL.Panels[3].Text := 'Transaction is ACTIVE.';
  282.     TransactionCommit.Enabled := true;
  283.     TransactionRollback.Enabled := true;    
  284.   end
  285.   else begin
  286.     stbISQL.Panels[3].Text := 'No active transaction.';
  287.     TransactionCommit.Enabled := false;
  288.     TransactionRollback.Enabled := false;    
  289.   end
  290. end;
  291.  
  292. ////////////////////////////////////////////////////////////
  293. procedure TdlgWisql.QuerySaveOutputExecute(Sender: TObject);
  294. begin
  295.   SaveOutput;
  296. end;
  297.  
  298. /////////////////////////////////////////////////////////////
  299. procedure TdlgWisql.QueryNextExecute(Sender: TObject);
  300. begin
  301.   try
  302.     reSQLInput.Lines := FQueryBuffer.GetNextQuery;
  303.   except on E: Exception do
  304.     reSQLInput.Clear;
  305.   end;
  306. end;
  307.  
  308. /////////////////////////////////////////////////////////////
  309. procedure TdlgWisql.QueryPreviousExecute(Sender: TObject);
  310. begin
  311.   try
  312.     reSQLInput.Lines := FQueryBuffer.GetPrevQuery;
  313.   except on E: Exception do
  314.     reSQLInput.Clear;
  315.   end;
  316. end;
  317.  
  318. /////////////////////////////////////////////////////////////
  319. procedure TdlgWisql.QuerySaveScriptExecute(Sender: TObject);
  320. var
  321.   lSaveDialog: TSaveDialog;
  322. begin
  323.   lSaveDialog := nil;
  324.   try
  325.   begin
  326.     lSaveDialog := TSaveDialog.Create(Self);
  327.     lSaveDialog.DefaultExt := 'sql';
  328.     lSaveDialog.Filter := 'SQL Files (*.sql)|*.SQL|Text files (*.txt)|*.TXT|All files (*.*)|*.*';
  329.     if lSaveDialog.Execute then
  330.     begin
  331.       if FileExists(lSaveDialog.FileName) then
  332.         if MessageDlg(Format('OK to overwrite %s', [lSaveDialog.FileName]),
  333.           mtConfirmation, mbYesNoCancel, 0) <> idYes then Exit;
  334.       reSQLInput.PlainText := true;
  335.       reSQLInput.Lines.SaveToFile(lSaveDialog.FileName);
  336.       reSQLInput.SetModified(False,false,stbISQL);
  337.       reSQLInput.PlainText := false;      
  338.     end;
  339.   end
  340.   finally
  341.     lSaveDialog.free;
  342.   end;
  343. end;
  344.  
  345. /////////////////////////////////////////////////////////////
  346. procedure TdlgWisql.QueryLoadScriptExecute(Sender: TObject);
  347. var
  348.   lOpenDialog: TOpenDialog;
  349. begin
  350.   lOpenDialog := nil;
  351.   try
  352.   begin
  353.     lOpenDialog := TOpenDialog.Create(self);
  354.     lOpenDialog.DefaultExt := 'sql';
  355.     lOpenDialog.Filter := 'SQL Files (*.sql)|*.SQL|Text files (*.txt)|*.TXT|All files (*.*)|*.*';
  356.     if lOpenDialog.Execute then
  357.     begin
  358.       try
  359.         Screen.Cursor := crHourGlass;
  360.         try
  361.           reSQLInput.Lines.LoadFromFile(lOpenDialog.FileName);
  362.         except
  363.           on E:Exception do
  364.           begin
  365.             MessageDlg(E.Message + #10#13+
  366.             Format('Could not open file "%s".',[lOpenDialog.FileName]), mtError, [mbOK], 0);
  367.             Exit;
  368.           end;
  369.         end;
  370.         reSQLInput.SetFocus;
  371.       finally
  372.         Screen.Cursor := crDefault;
  373.       end;
  374.     end;
  375.   end
  376.   finally
  377.     lOpenDialog.free;
  378.   end;
  379. end;
  380.  
  381. /////////////////////////////////////////////////////////////
  382. procedure TdlgWisql.QueryExecuteExecute(Sender: TObject);
  383. var
  384.   ISQLObj: TIBSQLObj;
  385.   Stats: TStringList;
  386. begin
  387.   if not Assigned(FDatabase) then
  388.     FDatabase := TIBDatabase.Create (self);
  389.  
  390.   if Assigned (FQryDataSet) then
  391.   begin
  392.     GridSource.DataSet := nil;
  393.     FQryDataSet.Free;
  394.   end;
  395.  
  396.   FQryDataSet := TIBDataSet.Create (self);
  397.  
  398.   if Assigned (FDefaultTransaction) then
  399.     FQryDataset.Transaction := FDefaultTransaction
  400.   else
  401.   begin
  402.     FDefaultTransaction := TIBTransaction.Create(self);
  403.     FDDLTransaction := TIBTransaction.Create(self);
  404.     FDDLTransIdx := FDatabase.AddTransaction (FDDLTransaction);
  405.     FDefaultTransIdx := FDatabase.AddTransaction (FDefaultTransaction);
  406.     FDefaultTransaction.DefaultDatabase := Database;
  407.     FDDLTransaction.DefaultDatabase := Database;
  408.     FQryDataset.Transaction := FDefaultTransaction;
  409.   end;
  410.  
  411.   reSQLOutput.Clear;
  412.   reSQLOutput.SetFont;
  413.   ISQLObj := nil;
  414.   Stats := nil;
  415.   try
  416.     lvStats.Items.BeginUpdate;
  417.     lvStats.Items.Clear;
  418.     lvStats.Items.EndUpdate;
  419.  
  420.     Stats := TStringList.Create;
  421.     ISQLObj := TIBSqlObj.Create (Self);
  422.     try
  423.       with ISQLObj do
  424.       begin
  425.         DefaultTransIDX := FDefaultTransIDX;
  426.         DDLTransIDX := FDDLTransIDX;
  427.         AutoDDL := FAutoDDL;
  428.         Query := reSQLInput.Lines;
  429.         Database := FDatabase;
  430.         DataSet := FQryDataSet;
  431.         OnDataOutput := UpdateOutputWindow;
  432.         OnISQLEvent := ProcessISQLEvent;
  433.         pgcOutput.ActivePage := TabData;
  434.         Statistics := true;
  435.         Cursor := crSQLWait;
  436.         lvStats.Items.BeginUpdate;
  437.         lvStats.Items.Clear;
  438.         lvStats.Items.EndUpdate;
  439.         DoIsql;
  440.         Cursor := crDefault;
  441.         Stats := StatisticsList;
  442.         FQueryBuffer.AddQueryList(reSqlInput.Lines);
  443.         if gAppSettings[CLEAR_INPUT].Setting then
  444.           reSQLInput.Clear;
  445.       end;
  446.     except on
  447.       E: EIsqlException do
  448.       begin
  449.         Cursor := crDefault;
  450.         case E.ExceptionCode of
  451.           eeInvDialect:
  452.             DisplayMsg (E.ErrorCode, Format('%s'#13#10'Invalid client dialect %s',
  453.               [E.Message, E.ExceptionData]));
  454.           eeInitialization:
  455.             DisplayMsg (E.ErrorCode, E.Message);
  456.           eeFOpen:
  457.             DisplayMsg (E.ErrorCode, Format('%s'#13#10'Unable to open file %s',
  458.               [E.Message, E.ExceptionData]));
  459.           eeParse:
  460.             DisplayMsg (E.ErrorCode, E.Message);
  461.           eeCreate,
  462.           eeConnect:
  463.             DisplayMsg (E.ErrorCode, Format('%s'#13#10'Database: %s', [E.Message, E.ExceptionData]));
  464.           eeStatement,
  465.           eeCommit,
  466.           eeRollback,
  467.           eeDDL,
  468.           eeDML,
  469.           eeQuery:
  470.             DisplayMsg (E.ErrorCode, Format('%s'#13#10'Statement: %s', [E.Message, E.ExceptionData]));
  471.           eeFree:
  472.             DisplayMsg (E.ErrorCode, E.Message);
  473.         end;
  474.       end;
  475.     end;
  476.   finally
  477.     FDefaultTransaction := Database.Transactions[FDefaultTransIDX];
  478.     FDDLTransaction := Database.Transactions[FDDLTransIDX];
  479.     GridSource.DataSet := FQryDataset;
  480.     FDefaultTransaction := FQryDataset.Transaction;
  481.     UpdateTransactionStatus ((FDefaultTransaction.InTransaction) or (FDDLTransaction.InTransaction));
  482.     ShowStatistics (Stats);
  483.     ISQLObj.Free;
  484.   end;
  485. end;
  486.  
  487. /////////////////////////////////////////////////////////////
  488. procedure TdlgWisql.UpdateOutputWindow(const Data: String);
  489. begin
  490.   reSqLOutput.Lines.Add (Data);
  491. end;
  492.  
  493. /////////////////////////////////////////////////////////////
  494. procedure TdlgWisql.DialectChange(Sender: TObject);
  495. var
  496.   tmpdialect: integer;
  497.  
  498. begin
  499.   if Assigned (FDatabase) then
  500.   begin
  501.     tmpdialect := TAction(Sender).Tag;
  502.     with FDatabase do begin
  503.       try
  504.         if tmpdialect <> DBSQLDialect then
  505.           DisplayMsg (WAR_DIALECT_MISMATCH, Format(
  506.               'Database dialect (%d) does not match client dialect (%d).',
  507.               [DBSQLDialect, tmpdialect]));
  508.         SQLDialect := TAction(Sender).tag;
  509.       except on E: Exception do
  510.          DisplayMsg (ERR_INV_DIALECT, Format('%s'#13#10'Unable to set the client dialect to %d',
  511.                                             [E.Message, tmpdialect]));
  512.       end;
  513.     end;
  514.   end;
  515.   Dialect := TAction(Sender).Tag;
  516. end;
  517.  
  518. /////////////////////////////////////////////////////////////
  519. procedure TdlgWisql.DialectUpdate(Sender: TObject);
  520. begin
  521.    with Sender as TAction do
  522.      Checked := (FCurrSQLDialect = Tag)
  523. end;
  524.  
  525. /////////////////////////////////////////////////////////////
  526. procedure TdlgWisql.ShowDialog;
  527. begin
  528.   reSQLInput.Lines.Clear;
  529.   reSQLOutput.Lines.Clear;
  530.   reSQLInput.ObjectName := OBJECTNAME;
  531.   reSQLInput.SetFont;
  532.   reSQLOutput.SetFont;
  533.   frmMain.UpdateWindowList(Caption, TObject(Self), true);
  534.   if Assigned (FDatabase) then
  535.   begin
  536.     FDatabase.BeforeDisconnect := CheckDisconnect;
  537.     if not FDatabase.TestConnected then
  538.     begin
  539.       FDatabase.Connected := true;
  540.     end;
  541.     FConnected := false;
  542.     UpdateConnectStatus(true);
  543.     Dialect := FDatabase.SQLDialect;
  544.   end
  545.   else
  546.     UpdateConnectStatus(false);
  547. {
  548.   if Assigned (FServerList) then
  549.   begin
  550.     cbServers.Items.Clear;
  551.     cbServers.Items.Text := ServerList.Text;
  552.     cbServers.ItemIndex := ServerIndex;
  553.   end;
  554. }
  555.   if Assigned (FDefaultTransaction) and Assigned(FDDLTransaction) then
  556.     UpdateTransactionStatus ((FDefaultTransaction.InTransaction) or (FDDLTransaction.InTransaction))
  557.   else
  558.     UpdateTransactionStatus (false);
  559.  
  560.   FQueryBuffer.Free;
  561.   FQueryBuffer := TQryList.Create;
  562.   Show;
  563.   frmMain.UpdateWindowList(Caption, TObject(Self));
  564. end;
  565.  
  566. /////////////////////////////////////////////////////////////
  567. procedure TdlgWisql.UpdateCursor(Sender: TObject);
  568. begin
  569.   TRichEditX(Sender).UpdateCursorPos(stbISQL);
  570. end;
  571.  
  572. /////////////////////////////////////////////////////////////
  573. procedure TdlgWisql.reSqlInputKeyPress(Sender: TObject; var Key: Char);
  574. begin
  575.   UpdateCursor(Sender);
  576. end;
  577.  
  578. /////////////////////////////////////////////////////////////
  579. procedure TdlgWisql.ProcessISQLEvent(const ISQLEvent: TSQLEvent;
  580.   const SubEvent: TSQLSubEvent; const Data: Variant; const Database: TIBDatabase);
  581. var
  582.   objType: integer;
  583.  
  584. begin
  585.   case ISQLEvent of
  586.     evntISQL:
  587.     begin
  588.       case SUbEvent of
  589.         seAutoDDL:
  590.           AutoDDL := Data;
  591.       end;
  592.     end;
  593.     evntDialect:
  594.     begin
  595.       case SubEvent of
  596.         seDialect1:
  597.           DialectChange(DialectAction1);
  598.         seDialect2:
  599.           DialectChange(DialectAction2);
  600.         seDialect3:
  601.           DialectChange(DialectAction3);
  602.       end;
  603.     end;
  604.     evntConnect:
  605.     begin
  606.       if Assigned (OnConnectDatabase) and
  607.         gAppSettings[UPDATE_ON_CONNECT].Setting then
  608.       begin
  609.         { force a path before the database name if this is a local connection }
  610.         if ExtractFilePath(FDatabase.DatabaseName) = '' then
  611.           FDatabase.DatabaseName := ExtractFilePath(Application.ExeName)+FDatabase.Databasename;
  612.  
  613. //        FDatabase.BeforeDisconnect := CheckDisconnect;
  614.       end;
  615.       UpdateConnectStatus(true);
  616.       FCurrSQLDialect := FDatabase.SQLDialect;
  617.       FConnected := true;
  618.     end;
  619.  
  620.     evntCreate:
  621.     begin
  622.       if SubEvent = seDatabase then
  623.       begin
  624.         UpdateConnectStatus(true);
  625.         if Assigned (OnCreateDatabase) and
  626.            gAppSettings[UPDATE_ON_CREATE].Setting then
  627.         OnCreateDatabase (FDatabase);
  628.  
  629.         FCurrSQLDialect := FDatabase.SQLDialect;
  630.         FConnected := true;
  631.         UpdateConnectStatus(true);        
  632.       end
  633.       else
  634.       begin
  635.         case SubEvent of
  636.           seDomain: objType := NODE_DOMAIN;
  637.           seTable: objType := NODE_TABLE;
  638.           seView: objType := NODE_VIEW;
  639.           seProcedure: objType := NODE_PROCEDURE;
  640.           seFunction: objType := NODE_FUNCTION;
  641.           seGenerator: objType := NODE_GENERATOR;
  642.           seException: objType := NODE_EXCEPTION;
  643.           seFilter: objType := NODE_BLOB_FILTER;
  644.           seRole: objType := NODE_ROLE;
  645.           else
  646.             objType := NODE_UNK;
  647.         end;
  648.         if Assigned (OnCreateObject) then
  649.           OnCreateObject (FDatabase, ObjType);
  650.       end;
  651.     end;
  652.  
  653.     evntAlter:
  654.       if Assigned (OnCreateObject) then
  655.         OnCreateObject (Database, NODE_UNK);
  656.  
  657.     evntDrop:
  658.     begin
  659.       if SubEvent = seDatabase then
  660.       begin
  661.        if Assigned(OnDropDatabase) then
  662.          OnDropDatabase;
  663.        UpdateConnectStatus(false);
  664.       end
  665.       else
  666.       begin
  667.         case SubEvent of
  668.           seDomain: objType := NODE_DOMAIN;
  669.           seTable: objType := NODE_TABLE;
  670.           seView: objType := NODE_VIEW;
  671.           seProcedure: objType := NODE_PROCEDURE;
  672.           seFunction: objType := NODE_FUNCTION;
  673.           seGenerator: objType := NODE_GENERATOR;
  674.           seException: objType := NODE_EXCEPTION;
  675.           seFilter: objType := NODE_BLOB_FILTER;
  676.           seRole: objType := NODE_ROLE;
  677.           else
  678.             objType := NODE_UNK;
  679.         end;
  680.           if Assigned (OnDropObject) then
  681.             OnDropObject (Database, ObjType);
  682.       end;
  683.     end;
  684.  
  685.     evntTransaction:
  686.     begin
  687.       UpdateTransactionStatus (Data);
  688.       if Assigned (OnCreateObject) then
  689.         OnCreateObject (Database, NODE_UNK);
  690.     end;
  691. //    else
  692. //      ShowMessage ('Unknown event');
  693.   end;
  694. end;
  695.  
  696. /////////////////////////////////////////////////////////////
  697. procedure TdlgWisql.reSqlInputKeyDown(Sender: TObject; var Key: Word;
  698.   Shift: TShiftState);
  699. begin
  700.   if (Key = VK_RETURN) and (ssCtrl in Shift) then
  701.     QueryExecuteExecute (Sender);
  702. end;
  703.  
  704. ////////////////////////////////////////////////////////////////
  705. procedure TdlgWisql.TransactionExecute(Sender: TObject);
  706. begin
  707.   with (Sender as TAction) do
  708.   begin
  709.     if Tag = 0 then
  710.     begin
  711.       if MessageDlg('Are you sure that you want to rollback work to previous commit point?',
  712.           mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  713.       begin
  714.         if FDefaultTransaction.InTransaction then
  715.           FDefaultTransaction.Rollback;
  716.  
  717.         if FDDLTransaction.InTransaction then
  718.           FDDLTransaction.Rollback;
  719.  
  720.         UpdateTransactionStatus ((FDefaultTransaction.InTransaction) or (FDDLTransaction.InTransaction));
  721.       end;
  722.     end
  723.     else
  724.     begin
  725.       if FDefaultTransaction.InTransaction then
  726.         FDefaultTransaction.Commit;
  727.       if FDDLTransaction.InTransaction then
  728.         FDDLTransaction.Commit;
  729.       UpdateTransactionStatus ((FDefaultTransaction.InTransaction) or (FDDLTransaction.InTransaction));
  730.     end;
  731.   end;
  732.   if Assigned (OnCreateObject) then
  733.     OnCreateObject (Database, NODE_UNK);
  734. end;
  735.  
  736. //////////////////////////////////////////////////////////
  737. constructor TdlgWisql.Create(AOwner: TComponent);
  738. begin
  739.   inherited;
  740.   FServerList := TStringList.Create;
  741.   FConnected := false;
  742.   Dialect := gAppSettings[DEFAULT_DIALECT].Setting;
  743.   AutoDDL := gAppSettings[AUTO_COMMIT_DDL].Setting;
  744.  
  745.   { On create, the input window is always 1/2 of the window }
  746.   reSQLInput.Height := Self.Height div 2;
  747.   reSQLOutput.SetFont;
  748.  
  749.   FQueryBuffer := TQryList.Create;
  750. end;
  751.  
  752. //////////////////////////////////////////////////////////
  753. destructor TdlgWisql.Destroy;
  754. begin
  755.   FServerList.Free;
  756.   FQueryBuffer.Free;
  757.   inherited;
  758. end;
  759.  
  760. //////////////////////////////////////////////////////////
  761. procedure TdlgWisql.cbServersChange(Sender: TObject);
  762.  
  763. begin
  764.   Disconnect1Click(Sender);
  765.  
  766.   if not Assigned(FDatabase.Handle) then
  767.     if Assigned (OnServerConnect) then
  768.       OnServerConnect ((Sender as TComboBox).Text);
  769. end;
  770.  
  771. //////////////////////////////////////////////////////////
  772. procedure TdlgWisql.FileOptionsExecute(Sender: TObject);
  773. var
  774.   origDialect: integer;
  775.   origDDL : boolean;
  776.   optsDlg: TfrmSQLOptions;
  777. begin
  778.   optsDlg := TfrmSQLOptions.Create (self);
  779.  
  780.   origDialect := gAppSettings[DEFAULT_DIALECT].Setting;
  781.   origDDL := gAppSettings[AUTO_COMMIT_DDL].Setting;
  782.   OptsDlg.ShowModal;
  783.   OptsDlg.Free;
  784.   if OrigDDL <> gAppSettings[AUTO_COMMIT_DDL].Setting then
  785.     AutoDDL := gAppSettings[AUTO_COMMIT_DDL].Setting;
  786.  
  787.   if OrigDialect <> gAppSettings[DEFAULT_DIALECT].Setting then
  788.     Dialect := gAppSettings[DEFAULT_DIALECT].Setting;
  789. end;
  790.  
  791. //////////////////////////////////////////////////////////
  792. procedure TdlgWisql.EditFindExecute(Sender: TObject);
  793. begin
  794.   (ActiveControl as TRichEditX).Find;
  795. end;
  796.  
  797. //////////////////////////////////////////////////////////
  798. procedure TdlgWisql.EditFindUpdate(Sender: TObject);
  799. begin
  800.   if (ActiveControl is TRichEditX) then
  801.     with (ActiveControl as TRichEditX) do
  802.       (Sender as TAction).Enabled := true
  803.   else
  804.     (Sender as TAction).Enabled := false;
  805. end;
  806.  
  807. /////////////////////////////////////////////////////////////
  808. procedure TdlgWisql.QueryUpdate(Sender: TObject);
  809. begin
  810.   (Sender as TAction).Enabled := (reSQlInput.Lines.Count > 0);
  811. end;
  812.  
  813. /////////////////////////////////////////////////////////////
  814. procedure TdlgWisql.QueryPrepareExecute(Sender: TObject);
  815. var
  816.   ISQLObj: TIBSQLObj;
  817. begin
  818.   try
  819.     reSQLOutput.Clear;
  820.     reSQLOutput.SetFont;
  821.     ISQLObj := TIBSqlObj.Create (Self);
  822.     with ISQLObj do
  823.     begin
  824.       DefaultTransIDX := FDefaultTransIDX;
  825.       DDLTransIDX := FDDLTransIDX;
  826.       Query := reSQLInput.Lines;
  827.       Database := FDatabase;
  828.       DataSet := FQryDataSet;
  829.       OnDataOutput := UpdateOutputWindow;
  830.       pgcOutput.ActivePage := TabResults;
  831.       Cursor := crSQLWait;
  832.       DoPrepare;
  833.       Cursor := crDefault;
  834.       Free;
  835.     end;
  836.   except on
  837.     E: EIsqlException do
  838.     begin
  839.       Cursor := crDefault;
  840.       case E.ExceptionCode of
  841.         eeStatement:
  842.           DisplayMsg (E.ErrorCode, Format('%s'#13#10'Statement: %s', [E.Message, E.ExceptionData]));
  843.         else
  844.           DisplayMsg (ERR_ISQL_ERROR, E.Message);
  845.       end;
  846.     end;
  847.   end;
  848. end;
  849.  
  850. /////////////////////////////////////////////////////////////
  851. procedure TdlgWisql.dbgSQLResultsCellClick(Column: TColumn);
  852. begin
  853.   if Column.Field.DataType in [ftMemo, ftBlob] then
  854.     Column.ButtonStyle := cbsEllipsis;
  855. end;
  856.  
  857. /////////////////////////////////////////////////////////////
  858. procedure TdlgWisql.dbgSQLResultsDrawColumnCell(Sender: TObject;
  859.   const Rect: TRect; DataCol: Integer; Column: TColumn;
  860.   State: TGridDrawState);
  861. var
  862.   DisplayStr:  String;
  863.   
  864. begin
  865.   with Sender as TDBGrid do begin
  866.     if Column.Field = nil then begin
  867.       with Canvas do begin
  868.         font.color := clBlue;
  869.         TextRect(Rect, Rect.Left, Rect.top, NULL_STR);
  870.       end
  871.     end
  872.     else begin
  873.       if Column.Field.IsNull then begin
  874.         with Canvas do begin
  875.           font.color := clBlue;
  876.           TextRect(Rect, Rect.Left, Rect.top, NULL_STR);
  877.         end;
  878.       end
  879.       else
  880.       begin
  881.         if Column.Field.DataType in [ftDateTime, ftTime] then
  882.         begin
  883.           { make sure that the time portion is always displayed! }
  884.           if Column.Field.DataType = ftDateTime then
  885.           begin
  886.             if FDatabase.SQLDialect = 3 then
  887.               DisplayStr := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', Column.Field.AsDateTime)
  888.             else
  889.               DisplayStr := FormatDateTime('c', Column.Field.AsDateTime)
  890.           end
  891.           else
  892.             DisplayStr := FormatDateTime('hh:nn:ss.zzz', Column.Field.AsDateTime);
  893.           Canvas.TextRect(Rect, Rect.Left, Rect.Top, DisplayStr);
  894.         end
  895.       end;
  896.     end;
  897.   end;
  898. end;
  899.  
  900. /////////////////////////////////////////////////////////////
  901. procedure TdlgWisql.dbgSQLResultsEditButtonClick(Sender: TObject);
  902. var
  903.   FieldObj: TField;
  904.  
  905. begin
  906.   with Sender as TDBGrid do begin
  907.     FieldObj := SelectedField;
  908.     if FieldObj = nil then
  909.       ShowMessage ('Unable to display Array Information')
  910.     else begin
  911.       case FieldObj.DataType of
  912.         ftBlob:
  913.            DisplayBlob (self, FieldObj, FQryDataSet);
  914.         ftMemo:
  915.           DisplayMemo (self, FieldObj, FQryDataSet);
  916.         else
  917.           ShowMessage (FieldObj.DisplayName+' is unknown');
  918.       end;
  919.     end;
  920.   end;
  921. end;
  922.  
  923. /////////////////////////////////////////////////////////////
  924. procedure TdlgWisql.EditFontExecute(Sender: TObject);
  925. begin
  926.   reSQLInput.ObjectName := OBJECTNAME;
  927.   reSQLInput.ChangeFont;
  928. end;
  929.  
  930. /////////////////////////////////////////////////////////////
  931. procedure TdlgWisql.SetAutoDDL(const Value: boolean);
  932. begin
  933.   FAutoDDL := Value;
  934.   if FAutoDDL then
  935.     stbISQL.Panels[4].Text := 'AutoDDL: ON'
  936.   else
  937.     stbISQL.Panels[4].Text := 'AutoDDL: OFF';
  938. end;
  939.  
  940. /////////////////////////////////////////////////////////////
  941. procedure TdlgWisql.SQLReference1Click(Sender: TObject);
  942. var
  943.   hlpPath: String;
  944. begin
  945.   inherited;
  946.   hlpPath := Format('%s\%s',[ExtractFilePath(Application.ExeName), SQL_REFERENCE]);
  947.   WinHelp(WindowHandle, PChar(hlpPath),HELP_FINDER,0);
  948. end;
  949.  
  950. /////////////////////////////////////////////////////////////
  951. procedure TdlgWisql.FormClose(Sender: TObject; var Action: TCloseAction);
  952. var
  953.   Reg: TRegistry;
  954.   State: TWinState;
  955.  
  956. begin
  957.   if CheckTransactionStatus (true) then
  958.   begin
  959.     frmMain.UpdateWindowList(Self.Caption, TObject(Self), true);
  960.     with State do
  961.     begin
  962.       _Top := Top;
  963.       _Left := Left;
  964.       _Height := Height;
  965.       _Width := Width;
  966.       _State := WindowState;
  967.       _Read := true;
  968.     end;
  969.     Reg := TRegistry.Create;
  970.     with Reg do begin
  971.       OpenKey(gRegSettingsKey,false);
  972.       WriteBinaryData('SQLState', State, sizeof(State));
  973.       CloseKey;
  974.       Free;
  975.     end;
  976.   end
  977.   else
  978.     Action := caNone;
  979. end;
  980.  
  981. /////////////////////////////////////////////////////////////
  982. procedure TdlgWisql.FileCloseExecute(Sender: TObject);
  983. begin
  984.   Self.Close;
  985. end;
  986.  
  987. /////////////////////////////////////////////////////////////
  988. procedure TdlgWisql.Print1Click(Sender: TObject);
  989. var
  990.   lPrintDialog: TPrintDialog;
  991.   lLine: integer;
  992.   lPrintText: TextFile;
  993. begin
  994.   lPrintDialog := nil;
  995.   if ActiveControl is TRichEditX then
  996.   begin
  997.     try
  998.       lPrintDialog := TPrintDialog.Create(Self);
  999.       try
  1000.         if lPrintDialog.Execute then
  1001.         begin
  1002.           AssignPrn(lPrintText);
  1003.           Rewrite(lPrintText);
  1004.           Printer.Canvas.Font := TRichEditX(ActiveControl).Font;
  1005.           for lLine := 0 to TRichEditX(ActiveControl).Lines.Count - 1 do
  1006.             Writeln(lPrintText, TRichEditX(ActiveControl).Lines[lLine]);
  1007.           CloseFile(lPrintText);
  1008.         end;
  1009.       except on E: Exception do
  1010.         DisplayMsg (ERR_PRINT, E.Message);
  1011.       end;
  1012.     finally
  1013.       lPrintDialog.free;
  1014.     end;
  1015.   end;
  1016. end;
  1017.  
  1018. /////////////////////////////////////////////////////////////
  1019. procedure TdlgWisql.Drop1Click(Sender: TObject);
  1020. begin
  1021.   if CheckTransactionStatus (false) then
  1022.   begin
  1023.    if not FConnected then
  1024.       frmMain.DatabaseDrop.OnExecute (sender)
  1025.     else begin
  1026.       if MessageDlg('Are you sure that you want to drop the selected database?',
  1027.           mtConfirmation, mbOkCancel, 0) = mrOK then
  1028.         FDatabase.DropDatabase;
  1029.     end;
  1030.  
  1031.     if not Assigned(FDatabase.Handle) then
  1032.     begin
  1033.       frmMain.UpdateWindowList(Caption, TObject(Self), true);
  1034.       UpdateConnectStatus(false);
  1035.       frmMain.UpdateWindowList(Caption, TObject(Self));
  1036.     end;
  1037.   end;
  1038. end;
  1039.  
  1040. /////////////////////////////////////////////////////////////
  1041. procedure TdlgWisql.Disconnect1Click(Sender: TObject);
  1042. begin
  1043.   if CheckTransactionStatus (false) then
  1044.   begin
  1045.     if not FConnected then
  1046.       frmMain.DatabaseDisconnect.OnExecute (sender)
  1047.     else
  1048.       FDatabase.Connected := false;
  1049.  
  1050.     if not Assigned(FDatabase.Handle) then
  1051.     begin
  1052.       frmMain.UpdateWindowList(Caption, TObject(Self), true);
  1053.       UpdateConnectStatus(false);
  1054.       frmMain.UpdateWindowList(Caption, TObject(Self));
  1055.       FDatabase.BeforeDisconnect := nil;
  1056.     end;
  1057.   end;
  1058. end;
  1059.  
  1060. /////////////////////////////////////////////////////////////
  1061. procedure TdlgWisql.Connect1Click(Sender: TObject);
  1062. begin
  1063.   if CheckTransactionStatus (false) then
  1064.   begin
  1065.     if frmMain.ConnectAsDatabase (Sender) then
  1066.     begin
  1067.       frmMain.UpdateWindowList(Caption, TObject(Self), true);
  1068.       UpdateConnectStatus(Assigned(FDatabase.Handle));
  1069.       frmMain.UpdateWindowList(Caption, TObject(Self));
  1070.       FConnected := false;
  1071.     end;
  1072.     resqlInput.Clear;
  1073.     reSQLOutput.Clear;
  1074.   end;
  1075. end;
  1076.  
  1077. /////////////////////////////////////////////////////////////
  1078. procedure TdlgWisql.Create1Click(Sender: TObject);
  1079. begin
  1080.   if CheckTransactionStatus(false) then
  1081.   begin
  1082.     if frmMain.CreateDatabase (Sender) then
  1083.     begin
  1084.       frmMain.UpdateWindowList(Caption, TObject(Self), true);
  1085.       UpdateConnectStatus(true);
  1086.       frmMain.UpdateWindowList(Caption, TObject(Self));
  1087.       FConnected := true;
  1088.     end;
  1089.     resqlInput.Clear;
  1090.     reSQLOutput.Clear;
  1091.   end;
  1092. end;
  1093.  
  1094. /////////////////////////////////////////////////////////////
  1095. function TdlgWisql.CheckTransactionStatus (const Closing: boolean): boolean;
  1096. var
  1097.   retval: integer;
  1098.  
  1099. begin
  1100.   { If there are any outstanding transactions, ask for a commit.  If no
  1101.     commit is issued, then do not allow the form to close}
  1102.   result := true;
  1103.   if Assigned (FDefaultTransaction) and Assigned (FDDLTransaction) then
  1104.   begin
  1105.     if gAppSettings[COMMIT_ON_EXIT].Setting and Closing then
  1106.     begin
  1107.       if FDefaultTransaction.InTransaction then
  1108.         FDefaultTransaction.Commit;
  1109.       if FDDLTransaction.InTransaction then
  1110.         FDDLTransaction.Commit;
  1111.       result := true;
  1112.     end
  1113.     else
  1114.     begin
  1115.       if FDefaultTransaction.InTransaction or
  1116.          FDDLTransaction.InTransaction then
  1117.       begin
  1118.         retval := MessageDlg ('Transactions are active.'#13#10+
  1119.                               'Would you like to commit the transactions?'#13#10+
  1120.                               #13#10+
  1121.                               'Choosing NO will rollback the active transactions.', mtInformation,
  1122.                               mbYesNoCancel, 0);
  1123.         case retval of
  1124.           mrYes:
  1125.           begin
  1126.             if FDefaultTransaction.InTransaction then
  1127.               FDefaultTransaction.Commit;
  1128.             if FDDLTransaction.InTransaction then
  1129.               FDDLTransaction.Commit;
  1130.             result := true;
  1131.           end;
  1132.           mrNo:
  1133.           begin
  1134.             if FDefaultTransaction.InTransaction then
  1135.               FDefaultTransaction.Rollback;
  1136.  
  1137.             if FDDLTransaction.InTransaction then
  1138.               FDDLTransaction.Rollback;
  1139.  
  1140.             result := true;
  1141.           end;
  1142.           mrCancel:
  1143.             result := false;
  1144.         end;
  1145.       end;
  1146.     end
  1147.   end;
  1148.  
  1149.   if Result and Closing and Assigned (FDatabase) then
  1150.   begin
  1151.     with FDatabase do
  1152.     begin
  1153.       BeforeDisconnect := nil;
  1154.       if TransactionCount > 0 then
  1155.       begin
  1156.         retval := FindTransaction(FDefaultTransaction);
  1157.         RemoveTransaction(retval);
  1158.         retval := FindTransaction(FDDLTransaction);
  1159.         RemoveTransaction(retval);
  1160.       end;
  1161.  
  1162.       { If a connection was made to a database (or a new database was created),
  1163.         disconnect from it now }
  1164.       if FConnected then
  1165.       begin
  1166.         FDatabase.Connected := false;
  1167.         FDatabase.Free;
  1168.         FDatabase := nil;
  1169.         FConnected := false;
  1170.       end;
  1171.     end;
  1172.     FDefaultTransaction.Free;
  1173.     FDDLTransaction.Free;
  1174.     FDefaultTransaction := nil;
  1175.     FDDLTransaction := nil;
  1176.   end;
  1177. end;
  1178.  
  1179. /////////////////////////////////////////////////////////////
  1180. procedure TdlgWisql.FormResize(Sender: TObject);
  1181. begin
  1182.   { On resize, force the input window to be 1/2 the size of the window }
  1183.   pnlEnterSQL.Height := (Self.ClientHeight div 2);
  1184.   reSQLInput.Refresh;
  1185. end;
  1186.  
  1187. /////////////////////////////////////////////////////////////
  1188. procedure TdlgWisql.UpdateConnectStatus(const Connected: boolean);
  1189. var
  1190.   dbString: String;
  1191. begin
  1192.   if Assigned (sbData) then
  1193.   begin
  1194.     if Connected then
  1195.     begin
  1196.       lblFileName.Caption := FDatabase.DatabaseName;
  1197.       dbString := MinimizeName (lblFileName.Caption, lblFileName.Canvas,
  1198.         sbData.Panels[0].Width);
  1199.       sbData.Panels[0].Text := dbString;
  1200.     end
  1201.     else
  1202.     begin
  1203.       sbData.Panels[0].Text := 'Not Connected';
  1204.       reSqlInput.Clear;
  1205.       reSQLOutput.Clear;
  1206.       FQueryBuffer.ClearList;
  1207.       FConnected := false;
  1208.     end;
  1209.   end;
  1210. end;
  1211.  
  1212. /////////////////////////////////////////////////////////////
  1213. procedure TdlgWisql.Windows1Click(Sender: TObject);
  1214. begin
  1215.   frmMain.ShowWindows;
  1216. end;
  1217.  
  1218. /////////////////////////////////////////////////////////////
  1219. procedure TdlgWisql.SetClientDialect(const Value: integer);
  1220. begin
  1221.   FCurrSQLDialect := value;
  1222.   stbISQL.Panels[2].Text := Format ('Client dialect %d',[FCurrSQLDialect]);
  1223. end;
  1224.  
  1225. /////////////////////////////////////////////////////////////
  1226. { TQryList }
  1227.  
  1228. procedure TQryList.AddQueryList(const Query: TStrings);
  1229. begin
  1230.  
  1231.   if not Assigned (FQueryArray) then
  1232.     SetLength(FQueryArray, 1)
  1233.   else
  1234.     SetLength(FQueryArray, Length(FQueryArray)+1);
  1235.  
  1236.   FQueryArray[High(FQueryArray)] := TStringList.Create;
  1237.   FQueryArray[High(FQueryArray)].AddStrings(Query);
  1238.   FCurrQuery := Length(FQueryArray);
  1239.   FAtFirst := false;
  1240. end;
  1241.  
  1242. /////////////////////////////////////////////////////////////
  1243. function TQryList.AtFirstQuery: boolean;
  1244. begin
  1245.     result := FAtFirst;
  1246. end;
  1247.  
  1248. /////////////////////////////////////////////////////////////
  1249. function TQryList.AtLastQuery: boolean;
  1250. begin
  1251.     result := FAtLast;
  1252. end;
  1253.  
  1254. /////////////////////////////////////////////////////////////
  1255. procedure TQryList.ClearList;
  1256. var
  1257.   lCnt: integer;
  1258. begin
  1259.   for lCnt := Low(FQueryArray) to High(FQueryArray) do
  1260.     FQueryArray[lCnt].Free;
  1261.  
  1262.   SetLength(FQueryArray, 0);
  1263.   FAtLast := true;
  1264.   FAtFirst:= true;
  1265.   FCurrQuery := -1;
  1266. end;
  1267.  
  1268. /////////////////////////////////////////////////////////////
  1269. constructor TQryList.Create;
  1270. begin
  1271.   FCurrQuery := -1;
  1272.   FAtLast := true;
  1273.   FAtFirst := true;
  1274. end;
  1275.  
  1276. /////////////////////////////////////////////////////////////
  1277. destructor TQryList.Destroy;
  1278. var
  1279.   lCnt: integer;
  1280. begin
  1281.   for lCnt := Low(FQueryArray) to High(FQueryArray) do
  1282.     FQueryArray[lCnt].Free;
  1283.   inherited;
  1284. end;
  1285.  
  1286. /////////////////////////////////////////////////////////////
  1287. function TQryList.GetNextQuery: TStrings;
  1288. begin
  1289.   if FCurrQuery < Length(FQueryArray) then
  1290.   begin
  1291.     result := FQueryArray[FCurrQuery+1];
  1292.     Inc (FCurrQuery);
  1293.     FAtLast := (FCurrQuery = Length(FQueryArray));
  1294.   end
  1295.   else begin
  1296.     result := nil;
  1297.     FAtLast := true;
  1298.   end;
  1299.   FAtFirst := false;
  1300. end;
  1301.  
  1302. /////////////////////////////////////////////////////////////
  1303. function TQryList.GetPrevQuery: TStrings;
  1304. begin
  1305.   if FCurrQuery >= 0 then
  1306.   begin
  1307.     result := FQueryArray[FCurrQuery-1];
  1308.     Dec(FCurrQuery);
  1309.     FAtFirst := (FCurrQuery = 0);
  1310.   end
  1311.   else begin
  1312.     result := nil;
  1313.     FAtFirst := true;
  1314.   end;
  1315.   FAtLast := false;
  1316. end;
  1317.  
  1318. /////////////////////////////////////////////////////////////
  1319. procedure TdlgWisql.QueryPreviousUpdate(Sender: TObject);
  1320. begin
  1321.   (Sender as TAction).Enabled := not FQueryBuffer.AtFirstQuery;
  1322. end;
  1323.  
  1324. /////////////////////////////////////////////////////////////
  1325. procedure TdlgWisql.QueryNextUpdate(Sender: TObject);
  1326. begin
  1327.   (Sender as TAction).Enabled := not FQueryBuffer.AtLastQuery;
  1328. end;
  1329.  
  1330. /////////////////////////////////////////////////////////////
  1331. procedure TdlgWisql.ShowStatistics(const Stats: TStringList);
  1332. var
  1333.   Line,
  1334.   Option,
  1335.   Value: String;
  1336.   lCnt : integer;
  1337.   lvItem: TListItem;
  1338. begin
  1339.  
  1340.   lvStats.Items.BeginUpdate;
  1341.   lvStats.Items.Clear;
  1342.   for lCnt := 0 to Stats.Count - 1 do
  1343.   begin
  1344.     Line := Stats[lCnt];
  1345.     Option := GetNextField(Line, DEL);
  1346.     Value := GetNextField(Line, DEL);
  1347.     if Pos('PLAN', Value) = 1 then
  1348.       reSQLOutput.Lines.Append(Value);
  1349.     lvItem := lvStats.Items.Add;
  1350.     lvItem.Caption := Option;
  1351.     lvItem.SubItems.Add (Value);
  1352.   end;
  1353.   lvStats.Items.EndUpdate;
  1354. end;
  1355.  
  1356. /////////////////////////////////////////////////////////////
  1357. procedure TdlgWisql.FormShow(Sender: TObject);
  1358. begin
  1359.   pgcOutput.ActivePageIndex := 0;
  1360. end;
  1361.  
  1362. /////////////////////////////////////////////////////////////
  1363. procedure TdlgWisql.CheckDisconnect(Sender: TObject);
  1364. begin
  1365.   if not CheckTransactionStatus(true) then
  1366.     exit;
  1367.   UpdateConnectStatus(false);
  1368. end;
  1369.  
  1370. /////////////////////////////////////////////////////////////
  1371. procedure TdlgWisql.SaveOutput;
  1372. var
  1373.   SaveDialog: TSaveDialog;
  1374.   lColDel,
  1375.   lStr,
  1376.   SaveFileName: String;
  1377.   colWidth,
  1378.   i, lCnt: integer;
  1379.   BlobList,
  1380.   tmpList,
  1381.   Data: TStringList;
  1382.   blbStream: TStream;
  1383.   lBookMark: TBookMark;
  1384.  
  1385. begin
  1386.   SaveDialog := TSaveDialog.Create(self);
  1387.   Data := TStringList.Create;
  1388.   with SaveDialog do
  1389.   begin
  1390.     Options := [ofPathMustExist, ofHideReadOnly, ofOverwritePrompt];
  1391.     DefaultExt := 'TXT';
  1392.     Filter := 'Text files (*.txt)|*.TXT';
  1393.     FilterIndex := 1;
  1394.     Title := 'Save Query Output';
  1395.     if Execute then
  1396.       SaveFileName :=  FileName
  1397.     else
  1398.     begin
  1399.       Free;
  1400.       Exit;
  1401.     end;
  1402.     Free;
  1403.   end;
  1404.  
  1405.   dbgSQLResults.Enabled := false;
  1406.   lBookMark := FQryDataset.GetBookmark;
  1407.   FQryDataset.First;
  1408.   with FQryDataset do
  1409.   begin
  1410.     DisableControls;
  1411.     while not EOF do
  1412.     begin
  1413.       { If this is the first record, write out the column headings }
  1414.       if BOF then
  1415.       begin
  1416.         for lCnt := 0 to FieldCount-1 do
  1417.         begin
  1418.           ColWidth := Max(Fields[lCnt].DataSize, Length(Fields[lCnt].FieldName));
  1419.           lStr := Format('%s%-*s',[lStr, ColWidth, Fields[lCnt].FieldName]);
  1420.           lStr := lStr + ' '+ ' '+ ' '+ ' ';
  1421.           for i := 0 to ColWidth-1 do
  1422.           begin
  1423.             lColDel := lColDel + '=';
  1424.           end;
  1425.           lColDel := lColDel + ' '+ ' '+ ' '+ ' ';
  1426.         end;
  1427.         Data.Add(lStr);
  1428.         Data.Add(lColDel);
  1429.       end;
  1430.  
  1431.       { Write the actual data }
  1432.       lStr := '';
  1433.       BlobList := nil;     
  1434.       for lCnt := 0 to FieldCount - 1 do
  1435.       begin
  1436.         ColWidth := Max(Fields[lCnt].DataSize, Length(Fields[lCnt].FieldName));
  1437.         if Fields[lCnt].IsNull then
  1438.           lStr := Format('%s%-*s',[lStr, ColWidth, NULL_STR])
  1439.         else
  1440.         begin
  1441.           case Fields[lCnt].Datatype of
  1442.             ftString:
  1443.               lStr := Format('%s%-*s',[lStr, ColWidth, Fields[lCnt].AsString]);
  1444.             ftSmallint:
  1445.               lStr := Format('%s%*d',[lStr, ColWidth, Fields[lCnt].AsInteger]);
  1446.             ftInteger:
  1447.               lStr := Format('%s%*d',[lStr, ColWidth, Fields[lCnt].AsInteger]);
  1448.             ftWord:
  1449.               lStr := Format('%s%*d',[lStr, ColWidth, Fields[lCnt].AsInteger]);
  1450.             ftFloat:
  1451.               lStr := Format('%s%*d',[lStr, ColWidth, Fields[lCnt].AsInteger]);
  1452.             ftBoolean:
  1453.               lStr := Format('%s%*s',[lStr, ColWidth, Fields[lCnt].AsString]);
  1454.             ftCurrency:
  1455.               lStr := Format('%s%*s',[lStr, ColWidth, Fields[lCnt].AsCurrency]);
  1456.             ftBCD:
  1457.               lStr := Format('%s%*s',[lStr, ColWidth, Fields[lCnt].AsString]);
  1458.             ftDate:
  1459.               lStr := Format('%s%*s',[lStr, ColWidth, DateToStr(Fields[lCnt].AsDateTime)]);
  1460.             ftTime:
  1461.               lStr := Format('%s%*s',[lStr, ColWidth, TimeToStr(Fields[lCnt].AsDateTime)]);
  1462.             ftDateTime:
  1463.               lStr := Format('%s%*s',[lStr, ColWidth, DateTimeToStr(Fields[lCnt].AsDateTime)]);
  1464.             ftMemo:
  1465.             begin
  1466.               if gAppSettings[BLOB_SUBTYPE].Setting = 'Text' then
  1467.               begin
  1468.                 tmpList := TStringList.Create;
  1469.                 BlobList := TStringList.Create;
  1470.                 blbStream := CreateBlobStream(Fields[lCnt], bmRead);
  1471.                 tmpList.LoadFromStream(blbStream);
  1472.                 tmpList.Insert(0, '====================================');
  1473.                 tmpList.Insert(1, Fields[lCnt].FieldName);
  1474.                 tmpList.Append('====================================');
  1475.                 BlobList.AddStrings(tmpList);
  1476.                 tmpList.Free;
  1477.                 Continue;
  1478.               end;
  1479.               lStr := Format('%s%*s',[lStr, ColWidth, BLOB_STR]);
  1480.             end;
  1481.           end; { case }
  1482.         end; { else }
  1483.         lStr := lStr + ' '+ ' '+ ' '+ ' ';
  1484.       end;
  1485.       Data.Add(lStr);
  1486.       if Assigned (BlobList) then
  1487.       begin
  1488.         Data.AddStrings(BlobList);
  1489.         BlobList.Free;
  1490.       end;
  1491.       Next;
  1492.     end;
  1493.     Data.SaveToFile (SaveFileName);
  1494.     Data.Free;
  1495.     FQryDataset.GotoBookmark(lBookMark);
  1496.     FQryDataset.FreeBookmark(lBookMark);
  1497.     EnableControls;
  1498.     dbgSQLResults.Enabled := true;
  1499.     MessageDlg ('Data saved to file: ' + SaveFileName, mtInformation, [mbOk], 0);
  1500.   end;
  1501. end;
  1502.  
  1503. procedure TdlgWisql.QuerySaveOutputUpdate(Sender: TObject);
  1504. begin
  1505.   (Sender as TAction).Enabled := (Assigned(FQryDataset) and
  1506.                                  (FQryDataset.StatementType = SQLSelect));
  1507. end;
  1508.  
  1509. procedure TdlgWisql.DatabaseDisconnectUpdate(Sender: TObject);
  1510. begin
  1511.   if Assigned (FDatabase) then
  1512.     (Sender as TAction).Enabled := FDatabase.Connected
  1513.   else
  1514.     (Sender as TAction).Enabled := false;
  1515. end;
  1516.  
  1517. procedure TdlgWisql.DatabaseConnectAsUpdate(Sender: TObject);
  1518. begin
  1519.   if Assigned (FDatabase) then
  1520.     (Sender as TAction).Enabled := not FDatabase.Connected
  1521. //  else
  1522. //    (Sender as TAction).Enabled := (cbServers.ItemIndex <> -1);
  1523. end;
  1524.  
  1525. end.
  1526.