lazarus-ccr/components/flashfiler/sourcelaz/explorer/fmmain.pas

{*********************************************************}
{* FlashFiler Explorer Main Form                         *}
{*********************************************************}

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower FlashFiler
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{$I ffdefine.inc}

unit fmmain;

{$IFDEF SingleEXE}
!! Error: This application should not be compiled with SingleEXE mode enabled.
{$ENDIF}
interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  Db,
  Menus,
  StdCtrls,
  DBGrids,
  DBCtrls,
  Grids,
  Outline,
  ExtCtrls,
  ComCtrls,
  ffdbbase,
  ffllbase,
  ffllprot,
  ffsrbde,
  uconfig,
  uentity,
  fflllgcy,
  ffdb,
  fflllog
{$IFDEF DCC4ORLATER}
  ,
  ImgList,
  ToolWin
{$ENDIF}
;

type
  TfrmMain = class(TForm)
    mnuMain: TMainMenu;
    mnuHelp: TMenuItem;
    mnuHelpAbout: TMenuItem;
    mnuServer: TMenuItem;
    N1: TMenuItem;
    mnuServerExit: TMenuItem;
    popmnuServer: TPopupMenu;
    popmnuServerAttach: TMenuItem;
    popmnuServerDetach: TMenuItem;
    popmnuAlias: TPopupMenu;
    popmnuTable: TPopupMenu;
    popmnuTableDefinition: TMenuItem;
    popmnuTableIndexes: TMenuItem;
    popmnuTableRedefine: TMenuItem;
    N2: TMenuItem;
    popmnuTableDelete: TMenuItem;
    popmnuTableRename: TMenuItem;
    popmnuTableNew: TMenuItem;
    popmnuDatabaseNew: TMenuItem;
    popmnuDatabaseDelete: TMenuItem;
    N3: TMenuItem;
    popmnuDatabaseRefresh: TMenuItem;
    pnlStatusContainer: TPanel;
    pnlStatusBarComment: TPanel;
    mnuServerRefresh: TMenuItem;
    popmnuServerNewDatabase: TMenuItem;
    N5: TMenuItem;
    popmnuDatabaseNewTable: TMenuItem;
    N6: TMenuItem;
    popmnuServerRefresh: TMenuItem;
    N7: TMenuItem;
    mnuOptions: TMenuItem;
    pnlBottomSpacer: TPanel;
    popmnuTableReindex: TMenuItem;
    mnuOptionsPrintSetup: TMenuItem;
    popmnuTableImportSchema: TMenuItem;
    mnuToolsFFComms: TMenuItem;
    popmnuDatabaseRename: TMenuItem;
    popmnuDatabaseImportSchema: TMenuItem;
    mnuHelpTopics: TMenuItem;
    N8: TMenuItem;
    mnuHelpWebSite: TMenuItem;
    mnuHelpEMail: TMenuItem;
    dlgPrinterSetup: TPrinterSetupDialog;
    mnuServerRegister: TMenuItem;
    popmnuServerRegister: TMenuItem;
    popmnuTableEmpty: TMenuItem;
    pnlLeft: TPanel;
    pnlLeftHeader: TPanel;
    lblFlashFilerServers: TLabel;
    mnuSetAutoInc: TMenuItem;
    mnuOptionsLiveDatasets: TMenuItem;
    logMain: TffEventLog;
    outServers: TTreeView;
    imgMain: TImageList;
    mnuDatabaseSQL: TMenuItem;
    mnuViewTable: TMenuItem;
    N4: TMenuItem;
    barToolBar: TToolBar;
    tbRefresh: TToolButton;
    tbServerRegister: TToolButton;
    N12: TToolButton;
    mnuWindows: TMenuItem;
    mnuCloseAll: TMenuItem;
    mnuWindowsSplitter: TMenuItem;
    tbOptionsLiveDataSets: TToolButton;
    tbOptionsPrintSetup: TToolButton;
    N11: TToolButton;
    tbCloseAll: TToolButton;
    N13: TToolButton;
    tbHelpTopics: TToolButton;
    tbHelpWebSite: TToolButton;
    tbHelpEMail: TToolButton;
    popmnuTableSQL: TMenuItem;
    mnuSetAsAutomaticDefault: TMenuItem;
    N9: TMenuItem;
    mnuTools: TMenuItem;
    tbFFComms: TToolButton;
    N10: TToolButton;
    popmnuTableReindexAll: TMenuItem;
    popmnuServerStatistics: TMenuItem;
    mnuOptionsSetDefaultTimeout: TMenuItem;
    N14: TMenuItem;

    procedure mnuHelpAboutClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure mnuServerExitClick(Sender: TObject);
    procedure outServersMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure mnuServerRefreshClick(Sender: TObject);
    procedure popmnuTableDefinitionClick(Sender: TObject);
    procedure popmnuTableNewClick(Sender: TObject);
    procedure popmnuDatabaseNewTableClick(Sender: TObject);
    procedure popmnuServerPopup(Sender: TObject);
    procedure popmnuServerDetachClick(Sender: TObject);
    procedure popmnuServerAttachClick(Sender: TObject);
    procedure popmnuTableDeleteClick(Sender: TObject);
    procedure popmnuTablePackClick(Sender: TObject);
    procedure popmnuTableRedefineClick(Sender: TObject);
    procedure popmnuTablePopup(Sender: TObject);
    procedure popmnuTableIndexesClick(Sender: TObject);
    procedure outServersClick(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
    procedure popmnuServerNewDatabaseClick(Sender: TObject);
    procedure popmnuTableReindexClick(Sender: TObject);
    procedure popmnuTableImportSchemaClick(Sender: TObject);
    procedure popmnuDatabaseImportSchemaClick(Sender: TObject);
    procedure mnuHelpWebSiteClick(Sender: TObject);
    procedure mnuHelpEMailClick(Sender: TObject);
    procedure popmnuDatabaseDeleteClick(Sender: TObject);
    procedure mnuOptionsPrintSetupClick(Sender: TObject);
    procedure popmnuDatabaseRenameClick(Sender: TObject);
    procedure mnuServerRegisterClick(Sender: TObject);
    procedure mnuHelpTopicsClick(Sender: TObject);
    procedure popmnuTableEmptyClick(Sender: TObject);
    procedure mnuSetAutoIncClick(Sender: TObject);
    procedure outServersDblClick(Sender: TObject);
    procedure mnuOptionsLiveDatasetsClick(Sender: TObject);
    procedure outServersExpanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure outServersEditing(Sender: TObject; Node: TTreeNode;
      var AllowEdit: Boolean);
    procedure outServersEdited(Sender: TObject; Node: TTreeNode;
      var S: String);
    procedure outServersKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure RefreshServers(Sender : TObject);
      { Refresh the entire list of servers. }

    procedure RefreshDatabases(Sender : TObject);
      { Refresh a servers' list of databases. }

    procedure RefreshTables(Sender : TObject);
    procedure mnuDatabaseSQLClick(Sender: TObject);
    procedure mnuViewTableClick(Sender: TObject);
    procedure outServersCompare(Sender: TObject; Node1, Node2: TTreeNode;
      Data: Integer; var Compare: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnuCloseAllClick(Sender: TObject);
    procedure mnuWindowsClick(Sender: TObject);
    procedure mnuToolsFFCommsClick(Sender: TObject);
    procedure mnuSetAsAutomaticDefaultClick(Sender: TObject);
    procedure outServersChange(Sender: TObject; Node: TTreeNode);
    procedure outServersContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure popmnuServerRefreshClick(Sender: TObject);
    procedure popmnuServerStatisticsClick(Sender: TObject);
    procedure mnuOptionsSetDefaultTimeoutClick(Sender: TObject);
      { Refresh a database's list of tables. }

  private
//    function mapProtocolClassToProtocol(const Protocol : TffCommsProtocolClass) : TffProtocolType;
    procedure WindowsMenuItemClick(Sender: TObject);                      {!!.06}
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);            {!!.06}
    procedure DoIdle(Sender: TObject; var Done: Boolean);
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
    procedure ShowServerStatistics(aServer: TffeServerItem);                 {!!.06}
  protected
    Initialized: Boolean;
    {- True if the (DB) Session has been started }

    function GetNewSelectedNode(aNode : TTreeNode) : TTreeNode;
    {- Assuming aNode is going to be deleted, determines which node should be
       selected after the deletion. }

  public
    function AddOutlineDatabase(aNode : TTreeNode;
                                aDatabase: TffeDatabaseItem) : TTreeNode;
    {- Adds a database entry to the outline.  Returns outline index of new entry}
    procedure AddOutlineServer(aServer : TffeServerItem);
    {- Adds a server entry to the outline.  Returns outline index of new entry}
    procedure AddOutlineTable(aNode : TTreeNode; aTable : TffeTableItem);
    {- Adds a table entry to the outline.  Returns outline index of new entry}
    procedure DeleteNodeChildren(aNode : TTreeNode);
    {- Deletes all the children for a given outline entry }
    function DoAttach(aNode : TTreeNode) : TffResult;                  {!!.01}
    {- Attach to the given server }
    procedure DoDetach;
    {- Detach from given server }
    procedure EnableScreen(aSwitch: Boolean);
    {- Enables/Disables the main screen controls while a process runs; allows
       main form to be minimized}
    function GetEntityNode(aEntityType : TffeEntityType;
                           anEntity : TffeEntityItem): TTreeNode;
    {- Returns the node for the given entity }
    function GetNodeEntity(aNode : TTreeNode) : TffeEntityItem;
    {- Returns the entity associated with a given node. }
    function GetNodeEntityType(aNode : TTreeNode) : TffeEntityType;
    {- Returns the entity type associated with a given node. }
    function GetSelectedEntity : TffeEntityItem;
    {- Returns the entity for the currently selected outline item. }
    procedure Initialize;
    {- Initial setup of the session and the server list }
    procedure LoadConfig;
    {- Read parameters out of persistent configuration storage }
    procedure LoadOutlineServers;
    {- Refreshes the entire outline view }
    procedure LoadOutlineDatabases(aNode : TTreeNode);
    {- Refreshes the outline view (databases, tables) for the given server}
    procedure LoadOutlineTables(aNode : TTreeNode);
    {- For a given database entry in the outline, load all of its member
       tables into the outline.  aNode may point to a table or
       a database entry in the outline. }
    procedure OutlineClear;
    {- Frees the TffeOutlineData instances attached to the TTreeNodes in
       outServers.  Clears the TTreeView. }
    procedure SaveConfig;
    {- Writes the FFE configuration settings to persistent storage}
    procedure ShowQueryWindow(aDatabaseIndex: LongInt);
    {- Creates a modeless query window for a particular database. }
    procedure ShowTableBrowser(aTable : TffeTableItem);
    {- Creates a modeless table browser for a particular table. }
    procedure slServerAttach(aServerIndex: LongInt);
    {- event-handler for server attaches}
    procedure StatusComment(aMsg: string);
    {- Displays a message in the status bar}
    procedure UncheckMenuGroupSiblings(aMenuItem: TMenuItem);
    {- Unchecks all the menu items in the same menu group as the given item
       (primary for compatibility with Delphi 1) }
    procedure UpdateWindowsMenuItems;                                 {!!.06}
    {- populates the Windows menu with the current
       table- and SQL-browser windows }
  end;

var
  frmMain: TfrmMain;

implementation

uses
  {$IFDEF USETeDEBUG}
  jcldebug,
  {$ENDIF}
  ffclbase,                                                            {!!.07}
  ffllcomm,                                                            {!!.07}
  ffclreng,                                                            {!!.07}
  ffclcfg,                                                             {!!.07}
  ffutil,
  uFFComms,                                                            {!!.07}
  {$IFDEF DCC6OrLater}
  Types,                                                               {!!.07}
  {$ENDIF}
  ffabout,
  ubase,
  uconsts,
  dgaddals,
  dgimport,
  dgregsrv,
  dgselidx,
  ffllexcp,                                                            {!!.01}
  fmprog,
  fmstruct,
  dgautoin,
  dgtable,
  dgquery,
  dgServSt;                                                            {!!.11}

{$R *.DFM}

const
  { Outline levels for schema entities }
  lvServer   = 1;
  lvDatabase = 2;
  lvTable    = 3;

{===TffeOutlineData==================================================}
type
  { This is the data kept by each outline entry to refer it to
    the underlying data structure. }
  TffeOutlineData = class
    public
      EntityType: TffeEntityType;
      Entity : TffeEntityItem;
      constructor Create(aEntityType: TffeEntityType; anEntity : TffeEntityItem);
  end;


constructor TffeOutlineData.Create(aEntityType: TffeEntityType;
                                   anEntity : TffeEntityItem);
begin
  inherited Create;
  EntityType := aEntityType;
  Entity := anEntity;
end;
{====================================================================}

{===TfrmMain=========================================================}
function TfrmMain.AddOutlineDatabase(aNode : TTreeNode;
                                     aDatabase : TffeDatabaseItem) : TTreeNode;
var
  OutlineData: TffeOutlineData;
begin
  Result := nil;
  OutlineData := TffeOutlineData.Create(etDatabase, aDatabase);
  with outServers do
    with TffeOutlineData(aNode.Data) do
      case EntityType of
        etServer:
          Result := Items.AddChildObject(aNode, aDatabase.DatabaseName,
                                         OutlineData);
        etDatabase:
          Result := Items.AddObject(aNode, aDatabase.DatabaseName,
                                    OutlineData);
      end;
  if assigned(Result) then begin
    Result.ImageIndex := pred(lvDatabase);
    Result.SelectedIndex := Result.ImageIndex;
    Result.HasChildren := True;
  end;
  outServers.AlphaSort;
end;
{--------}
procedure TfrmMain.AddOutlineServer(aServer : TffeServerItem);
var
  Node : TTreeNode;
  OutlineData: TffeOutlineData;
  aProtocol : TffCommsProtocolClass;
  aProtocolName : TffShStr;


  {Begin !!.07}
  { removes leading zeroes in order to compare ip addresses
    like 192.000.001.001 against 192.0.1.1 - necessary because
    FFCOMMS might register addresses with extra 0's }
  function StripLeadingZeros(servername : String) : String;
  var
    s : String;
  begin
    Result := '';
    { while characters in string do }
    while (Length(servername)>0) do begin
      { if first char not a number}
      if NOT (servername[1] IN ['0'..'9']) then begin
        { move char to result }
        Result := Result + servername[1];
        Delete(servername, 1, 1);
      end
      else begin
        s := '';
        { collect numbers up to next non-numerical char }
        while (Length(servername)>0) and (servername[1] IN ['0'..'9']) do begin
          s := s + servername[1];
          Delete(servername, 1, 1);
        end;
        { strip leading zeroes and add to Result }
        Result := Result + IntToStr(StrToInt(s));
      end;
    end;
  end;
  {End !!.07}

begin
  OutlineData := TffeOutlineData.Create(etServer, aServer);
  with outServers do
    Node := Items.AddObject(outServers.TopItem, aServer.ServerName, OutlineData);
  if assigned(Node) then begin
    {Begin !!.07}
    { check if the server is the default for the workstation
      and use a different glyph if so }
    FFClientConfigReadProtocol(aProtocol, aProtocolName);
    if (FFGetProtocolString(aServer.Protocol)=aProtocolName) and
       ((aServer.Protocol=ptSingleUser) or
       (StripLeadingZeros(FFClientConfigReadServerName)=StripLeadingZeros(aServer.ServerName))) then begin
      Node.ImageIndex := 12;
    end
    else
    {End !!.07}
      Node.ImageIndex := pred(lvServer);
    Node.SelectedIndex := Node.ImageIndex;
    Node.HasChildren := True;
  end;
  outServers.AlphaSort;
end;
{--------}
procedure TfrmMain.AddOutlineTable(aNode : TTreeNode; aTable : TffeTableItem);
var
  Node : TTreeNode;
  OutlineData: TffeOutlineData;
begin
  Node := nil;
  OutlineData := TffeOutlineData.Create(etTable, aTable);
  with outServers do
    with TffeOutlineData(aNode.Data) do
      case EntityType of
        etDatabase:
          Node := Items.AddChildObject(aNode, aTable.TableName, OutlineData);
        etTable:
          Node := Items.AddObject(aNode, aTable.TableName, OutlineData);
      end;
  if assigned(Node) then begin
    Node.ImageIndex := pred(lvTable);
    Node.SelectedIndex := Node.ImageIndex;
    Node.HasChildren := False;
  end;
  outServers.AlphaSort;
end;
{--------}
procedure TfrmMain.DeleteNodeChildren(aNode : TTreeNode);
var
  aChild : TTreeNode;
begin
  with outServers do begin
    Items.BeginUpdate;
    try
      with aNode do begin
        aChild := GetFirstChild;
        while assigned(aChild) do begin
          if assigned(aChild.Data) then begin
            DeleteNodeChildren(aChild);
            TffeOutlineData(aChild.Data).free;
          end;
          aChild := GetNextChild(aChild);
        end;
      end;
      aNode.DeleteChildren;
    finally
      Items.EndUpdate;
    end;
  end;
end;
{--------}
function TfrmMain.DoAttach(aNode : TTreeNode) : TffResult;             {!!.01}
var
  aServer : TffeServerItem;
begin
  aServer := TffeServerItem(TffeOutlineData(aNode.Data).Entity);
  try
    Result := aServer.Attach(logMain);                                 {!!.01}
    if Result = DBIERR_NONE then begin                                 {!!.01}
      LoadOutlineDatabases(aNode);                                     {!!.01}
      Config.LastServer := aServer.ServerName;                         {!!.01}
    end;                                                               {!!.01}
  except
    on E: EffDatabaseError do begin                                    {!!.01}
      if E.ErrorCode = 11278 then
        raise EffDatabaseError.CreateFmt('Unable to connect. "%S" is currently unavailable',
                                         [aServer.EntityName])
      else
        raise;
    end;                                                               {!!.01}
  end;
end;
{--------}
procedure TfrmMain.DoDetach;
var
  aServer : TffeServerItem;
begin
  aServer := TffeServerItem(GetSelectedEntity);
  if assigned(aServer) then begin
    outServers.Selected.Collapse(True);
    DeleteNodeChildren(outServers.Selected);
    aServer.Detach;
    outServers.Selected.HasChildren := True;
  end;
end;
{--------}
procedure TfrmMain.EnableScreen(aSwitch: Boolean);
begin
  if aSwitch then Application.ProcessMessages;
  mnuServer.Enabled := aSwitch;
  mnuOptions.Enabled := aSwitch;
end;
{--------}
function TfrmMain.GetEntityNode(aEntityType: TffeEntityType;
                                anEntity: TffeEntityItem): TTreeNode;
var
  I : longInt;
begin
  Result := nil;
  with outServers do
    for I := 0 to pred(Items.Count) do
      with TffeOutlineData(Items[I].Data) do
        if (EntityType = aEntityType) and
           (Entity = anEntity) then begin
          Result := Items[I];
          Break;
        end;
end;
{--------}
function TfrmMain.GetNodeEntity(aNode : TTreeNode) : TffeEntityItem;
begin
  Result := TffeOutlineData(aNode.Data).Entity;
end;
{--------}
function TfrmMain.GetNodeEntityType(aNode : TTreeNode) : TffeEntityType;
begin
  Result := TffeOutlineData(aNode.Data).EntityType;
end;
{--------}
function TfrmMain.GetSelectedEntity : TffeEntityItem;
begin
  Result := TffeOutlineData(outServers.Selected.Data).Entity;
end;
{--------}
procedure TfrmMain.Initialize;
begin
  try
    Initialized := False;
    if not assigned(ServerList) then begin
      ServerList := TffeServerList.Create(logMain);
      ServerList.OnAttach := slServerAttach;
    end;
    LoadOutlineServers;
  except
    on E:Exception do
      showMessage(E.Message);
  end;
end;
{--------}
procedure TfrmMain.LoadConfig;
begin
  { Set window coordinates }
  WindowState := Config.WindowState;
  if (WindowState <> wsMaximized) and (Config.Window.Bottom <> 0) then
    with Config do begin
      Left   := Window.Left;
      Top    := Window.Top;
      Width  := Window.Right - Config.Window.Left;
      Height := Window.Bottom - Config.Window.Top;
    end;
  mnuOptionsLiveDataSets.Checked := coLiveDatasets in Config.Options;
  tbOptionsLiveDataSets.Down := mnuOptionsLiveDataSets.Checked;    {!!.06}
end;
{--------}
procedure TfrmMain.OutlineClear;
var
  Index : longInt;
begin
  { Free the TffeOutlineData structures associated with the nodes. }
  with outServers do begin
    for Index := 0 to pred(Items.Count) do
      if assigned(Items[Index].Data) then
        TffeOutlineData(Items[Index].Data).Free;
  end;
  outServers.Items.Clear;
end;
{--------}
procedure TfrmMain.LoadOutlineServers;
var
  aNode : TTreeNode;
  Server : TffeServerItem;
  S : LongInt;
  DefaultServerName: TffNetAddress;
  OldCursor: TCursor;
begin

  OutlineClear;

  { Load up the registered servers into the outline }
  StatusComment('Searching for active FlashFiler servers...');
  mnuServer.Enabled := False;
  outServers.Enabled := False;
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  try
    ServerList.Load;

    { Load up all the servers into the outline }
    for S := 0 to ServerList.Count - 1 do
      AddOutlineServer(ServerList.Items[S]);

    { Find the default server }
    DefaultServerName := Config.LastServer;
    if DefaultServerName <> '' then begin
      S := ServerList.IndexOfName(DefaultServerName);
      if S <> -1 then begin
        Server := ServerList.Items[S];
        aNode := GetEntityNode(etServer, Server);
{Begin !!.01}
        { Attached to server? }
        if DoAttach(aNode) = DBIERR_NONE then
          { Expand the attached server.  If the server has only one
            database then expand the database too. }
          aNode.Expand(Server.DatabaseCount = 1);
{End !!.01}
      end;
    end;
    outServers.AlphaSort;
  finally
    Screen.Cursor := OldCursor;
    outServers.Invalidate;
    StatusComment('');
    if outServers.Items.Count = 0 then
      StatusComment('No active FlashFiler servers found.');
    Screen.Cursor := OldCursor;
    mnuServer.Enabled := True;
    outServers.Enabled := True;
  end;
end;
{--------}
procedure TfrmMain.LoadOutlineDatabases(aNode : TTreeNode);
{ For a given server entry in the outline, load all of its member
  databases into the outline }
var
  D : longInt;
  Server : TffeServerItem;
begin

  Server := TffeServerItem(TffeOutlineData(aNode.Data).Entity);

  if (not Server.Attached) then
    if DoAttach(aNode) <> DBIERR_NONE then                             {!!.01}
      Exit;                                                            {!!.01}

  { Delete all the children of this server }
  DeleteNodeChildren(aNode);

  { Load the databases into the outline; we assume the server's database list &
    table list have already been populated. }
  for D := 0 to pred(Server.DatabaseCount) do
    AddOutlineDatabase(aNode, Server.Databases[D]);

  outServers.AlphaSort;
end;
{--------}
procedure TfrmMain.LoadOutlineTables(aNode : TTreeNode);
var
  Database : TffeDatabaseItem;
  T: LongInt;
begin
  { If we're pointing to a table entry, kick up to the table's
    database entry }
  with TffeOutlineData(aNode.Data) do
    if EntityType = etTable then begin
      aNode := aNode.Parent;
      outServers.Selected := aNode;
    end;
  Database := TffeDatabaseItem(TffeOutlineData(aNode.Data).Entity);

  outServers.Items.BeginUpdate;
  try
    { Delete all the children of this database }
    DeleteNodeChildren(aNode);

    { Load the database's tables. }
    Database.LoadTables;

    { Load the database's tables into the outline }
      for T := 0 to pred(Database.TableCount) do
        AddOutlineTable(aNode, Database.Tables[T]);
    outServers.AlphaSort;    
  finally
    outServers.Items.EndUpdate;
  end;

end;
{--------}
procedure TfrmMain.SaveConfig;
begin
  if Assigned(Config) then begin
    with Config do begin
      Window := Bounds(Left, Top, Width, Height);
      Options := [];
    end;
    Config.WindowState := WindowState;
    Config.Options := [];
    if mnuOptionsLiveDataSets.Checked then
      Config.Options := [coLiveDataSets];

    Config.Save;
  end;
end;
{--------}
procedure TfrmMain.ShowQueryWindow(aDatabaseIndex : LongInt);
var
  dummy: Boolean;
begin
  { implicitly check valid directory }
  outServersExpanding(outServers, outServers.Selected, dummy);                    {!!.07}
  with TdlgQuery.create(nil) do begin
    {Begin !!.07}
    { If we're pointing to a table entry, get the table's
      database entry from the parent }
    if TffeOutlineData(outServers.Selected.Data).EntityType = etTable then begin
      DatabaseItem := TffeDatabaseItem(TffeOutlineData(outServers.Selected.Parent.Data).Entity);
      ServerName := outServers.Selected.Parent.Parent.Text;
      DatabaseName := outServers.Selected.Parent.Text;
      Protocol := TffeDatabaseItem(TffeOutlineData(outServers.Selected.Parent.Data).Entity).Server.Protocol;
      InitialStatement := 'SELECT * FROM ' +
                          TffeTableItem(TffeOutlineData(outServers.Selected.Data).Entity).TableName;
      with TffexpSession(TffeDatabaseItem(TffeOutlineData(outServers.Selected.Parent.Data).Entity).Database.Session) do begin
        Password := ffePassword;
        UserName := ffeUserName;
      end;
    end
    else
    begin
      DatabaseItem := TffeDatabaseItem(GetSelectedEntity);
      ServerName := outServers.Selected.Parent.Text;
      DatabaseName := outServers.Selected.Text;
      Protocol := TffeDatabaseItem(GetSelectedEntity).Server.Protocol;
      with TffexpSession(TffeDatabaseItem(GetSelectedEntity).Database.Session) do begin
        Password := ffePassword;
        UserName := ffeUserName;
      end;
    end;
    {End !!.07}
    Log := LogMain;                                                    {!!.02}
    Show;
  end;
end;
{--------}
procedure TfrmMain.ShowTableBrowser(aTable : TffeTableItem);
var
  OldCursor: TCursor;
  aTableDlg : TdlgTable;
begin
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  try
    aTableDlg := TdlgTable.Create(Application);                       {!!.02}
    with aTableDlg do begin
      TableItem := aTable;                                            {!!.10}
      Protocol := aTable.Server.Protocol;                             {!!.07}
      ServerName := aTable.Server.ServerName;
      DatabaseName := aTable.Database.DatabaseName;
      TableName := aTable.TableName;
      UserName := TffexpSession(aTable.Table.Session).ffeUserName;
      Password := TffexpSession(aTable.Table.Session).ffePassword;
      ReadOnly := (not mnuOptionsLiveDataSets.Checked);
      Log := LogMain;                                                  {!!.02}
      Show;
    end;
  finally
    Screen.Cursor := OldCursor;
  end;
end;
{--------}
procedure TfrmMain.slServerAttach(aServerIndex: LongInt);
begin
  StatusComment('');
end;
{--------}
procedure TfrmMain.StatusComment(aMsg: string);
begin
  pnlStatusBarComment.Caption := ' ' + aMsg;
  Application.ProcessMessages;
end;
{====================================================================}

{===Form-level event handlers========================================}
procedure TfrmMain.ApplicationEvents1Exception(Sender: TObject; E: Exception);
{$IFDEF USETeDEBUG}
var
  i : Integer;
  sl : TSTringList;
{$ENDIF}
begin
  {$IFDEF USETeDEBUG}
  sl := TSTringList.Create;
  try
    sl.Add(E.Message);
    if JclLastExceptStackList <> nil then
      JclLastExceptStackList.AddToStrings(sl);
    for i := 0 to sl.Count-1 do
      logMain.WriteString(sl[i]);
    Application.ShowException(E);
  finally
    sl.Free;
  end;
  {$ELSE}
  Application.ShowException(E);
  {$ENDIF}
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  { write log to app directory }
  logMain.FileName := Config.WorkingDirectory + ChangeFileExt(ExtractFileName(Application.ExeName), '.LOG');      {!!.11}
  Application.OnException := ApplicationEvents1Exception;
  HelpContext := hcMainOutline;
  Initialized := False;

  if FileExists(ExtractFilePath(ParamStr(0)) + 'FFE.HLP') then
    Application.HelpFile := ExtractFilePath(ParamStr(0)) + 'FFE.HLP'
  else
    Application.HelpFile := ExtractFilePath(ParamStr(0)) + '..\HELP\FFE.HLP';

  mnuOptionsLiveDataSets.Checked := True;
  tbOptionsLiveDataSets.Down := mnuOptionsLiveDataSets.Checked;    {!!.06}

  LoadConfig;

  Application.OnMessage := AppMessage;
  Application.OnIdle := DoIdle;
end;
{Begin !!.02}
{--------}
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
var
  Idx : Integer;
begin
  for Idx := 0 to Pred(Screen.FormCount) do
    if (Screen.Forms[Idx] is TdlgTable) or
       (Screen.Forms[Idx] is TdlgQuery) or
       (Screen.Forms[Idx] is TdlgServerStats) then                 {!!.11}
    Screen.Forms[Idx].Close;
end;
{End !!.02}
{--------}
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  ClosingApp := True;
  outServers.onClick := nil;
  ServerList.Free;
  SaveConfig;
  OutlineClear;
end;
{====================================================================}

{===Server menu event handlers=======================================}
procedure TfrmMain.mnuServerRefreshClick(Sender: TObject);
begin
  LoadOutlineServers;
end;
{--------}
procedure TfrmMain.mnuServerRegisterClick(Sender: TObject);
begin
  if ShowRegisteredServersDlg = mrOK then
    LoadOutlineServers;
end;
{--------}
procedure TfrmMain.mnuServerExitClick(Sender: TObject);
begin
  Close;
end;

{ "Options" menu event-handlers }

procedure TfrmMain.mnuOptionsPrintSetupClick(Sender: TObject);
begin
  dlgPrinterSetup.Execute;
end;
{====================================================================}

{===Help menu event handlers=========================================}
procedure TfrmMain.mnuHelpTopicsClick(Sender: TObject);
begin
  Application.HelpCommand(HELP_FINDER, 0);
end;
{--------}
procedure TfrmMain.mnuHelpAboutClick(Sender: TObject);
var
  AboutBox : TFFAboutBox;
begin
  AboutBox := TFFAboutBox.Create(Application);
  try
    AboutBox.Caption := 'About FlashFiler Explorer';
    AboutBox.ProgramName.Caption := 'FlashFiler Explorer';
    AboutBox.ShowModal;
  finally
    AboutBox.Free;
  end;
end;
{--------}
procedure TfrmMain.mnuHelpWebSiteClick(Sender: TObject);
begin
  ShellToWWW;
end;
{--------}
procedure TfrmMain.mnuHelpEMailClick(Sender: TObject);
begin
  ShellToEMail;
end;
{====================================================================}

{===Server outline event handlers====================================}
procedure TfrmMain.outServersClick(Sender: TObject);
{ Set the popup menu depending on which level we are on }
begin
  with outServers do begin
    if assigned(Selected) then
      case TffeOutlineData(Selected.Data).EntityType of
        etServer:
          begin
            PopupMenu := popmnuServer;
          end;
        etDatabase:
          begin
            PopupMenu := popmnuAlias;
          end;
        etTable:
          begin
            PopupMenu := popmnuTable;
          end;
      end;
  end;
end;
{--------}
procedure TfrmMain.outServersCompare(Sender: TObject; Node1,
  Node2: TTreeNode; Data: Integer; var Compare: Integer);
begin
  Compare := FFAnsiCompareText(Node1.Text, Node2.Text);               {!!.07}
end;
{--------}
procedure TfrmMain.outServersMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  aNode : TTreeNode;
begin
  if Button = mbRight then begin
    aNode := outServers.GetNodeAt(X,Y);
    if assigned(aNode) and assigned(aNode.Data) then begin
      outServers.Selected := aNode;
      case TffeOutlineData(aNode.Data).EntityType of
        etServer:   PopupMenu := popmnuServer;
        etDatabase: PopupMenu := popmnuAlias;
        etTable:    PopupMenu := popmnuTable;
      end;
      PopupMenu.Popup(ClientToScreen(Point(X, Y)).X + 5,
                      ClientToScreen(Point(X, Y)).Y + 5);
    end;
  end;
end;
{====================================================================}

{===Server outline context menus event handlers======================}
procedure TfrmMain.popmnuServerPopup(Sender: TObject);
var
  Entity : TffeEntityItem;
begin
  Entity := TffeOutlineData(outServers.Selected.Data).Entity;
  popmnuServerAttach.Enabled := not TffeServerItem(Entity).Attached;
  popmnuServerDetach.Enabled := not popmnuServerAttach.Enabled;
  popmnuServerNewDatabase.Enabled := not popmnuServerAttach.Enabled;
end;
{--------}
procedure TfrmMain.popmnuServerAttachClick(Sender: TObject);
var
  aNode : TTreeNode;
  Server : TffeServerItem;
begin

  aNode := outServers.Selected;
{Begin !!.01}
  if DoAttach(aNode) = DBIERR_NONE then begin
    Server := TffeServerItem(GetSelectedEntity);

    { Expand the attached server.  If it has only one database then expand
      the database too. }
    aNode.Expand(Server.DatabaseCount = 1);
  end;
{End !!.01}
end;
{--------}
procedure TfrmMain.popmnuServerDetachClick(Sender: TObject);
begin
  DoDetach;
end;
{--------}
procedure TfrmMain.RefreshServers(Sender: TObject);
begin
  LoadOutlineServers;
end;
{--------}
procedure TfrmMain.RefreshDatabases(Sender: TObject);
var
  aNode : TTreeNode;
  OldCursor : TCursor;
  Server : TffeServerItem;
begin
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  outServers.Items.BeginUpdate;
  try
    { Get the server. }
    aNode := outServers.Selected;
    Server := TffeServerItem(GetNodeEntity(aNode));
    Server.LoadDatabases;
    LoadOutlineDatabases(aNode);
    aNode.Expand(False);
  finally
    outServers.Items.EndUpdate;
    Screen.Cursor := OldCursor;
  end;
end;
{--------}
procedure TfrmMain.RefreshTables(Sender: TObject);
var
  aNode : TTreeNode;
  Database : TffeDatabaseItem;
  OldCursor : TCursor;
begin
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  outServers.Items.BeginUpdate;
  try
    { Get the database. }
    aNode := outServers.Selected;
    Database := TffeDatabaseItem(GetNodeEntity(aNode));
    Database.LoadTables;
    LoadOutlineTables(aNode);
    aNode.Expand(True);
  finally
    outServers.Items.EndUpdate;
    Screen.Cursor := OldCursor;
  end;
end;
{--------}
procedure TfrmMain.popmnuDatabaseNewTableClick(Sender: TObject);
var
  Database : TffeDatabaseItem;
  TableIndex: LongInt;
  dummy : Boolean;
begin
  { make sure tablelist is loaded; implicitly checks for valid directory }
  outServersExpanding(outServers, outServers.Selected, dummy);              {!!.06}
  Database := TffeDatabaseItem(GetSelectedEntity);
  with outServers do
    if ShowCreateTableDlg(Database, TableIndex, nil) = mrOK then begin
      LoadOutlineTables(Selected);
      Selected.Expand(False);
    end;
end;
{--------}
procedure TfrmMain.popmnuServerNewDatabaseClick(Sender: TObject);
var
  aDatabase : TffeDatabaseItem;
  anEntity : TffeEntityItem;
  aNode : TTreeNode;
  Server : TffeServerItem;
begin
  aDatabase := nil;
  Server := nil;
  aNode := outServers.Selected;
  anEntity := TffeOutlineData(aNode.Data).Entity;
  case anEntity.EntityType of
    etServer :
      Server := TffeServerItem(anEntity);
    etDatabase :
      begin
        aNode := aNode.Parent;
        Server := TffeServerItem(TffeOutlineData(aNode.Data).Entity);
      end;
  end;

  with outServers do begin
    if ShowAddAliasDlg(Server, aDatabase) = mrOK then
      LoadOutlineTables
        (AddOutlineDatabase(aNode, aDatabase));
    AlphaSort;
  end;
end;
{--------}
function TfrmMain.GetNewSelectedNode(aNode : TTreeNode) : TTreeNode;
begin
  { Does the node have a previous sibling? }
  Result := aNode.Parent.GetPrevChild(aNode);
  if not assigned(Result) then begin
    { No previous sibling.  See if has next sibling. }
    Result := aNode.Parent.GetNextChild(aNode);
    if not assigned(Result) then
      { No siblings.  Default to parent node. }
      Result := aNode.Parent;
  end;
end;
{--------}
procedure TfrmMain.popmnuDatabaseDeleteClick(Sender: TObject);
var
  aNode : TTreeNode;
  Database : TffeDatabaseItem;
begin
  Database := TffeDatabaseItem(GetSelectedEntity);
  if MessageDlg('Delete ' + Database.DatabaseName + '?',
                mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
    Screen.Cursor := crHourglass;
    try

      { Delete the database from the server. }
      Database.Server.DropDatabase(Database.DatabaseName);

      { Delete database from outline }
      with outServers do begin
        aNode := Selected;
        if assigned(aNode.Data) then
          TffeOutlineData(aNode.Data).free;
        Selected := GetNewSelectedNode(aNode);
        Items.Delete(aNode);
      end;
    finally
      Screen.Cursor := crDefault;
    end;
  end;
end;
{--------}
procedure TfrmMain.popmnuDatabaseRenameClick(Sender: TObject);
begin
  outServers.Selected.EditText;
end;
{--------}
procedure TfrmMain.popmnuDatabaseImportSchemaClick(Sender: TObject);
var
  Database : TffeDatabaseItem;
  TableIndex: LongInt;
  dummy : Boolean;
begin
  outServersExpanding(outServers, outServers.Selected, dummy);
  TableIndex := -1;
  Database := TffeDatabaseItem(GetSelectedEntity);
  with outServers do begin
    ShowImportDlg(Database, TableIndex);
    if TableIndex <> -1 then {we have a new table}
      AddOutlineTable(Selected, Database.Tables[TableIndex]);
  end;
end;
{--------}
procedure TfrmMain.popmnuTablePopup(Sender: TObject);
var
  Table : TffeTableItem;
  I: Integer;
begin
  Table := TffeTableItem(GetSelectedEntity);
  with Table do
    with popmnuTable do begin
      if Rebuilding then begin
        for I := 0 to Items.Count - 1 do
          Items[I].Enabled := False;
        popmnuTableNew.Enabled := True;
      end
      else
        for I := 0 to Items.Count - 1 do
          Items[I].Enabled := True;
    end;
end;
{--------}
procedure TfrmMain.popmnuTableDefinitionClick(Sender: TObject);
var
  Database : TffeDatabaseItem;
  Table    : TffeTableItem;
begin
  Table := TffeTableItem(GetSelectedEntity);
  Database := Table.Database;
  ShowViewTableStructureDlg(Database, Database.IndexOf(Table), vtViewFields);
end;
{--------}
procedure TfrmMain.popmnuTableIndexesClick(Sender: TObject);
var
  Database : TffeDatabaseItem;
  Table    : TffeTableItem;
begin
  Table := TffeTableItem(GetSelectedEntity);
  Database := Table.Database;
  ShowViewTableStructureDlg(Database, Database.IndexOf(Table), vtViewIndexes);
end;
{--------}
procedure TfrmMain.popmnuTableNewClick(Sender: TObject);
var
  Database : TffeDatabaseItem;
  Table    : TffeTableItem;
  TableIndex : longInt;
begin
  Table := TffeTableItem(GetSelectedEntity);
  Database := Table.Database;
  TableIndex := Database.IndexOf(Table);
  with outServers do
    if ShowCreateTableDlg(Database, TableIndex, nil) = mrOK then
      LoadOutlineTables(outServers.Selected);
//      AddOutlineTable(Selected, Table);
end;
{--------}
procedure TfrmMain.popmnuTableDeleteClick(Sender: TObject);
var
  aNode : TTreeNode;
  Table : TffeTableItem;
begin
  Table := TffeTableItem(GetSelectedEntity);
  if MessageDlg(Format('Delete table %s?', [Table.TableName]),
                mtConfirmation,
                [mbYes, mbNo],
                0) = mrYes then begin
    Screen.Cursor := crHourglass;
    try
      Table.Database.DropTable(Table.Database.IndexOf(Table));

      { Remove table from tree view. }
      with outServers do begin
        aNode := Selected;
        if assigned(aNode.Data) then
          TffeOutlineData(aNode.Data).free;
        Selected := GetNewSelectedNode(aNode);
        aNode.Delete;
      end;
    finally
      Screen.Cursor := crDefault;
    end;
  end;
end;
{--------}
procedure TfrmMain.popmnuTablePackClick(Sender: TObject);
var
  aNode : TTreeNode;
  Status: TffRebuildStatus;
  RebuildDone: Boolean;
  Table : TffeTableItem;
  PromptMsg : string;                                                  {!!.10}
  StatusMsg : string;                                                  {!!.10}
begin
  PromptMsg := 'Are you sure you want to pack/reindex this table?';    {!!.10}
  StatusMsg := 'Packing';                                              {!!.10}

  if MessageDlg(PromptMsg, mtConfirmation,                             {!!.10}
                [mbYes, mbNo], 0) = mrYes then begin

    aNode := outServers.Selected;
    Table := TffeTableItem(GetNodeEntity(aNode));

    with Table do begin
      Pack;

      if Rebuilding then begin

        { Change the display in the outline; table will be unavailable
          until the rebuild is done. }
        aNode.Text := TableName + ' (packing)';
        try
          Application.ProcessMessages;

          { Display the rebuild progress window }
          with TfrmRebuildStatus.Create(nil) do
          try
            ShowProgress(StatusMsg, TableName);                        {!!.10}
            try
              repeat
                CheckRebuildStatus(RebuildDone, Status);
                if not RebuildDone then begin
                  UpdateProgress(RebuildDone, Status);
                  Sleep(250);
                end;
              until RebuildDone;
            finally
              Hide;
            end;
          finally
            Free;
          end;
        finally
          aNode.Text := TableName;
        end;
      end;
    end;
  end;
end;
{--------}
procedure TfrmMain.popmnuTableReindexClick(Sender: TObject);
var
  aNode : TTreeNode;
  IndexNum: Integer;
  RebuildDone: Boolean;
  Status: TffRebuildStatus;
  Table : TffeTableItem;
begin
  Table := TffeTableItem(GetSelectedEntity);
  if SelectIndexDlg(Table, IndexNum) = mrOk then begin
    aNode := outServers.Selected;

    with Table do begin
      Reindex(IndexNum);

      { Change the display in the outline; table will be unavailable
        until the rebuild is done. }
      aNode.Text := TableName + ' (reindexing)';
      try
        Application.ProcessMessages;

        { Display the rebuild progress window }
        with TfrmRebuildStatus.Create(nil) do
        try
          ShowProgress('Reindexing', TableName);
          try
            repeat
              CheckRebuildStatus(RebuildDone, Status);
              if not RebuildDone then begin
                UpdateProgress(RebuildDone, Status);
                Sleep(250);
              end;
            until RebuildDone;
          finally
            Hide;
          end;
        finally
          Free;
        end;
      finally
        aNode.Text := TableName;
      end;
    end;
  end;
end;
{--------}
procedure TfrmMain.popmnuTableRedefineClick(Sender: TObject);
var
  aNode : TTreeNode;
  Status: TffRebuildStatus;
  RebuildDone: Boolean;
  Database : TffeDatabaseItem;
  Table    : TffeTableItem;
  TableIndex : longInt;
  UnableToOpen : Boolean;
begin
  Table := TffeTableItem(GetSelectedEntity);
  Database := Table.Database;
  TableIndex := Database.IndexOf(Table);
  with outServers do begin
    if Table.Table.Active then
      Table.Table.Close;
    Table.Table.Exclusive := True;
    try
      Screen.Cursor := crHourGlass;
      try
        Table.Table.Open;
        Table.Table.Close;
        UnableToOpen := False;
      finally
        Table.Table.Exclusive := False;
        Screen.Cursor := crDefault;
      end;
    except
      UnableToOpen := True;
    end;
    if UnableToOpen then begin
      MessageDlg('Unable to gain exclusive access to the table. Restructure operation '
                 + #13 + #10 + 'cannot contiue.', mtInformation, [mbOK], 0);
      Exit;
    end;
    if ShowRestructureTableDlg(Database, TableIndex) = mrOK then begin
      aNode := outServers.Selected;

      with Table do begin
        if Rebuilding then begin

          { Change the display in the outline; table will be unavailable
            until the rebuild is done. }
          aNode.Text := TableName + ' (restructuring)';
          try
            Application.ProcessMessages;

            { Display the rebuild progress window }
            with TfrmRebuildStatus.Create(nil) do
            try
              ShowProgress('Restructuring', TableName);
              try
                repeat
                  CheckRebuildStatus(RebuildDone, Status);
                  if not RebuildDone then begin
                    UpdateProgress(RebuildDone, Status);
                    Sleep(250);
                  end;
                until RebuildDone;
              finally
                Hide;
              end;
              Check(Status.rsErrorCode);
            finally
              Free;
            end;
          finally
            aNode.Text := TableName;
          end;
        end;
      end;
    end;
  end;
  if Table.Table.Active then                                                    {!!.06}
    Table.Table.Close                                                           {!!.06}
end;
{--------}
procedure TfrmMain.popmnuTableImportSchemaClick(Sender: TObject);
var
  Database : TffeDatabaseItem;
  Table    : TffeTableItem;
  TableIndex : longInt;
begin
  Table := TffeTableItem(GetSelectedEntity);
  Database := Table.Database;
  TableIndex := Database.IndexOf(Table);

  with outServers do begin
    ShowImportDlg(Database, TableIndex);
    if TableIndex <> -1 then {we have a new table}
      AddOutlineTable(Selected, Table);
  end;
end;
{--------}
procedure TfrmMain.popmnuTableEmptyClick(Sender: TObject);
var
  aSavCursor : TCursor;                                                {!!.01}
  aTable : TffeTableItem;
begin
  aTable := TffeTableItem(GetSelectedEntity);
  with aTable do begin
    Table.DisableControls;
    try
//      if not Table.Active or not Table.Exclusive then begin          {Deleted !!.01}
        with Table do begin
          Close;
          Exclusive := True;
          Open;
        end;
//      end;                                                           {Deleted !!.01}

      if RecordCount = 0 then
        ShowMessage('Table is already empty')
      else begin
        if MessageDlg('Delete all records in ' + TableName + '?',
                      mtWarning, [mbYes, mbNo], 0) = mrYes then begin
          aSavCursor := Screen.Cursor;                                 {!!.01}
          Screen.Cursor := crHourglass;
          try
            Table.EmptyTable;
          finally
//            Table.Close;                                             {Deleted !!.01}
//            Table.Exclusive := False;                                {Deleted !!.01}
            Screen.Cursor := aSavCursor;                               {!!.01}
          end;
        end;
      end;
    finally
      Table.Close;                                                     {!!.01}
      Table.Exclusive := False;                                        {!!.01}
      Table.EnableControls;
    end;
  end;
end;
{--------}
procedure TfrmMain.ExitBtnClick(Sender: TObject);
begin
  Close;
end;
{--------}
procedure TfrmMain.UncheckMenuGroupSiblings(aMenuItem: TMenuItem);
var
  I: Integer;
begin
  with aMenuItem.Parent do begin
    for I := 0 to Count - 1 do
      if (Items[I] <> aMenuItem) and (Items[I].GroupIndex = aMenuItem.GroupIndex) then
        Items[I].Checked := False;
  end;
end;
{--------}
procedure TfrmMain.mnuSetAutoIncClick(Sender: TObject);
var
  aTable : TffeTableItem;
  Seed : TffWord32;                                                {!!.10}
begin
  aTable := TffeTableItem(GetSelectedEntity);
  Seed := aTable.GetAutoInc;
  with aTable do begin
    if ShowAutoIncDlg(TableName, Seed) = mrOK then
      SetAutoIncSeed(Seed);
  end;
end;
{--------}
procedure TfrmMain.outServersDblClick(Sender: TObject);
var
  aTable : TffeTableItem;
//  dummy : boolean;
begin
  with outServers do begin
    if assigned(Selected) then
      case TffeOutlineData(Selected.Data).EntityType of
        etServer:
          begin
            PopupMenu := popmnuServer;
//            outServersExpanding(outServers, outServers.Selected, dummy);
          end;
        etDatabase:
          begin
            PopupMenu := popmnuAlias;
//            outServersExpanding(outServers, outServers.Selected, dummy);
          end;
        etTable:
          begin
            aTable := TffeTableItem(GetSelectedEntity);
            PopupMenu := popmnuTable;
            ShowTableBrowser(aTable);
          end;
      end;
  end;
end;
{--------}
{function TfrmMain.mapProtocolClassToProtocol(const Protocol : TffCommsProtocolClass) : TffProtocolType;
begin
  if (Protocol = TffTCPIPProtocol) then
    result := ptTCPIP
  else if (Protocol = TffIPXSPXProtocol) then
    result := ptIPXSPX
  else
    result := ptSingleUser;
end;}
{--------}
procedure TfrmMain.mnuOptionsLiveDatasetsClick(Sender: TObject);
var                                                                      {!!.01}
  Idx : Integer;                                                         {!!.01}
begin
  mnuOptionsLiveDataSets.Checked := not mnuOptionsLiveDataSets.Checked;
  tbOptionsLiveDataSets.Down := mnuOptionsLiveDataSets.Checked;          {!!.06}
  with Config do
    if mnuOptionsLiveDataSets.Checked then
      Options := Options + [coLiveDatasets]
    else
      Options := Options - [coLiveDatasets];

  for Idx := 0 to Pred(Screen.FormCount) do                        {BEGIN !!.01}
    if Screen.Forms[Idx] is TdlgTable then
      with TdlgTable(Screen.Forms[Idx]) do begin
        ReadOnly := not mnuOptionsLiveDataSets.Checked;
        UpdateDisplay;
      end;                                                           {END !!.01}
end;
{--------}
procedure TfrmMain.outServersExpanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
var
  aData : TffeOutlineData;
begin
  aData := TffeOutlineData(Node.Data);
  AllowExpansion := aData.EntityType in [etServer, etDatabase];

  { If we can expand and the node currently has no children, go grab the
    children. }
  if AllowExpansion and (Node.Count = 0) then begin
    case aData.EntityType of
      etServer :
        LoadOutlineDatabases(Node);
      etDatabase :
        LoadOutlineTables(Node);
    end;  { case }
{Begin !!.01}
    if Node.Expanded then begin
      Node.HasChildren := (Node.Count > 0);
      AllowExpansion := Node.HasChildren;
    end;
{End !!.01}
  end;
end;
{--------}
procedure TfrmMain.outServersEditing(Sender: TObject; Node: TTreeNode;
  var AllowEdit: Boolean);
begin
  AllowEdit := GetNodeEntityType(Node) in [etDatabase, etTable];
end;
{--------}
procedure TfrmMain.outServersEdited(Sender: TObject; Node: TTreeNode;
  var S: String);
var
  OldCursor : TCursor;
begin
  { Perform the rename. }
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  try
    case GetNodeEntityType(Node) of
      etDatabase :
        begin
          TffeDatabaseItem(GetNodeEntity(Node)).Rename(S);
          Node.Text := S;
          LoadOutlineServers;                                            {!!.01}
        end;
      etTable :
        begin
          TffeTableItem(GetNodeEntity(Node)).Rename(S);
          Node.Text := S;
        end;
    end;
  finally
    Screen.Cursor := OldCursor;
  end;
end;
{--------}
{$IFNDEF DCC6OrLater}
function CenterPoint(const Rect: TRect): TPoint;
begin
  with Rect do
  begin
    Result.X := (Right - Left) div 2 + Left;
    Result.Y := (Bottom - Top) div 2 + Top;
  end;
end;
{$ENDIF}
{--------}
procedure TfrmMain.outServersKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  aNode : TTreeNode;
begin
  { If user presses F2 then edit current node. }
  if (Key = VK_F2) and assigned(outServers.Selected) then
    outServers.Selected.EditText
  else if Key = VK_RETURN then
    outServersDblClick(nil)
  {Begin !!.07}
  { support the windows keyboard context menu key }
  else if (Key = VK_APPS) or
          ((Shift = [ssShift]) and (Key = VK_F10)) then begin
    aNode := outServers.Selected;
    if assigned(aNode) and assigned(aNode.Data) then begin
      case TffeOutlineData(aNode.Data).EntityType of
        etServer:   PopupMenu := popmnuServer;
        etDatabase: PopupMenu := popmnuAlias;
        etTable:    PopupMenu := popmnuTable;
      end;
      PopupMenu.Popup(ClientToScreen(CenterPoint(aNode.DisplayRect(True))).X + 5,
                      ClientToScreen(CenterPoint(aNode.DisplayRect(True))).Y + 5);
    end;
  end;
  {End !!.07}
end;
{--------}
procedure TfrmMain.mnuViewTableClick(Sender: TObject);
begin
  outServersDblClick(nil);
end;
{--------}
procedure TfrmMain.mnuDatabaseSQLClick(Sender: TObject);
begin
  ShowQueryWindow(0);
end;
{Begin !!.06}
{--------}
procedure TfrmMain.mnuCloseAllClick(Sender: TObject);
var
  Idx : Integer;
begin
  for Idx := 0 to Pred(Screen.FormCount) do
    if (Screen.Forms[Idx] is TdlgTable) or
       (Screen.Forms[Idx] is TdlgQuery) then
    Screen.Forms[Idx].Close;
end;
{End !!.06}

{Begin !!.06}
{--------}
procedure TfrmMain.UpdateWindowsMenuItems;
var
  Count,
  Idx : Integer;
  NewItem : TMenuItem;
Begin
  { ensure windows are closed first }
  Application.ProcessMessages;
  { remove all items - requires that mnuWindowsSplitter is the last
    item in the menu at designtime! }
  while mnuWindows.Items[mnuWindows.Count-1]<>mnuWindowsSplitter do
    mnuWindows.Delete(mnuWindows.Count-1);
  { add back existing forms }
  Count := 1;
  { note: it varies between Delphi versions wether new forms are added
    at the beginning or end of the Screen.Forms array. The code below
    assumes it is compiled with Delphi 6. The last opened window should
    appear at the bottom of the menu. If it appears at the top, switch
    the loop parameters around. }
  for Idx := Pred(Screen.FormCount) downto 0 do
    if (Screen.Forms[Idx] is TdlgTable) or
       (Screen.Forms[Idx] is TdlgQuery) or
       (Screen.Forms[Idx] is TfrmTableStruct) then begin             {!!.11}
      NewItem := TMenuItem.Create(NIL);
      NewItem.Caption := Screen.Forms[Idx].Caption;
      if Count<=9 then
        NewItem.Caption := '&' + IntToStr(Count) + ' ' + NewItem.Caption;
      Inc(Count);
      NewItem.OnClick := WindowsMenuItemClick;
      NewItem.Tag := Integer(Screen.Forms[Idx]);
      mnuWindows.Add(NewItem);
    end;
end;
{End !!.06}

{Begin !!.06}
{--------}
procedure TfrmMain.WindowsMenuItemClick(Sender: TObject);
begin
  if (Sender IS TMenuItem) AND
      Assigned(Pointer(TMenuItem(Sender).Tag)) then
    TForm(TMenuItem(Sender).Tag).BringToFront;
end;
{End !!.06}

{Begin !!.06}
{--------}
procedure TfrmMain.mnuWindowsClick(Sender: TObject);
begin
  { we only update the menu when the user actually clicks it. the update
    executes so fast that the user won't notice anyway. }
  UpdateWindowsMenuItems;
  mnuCloseAll.Enabled := Screen.FormCount>1;
  tbCloseAll.Enabled := mnuCloseAll.Enabled;
end;
{End !!.06}

{Begin !!.06}
{--------}
procedure TfrmMain.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
  Idx : Integer;
begin
  { trap ALT-F6 keypresses and make the next window in the
    window list active }
  if (Msg.message = WM_SYSKEYDOWN) and
     (Msg.wparam = VK_F6) then
  begin
    if (Screen.FormCount>1) and
       (Screen.ActiveForm is TfrmMain) or
       (Screen.ActiveForm is TdlgTable) or
       (Screen.ActiveForm is TdlgQuery) or
       (Screen.ActiveForm is TfrmTableStruct) then begin          {!!.11}
      Idx := 0;
      { find index of active form }
      while (Idx<Screen.FormCount) and
            (Screen.ActiveForm<>Screen.Forms[Idx]) do
        Inc(Idx);
      { note: it may be that the code below will fail, depending on what delphi
        version it is compiled with and how that delphi version updates the
        Screen.Forms array. the code below works with Delphi 6. }
      { if at start of array, wrap around, else pick previous in list }
      if Idx=0 then
        Screen.Forms[Pred(Screen.FormCount)].BringToFront
      else
        Screen.Forms[Idx-1].BringToFront;
    end;
    Handled := True;
  end;
  { for all other messages, Handled remains False }
  { so that other message handlers can respond }
end;
{End !!.06}
{Begin !!.06}
{--------}
procedure TfrmMain.DoIdle(Sender: TObject; var Done: Boolean);
var
  Idx : Integer;
begin
  { to ensure the toolbutton is correctly updated }
  for Idx := 0 to Pred(Screen.FormCount) do
    if (Screen.Forms[Idx] is TdlgTable) or
       (Screen.Forms[Idx] is TdlgQuery) then begin
      tbCloseAll.Enabled := True;
      Exit;
    end;
  tbCloseAll.Enabled := False;
end;
{End !!.06}
{Begin !!.07}
procedure TfrmMain.mnuToolsFFCommsClick(Sender: TObject);
begin
  with uFFComms.TfrmFFCommsMain.Create(Self) do
  try
    Caption := 'Set Default Server';
//    Label3.Visible := False;
    if ShowModal=mrOK then
      Initialize;
  finally
    Free;
  end;
end;
{End !!.07}
{Begin !!.07}
procedure TfrmMain.mnuSetAsAutomaticDefaultClick(Sender: TObject);
begin
  { leave servername alone if SUP, like FFCOMMS does }
  if TffeServerItem(GetSelectedEntity).Protocol=ptSingleUser then
    FFClientConfigWriteProtocolName(ffc_SingleUser)
  else begin
    if TffeServerItem(GetSelectedEntity).Protocol=ptTCPIP then
      FFClientConfigWriteProtocolName(ffc_TCPIP)
    else
    if TffeServerItem(GetSelectedEntity).Protocol=ptIPXSPX then
      FFClientConfigWriteProtocolName(ffc_IPXSPX);
    FFClientConfigWriteServerName(TffeServerItem(GetSelectedEntity).ServerName);
  end;
  Initialize;
end;
{End !!.07}
procedure TfrmMain.outServersChange(Sender: TObject; Node: TTreeNode);
begin
  outServersClick(Sender);
end;

procedure TfrmMain.outServersContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
begin
{}
end;

{Begin !!.11}
procedure TfrmMain.popmnuServerRefreshClick(Sender: TObject);
begin
  RefreshDatabases(Sender);
end;

{--------}
procedure TfrmMain.ShowServerStatistics(aServer : TffeServerItem);
var
  OldCursor: TCursor;
  dlgServerStats : TdlgServerStats;
begin
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  try
    dlgServerStats := TdlgServerStats.Create(Application);                       {!!.02}
    with dlgServerStats do begin
      Log := LogMain;
      Protocol := aServer.Protocol;
      ServerName := aServer.ServerName;
      UserName := TffexpSession(aServer.Session).ffeUserName;
      Password := TffexpSession(aServer.Session).ffePassword;
      Show;
    end;
  finally
    Screen.Cursor := OldCursor;
  end;
end;


procedure TfrmMain.popmnuServerStatisticsClick(Sender: TObject);
var
  anEntity : TffeEntityItem;
  Server : TffeServerItem;
begin
  anEntity := TffeOutlineData(outServers.Selected.Data).Entity;
  Server := TffeServerItem(anEntity);
  ShowServerStatistics(Server);
end;


procedure TfrmMain.mnuOptionsSetDefaultTimeoutClick(Sender: TObject);
var
  sTimeout : String;
  res : Boolean;
  Idx : Integer;
begin
  sTimeout := IntToStr(Config.DefaultTimeout);
  repeat
    res := InputQuery('Default Timeout (ms)', 'Value:', sTimeout);
    if res then
    try
      Config.DefaultTimeout := StrToInt(sTimeout);
      if Config.DefaultTimeout<-1 then
        raise EConvertError.Create('');
      {Begin !!.11}
      { set default timeout on open servers, tables and queries }
      for idx := 0 to ServerList.Count - 1 do
        if Assigned(ServerList.Items[idx].Client) then
          ServerList.Items[idx].Client.TimeOut := Config.DefaultTimeout;
      for Idx := 0 to Pred(Screen.FormCount) do
        if (Screen.Forms[Idx] is TdlgTable) then
           TdlgTable(Screen.Forms[Idx]).UpdateDefaultTimeout
        else
        if (Screen.Forms[Idx] is TdlgQuery) then
           TdlgQuery(Screen.Forms[Idx]).UpdateDefaultTimeout;
      {End !!.11}
      res := False;
    except
      on EConvertError do begin
        MessageDlg('Value must be a number between -1 and '+IntToStr(MaxInt), mtError, [mbOK], 0);
      end;
    end;
  until not res;
end;
{End !!.11}
end.