You've already forked lazarus-ccr
27aea1d1ad
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5438 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1938 lines
58 KiB
ObjectPascal
1938 lines
58 KiB
ObjectPascal
{*********************************************************}
|
|
{* 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.
|
|
|