{ -----------------------------------------------------------------------
Tcl Scripting Language Components (Tslc)
Copyright (C) 1996-2002 William Byrne

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

WilliamB@ByrneLitho.com
------------------------------------------------------------------------}
unit TclDbDef;

///////////////////////////////////////////////////////////////////////////////
//
//  TclDbTbl.pas
//	Copyright(c) 1996-1997 William Byrne
//		WilliamB@ByrneLitho.com
//		76262.13@CompuServe.com
//
//	All rights reserved.
//  	William Byrne makes no representations about the suitability of this
//    	software for any purpose.  It is provided "as is" without express or
//    	implied warranty.
//
//	Usage
//      I hereby grant to the legal purchasors of the source code contained
//      herein a non-exclusive license for the use of said source code in
//      developing compiled, executable software, and for the distribution of
//      said source code as part of said developed, compiled, executable software.
//
//  Purpose:
//		This file provides for Bde Table Manipulation using the
//		Tcl Scripting Language Components.
//
//	Editor:
//		Tab stops = 4
//		Page width = 132 characters
//		Font = Courier New, 8pt
//
//  Misc:
//      ??? = Note to self


interface

// The Unit Defines the TTclCmdDbDef class that's derived from TTclCommandDesc
// TTclCmdDbDef makes BDE table definition structures and operations available in scripts.

uses Windows, Classes, SysUtils, Bde, TclTk, Tslc, TclDbPro, Db, DbTables, BdeMisc, BdeClass, DynaData;


Type

    TTclCmdSession = class(TTclCommandBDE)
    private
        FSession: TSession;
    	FFilter: string;
        FPassword: string;
        FOptDesc: TBDEOptDesc;
        FSystem: bool;
        FOverWrite: boolean;
        FLockBox: boolean;
        FClone: boolean;
        FAutoFree: boolean;
		FPasswordScript: string;
        FPasswordInterp: pTcl_Interp;
        
        // filter
		procedure _f(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
        // lockbox
		procedure _l(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
        // password
		procedure _p(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// system
		procedure _s(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// overWrite
		procedure _w(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// options
        procedure _o(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);

	    procedure PasswordHandler(Sender: TObject; var continue: boolean);
    protected
		procedure DoCommand(var result: string; var success: boolean); override;
        procedure DoInterpDelete(AInterp: pTcl_Interp); override;
		procedure DoPrepare(var result: string; var success: boolean); override;
        procedure DoScriptDelete(AInterp: pTcl_Interp); override;
		procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    public
		constructor Create(AOwner: TComponent; ASessionName: string; AClone, AAutoFree: boolean);
		destructor Destroy; override;

        property Session: TSession read FSession;

    end;

    TTclCmdDatabase = class(TTclCommandBDE)
    private
        FDatabase: TDatabase;
        FClone: boolean;

    protected
		procedure DoCommand(var result: string; var success: boolean); override;
        procedure DoInterpDelete(AInterp: pTcl_Interp); override;
		procedure DoPrepare(var result: string; var success: boolean); override;
        procedure DoScriptDelete(AInterp: pTcl_Interp); override;
		procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    public
		constructor Create(AOwner: TComponent; ADatabaseName: pChar; AClone: boolean);
		destructor Destroy; override;

        property Database: TDatabase read FDatabase;

    end;

	TTclCmdDbDef = class;
	TTclCmdDataSource = class;
    TTclTraceField = class(TTclTrace)
    private
    	FParentInterp: pTcl_Interp;
    	FField: TField;
        FDataSource: TDataSource;
        FFieldName: string;
        FSettingVar: boolean;
    protected
    	procedure DataChange;
        procedure StateChange;
        procedure DoInterpDelete(AInterp: pTcl_Interp); override;
        procedure DoTrace(AVarName, AElemName: string; flags: TTclFlags; var result: string; var success: boolean); override;
		procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    public
		constructor Create(AOwner: TComponent; AVarName, AFieldName: string);
        destructor Destroy; override;
        property FieldName: string read FFieldName;
    end;

    TTclCmdDataSource = class(TTclCommandBDE)
    private
    	FDataSource: TDataSource;
        FCmdDataSet: TTclCmdDbDef;
        FTraceList: TList;
        FDataChangeList, FStateChangeList, FUpdateDataList: TStrings;
        FDataSema, FStateSema, FUpdateSema: integer;
        FEventCall: boolean;
		procedure _e(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
 		procedure DataChange(Sender: TObject; Field: TField);
        procedure StateChange(Sender: TObject);
        procedure UpdateData(Sender: TObject);
     protected
		function AddLinkVar(varName, fieldName: string): string;
        procedure RemoveLinkVar(varName, fieldName: string);

		procedure EvalList(list: TStrings);
        function EventData(list: TStrings; id: string): string;
        function EventAdd(var list: TStrings; data: string; eventCall: boolean): string;
        procedure EventDelete(list: TStrings; id: string);
        function EventList(list: TStrings): string;
		function ListId(list: TStrings; id: string): integer;
		function ListName(list: TStrings): string;
		function ListSema(list: TStrings): integer;
		procedure DoCommand(var result: string; var success: boolean); override;
        procedure DoInterpDelete(AInterp: pTcl_Interp); override;
		procedure DoPrepare(var result: string; var success: boolean); override;
        procedure DoScriptDelete(AInterp: pTcl_Interp); override;
		procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    public
		constructor Create(AOwner: TComponent);
        destructor Destroy; override;
    end;


	TTclCmdDbDef = class(TTclCommandDesc)
	private
        FFlags: TRestructureOptions;
		FPassword, FSaveAs: string;
        FLockBox: boolean; // data attached to -p switch is a lockbox not a password
		FOverWrite: boolean;
        FLanguage: string;
        FOptCount: integer;
		FProc: TTclCommandEvent;

		// Switch procedures that are linked to script command switches in Create constructor

		// language
		procedure _l(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// driver
		procedure _d(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// saveAs
		procedure _a(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// keyViol
		procedure _k(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// problems
		procedure _x(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// password
		procedure _p(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		procedure _lockbox(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// fieldDesc
		procedure _f(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// indexDesc
		procedure _i(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// refInt
		procedure _r(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// security
		procedure _s(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// valChecks
		procedure _v(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// overWrite
		procedure _w(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
		// options
        procedure _o(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);

		// Operational procedures that are linked to script command parameters in Create constructor

		procedure _FldDesc(Sender: TTclCommand; var result: string; var success: boolean);
		procedure _IdxDesc(Sender: TTclCommand; var result: string; var success: boolean);
		procedure _RefDesc(Sender: TTclCommand; var result: string; var success: boolean);
		procedure _SecDesc(Sender: TTclCommand; var result: string; var success: boolean);
		procedure _ValDesc(Sender: TTclCommand; var result: string; var success: boolean);

		// Wrapper functions for the above five functions
		function EvalFldDesc: string;
		function EvalIdxDesc: string;
		function EvalRefDesc: string;
		function EvalSecDesc: string;
		function EvalValDesc: string;

	protected

		procedure DoCommand(var result: string; var success: boolean); override;
        procedure DoInterpDelete(AInterp: pTcl_Interp); override;
		procedure DoPrepare(var result: string; var success: boolean); override;
        procedure DoScriptDelete(AInterp: pTcl_Interp); override;

        function GetDataSet: TDataSet; virtual; abstract;

		function GetOverWrite: boolean; virtual;
        function GetPassword: string; virtual;
        function GetSaveAs: string; virtual;

		// help
        procedure _Help(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean); virtual;

        procedure SetOverWrite(value: boolean); virtual;
        procedure SetPassword(value: string); virtual;
        procedure SetSaveAs(value: string); virtual;


	public
		constructor Create(AOwner: TComponent);
		destructor Destroy; override;

        procedure AddOption(option: string);

        property Flags: TRestructureOptions read FFlags;
        property OverWrite: boolean read GetOverWrite write SetOverWrite;
        property Password: string read GetPassword write SetPassword;
        property SaveAs: string read GetSaveAs write SetSaveAs;

	end;

function DataSetFromCommand(AInterp: pTcl_Interp; command: string): TDataSet; // Throws ETclError
function DataSourceFromCommand(AInterp: pTcl_Interp; command: string): TDataSource; // Throws ETclError

implementation
uses TslcUtil, TslcPlat, TslcHash, uTslcUti, TslcLock, TslcKey, DBPWDlg;


function DataSetFromCommand(AInterp: pTcl_Interp; command: string): TDataSet;
var
	cmd: TTclCommand;
begin
	cmd := TslcFindCommand(AInterp, command);
    if cmd is TTclCmdDbDef then
    	result := (cmd as TTclCmdDbDef).GetDataSet
    else
    	TclErrorFmt('%s is not a ::TslcBDE::DataSet command', [command]);
end;

function DataSourceFromCommand(AInterp: pTcl_Interp; command: string): TDataSource;
var
	cmd: TTclCommand;
begin
	cmd := TslcFindCommand(AInterp, command);
    if cmd is TTclCmdDataSource then
    	result := (cmd as TTclCmdDataSource).FDataSource
    else
    	TclErrorFmt('%s is not a ::TslcBDE::DataSource command', [command]);
end;

function TruthDef(value: string; def: boolean): boolean;
begin
	if value = '' then
    	result := def
    else
    	result := TslcStrTruth(value);
end;

// constants used in DoCommand methods
const
	hash_					: integer = 0;
    hashACTIVE				: integer = 0;
    hashKEEPCONNECTIONS		: integer = 0;
    hashNETFILEDIR			: integer = 0;
    hashPRIVATEDIR			: integer = 0;
    hashSESSIONNAME			: integer = 0;

    hashADDALIAS			: integer = 0;
    hashDELETEALIAS			: integer = 0;
    hashISALIAS				: integer = 0;
    hashALIASPATH			: integer = 0;
    hashMODIFYALIAS			: integer = 0;
    hashGETALIASDRIVERNAME	: integer = 0;
    hashADDPASSWORD			: integer = 0;
    hashREMOVEPASSWORD		: integer = 0;
    hashREMOVEALLPASSWORDS	: integer = 0;

    hashALIASNAME			: integer = 0;
    hashCONNECTED			: integer = 0;
    hashDATABASENAME		: integer = 0;
    hashDATASET				: integer = 0;
    hashDATASETS			: integer = 0;
    hashDRIVERNAME       	: integer = 0;
    hashISSQLBASED			: integer = 0;
	hashKEEPCONNECTION		: integer = 0;
    hashLOGINPROMPT			: integer = 0;
    hashPARAMS				: integer = 0;
    hashCLOSEDATASETS		: integer = 0;
    hashCOMMIT				: integer = 0;
    hashROLLBACK			: integer = 0;
    hashSTARTTRANSACTION	: integer = 0;
    hashTRANSISOLATION		: integer = 0;
    hashTABLELIST			: integer = 0;
    hashFINDDATABASE		: integer = 0;
	hashGETTABLEOPENCOUNT	: integer = 0;

    hashFREE		: integer = 0;
    hashOPEN		: integer = 0;
    hashCLOSE		: integer = 0;
    hashINFO		: integer = 0;
    hashRESTRUCTURE	: integer = 0;
    hashCREATETABLE	: integer = 0;
	hashADD			: integer = 0;
    hashINSERT		: integer = 0;
	hashDELETE		: integer = 0;
	hashCOUNT		: integer = 0;
    hashVALUE		: integer = 0;
	hashNUM			: integer = 0;
	hashNAME		: integer = 0;
	hashTYPE		: integer = 0;
	hashTBLNAME		: integer = 0;
    hashTABLENAME	: integer = 0;
	hashTBLTYPE 	: integer = 0;
    hashTABLETYPE	: integer = 0;
	hashDBNAME		: integer = 0;
    hashDBTYPE		: integer = 0;
    hashDATABASETYPE: integer = 0;
	hashLANG		: integer = 0;
    hashLANGUAGE	: integer = 0;
    hashDRIVER		: integer = 0;
	hashMODOP		: integer = 0;
	hashDELOP		: integer = 0;
	hashFLDCOUNT	: integer = 0;
	hashTHISTBLFLD	: integer = 0;
	hashOTHTBLFLD	: integer = 0;
	hashOP			: integer = 0;
	hashFLDNUM		: integer = 0;
	hashREQUIRED	: integer = 0;
	hashMIN			: integer = 0;
	hashMAX			: integer = 0;
	hashDEF			: integer = 0;
	hashPICT		: integer = 0;
	hashREQ			: integer = 0;
	hashBYTES		: integer = 0;
	hashPURGE		: integer = 0;
	hashSERIALIZE	: integer = 0;
	hashFLDTYPE		: integer = 0;
	hashSUBTYPE		: integer = 0;
	hashUNITS1		: integer = 0;
	hashUNITS2		: integer = 0;
	hashOFFSET		: integer = 0;
	hashLEN			: integer = 0;
	hashNULLOFFSET	: integer = 0;
	hashVCHK		: integer = 0;
	hashRIGHTS		: integer = 0;
	hashCALCFIELD	: integer = 0;
	hashINDEXID		: integer = 0;
	hashTAGNAME		: integer = 0;
	hashFORMAT		: integer = 0;
	hashPRIMARY		: integer = 0;
	hashUNIQUE		: integer = 0;
	hashDESC		: integer = 0;
	hashMAINT		: integer = 0;
	hashSUBSET		: integer = 0;
	hashEXPIDX		: integer = 0;
	hashCOST		: integer = 0;
	hashFLDSINKEY	: integer = 0;
	hashKEYLEN		: integer = 0;
	hashOUTOFDATE	: integer = 0;
	hashKEYEXPTYPE	: integer = 0;
	hashKEYFLD		: integer = 0;
	hashKEYEXP		: integer = 0;
	hashKEYCOND		: integer = 0;
	hashCASEINS		: integer = 0;
	hashBLOCKSIZE	: integer = 0;
	hashRESTRNUM	: integer = 0;
	hashDESCFLDS	: integer = 0;
	hashSECNUM		: integer = 0;
	hashTABLE		: integer = 0;
	hashFAMRIGHTS	: integer = 0;
	hashPASSWORD	: integer = 0;
	hashFLD			: integer = 0;
    hashSWAP		: integer = 0;
    hashLOADFILE	: integer = 0;
    hashSAVEFILE	: integer = 0;
    hashLOADSTREAM	: integer = 0;
    hashSAVESTREAM	: integer = 0;
    hashONPASSWORD	: integer = 0;
    hashLINKVAR		: integer = 0;
    hashUNLINKVAR	: integer = 0;
    hashLIST		: integer = 0;
    hashSTATE		: integer = 0;
	hashONDATACHANGE	: integer = 0;
    hashONSTATECHANGE	: integer = 0;
    hashONUPDATEDATA	: integer = 0;

// TTclCmdSession
// filter
procedure TTclCmdSession._f(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	FFilter := Sender.Split(ASwitch);
end;

// lockbox
procedure TTclCmdSession._l(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	FLockBox := TslcStrTruth(Sender.SplitDef(ASwitch, '+'));
end;

// password
procedure TTclCmdSession._p(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	FPassword := Sender.Split(ASwitch);
end;

// system
procedure TTclCmdSession._s(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	FSystem := TslcStrTruth(Sender.SplitDef(ASwitch, '+'));
end;

// overWrite
procedure TTclCmdSession._w(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	FOverWrite := TslcStrTruth(Sender.SplitDef(ASwitch, '+'));
end;

// options
procedure TTclCmdSession._o(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	FOptDesc.AddOption(Sender.Split(ASwitch));
end;


constructor TTclCmdSession.Create(AOwner: TComponent; ASessionName: string; AClone, AAutoFree: boolean);
	procedure GenSwitch(sw: string; proc: TTclCmdSwitchEvent);
	var
		s: TTclCmdSwitch;
	begin
		s := TTclCmdSwitch.Create(Self);
		s.Switch := sw;
		s.OnSwitch := proc;
		s.Command := self;
	end;
const
	cSyntax = 'Syntax: Session ...'; // ???
begin
	FClone := AClone;
    if AAutoFree then
    	Options := Options + [coAutoFree];
	if FClone then
    begin
    	FSession := Sessions.FindSession(ASessionName);
        if FSession = nil then
        	TclErrorFmt('Could not clone session: %s', [ASessionName]);
        FSession.FreeNotification(self);
    end else
    begin
	    FSession := TSession.Create(nil);
        FSession.SessionName := ASessionName;
    end;
    FSession.OnPassword := PasswordHandler;
	inherited Create(AOwner);
    Command := ASessionName;
	FOptDesc := TBDEOptDesc.Create(8, 512);


    GenSwitch('f', _f);
	GenSwitch('l', _l);
	GenSwitch('p', _p);
	GenSwitch('s', _s);
	GenSwitch('w', _w);
    GenSwitch('o', _o);


	MinArgs := 1;
	MaxArgs := Byte(MaxInt);
	ErrorMsg := cSyntax;

end;

destructor TTclCmdSession.Destroy;
begin
	inherited Destroy;
    if not FClone then
		FSession.Free;
    FOptDesc.Free;
end;

procedure TTclCmdSession.Notification(AComponent: TComponent; Operation: TOperation);
begin
	inherited Notification(AComponent, Operation);
    if (AComponent = FSession) and (Operation = opRemove) and FClone then
    	Free;
end;

procedure TTclCmdSession.PasswordHandler(Sender: TObject; var continue: boolean);
begin
    if FPasswordInterp <> nil then
    begin
    	if Tcl_Eval(FPasswordInterp, pChar(FPasswordScript)) <> TCL_ERROR then
	       	continue := Tcl_GetStringResult(FPasswordInterp) = 'continue'
        else
        	continue := False;
    end else
    begin
    	TslcEnterCritical;
        try
			continue := PasswordDialog(Session)
        finally
        	TslcLeaveCritical;
        end;
    end;
end;

procedure TTclCmdSession.DoPrepare(var result: string; var success: boolean);
begin
	FPassword := '';
    FLockBox := False;
    FSystem := False;
    FFilter := '';
    FOptDesc.Close;
    FOverwrite := False;
end;

procedure TTclCmdSession.DoInterpDelete(AInterp: pTcl_Interp);
begin
	if AInterp = FPasswordInterp then
    	FPasswordInterp := nil;
end;

procedure TTclCmdSession.DoCommand(var result: string; var success: boolean);
var
	hDb: hDBIDb;
	hCur: hDBICur;
	baseDesc: TBLBaseDesc; // Second arg to DbiOpenTableList false
    fullDesc: TBLFullDesc; // Second arg to DbiOpenTableList true (extended info)
	list: TStringList;
    dbPath: string;
    str: string;
    param: string;
    p: pChar;
    pOpt: pFLDDesc;
    pData: ^BYTE;
    pFilter: pChar;
    optCount: integer;
	cnt, x, hash: integer;
    cmd: TTclCommand;
begin
	cnt := ParamValuesCount;
	hash := HashValues[0];
	if hash = hashACTIVE then
    begin
		result := BoolStr[FSession.Active];
        if cnt = 2 then
        	FSession.Active := TslcStrTruth(ParamValues[1])
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashFINDDATABASE then
    begin
		if cnt <> 2 then
        	TclError(ErrorMsg);
        result := ParamValues[1];
        if TslcFindCommand(Interp, ParamValues[1]) is TTclCmdDatabase then
			exit
        else
        begin
			cmd := TTclCmdDatabase.Create(Owner, pChar(result), True);
            with cmd do
		    try
    			Install(Self.Interp);
		    except
    			Free;
	        	raise;
    		end;
        end;
		exit;
    end;
    if hash = hashKEEPCONNECTIONS then
    begin
    	result := BoolStr[FSession.KeepConnections];
        if cnt = 2 then
        	FSession.KeepConnections := TslcStrTruth(ParamValues[1])
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashNETFILEDIR then
    begin
		result := FSession.NetFileDir;
        if cnt = 2 then
        	FSession.NetFileDir := ParamValues[1]
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashPRIVATEDIR then
    begin
		result := FSession.PrivateDir;
        if cnt = 2 then
        	FSession.PrivateDir := ParamValues[1]
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashSESSIONNAME then
    begin
		result := FSession.SessionName;
        if cnt = 2 then
        	FSession.SessionName := ParamValues[1]
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashOPEN then
    begin
    	if cnt <> 1 then
        	TclError(ErrorMsg);
        FSession.Open;
        exit;
    end;
    if hash = hashCLOSE then
    begin
    	if cnt <> 1 then
        	TclError(ErrorMsg);
        FSession.Close;
    	exit;
    end;
    if hash = hashTABLELIST then
    begin
    	if cnt <> 2 then
        	TclError(ErrorMsg);
	   	dbPath := ParamValues[1];
       	if FPassword <> '' then
           	p := pChar(FPassword)
        else
           	p := nil;
        if FFilter <> '' then
           	pFilter := pChar(FFilter)
        else
        	pFilter := nil;
        optCount := FOptDesc.Count;
        if optCount > 0 then
        begin
        	pData := FOptDesc.Data;
            pOpt := FOptDesc.GetDescPointer;
        end else
        begin
        	pData := nil;
            pOpt := nil;
        end;
		// TclCmd_DB.Options has coCatchAll set to catch all exceptions; otherwise, traverses back into Tcl engine (not good.)
		list := TStringList.Create;
		try
			Check(DbiOpenDatabase(pChar(dbPath), nil, dbiReadOnly, dbiOpenShared, p, optCount, pOpt, pData, hDb));
			try
				Check(DbiOpenTableList(hDb, False, FSystem, pFilter, hCur));
		        try
					while DbiGetNextRecord(hCur, dbiNOLOCK, @baseDesc, nil) = DBIERR_NONE do
    	            	list.Add(UpperCase(baseDesc.szName));
					result := MergeList(list); // Make into a Tcl list
	    	    finally
	        		Check(DbiCloseCursor(hCur));
		        end;
            finally
		    	Check(DbiCloseDatabase(hDb));
    		end;
	    finally
			list.Free;
	    end;
    	exit;
    end;
    if (hash = hashADDPASSWORD) or (hash = hashREMOVEPASSWORD) then
    begin
    	if cnt < 2 then
        	TclError(ErrorMsg);
   		for x := 1 to cnt - 1 do
        begin
            if FLockBox then        
	            LockBoxGetStr(Interp, ParamValues[x], str, TslcGetSecondaryKey)
            else
				str := ParamValues[x];
    		if hash = hashADDPASSWORD then
            	FSession.AddPassword(str)
            else
            	FSession.RemovePassword(str);
        end;
    	exit;
    end;
    if hash = hashREMOVEALLPASSWORDS then
    begin
    	if cnt <> 1 then
        	TclError(ErrorMsg);
       	FSession.RemoveAllPasswords;
    	exit;
    end;
    if hash = hashGETALIASDRIVERNAME then
    begin
    	if cnt <> 2 then
        	TclError(ErrorMsg);
       	result := FSession.GetAliasDriverName(ParamValues[1]);
        exit;
    end;
    if hash = hashADDALIAS then
    begin
       	if (cnt <> 3) then
           	TclError(ErrorMsg);
		list := TStringList.Create;
        try
           	FOptDesc.ToStrings(list); // Using options switch to store params
            FSession.AddAlias(ParamValues[1], ParamValues[2], list);
            if FOverWrite then
            	FSession.SaveConfigFile; // writes all data!!!
        finally
        	list.free;
        end;
	    exit;
	end;
    if hash = hashDELETEALIAS then
    begin
       	if cnt <> 2 then
           	TclError(ErrorMsg);
        FSession.DeleteAlias(ParamValues[1]);
        if FOverWrite then
    	    FSession.SaveConfigFile;
        exit;
    end;
    if hash = hashISALIAS then
    begin
    	if cnt <> 2 then
        	TclError(ErrorMsg);
        if FSession.IsAlias(ParamValues[1]) then
        	result := '1'
        else
        	result := '0';
        exit;
    end;
    if hash = hashALIASPATH then
    begin
    	if cnt <> 2 then
        	TclError(ErrorMsg);
        list := TStringList.Create;
        try
        	FSession.GetAliasParams(ParamValues[1], list);
            result := list.Values['PATH'];
        finally
        	list.Free;
        end;
        exit;
    end;
    if hash = hashMODIFYALIAS then
    begin
       	if (cnt <> 2) then
           	TclError(ErrorMsg);
		list := TStringList.Create;
        try
           	FOptDesc.ToStrings(list); // Using options switch to store params
            FSession.ModifyAlias(ParamValues[1], list);
            if FOverWrite then
            	FSession.SaveConfigFile; // writes all data!!!
        finally
        	list.free;
        end;
	    exit;
    end;
    if hash = hashONPASSWORD then
    begin
    	if cnt = 1 then
        	result := FPasswordScript
        else
        begin
			FPasswordScript := ParamValues[1];
            if FPasswordScript <> '' then
	            FPasswordInterp := Interp
            else
            	FPasswordInterp := nil;
        end;
        exit;
    end;
   	inherited DoCommand(result, success);
end;


procedure TTclCmdSession.DoScriptDelete(AInterp: pTcl_Interp);
begin
	// Assuming that command exists only in a single interpreter. Natural form per class design.
    // ??? should consider multiple interpreters for future...
	Free;
end;

// TTclCmdDatabase
constructor TTclCmdDatabase.Create(AOwner: TComponent; ADatabaseName: pChar; AClone: boolean);
	procedure GenSwitch(sw: string; proc: TTclCmdSwitchEvent);
	var
		s: TTclCmdSwitch;
	begin
		s := TTclCmdSwitch.Create(Self);
		s.Switch := sw;
		s.OnSwitch := proc;
		s.Command := self;
	end;
const
	cSyntax = 'Syntax: Database ...'; // ???
begin
	inherited Create(AOwner);
	FClone := AClone;
	if FClone then
    begin
    	FDatabase := Session.FindDatabase(ADatabaseName);
        if FDatabase = nil then
        	TclErrorFmt('Could not clone database: %s', [ADatabaseName]);
        FDatabase.FreeNotification(self);
    end else
    begin
	    FDatabase := TDatabase.Create(nil);
        FDatabase.DatabaseName := ADatabaseName;
        FDatabase.LoginPrompt := False;
    end;
    Command := ADatabaseName;


	MinArgs := 1;
	MaxArgs := Byte(MaxInt);
	ErrorMsg := cSyntax;

end;

destructor TTclCmdDatabase.Destroy;
begin
	inherited Destroy;
    if not FClone then
		FDatabase.Free;
end;

procedure TTclCmdDatabase.Notification(AComponent: TComponent; Operation: TOperation);
begin
	inherited Notification(AComponent, Operation);
    if (AComponent = FDatabase) and (Operation = opRemove) and FClone then
    	Free;
end;

procedure TTclCmdDatabase.DoInterpDelete(AInterp: pTcl_Interp);
begin
	if InterpreterCount = 0 then
    	Free;
end;

// borrowed from db.pas
function StrToOem(const AnsiStr: string): string;
begin
  SetLength(Result, Length(AnsiStr));
  if Length(Result) > 0 then
    CharToOem(PChar(AnsiStr), PChar(Result));
end;

procedure TTclCmdDatabase.DoPrepare(var result: string; var success: boolean);
begin
end;

procedure TTclCmdDatabase.DoCommand(var result: string; var success: boolean);
const
	TiStr: array[tiDirtyRead..tiRepeatableRead] of pChar = ('DirtyRead', 'ReadCommitted', 'RepeatableRead');

    function StrToTi(str: string): TTransIsolation;
    begin
		for result := tiDirtyRead to tiRepeatableRead do
        	if TslcTextEqual(TiStr[result], str) then
            	exit;
        TclError('Invalid TransIsolation Type');
    end;
var
	cnt, hash, x, y: integer;
    list: TStrings;
    ds: TDataSet;
    w: Word;
    p: pChar;
begin
	cnt := ParamValuesCount;
	hash := HashValues[0];
    if hash = hashALIASNAME then
    begin
    	result := FDatabase.AliasName;
        if cnt = 2 then
        	FDatabase.AliasName := ParamValues[1]
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashDATABASENAME then
    begin
    	result := FDatabase.DatabaseName;
        if cnt = 2 then
        	FDatabase.DatabaseName := ParamValues[1]
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashDATASETS then
    begin
		if cnt <> 1 then
        	TclError(ErrorMsg);
        list := TStringList.Create;
        try
        	y := 0;
        	for x:= 0 to FDatabase.DataSetCount - 1 do
            begin
	            ds := FDatabase.DataSets[x];
                if ds is TTable then
                	list.Add(TTable(ds).TableName)
                else if ds is TQuery then
                begin
                	list.Add(format('Query%d', [y]));
					inc(y);
                end else if ds is TStoredProc then
                	list.Add(TStoredProc(ds).StoredProcName)
                else
                	list.Add('Unknown');
            end;
            result := MergeList(list);
        finally
        	list.Free;
        end;
    end;
    if hash = hashDRIVERNAME then
    begin
		result := FDatabase.DriverName;
        if cnt = 2 then
        	FDatabase.DriverName := ParamValues[1]
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashISSQLBASED then
    begin
    	if cnt <> 1 then
        	TclError(ErrorMsg);
    	result := BoolStr[FDatabase.IsSQLBased];
        exit;
    end;
    if hash = hashPARAMS then
    begin
		if cnt = 1 then
    	begin
			result := MergeList(FDatabase.Params);
            exit;
        end;
		hash := HashValues[1];
        if hash = hashADD then
        begin
        	if cnt <> 3 then
            	TclError(ErrorMsg);
			FDatabase.Params.Add(ParamValues[2]);
            exit;
        end;
        if hash = hashINSERT then
        begin
        	if cnt <> 4 then
            	TclError(ErrorMsg);
            FDatabase.Params.Insert(TslcStrToInt(ParamValues[2]), ParamValues[3]);
            exit;
        end;
        if hash = hashDELETE then
        begin
        	if cnt <> 3 then
            	TclError(ErrorMsg);
            FDatabase.Params.Delete(TslcStrToInt(ParamValues[2]));
            exit;
        end;
        if hash = hashCOUNT then
        begin
        	if cnt <> 2 then
            	TclError(ErrorMsg);
            result := inttostr(FDatabase.Params.Count);
        	exit;
        end;
        if hash = hashVALUE then
        begin
        	if cnt <> 3 then
            	TclError(ErrorMsg);
            result := FDatabase.Params.Strings[TslcStrToInt(ParamValues[2])];
        	exit;
        end;
        TclError(ErrorMsg);
    end;
    if hash = hashCLOSEDATASETS then
    begin
    	if cnt <> 1 then
        	TclError(ErrorMsg);
        FDatabase.CloseDataSets;
        exit;
	end;
    if hash = hashCOMMIT then
    begin
    	if cnt <> 1 then
        	TclError(ErrorMsg);
        FDatabase.Commit;
        exit;
    end;
    if hash = hashROLLBACK then
    begin
    	if cnt <> 1 then
        	TclError(ErrorMsg);
        FDatabase.Rollback;
        exit;
    end;
    if hash = hashSTARTTRANSACTION then
    begin
    	if cnt <> 1 then
        	TclError(ErrorMsg);
        FDatabase.StartTransaction;
        exit;
    end;
    if hash = hashTRANSISOLATION then
    begin
       	result := TiStr[FDatabase.TransIsolation];
        if cnt = 2 then
        	FDatabase.TransIsolation := StrToTi(ParamValues[1])
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
	if hash = hashCONNECTED then
    begin
		result := BoolStr[FDatabase.Connected];
        if cnt = 2 then
        	FDatabase.Connected := TslcStrTruth(ParamValues[1])
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashKEEPCONNECTION then
    begin
    	result := BoolStr[FDatabase.KeepConnection];
        if cnt = 2 then
        	FDatabase.KeepConnection := TslcStrTruth(ParamValues[1])
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashLOGINPROMPT then
    begin
    	result := BoolStr[FDatabase.LoginPrompt];
        if cnt = 2 then
        	FDatabase.LoginPrompt := TslcStrTruth(ParamValues[1])
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashSESSIONNAME then
    begin
		result := FDatabase.SessionName;
        if cnt = 2 then
        	FDatabase.SessionName := ParamValues[1]
        else if cnt > 2 then
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashOPEN then
    begin
    	if cnt <> 1 then
        	TclError(ErrorMsg);
        FDatabase.Open;
        exit;
    end;
    if hash = hashCLOSE then
    begin
    	if cnt <> 1 then
        	TclError(ErrorMsg);
        FDatabase.Close;
    	exit;
    end;
    if hash = hashGETTABLEOPENCOUNT then
    begin
    	if (cnt < 2) or (cnt > 3) then
        	TclError(ErrorMsg);
        if cnt = 3 then
        	p := pChar(StrToOEM(ParamValues[2]))
		else if ExtractFileExt(ParamValues[1]) = '' then
           	p := szPARADOX
        else
        	p := nil;
       	Check(DbiGetTableOpenCount(FDatabase.Handle, pChar(StrToOEM(ParamValues[1])), p, w));
		result := inttostr(w);
        exit;
    end;
   	inherited DoCommand(result, success);
end;

procedure TTclCmdDatabase.DoScriptDelete(AInterp: pTcl_Interp);
begin
	// Assuming that command exists only in a single interpreter. Natural form per class design.
    // ??? should consider multiple interpreters for future...
	Free;
end;


//    TTclTraceField

constructor TTclTraceField.Create(AOwner: TComponent; AVarName, AFieldName: string);
const
	cBufSize = 63;
var
	p: pChar;
	buf: array[0..cBufSize] of char;
begin
	inherited Create(AOwner);

    strplcopy(buf, AFieldName, cBufSize);
 	p := buf; // Clean up unfriendly variable characters
    while p^ <> #0 do
    begin
       	if not (p^ in ['a'..'z']) and not (p^ in ['A'..'Z']) and not (p^ in ['0'..'9']) then
			p^ := '_';
        inc(p);
    end;
    FFieldName := AFieldName;
    VarName := AVarName;
    ElemName := buf;
    Flags := [tfWrites];
end;

destructor TTclTraceField.Destroy;
begin
	inherited Destroy;
end;


procedure TTclTraceField.DataChange;
begin
   	FSettingVar := True;
    try
		if (FField <> nil) and (FParentInterp <> nil) and
	        not Tslc.SetVar(FParentInterp, VarName, ElemName, FField.DisplayText, [tfGlobalOnly]) then
        	TclErrorFmt('Unable to set variable: %s', [Variable]);
    finally
       	FSettingVar := False;
    end;
end;

procedure TTclTraceField.StateChange;
begin
	if FDataSource.State = dsInactive then
    	FField := nil
    else if FField = nil then
    begin
    	FField := FDataSource.DataSet.FieldByName(FFieldName);
    	if FField <> nil then
        	FField.FreeNotification(Self);
	end;
end;

procedure TTclTraceField.DoInterpDelete(AInterp: pTcl_Interp);
begin
	if AInterp = FParentInterp then
		FParentInterp := nil;
//    if InterpreterCount = 0 then
//    	Free;
end;

procedure TTclTraceField.DoTrace(AVarName, AElemName: string; flags: TTclFlags; var result: string; var success: boolean);
var
	value: string;
begin
	if (FSettingVar) or not (tfWrites in flags) or (FField = nil) then
    	exit;
    if not Tslc.GetVar(FParentInterp, AVarName, AElemName, value, [tfGlobalOnly]) then
    	TclErrorFmt('Unable to get variable: %s', [Variable]);
   	FDataSource.Edit;
	FField.AsString := Value
end;

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

// TTclCmdDataSource
constructor TTclCmdDataSource.Create(AOwner: TComponent);
	procedure GenSwitch(sw: string; proc: TTclCmdSwitchEvent);
	var
		s: TTclCmdSwitch;
	begin
		s := TTclCmdSwitch.Create(Self);
		s.Switch := sw;
		s.OnSwitch := proc;
		s.Command := self;
	end;
begin
	inherited Create(AOwner);
    FDataSource := TDataSource.Create(nil);
    FDataSource.OnDataChange := DataChange;
    FDataSource.OnStateChange := StateChange;
    FDataSource.OnUpdateData := UpdateData;
    FTraceList := TList.Create;
    MinArgs := 1;
    MaxArgs := 99;
    ErrorMsg := 'Syntax: <?DataSource?> ...';
end;

destructor TTclCmdDataSource.Destroy;
begin
	RemoveLinkVar('', '');
	inherited Destroy;
    FDataSource.Free;
    FTraceList.Free;
    FDataChangeList.Free;
    FStateChangeList.Free;
    FUpdateDataList.Free;
end;

procedure TTclCmdDataSource._e(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	FEventCall := TslcStrTruth(Sender.SplitDef(ASwitch, '+'));
end;

procedure TTclCmdDataSource.DoInterpDelete(AInterp: pTcl_Interp);
begin
	if InterpreterCount = 0 then
    	Free;
end;

procedure TTclCmdDataSource.DoPrepare(var result: string; var success: boolean);
begin
	FEventCall := True;
end;

procedure TTclCmdDataSource.DoCommand(var result: string; var success: boolean);
{$IFDEF VER90}
const
	cState: array[dsInactive..dsFilter] of pChar = ('Inactive', 'Browse', 'Edit', 'Insert',
    	'SetKey', 'CalcFields', 'UpdateNew', 'UpdateOld', 'Filter');
{$ELSE}
const
	cState: array[dsInactive..dsCurValue] of pChar = ('Inactive', 'Browse', 'Edit', 'Insert',
    	'SetKey', 'CalcFields', 'Filter', 'NewValue', 'OldValue', 'CurValue');
{$ENDIF}
var
	cnt, hash: integer;
begin
	cnt := ParamValuesCount;
    hash := HashValues[0];
    if hash = hashDATASET then
    begin
    	if cnt = 1 then
        begin
        	if FCmdDataSet <> nil then
            	result := FCmdDataSet.Command;
        end else if cnt = 2 then
        begin
        	FDataSource.DataSet := DataSetFromCommand(Interp, ParamValues[1]);
			FCmdDataSet := TslcFindCommand(Interp, ParamValues[1]) as TTclCmdDbDef;
			FreeNotification(FCmdDataSet);
        end else
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashSTATE then
    begin
    	result := cState[FDataSource.State];
        exit;
    end;
    if hash = hashLINKVAR then
    begin
    	if cnt = 2 then
			result := AddLinkVar(ParamValues[1], '')
        else if cnt = 3 then
        	result := AddLinkVar(ParamValues[1], ParamValues[2])
        else
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashUNLINKVAR then
    begin
    	if cnt = 1 then
        	RemoveLinkVar('', '')
        else if cnt = 2 then
        	RemoveLinkVar(ParamValues[1], '')
        else if cnt = 3 then
        	RemoveLinkVar(ParamValues[1], ParamValues[2])
        else
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashONDATACHANGE then
    begin
		if cnt <> 3 then
        	TclError(ErrorMsg);
        hash := HashValues[1];
        if hash = hashVALUE then
        	result := EventData(FDataChangeList, ParamValues[2])
        else if hash = hashADD then
        	result := EventAdd(FDataChangeList, ParamValues[2], FEventCall)
		else if hash = hashDELETE then
        	EventDelete(FDataChangeList, ParamValues[2])
        else if hash = hashLIST then
        	result := EventList(FDataChangeList)
        else
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashONSTATECHANGE then
    begin
		if cnt <> 3 then
        	TclError(ErrorMsg);
        hash := HashValues[1];
        if hash = hashVALUE then
        	result := EventData(FStateChangeList, ParamValues[2])
        else if hash = hashADD then
        	EventAdd(FStateChangeList, ParamValues[2], FEventCall)
		else if hash = hashDELETE then
        	EventDelete(FStateChangeList, ParamValues[2])
        else if hash = hashLIST then
        	result := EventList(FStateChangeList)
        else
        	TclError(ErrorMsg);
        exit;
    end;
    if hash = hashONUPDATEDATA then
    begin
		if cnt <> 3 then
        	TclError(ErrorMsg);
        hash := HashValues[1];
        if hash = hashVALUE then
        	result := EventData(FUpdateDataList, ParamValues[2])
        else if hash = hashADD then
        	EventAdd(FUpdateDataList, ParamValues[2], FEventCall)
		else if hash = hashDELETE then
        	EventDelete(FUpdateDataList, ParamValues[2])
        else if hash = hashLIST then
        	result := EventList(FUpdateDataList)
        else
        	TclError(ErrorMsg);
        exit;
    end;
	if hash = hashFREE then
    begin
    	Free;
        exit;
    end;
	inherited DoCommand(result, success);
end;

procedure TTclCmdDataSource.DoScriptDelete(AInterp: pTcl_Interp);
begin
	// Assuming that command exists only in a single interpreter. Natural form per class design.
    // ??? should consider multiple interpreters for future...
	Free;
end;

function TTclCmdDataSource.ListName(list: TStrings): string;
begin
	if list = nil then
    	result := ''
    else if list = FDataChangeList then
    	result := Command + 'Data'
    else if list = FStateChangeList then
    	result := Command + 'State'
    else if list = FUpdateDataList then
    	result := Command + 'Update'
    else
    	result := '';
end;

function TTclCmdDataSource.ListSema(list: TStrings): integer;
begin
	if list = nil then
    	result := 0
    else if list = FDataChangeList then
    begin
    	inc(FDataSema);
    	result := FDataSema;
    end else if list = FStateChangeList then
    begin
    	inc(FStateSema);
    	result := FStateSema;
    end else if list = FUpdateDataList then
    begin
    	inc(FUpdateSema);
    	result := FUpdateSema;
    end else
    	result := 0;
end;

function TTclCmdDataSource.ListId(list: TStrings; id: string): integer;
var
	base: string;
    len: integer;
begin
	base := ListName(list);
    len := length(base);
	if (len = 0) or (base <> Copy(id, 1, len)) or (StrToIntDef(Copy(id, len + 1, length(id)), 0) <= 0) then
    	TclError('Invalid id' + #13 + ErrorMsg);
    result := StrToInt(Copy(id, len + 1, length(id)));
end;

function TTclCmdDataSource.EventData(list: TStrings; id: string): string;
var
	idn, x: integer;
begin
	result := '';
	idn := ListId(list, id);
    if list <> nil then
    for x:= 0 to list.Count - 1 do
    	if abs(integer(list.objects[x])) = idn then
        begin
        	result := list.strings[x];
            break;
        end;
end;

function TTclCmdDataSource.EventAdd(var list: TStrings; data: string; eventCall: boolean): string;
var
	sema: integer;
begin
	if list = nil then
    	list := TStringList.Create;
	sema := ListSema(list);
    result := Format('%s%d', [ListName(list), sema]);
    if not eventCall then
    	sema := -sema;
	list.AddObject(ConvertPEOL(pChar(data)), TObject(sema))
end;

procedure TTclCmdDataSource.EventDelete(list: TStrings; id: string);
var
	x, idn: integer;
begin
	idn := ListId(list, id);
    for x:= 0 to list.Count -1 do
    	if abs(integer(list.objects[x])) = idn then
        begin
        	list.Delete(x);
            break;
        end;
end;

function TTclCmdDataSource.EventList(list: TStrings): string;
var
	nam: string;
    idList: TStrings;
    x: integer;
begin
	nam := ListName(list);
    if nam = '' then
    	result := ''
    else
    begin
    	idList := TStringList.Create;
        try
        	for x:= 0 to list.Count - 1 do
            	idList.Add(Format('%s%d', [nam, abs(integer(list.objects[x]))]));
            result := MergeList(idList);
        finally
        	idList.Free;
        end;
    end;

end;

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

function TTclCmdDataSource.AddLinkVar(varName, fieldName: string): string;
	procedure TraceField(varName, fieldName: string; list: TStrings);
    var
        t: TTclTraceField;
	begin
		t := TTclTraceField.Create(nil, varName, fieldName);
		FTraceList.Add(t);
        t.FDataSource := FDataSource;
        t.FParentInterp := Interp;
        t.Install(Interp);
        t.StateChange; // wake up...
        t.DataChange;
        list.Add(t.ElemName);
    end;

var
	ds: TDataSet;
    x: integer;
    list: TStrings;
begin
	ds := FDataSource.DataSet;
    if ds = nil then
    	TclError('Cannot link to null dataset');
    list := TStringList.Create;
    try
 		if fieldName <> '' then
			TraceField(varName, fieldName, list)
		else
			for x:= 0 to ds.FieldCount - 1 do
    	    	TraceField(varName, ds.Fields[x].FieldName, list);
        result := MergeList(list);
    finally
    	list.Free;
    end;
end;

procedure TTclCmdDataSource.RemoveLinkVar(varName, fieldName: string);
var
	t: TTclTraceField;
    x: integer;
begin
	for x:= FTraceList.Count - 1 downto 0 do
    begin
    	t := TTclTraceField(FTraceList.items[x]);
        if (varName = '') or ((t.varName = varName) and ((fieldName = '') or (t.FieldName = fieldName))) then
        begin
        	t.Free;
            FTraceList.Delete(x);
        end;
    end;
end;

procedure TTclCmdDataSource.EvalList(list: TStrings);
var
	i, x: integer;
    expr: string;
    p: pChar;
begin
	if list <> nil then
    for i:= 0 to InterpreterCount - 1 do // typically, no more than one interpreter will exist in this scheme
	    for x:= 0 to list.Count - 1 do
	    begin
	    	if integer(list.objects[x]) < 0 then
	        	p := pChar(list.strings[x])
	        else
	        begin
	        	expr := format('%s %s', [list.strings[x], command]);
	            p := pChar(expr);
	        end;
			if Tcl_Eval(Interpreters[i], p) <> TCL_OK then
	        	Tcl_BackgroundError(Interpreters[i]); // Preferred to raising exception since we're here
                										// due to layered event calls both script and machine.
                                                        // Tcl_BackgroundError queues the message peacefully.
    end;
end;


procedure TTclCmdDataSource.DataChange(Sender: TObject; Field: TField);
var
	x: integer;
begin
	if Field = nil then
    begin
		for x:= 0 to FTraceList.Count - 1 do
    		TTclTraceField(FTraceList.items[x]).DataChange;
	    EvalList(FDataChangeList);
    end;
end;

procedure TTclCmdDataSource.StateChange(Sender: TObject);
var
	x: integer;
begin
	for x:= 0 to FTraceList.Count - 1 do
    	TTclTraceField(FTraceList.items[x]).StateChange;
    EvalList(FStateChangeList);
end;

procedure TTclCmdDataSource.UpdateData(Sender: TObject);
begin
	EvalList(FUpdateDataList);
end;


// TTclCmdDbDef
// language
procedure TTclCmdDbDef._l(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	with Sender.Command as TTclCmdDbDef do
    	AddOption(format('%s=%s', [szCFGSYSLANGDRV, Sender.Split(ASwitch)]));
end;

// driver
procedure TTclCmdDbDef._d(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	with Sender.Command as TTclCmdDbDef do
		TableType := Sender.Split(ASwitch);
end;
// saveAs
procedure TTclCmdDbDef._a(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	with Sender.Command as TTclCmdDbDef do
		SaveAs := Sender.Split(ASwitch);
end;
// keyViol
procedure TTclCmdDbDef._k(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	with Sender.Command as TTclCmdDbDef do
	begin
		KeyViol := Sender.Split(ASwitch);
		include(FFlags, roKeyViol);
	end;
end;
// problems
procedure TTclCmdDbDef._x(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	with Sender.Command as TTclCmdDbDef do
	begin
		Problems := Sender.Split(ASwitch);
		include(FFlags, roProblems);
	end;
end;
// password
procedure TTclCmdDbDef._p(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	with Sender.Command as TTclCmdDbDef do
    	if FLockBox then     
            LockBoxGetStr(Interp, Sender.Split(ASwitch), FPassword, TslcGetSecondaryKey)
        else
			Password := Sender.Split(ASwitch);
end;
procedure TTclCmdDbDef._lockbox(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	with Sender.Command as TTclCmdDbDef do
    	FLockBox := TslcStrTruth(Sender.SplitDef(ASwitch, '+'));
end;
// fieldDesc
procedure TTclCmdDbDef._f(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	if TruthDef( Sender.Split(ASwitch), True) then
	with Sender.Command as TTclCmdDbDef do
		include(FFlags, roFields);
end;
// indexDesc
procedure TTclCmdDbDef._i(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	if TruthDef( Sender.Split(ASwitch), True) then
	with Sender.Command as TTclCmdDbDef do
		include(FFlags, roIndexes);
end;
// refInt
procedure TTclCmdDbDef._r(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	if TruthDef( Sender.Split(ASwitch), True) then
	with Sender.Command as TTclCmdDbDef do
		include(FFlags, roRefInt);
end;
// security
procedure TTclCmdDbDef._s(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	if TruthDef( Sender.Split(ASwitch), True) then
	with Sender.Command as TTclCmdDbDef do
		include(FFlags, roSecurity);
end;
// valChecks
procedure TTclCmdDbDef._v(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	if TruthDef( Sender.Split(ASwitch), True) then
	with Sender.Command as TTclCmdDbDef do
		include(FFlags, roValChecks);
end;
// overWrite
procedure TTclCmdDbDef._w(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	with Sender.Command as TTclCmdDbDef do
		OverWrite := TruthDef( Sender.Split(ASwitch), True);
end;
// options
procedure TTclCmdDbDef._o(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	with Sender.Command as TTclCmdDbDef do
    begin
    	include(FFlags, roOptions);
    	AddOption(Sender.Split(ASwitch));
    end;
end;
// help
procedure TTclCmdDbDef._Help(Sender: TTclCmdSwitch; ASwitch: string; var result: string; var success: boolean);
begin
	TclError('Not Coded');
end;

procedure TTclCmdDbDef._FldDesc(Sender: TTclCommand; var result: string; var success: boolean);
begin
	result := EvalFldDesc;
end;

procedure TTclCmdDbDef._IdxDesc(Sender: TTclCommand; var result: string; var success: boolean);
begin
	result := EvalIdxDesc;
end;

procedure TTclCmdDbDef._RefDesc(Sender: TTclCommand; var result: string; var success: boolean);
begin
	result := EvalRefDesc;
end;

procedure TTclCmdDbDef._SecDesc(Sender: TTclCommand; var result: string; var success: boolean);
begin
	result := EvalSecDesc;
end;

procedure TTclCmdDbDef._ValDesc(Sender: TTclCommand; var result: string; var success: boolean);
begin
	result := EvalValDesc;
end;

procedure TTclCmdDbDef.AddOption(option: string);
begin
    OptDsc.AddOption(option);
	inc(FOptCount);
end;

function BinToHex(pb: DBIVCHK; cbLen: integer): string;
const
	hex: array[0..15] of char =	('0', '1', '2', '3', '4', '5', '6', '7',
								 '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
var
	buf: array[0..DBIMAXVCHKLEN*3] of char;
	x, y: integer;
	b: byte;
begin
	if cbLen > DBIMAXVCHKLEN then cbLen := DBIMAXVCHKLEN;
	y := 0;
	for x:= 0 to cbLen - 1 do
	begin
		b := pb[x];
		buf[y] := hex[b div 16]; inc(y);
		buf[y] := hex[b mod 16]; inc(y);
		buf[y] := ' '; inc(y);
	end;
	buf[y] := #0;
	result := strpas(buf);
end;

type
	// Special handler class for TTclCmdDbDef. Will be in its Params property.
	TTclCmdDescParam = class(TTclCmdParam)
	protected
		procedure DoParam(APos: integer; AParam: string; var result: string; var success: boolean); override;
	public
		Proc: TTclCommandEvent;
	end;


procedure TTclCmdDescParam.DoParam(APos: integer; AParam: string; var result: string; var success: boolean);
begin
	(Command as TTclCmdDbDef).FProc := Proc;
	Command.BreakLoop;
end;


{~~~ TTclCmdDbDef ~~~}

constructor TTclCmdDbDef.Create(AOwner: TComponent);
const
	cSyntax =
		'Syntax: <?CommandObject?> <open [[?databaseName?] <?tableName?>]|close' + #13 +
        '|bool <false|true> [?newValue?]'+ #13 +
        '|info <0..fldCount-1|databaseName|databaseType|tableName|tableType>' + #13 +
        '    |<fldDesc|idxDesc|refDesc|secDesc|valDesc> <?args?>' + #13 +
		'|<restructure|createTable> [?databaseName?] <?tableName?> [-xakpwfirdsvo?]>' + #13 +
        '|addalias <?aliasname?> [?driver?] <?params?> <?persist?>';

	procedure GenSwitch(sw: string; proc: TTclCmdSwitchEvent);
	var
		s: TTclCmdSwitch;
	begin
		s := TTclCmdSwitch.Create(Self);
		s.Switch := sw;
		s.OnSwitch := proc;
		s.Command := self;
	end;

	procedure GenParam(param: string; pos: integer; default: boolean; proc: TTclCmdParamEvent);
	var
		p: TTclCmdParam;
	begin
		p := TTclCmdParam.Create(Self);
		p.Default := default;
		p.Param := param;
		p.Position := pos;
		p.OnParam := proc;
		p.Command := self;
	end;

	procedure GenDesc(param: string; proc: TTclCommandEvent);
	var
		p: TTclCmdDescParam;
	begin
		p := TTclCmdDescParam.Create(Self);
		p.Param := param;
		p.Position := 1;
		p.Proc := proc;
		p.Command := self;
	end;

begin
	inherited Create(AOwner);

	// Restructure switches. Link switch characters to procedures
	GenSwitch('x', _x);
	GenSwitch('a', _a);
	GenSwitch('k', _k);
    GenSwitch('lockbox', _lockbox);
    GenSwitch('l', _l);
	GenSwitch('p', _p);
	GenSwitch('w', _w);
	GenSwitch('f', _f);
	GenSwitch('i', _i);
	GenSwitch('r', _r);
	GenSwitch('s', _s);
	GenSwitch('v', _v);
	GenSwitch('o', _o);
    GenSwitch('d', _d);
    GenSwitch('?', _Help);

	// General Operational Params. Link param values to procedures.
	GenDesc('FldDesc', _FldDesc);
	GenDesc('IdxDesc', _IdxDesc);
	GenDesc('RefDesc', _RefDesc);
	GenDesc('SecDesc', _SecDesc);
	GenDesc('ValDesc', _ValDesc);

	MinArgs := 1;
	MaxArgs := Byte(MaxInt);
	ErrorMsg := cSyntax;

end;

destructor TTclCmdDbDef.Destroy;
begin
	inherited Destroy; // induces call to *virtual* Close.
//	FTable.Free // So we'll keep this alive until after inherited destroy.

end;
{
procedure TTclCmdDbDef.Close;
begin
	FTable.Close;
end;
}
function TslcGetCheckStrRangeSyntax(str: string; min, max: integer; syntax: string): integer;
begin
	try
		result := TslcGetCheckStrRange(str, min, max);
	except
		on E:ETclError do
			TclErrorFmt('%s %s', [E.Message, syntax]);
	end;
end;

procedure TTclCmdDbDef.DoInterpDelete(AInterp: pTcl_Interp);
begin
	if InterpreterCount = 0 then
    	Free;
end;

procedure TTclCmdDbDef.DoCommand(var result: string; var success: boolean);
var
	cnt: integer;
	hash, fldNum, x: integer;
	b, tempDb: boolean;
    db: hDBIDb;
    dbName, tblName: string;
begin
	cnt := ParamValuesCount; // MinArgs guarantees at least one parameterValue/argument
	hash := HashValues[0];	// Note: (index  = 0) is not the first argument; it's the first parameter
//	try
		if Assigned(FProc) then // Param Handlers defined in Create will set the Proc property
		begin
			FProc(self, result, success);
			exit;
		end;
		if hash = hashFREE then
		begin
			if cnt > 1 then
				TclError(ErrorMsg);
			Close;
			Free;
			exit;
		end;
		if hash = hashOPEN then
		begin
			if cnt = 2 then
				TableName := ParamValues[1]
			else if cnt = 3 then
			begin
				DatabaseName := ParamValues[1];
				TableName := ParamValues[2];
			end else if cnt > 3 then
				TclError(ErrorMsg);
			open;
			exit;
		end;
		if hash = hashCLOSE then
		begin
			if cnt > 1 then
				TclError(ErrorMsg);
			close;
			exit;
		end;
		if hash = hashINFO then
		begin
			if cnt <> 2 then
				TclError(ErrorMsg);
			hash := HashValues[1];
			if (hash = hashDATABASENAME) or (hash = hashDBNAME) then
				result := DatabaseName
			else if (hash = hashDATABASETYPE) or (hash = hashDBTYPE) then
				result := DatabaseType
			else if (hash = hashTABLENAME) or (hash = hashTBLNAME) then
				result := TableName
			else if (hash = hashTABLETYPE) or (hash = hashTBLTYPE) then
				result := TableType
            else if (hash = hashLANGUAGE) or (hash = hashLANG) then
            	result := Language
			else
			begin
				fldNum := TslcGetCheckStrRangeSyntax(ParamValues[1], 0, (FldDsc.Count - 1), ErrorMsg);
				result := format('%-10.10s %-12.12s %4d %4d',
					[FldDsc.Name[fldNum],
					FLDDescToStr(FldDsc.Desc[fldNum]^),
					FldDsc.Units1[fldNum],
					FldDsc.Len[fldNum]]);
			end;
			exit;
		end;
		if hash = hashRESTRUCTURE then
		begin try
			if cnt > 3 then
				TclError(ErrorMsg);
			if cnt = 3 then
            begin
    			dbName := ParamValues[1];
                tblName := ParamValues[2];
            end else if cnt = 2 then
            begin
            	dbName := DatabaseName;
                tblName := ParamValues[1];
            end else
            begin
            	dbName := DatabaseName;
                tblName := TableName;
            end;
		   	Check(DbiOpenDatabase(pChar(dbName), nil, dbiReadWrite, dbiOpenShared, nil, 0, nil, nil, db));
			Restructure(db, tblName, TableType, Password, SaveAs, FFlags);
		finally
			if Assigned(db) then
				Check(DbiCloseDatabase(db));
		end;
			exit;
		end;
		if (hash = hashTABLENAME) or (hash = hashTBLNAME) then
        begin
        	if cnt > 2 then
            	TclError(ErrorMsg);
            result := TableName;
            if cnt > 1 then
            	TableName := ParamValues[1];
			exit;
        end;
		if (hash = hashTABLETYPE) or (hash = hashTBLTYPE) then
        begin
        	if cnt > 2 then
            	TclError(ErrorMsg);
            result := TableType;
            if cnt > 1 then
            	TableType := ParamValues[1];
            exit;
        end;
		if (hash = hashLANGUAGE) or (hash = hashLANG) then
        begin
        	if cnt > 2 then
            	TclError(ErrorMsg);
            result := Language;
//            if cnt > 1 then
//            	Language := ParamValues[1];
            exit;
        end;
        if (hash = hashDATABASENAME) or (hash = hashDBNAME) then
        begin
        	if cnt > 2 then
            	TclError(ErrorMsg);
            result := DatabaseName;
            if cnt > 1 then
            	DatabaseName := ParamValues[1];
            exit;
        end;
		if hash = hashCREATETABLE then
		begin
			if cnt > 3 then
				TclError(ErrorMsg);
//			if cnt = 3 then
//                DatabaseName := ParamValues[1];
    		db := nil;
			tempDb := hDb = nil;
			try
    	        if not tempDb then
        	    	db := hDb
            	else if cnt = 3 then
	           	   	Check(DbiOpenDatabase(pChar(ParamValues[1]), nil, dbiReadWrite, dbiOpenShared, nil, 0, nil, nil, db))
				else
					Check(DbiOpenDatabase(nil, nil, dbiReadWrite, dbiOpenShared, nil, 0, nil, nil, db));
				CreateTable(db, ParamValues[cnt - 1], TableType, Password, OverWrite, FFlags);
			finally
				if tempDb and Assigned(db) then
					Check(DbiCloseDatabase(db));
			end;
			exit;
		end;
        if hash = hashLOADFILE then
        begin
            if cnt <> 2 then
            	TclError(ErrorMsg);
            LoadFromFile(ParamValues[1]);
            exit;
        end;
        if hash = hashSAVEFILE then
        begin
        	if cnt <> 2 then
            	TclError(ErrorMsg);
            SaveToFile(ParamValues[1]);
        	exit;
        end;
        if hash = hashLOADSTREAM then
        begin
        	if cnt <> 2 then
            	TclError(ErrorMsg);
            LoadFromStream(StreamFromCommand(Interp, ParamValues[1])); // pointer value
            exit;
        end;
        if hash = hashSAVESTREAM then
        begin
        	if cnt <> 2 then
            	TclError(ErrorMsg);
            SaveToStream(StreamFromCommand(Interp, ParamValues[1])); // pointer value;
        	exit;
        end;
        if hash = hashSESSIONNAME then
        begin
            result := SessionName;
            if cnt = 2 then
            	SessionName := ParamValues[1]
            else
            	TclError(ErrorMsg);
            exit;
        end;
       	inherited DoCommand(result, success);
//
//  Will be using DoException override to handle Exceptions
//
//	except
//		on ETclError do  // ETclErrors are Safe exceptions to raise.
//			raise;
//		on E:Exception do // if coCatchAll is not in TTcl.Options Exception could trickle back into Tcl engine!
//			TclError(E.Message);
//	end;
end;

procedure TTclCmdDbDef.DoPrepare(var result: string; var success: boolean);
begin
	// inherited DoPrepare - not interested, simply wraps event callback
	FFlags := [];
//	FDriver := '';
	FPassword := '';
	FSaveAs := '';
    FLanguage := '';
	FProc := nil;
	FOverWrite := False;
    if FOptCount <> 0 then
    begin
	    FOptCount := 0;
        OptDsc.Close;
    end;
end;

procedure TTclCmdDbDef.DoScriptDelete(AInterp: pTcl_Interp);
begin
	// Assuming that command exists only in a single interpreter. Natural form per class design.
    // ??? should consider multiple interpreters for future...
	Free;
end;

{~~~ EvalFldDesc ~~~}

function TTclCmdDbDef.EvalFldDesc: string;
const
	cSyntax =
		'Syntax:' + #13 +
        '    <?CommandObject?> FldDesc <add [*1..32]|count|serialize|purge|swap <?idx1?> <?idx2?>' + #13 +
        '    |<0..count-1> <op|fldNum|name|fldType|subType|units1' + #13 +
		'    |units2|offset|len|nullOffset|vchk|rights|calcField> [?newValue?]>';
	cUnknownFldType_S =
		'<?dbProps?> FldDesc: Unknown Field Type %s';
var
	hash, x, cnt, idx, num, ftype: integer;
begin
	cnt := ParamValuesCount;
	if cnt < 2 then
		TclError(cSyntax);
	hash := HashValues[1];
	if hashADD = hash then
	begin
		if cnt > 3 then
			TclError(cSyntax);
		if cnt = 3 then
			num := TslcGetCheckStrRangeSyntax(ParamValues[2], 1, 32, cSyntax)
		else num := 1;
		result := inttostr(FldDsc.Inflate(num));
		exit;
	end;
	if hashINSERT = hash then
	begin
		if (cnt < 3) or (cnt > 4) then
			TclError(cSyntax);
		idx := TslcGetCheckStrRangeSyntax(ParamValues[2], 0, MaxInt, cSyntax);
		if cnt > 3 then
			num := TslcGetCheckStrRangeSyntax(ParamValues[3], 1, MaxInt, cSyntax)
		else num := 1;
        cnt := FldDsc.Count;
		FldDsc.Inflate(num);
        FldDsc.Shift(idx, cnt - 1, num);
		result := inttostr(idx);
		exit;
	end;
	if hashPURGE = hash then
	begin
		if cnt > 2 then
			TclError(cSyntax);
		FldDsc.Purge;
		exit;
	end;
	if hashSERIALIZE = hash then
	begin
//		if FldDsc.Dirty then  // ???
//			TclError('Cannot serialize dirty field descriptors');
		if cnt > 2 then
			TclError(cSyntax);
		for x:= 1 to FldDsc.Count do
			FldDsc.FldNum[x - 1] := x;
		exit;
	end;
	if hashCOUNT = hash then
	begin
		if cnt > 2 then
			TclError(cSyntax);
		result := inttostr(FldDsc.Count);
		exit;
	end;
    if hashSWAP = hash then
    begin
    	if cnt <> 4 then
        	TclError(cSyntax);
        FldDsc.Swap(TslcStrToInt(ParamValues[2]), TslcStrToInt(ParamValues[3]));
        exit;
    end;
	if cnt < 3 then
		TclError(cSyntax);
	idx := TslcGetCheckStrRangeSyntax(ParamValues[1], 0, FldDsc.Count - 1, cSyntax );
	hash := HashValues[2];
	if hashFLDNUM = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr( FldDsc.FldNum[idx] );
		if cnt > 3 then
			FldDsc.FldNum[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashNAME = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := FldDsc.Name[idx];
		if cnt > 3 then
			FldDsc.Name[idx] := ParamValues[3];
		exit;
	end;
	if hashFLDTYPE = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		ftype := FldDsc.FldType[idx];
		if (ftype >= Low(BDEFldTypes)) and (ftype <= High(BDEFldTypes)) then
			result := BDEFldTypes[ftype];
		if cnt > 3 then
		begin
			ftype := StrToBDEField(ParamValues[3]);
			if (ftype = fldUNKNOWN) and ( not TslcTextEqual(ParamValues[3],'UNKNOWN')) then
				TclErrorFmt(cUnknownFldType_S, [ParamValues[3]]);
			FldDsc.FldType[idx] := ftype;
		end;
		exit;
	end;
	if hashSUBTYPE = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		ftype := FldDsc.SubType[idx];
		if (ftype >= Low(BDESubTypes)) and (ftype <= High(BDESubTypes)) then
			result := BDESubTypes[ftype];
		if cnt > 3 then
		begin
			ftype := StrToBDEField(ParamValues[3]);
			if (ftype = fldUNKNOWN) and (not TslcTextEqual(ParamValues[3],'UNKNOWN')) then
				TclErrorFmt(cUnknownFldType_S, [ParamValues[3]]);
			FldDsc.SubType[idx] := ftype;
		end;
		exit;
	end;
	if hashUNITS1 = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr(FldDsc.Units1[idx]);
		if cnt > 3 then
			FldDsc.Units1[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashUNITS2 = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr(FldDsc.Units2[idx]);
		if cnt > 3 then
			FldDsc.Units2[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashOFFSET = hash then
	begin
		result := inttostr(FldDsc.Offset[idx]);
		if cnt > 3 then
			TclError('Cannot assign FldDesc Offset');
		exit;
	end;
	if hashLEN = hash then
	begin
		result := inttostr(FldDsc.Len[idx]);
		if cnt > 3 then
			TclError('Cannot assign FldDesc Len');
		exit;
	end;
	if hashNULLOFFSET = hash then
	begin
		result := inttostr(FldDsc.NullOffset[idx]);
		if cnt > 3 then
			TclError('Cannot assign FldDesc NullOffset');
		exit;
	end;
	if hashVCHK = hash then
	begin
		result := FLDVchkStr[FldDsc.Vchk[idx]];
		if cnt > 3 then    
			FldDsc.Vchk[idx] := StrToFLDVchk(ParamValues[3]);
//			TclError('Cannot assign FldDesc Vchk');
		exit;
	end;
	if hashRIGHTS = hash then
	begin
		result := FLDRightsStr[FldDsc.Rights[idx]];
		if cnt > 3 then
			FldDsc.Rights[idx] := StrToFLDRights(ParamValues[3]);
//			TclError('Cannot assign FldDesc Rights');
		exit;
	end;
	if hashCALCFIELD = hash then
	begin
		result := BOOLTypeStr[FldDsc.CalcField[idx]];
		if cnt > 3 then
  			FldDsc.CalcField[idx] := TslcStrTruth(ParamValues[3]);
//			TclError('Cannot assign FldDesc CalcField');
		exit;
	end;
	if hashOP = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := CROpStr[FldDsc.Op[idx]];
		if cnt > 3 then
			FldDsc.Op[idx] := StrToCROp(ParamValues[3]);
		exit;
	end;
	TclError(cSyntax);

end;

{~~~ EvalIdxDesc ~~~}

function TTclCmdDbDef.EvalIdxDesc: string;
const
	cSyntax =
			'Syntax:' + #13+
            '    <?CommandObject?> IdxDesc <add [*1..32]|count|purge|swap <?idx1?> <?idx2?>' + #13 +
            '    |<0..count-1> <op|name|indexId|tagName|format|primary|unique|desc|maint' + #13 +
			'    |subset|expIdx|cost|fldsInKey|keyLen|outOfDate|keyExpType|keyFld <0..15>' + #13 +
            '    |keyExp|keyCond|caseIns|blockSize|restrNum|DescFlds <0..15>> [?newValue?]>';
var
//	prm: string;
	hash, cnt, idx, posIdx, num: integer;
begin
	cnt := ParamValuesCount;
	if cnt < 2 then
		TclError(cSyntax);
//	prm := ParamValues[1];
//	hash := PJWStrHash(pChar(UpperCase(prm)));
	hash := HashValues[1];
	if hashADD = hash then
	begin
		num := 1;
		if cnt = 3 then
			num := TslcGetCheckStrRangeSyntax(ParamValues[2], 1, 32, cSyntax)
		else if cnt > 3 then
			TclError(cSyntax);
		result := inttostr(IdxDsc.Inflate(num));
		exit;
	end;
	if hashCOUNT = hash then
	begin
		if cnt > 2 then
			TclError(cSyntax);
		result := inttostr(IdxDsc.Count);
		exit;
	end;
	if hashPURGE = hash then
	begin
		if cnt > 2 then
			TclError(cSyntax);
		IDXDsc.Purge;
		exit;
	end;
    if hashSWAP = hash then
    begin
    	if cnt <> 4 then
        	TclError(cSyntax);
        IdxDsc.Swap(TslcStrToInt(ParamValues[2]), TslcStrToInt(ParamValues[3]));
        exit;
    end;
	if cnt < 3 then
		TclError(cSyntax);
	idx := TslcGetCheckStrRangeSyntax(ParamValues[1], 0, IdxDsc.Count - 1, cSyntax );
//	prm := ParamValues[2];
//	hash := PJWStrHash(pChar(UpperCase(prm)));
	hash := HashValues[2];
	if hashNAME = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := IdxDsc.Name[idx];
		if cnt = 4 then
			IdxDsc.Name[idx] := ParamValues[3];
		exit;
	end;
	if hashINDEXID = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr(IdxDsc.IndexId[idx]);
		if cnt = 4 then
			IdxDsc.IndexId[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashTAGNAME = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := IdxDsc.TagName[idx];
		if cnt = 4 then
			IdxDsc.TagName[idx] := ParamValues[3];
		exit;
	end;
	if hashFORMAT = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := IdxDsc.Format[idx];
		if cnt = 4 then
			IdxDsc.Format[idx] := ParamValues[3];
		exit;
	end;
	if hashPRIMARY = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := BoolStr[IdxDsc.Primary[idx]];
		if cnt = 4 then
			IdxDsc.Primary[idx] := TslcStrTruth(ParamValues[3]);
		exit;
	end;
	if hashUNIQUE = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := BoolStr[IdxDsc.Unique[idx]];
		if cnt  = 4 then
			IdxDsc.Unique[idx] := TslcStrTruth(ParamValues[3]);
		exit;
	end;
	if hashDESC = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := BoolStr[IdxDsc.Descending[idx]];
		if cnt = 4 then
			IdxDsc.Descending[idx] := TslcStrTruth(ParamValues[3]);
		exit;
	end;
	if hashMAINT = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := BoolStr[IdxDsc.Maintained[idx]];
		if cnt = 4 then
			IdxDsc.Maintained[idx] := TslcStrTruth(ParamValues[3]);
		exit;
	end;
	if hashSUBSET = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := BoolStr[IdxDsc.Subset[idx]];
		if cnt = 4 then
			IdxDsc.Subset[idx] := TslcStrTruth(ParamValues[3]);
		exit;
	end;
	if hashEXPIDX = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := BoolStr[IdxDsc.ExpIdx[idx]];
		if cnt = 4 then
			IdxDsc.ExpIdx[idx] := TslcStrTruth(ParamValues[3]);
		exit;
	end;
	if hashCOST = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr(IdxDsc.Cost[idx]);
		if cnt = 4 then
			IdxDsc.Cost[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashFLDSINKEY = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr(IdxDsc.FldsInKey[idx]);
		if cnt = 4 then
			IdxDsc.FldsInKey[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashKEYLEN = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr(IdxDsc.KeyLen[idx]);
		if cnt = 4 then
			IdxDsc.KeyLen[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashOUTOFDATE = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := BoolStr[IdxDsc.OutOfDate[idx]];
		if cnt = 4 then
			IdxDsc.OutOfDate[idx] := TslcStrTruth(ParamValues[3]);
		exit;
	end;
	if hashKEYEXPTYPE = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr(IdxDsc.KeyExpType[idx]);
		if cnt = 4 then
			IdxDsc.KeyExpType[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashKEYFLD = hash then
	begin
		if (cnt < 4) or (cnt > 5) then
			TclError(cSyntax);
	   	posIdx := TslcGetCheckStrRangeSyntax(ParamValues[3], 0, DBIMAXFLDSINKEY - 1, cSyntax);
		result := inttostr(IdxDsc.KeyFld[idx,posIdx]);
		if cnt = 5 then
		   	IdxDsc.KeyFld[idx,posIdx] := TslcStrToInt(ParamValues[4]);
		exit;
	end;
	if hashKEYEXP = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := IdxDsc.KeyExp[idx];
	  	if cnt = 4 then
			IdxDsc.KeyExp[idx] := ParamValues[3];
		exit;
	end;
	if hashKEYCOND = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := IdxDsc.KeyCond[idx];
		if cnt = 4 then
			IdxDsc.KeyCond[idx] := ParamValues[3];
		exit;
	end;
	if hashCASEINS = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := BoolStr[IdxDsc.CaseIns[idx]];
		if cnt = 4 then
			IdxDsc.CaseIns[idx] := TslcStrTruth(ParamValues[3]);
		exit;
	end;
	if hashBLOCKSIZE = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr(IdxDsc.BlockSize[idx]);
		if cnt = 4 then
			IdxDsc.BlockSize[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashRESTRNUM = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr(IdxDsc.RestrNum[idx]);
		if cnt = 4 then
			TclError('Cannot assign value to readonly IdxDesc RestrNum');
		//	IdxRestrNum[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashDESCFLDS = hash then
	begin
		if (cnt < 4) or (cnt > 5) then
			TclError(cSyntax);
	   	posIdx := TslcGetCheckStrRangeSyntax(ParamValues[3], 0, DBIMAXFLDSINKEY - 1, cSyntax);
		result := BoolStr[IdxDsc.DescFlds[idx,posIdx]];
		if cnt = 5 then
			IdxDsc.DescFlds[idx,posIdx] := TslcStrTruth(ParamValues[4]);
		exit;
	end;
	if hashOP = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := CROpStr[IdxDsc.Op[idx]];
		if cnt = 4 then
			IdxDsc.Op[idx] := StrToCROp(ParamValues[3]);
		exit;
	end;
	TclError(cSyntax);
end;

function TTclCmdDbDef.EvalRefDesc: string;
const
	cSyntax =
		'Syntax:' + #13 +
        '    <?CommandObject?> RefDesc <add [*1..32]|count|purge|swap <?idx1?> <?idx2?>' + #13 +
        '    |<0..count-1> <op|num|name|type|tblName|modOp|delOp|fldCount' + #13 +
		'    |thisTblFld <0..15>|othTblFld <0..15>> [?newValue?]>';
var
//	prm: string;
	hash, idx, cnt, n, posIdx: integer;
begin
	cnt := ParamValuesCount;
	if cnt < 2 then
		TclError(cSyntax);
//	prm := ParamValues[1];
//	hash := PJWStrHash(pChar(UpperCase(prm)));
	hash := HashValues[1];
	if hashADD = hash then
	begin
		if cnt > 3 then
			TclError(cSyntax);
		if cnt = 3 then
			n := TslcGetCheckStrRangeSyntax(ParamValues[2], 1, 32, cSyntax)
		else n := 1;
		result := inttostr(RefDsc.Inflate(n));
		exit;
	end;
	if hashCOUNT = hash then
	begin
		if cnt > 2 then
			TclError(cSyntax);
		result := inttostr(RefDsc.Count);
		exit;
	end;
	if hashPURGE = hash then
	begin
		if cnt > 2 then
			TclError(cSyntax);
		RefDsc.Purge;
		exit;
	end;
    if hashSWAP = hash then
    begin
    	if cnt <> 4 then
        	TclError(cSyntax);
        RefDsc.Swap(TslcStrToInt(ParamValues[2]), TslcStrToInt(ParamValues[3]));
        exit;
    end;
	if cnt < 3 then
		TclError(cSyntax);
	idx := TslcGetCheckStrRangeSyntax(ParamValues[1], 0, RefDsc.Count - 1, cSyntax);
//	prm := ParamValues[2];
//	hash := PJWStrHash(pChar(UpperCase(prm)));
	hash := HashValues[2];
	if hashNUM = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr( RefDsc.RintNum[idx] );
		if cnt > 3 then
			RefDsc.RintNum[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashNAME = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := RefDsc.RintName[idx];
		if cnt > 3 then
			RefDsc.RintName[idx] := ParamValues[3];
		exit;
	end;
	if hashTYPE = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := RINTTypeStr[RefDsc.RintType[idx]];
		if cnt > 3 then
			RefDsc.RintType[idx] := StrToRINTType(ParamValues[3]);
		exit;
	end;
	if hashTBLNAME = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := RefDsc.TblName[idx];
		if cnt > 3 then
			RefDsc.TblName[idx] := ParamValues[3];
		exit;
	end;
	if hashMODOP = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := RINTQualStr[RefDsc.ModOp[idx]];
		if cnt > 3 then
			RefDsc.ModOp[idx] := StrToRINTQual(ParamValues[3]);
		exit;
	end;
	if hashDELOP = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := RINTQualStr[RefDsc.DelOp[idx]];
		if cnt > 3 then
			RefDsc.DelOp[idx] := StrToRINTQual(ParamValues[3]);
		exit;
	end;
	if hashFLDCOUNT = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr(RefDsc.FldCount[idx]);
		if cnt > 3 then
			RefDsc.FldCount[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashTHISTBLFLD = hash then
	begin
		if (cnt < 4) or (cnt > 5) then
			TclError(cSyntax);
	   	posIdx := TslcGetCheckStrRangeSyntax(ParamValues[3], 0, DBIMAXFLDSINKEY - 1, cSyntax);
		result := inttostr(RefDsc.ThisTabFld[idx,posIdx]);
		if cnt > 4 then
			RefDsc.ThisTabFld[idx,posIdx] := TslcStrToInt(ParamValues[4]);
		exit;
	end;
	if hashOTHTBLFLD = hash then
	begin
		if (cnt < 4) or (cnt > 5) then
			TclError(cSyntax);
		posIdx := TslcGetCheckStrRangeSyntax(ParamValues[3], 0, DBIMAXFLDSINKEY - 1, cSyntax);
		result := inttostr(RefDsc.OthTabFld[idx,posIdx]);
		if cnt > 4 then
			RefDsc.OthTabFld[idx,posIdx] := TslcStrToInt(ParamValues[4]);
		exit;
	end;
	if hashOP = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := CROpStr[RefDsc.Op[idx]];
		if cnt > 3 then
			RefDsc.Op[idx] := StrToCROp(ParamValues[3]);
		exit;
	end;
	TclError(cSyntax);
end;

{~~~ EvalSecDesc ~~~}

function TTclCmdDbDef.EvalSecDesc: string;
const
	cSyntax =
		'Syntax:' + #13 +
        '    <?CommandObject?> SecDesc <add [*1..32]|count|purge|swap <?idx1?> <?idx2?>' + #13 +
        '    |<0..count-1> <op|secNum|table|famRights|password|Fld <0..255>> [?newValue?]>';
var
//	prm: string;
	hash, cnt, idx, posIdx, num: integer;
begin
	cnt := ParamValuesCount;
	if cnt < 2 then
		TclError(cSyntax);
//	prm := ParamValues[1];
//	hash := PJWStrHash(pChar(UpperCase(prm)));
	hash := HashValues[1];
	if hashADD = hash then
	begin
		num := 1;
		if cnt = 3 then
			num := TslcGetCheckStrRangeSyntax(ParamValues[2], 1, 32, cSyntax)
		else if cnt > 3 then
			TclError(cSyntax);
		result := inttostr(SecDsc.Inflate(num));
		exit;
	end;
	if hashCOUNT = hash then
	begin
		if cnt > 2 then
			TclError(cSyntax);
		result := inttostr(SecDsc.Count);
		exit;
	end;
	if hashPURGE = hash then
	begin
		if cnt > 2 then
			TclError(cSyntax);
		SecDsc.Purge;
		exit;
	end;
    if hashSWAP = hash then
    begin
    	if cnt <> 4 then
        	TclError(cSyntax);
        SecDsc.Swap(TslcStrToInt(ParamValues[2]), TslcStrToInt(ParamValues[3]));
        exit;
    end;
	if cnt < 3 then
		TclError(cSyntax);
	idx := TslcGetCheckStrRangeSyntax(ParamValues[1], 0, SecDsc.Count - 1, cSyntax );
//	prm := ParamValues[2];
//	hash := PJWStrHash(pChar(UpperCase(prm)));
	hash := HashValues[2];

	if hashSECNUM = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr(SecDsc.SecNum[idx]);
		if cnt = 4 then
			SecDsc.SecNum[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashTABLE = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := PRVTypeStr[SecDsc.Table[idx]];
		if cnt = 4 then
			SecDsc.Table[idx] := StrToPRVType(ParamValues[3]);
		exit;
	end;
	if hashFAMRIGHTS = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := SafeFAMTypeStr(SecDsc.FamRights[idx]);
		if cnt = 4 then
			SecDsc.FamRights[idx] := StrToFAMType(ParamValues[3]);
		exit;
	end;
	if hashPASSWORD = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := SecDsc.Password[idx];
		if cnt = 4 then
			SecDsc.Password[idx] := ParamValues[3];
		exit;
	end;
	if hashFLD = hash then
	begin
		if (cnt < 4) or (cnt > 5) then
			TclError(cSyntax);
		posIdx := TslcGetCheckStrRangeSyntax(ParamValues[3], 0, DBIMAXFLDSINKEY - 1, cSyntax);
		result := PRVTypeStr[SecDsc.Fld[idx,posIdx]];
		if cnt = 5 then
			SecDsc.Fld[idx,posIdx] := StrToPRVType(ParamValues[4]);
		exit;
	end;
 	TclError(cSyntax);
end;

{~~~ EvalValDesc ~~~}

function TTclCmdDbDef.EvalValDesc: string;
const
	cSyntax =
		'Syntax:' + #13 +
        '    <?CommandObject?> ValDesc <add [*1..32]|count|purge|swap <?idx1?> <?idx2?>' + #13 +
        '    |<0..count-1> <op|req|min|max|def|pict> [?newValue?]' + #13 +
		'    |<0..count-1> bytes <min|max|def> [1..255,*8]>';
var
//	prm: string;
	hash, idx, cnt, n: integer;
begin
	cnt := ParamValuesCount;
	if cnt < 2 then
		TclError(cSyntax);
//	prm := ParamValues[1];
//	hash := PJWStrHash(pChar(UpperCase(prm)));
	hash := HashValues[1];
	if hashADD = hash then
	begin
		n := 1;
		if cnt = 3 then
			n := TslcGetCheckStrRangeSyntax(ParamValues[2], 1, 32, cSyntax)
		else if cnt > 3 then
			TclError(cSyntax);
		result := inttostr(ValDsc.Inflate(n));
		exit;
	end;
	if hashCOUNT = hash then
	begin
		if cnt > 2 then
			TclError(cSyntax);
		result := inttostr(ValDsc.Count);
		exit;
	end;
	if hashPURGE = hash then
	begin
		if cnt > 2 then
			TclError(cSyntax);
		ValDsc.Purge;
		exit;
	end;
    if hashSWAP = hash then
    begin
    	if cnt <> 4 then
        	TclError(cSyntax);
        ValDsc.Swap(TslcStrToInt(ParamValues[2]), TslcStrToInt(ParamValues[3]));
        exit;
    end;
	if cnt < 3 then
		TclError(cSyntax);
	idx := TslcGetCheckStrRangeSyntax(ParamValues[1], 0, ValDsc.Count - 1, cSyntax);
//	prm := ParamValues[2];
//	hash := PJWStrHash(pChar(UpperCase(prm)));
	hash := HashValues[2];
	if hashFLDNUM = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := inttostr( ValDsc.FldNum[idx] );
		if cnt > 3 then
			ValDsc.FldNum[idx] := TslcStrToInt(ParamValues[3]);
		exit;
	end;
	if hashREQUIRED = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := BoolStr[ValDsc.Required[idx]];
		if cnt > 3 then
			ValDsc.Required[idx] := TslcStrTruth(ParamValues[3]);
		exit;
	end;
	if hashMIN = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := ValDsc.MinVal[idx];
		if cnt > 3 then
			ValDsc.MinVal[idx] := ParamValues[3];
		exit;
	end;
	if hashMAX = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := ValDsc.MaxVal[idx];
		if cnt > 3 then
			ValDsc.MaxVal[idx] := ParamValues[3];
		exit;
	end;
	if hashDEF = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := ValDsc.DefVal[idx];
		if cnt > 3 then
			ValDsc.DefVal[idx] := ParamValues[3];
		exit;
	end;
	if hashPICT = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := ValDsc.Pict[idx];
		if cnt > 3 then
			ValDsc.Pict[idx] := ParamValues[3];
		exit;
	end;
	if hashREQ = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := BoolStr[ValDsc.Required[idx]];
		if cnt > 3 then
			ValDsc.Required[idx] := TslcStrTruth(ParamValues[3]);
		exit;
	end;
	if hashOP = hash then
	begin
		if cnt > 4 then
			TclError(cSyntax);
		result := CROpStr[ValDsc.Op[idx]];
		if cnt > 3 then
			ValDsc.Op[idx] := StrToCROp(ParamValues[3]);
		exit;
	end;
	if hashBYTES = hash then
	begin
		if (cnt < 4) or (cnt > 5) then
			TclError(cSyntax);
//		prm := ParamValues[3];
//		hash := PJWStrHash(pChar(UpperCase(prm)));
		hash := HashValues[3];
		if cnt > 4 then
			n := TslcStrToInt(ParamValues[4])
		else
			n := 8;
		if hashMIN = hash then
			result := BinToHex(ValDsc.Desc[idx].aMinVal, n)
		else if hashMAX = hash then
			result := BinToHex(ValDsc.Desc[idx].aMaxVal, n)
		else if hashDEF = hash then
			result := BinToHex(ValDsc.Desc[idx].aDefVal, n)
		else
			TclErrorFmt('Unsupported VCHK field for Bytes operation: %s', [ParamValues[3]]);
		exit;
	end;
	TclError(cSyntax);
end;


{~~~ GetOverWrite ~~~}
function TTclCmdDbDef.GetOverWrite: boolean;
begin
	result := FOverWrite;
end;

{~~~ GetPassword ~~~}
function TTclCmdDbDef.GetPassword: string;
begin
	result := FPassword;
end;

{~~~ GetSaveAs ~~~}
function TTclCmdDbDef.GetSaveAs: string;
begin
	result := FSaveAs;
end;

{~~~ SetOverWrite ~~~}
procedure TTclCmdDbDef.SetOverWrite(value: boolean);
begin
	FOverWrite := value;
end;

{~~~ SetPassword ~~~}
procedure TTclCmdDbDef.SetPassword(value: string);
begin
	FPassword := value;
end;

{~~~ SetSaveAs ~~~}
procedure TTclCmdDbDef.SetSaveAs(value: string);
begin
	FSaveAs := value;
end;

const
 	HashArray: pHashArray = nil;

	cCountHashValues = 122;
	_HashCount_: integer = cCountHashValues;
	cHashValues: array[0..cCountHashValues,0..1] of pChar = (
    	(@_HashCount_,		''),  // not counted. Used to store array size. See TslcHash.HashCount()
    	(@hash_,			''),
        (@hashACTIVE,		'ACTIVE'),
	    (@hashKEEPCONNECTIONS, 'KEEPCONNECTIONS'),
    	(@hashNETFILEDIR,	'NETFILEDIR'),
	    (@hashPRIVATEDIR,	'PRIVATEDIR'),
	    (@hashSESSIONNAME,	'SESSIONNAME'),
	    (@hashALIASNAME,	'ALIASNAME'),
	    (@hashCONNECTED,	'CONNECTED'),
	    (@hashDATABASENAME,	'DATABASENAME'),
	    (@hashDRIVERNAME,	'DRIVENAME'),
	    (@hashPARAMS,		'PARAMS'),
        (@hashDATASET,		'DATASET'),
		(@hashDATASETS,		'DATASETS'),
        (@hashISSQLBASED,	'ISSQLBASED'),
		(@hashKEEPCONNECTION, 'KEEPCONNECTION'),
        (@hashLOGINPROMPT,	'LOGINPROMPT'),
        (@hashCLOSEDATASETS,'CLOSEDATASETS'),
        (@hashCOMMIT,		'COMMIT'),
        (@hashROLLBACK,		'ROLLBACK'),
        (@hashSTARTTRANSACTION, 'STARTTRANSACTION'),
	    (@hashTRANSISOLATION, 'TRANISOLATION'),
        (@hashADDALIAS,		'ADDALIAS'),
        (@hashDELETEALIAS,	'DELETEALIAS'),
        (@hashISALIAS,		'ISALIAS'),
        (@hashALIASPATH,	'ALIASPATH'),
        (@hashMODIFYALIAS,	'MODIFYALIAS'),
        (@hashGETALIASDRIVERNAME,	'GETALIASDRIVERNAME'),
        (@hashADDPASSWORD,			'ADDPASSWORD'),
        (@hashREMOVEPASSWORD,		'REMOVEPASSWORD'),
		(@hashREMOVEALLPASSWORDS,	'REMOVEALLPASSWORDS'),
		(@hashTABLELIST,	'TABLELIST'),
		(@hashFINDDATABASE,	'FINDDATABASE'),
		(@hashGETTABLEOPENCOUNT, 'GETTABLEOPENCOUNT'),
        (@hashFREE,			'FREE'),
        (@hashOPEN,			'OPEN'),
        (@hashCLOSE,		'CLOSE'),
        (@hashINFO,			'INFO'),
        (@hashRESTRUCTURE,	'RESTRUCTURE'),
        (@hashCREATETABLE,	'CREATETABLE'),
        (@hashADD,			'ADD'),
        (@hashINSERT,		'INSERT'),
        (@hashDELETE,		'DELETE'),
        (@hashCOUNT,		'COUNT'),
        (@hashVALUE,		'VALUE'),
        (@hashNUM,			'NUM'),
        (@hashNAME,			'NAME'),
        (@hashTYPE,			'TYPE'),
        (@hashTBLNAME,		'TBLENAME'),
        (@hashTABLENAME,	'TABLENAME'),
        (@hashTBLTYPE,		'TBLTYPE'),
        (@hashTABLETYPE,  	'TABLETYPE'),
        (@hashDBNAME,		'DBNAME'),
        (@hashDBTYPE,		'DBTYPE'),
        (@hashDATABASETYPE,	'DATABASETYPE'),
        (@hashLANG,			'LANG'),
        (@hashLANGUAGE,		'LANGUAGE'),
        (@hashDRIVER,		'DRIVER'),
        (@hashMODOP,		'MODOP'),
        (@hashDELOP,		'DELOP'),
        (@hashFLDCOUNT,		'FLDCOUNT'),
        (@hashTHISTBLFLD,	'THISTBLFLD'),
        (@hashOTHTBLFLD,	'OTHTBLFLD'),
        (@hashOP,			'OP'),
        (@hashFLDNUM,		'FLDNUM'),
        (@hashREQUIRED,		'REQUIRED'),
        (@hashMIN,			'MIN'),
        (@hashMAX,			'MAX'),
        (@hashDEF,			'DEF'),
        (@hashPICT,			'PICT'),
        (@hashREQ,			'REQ'),
        (@hashBYTES,		'BYTES'),
        (@hashPURGE,		'PURGE'),
        (@hashSERIALIZE,	'SERIALIZE'),
        (@hashFLDTYPE,		'FLDTYPE'),
        (@hashSUBTYPE,		'SUBTYPE'),
        (@hashUNITS1,		'UNITS1'),
        (@hashUNITS2,		'UNITS2'),
        (@hashLEN,			'LEN'),
        (@hashOFFSET,		'OFFSET'),
        (@hashNULLOFFSET,	'NULLOFFSET'),
        (@hashVCHK,			'VCHK'),
        (@hashRIGHTS,		'RIGHTS'),
        (@hashCALCFIELD,	'CALCFIELD'),
        (@hashINDEXID,		'INDEXID'),
        (@hashTAGNAME,		'TAGNAME'),
        (@hashFORMAT,		'FORMAT'),
        (@hashPRIMARY,		'PRIMARY'),
        (@hashUNIQUE,		'UNIQUE'),
        (@hashDESC,			'DESC'),
        (@hashMAINT,		'MAINT'),
        (@hashSUBSET,		'SUBSET'),
        (@hashEXPIDX,		'EXPIDX'),
        (@hashCOST,			'COST'),
        (@hashFLDSINKEY, 	'FLDSINKEY'),
        (@hashKEYLEN,		'KEYLEN'),
        (@hashOUTOFDATE,	'OUTOFDATE'),
        (@hashKEYEXPTYPE,  	'KEYEXPTYPE'),
        (@hashKEYFLD,		'KEYFLD'),
        (@hashKEYEXP,		'KEYEXP'),
        (@hashKEYCOND,		'KEYCOND'),
        (@hashCASEINS,		'CASEINS'),
        (@hashBLOCKSIZE,   	'BLOCKSIZE'),
        (@hashRESTRNUM,		'RESTRNUM'),
        (@hashDESCFLDS,		'DESCFLDS'),
		(@hashSECNUM,		'SECNUM'),
        (@hashTABLE,		'TABLE'),
        (@hashFAMRIGHTS,   	'FAMRIGHTS'),
        (@hashPASSWORD,		'PASSWORD'),
        (@hashFLD,			'FLD'),
        (@hashSWAP,			'SWAP'),
        (@hashLOADFILE,		'LOADFILE'),
        (@hashSAVEFILE,		'SAVEFILE'),
        (@hashLOADSTREAM,	'LOADSTREAM'),
        (@hashSAVESTREAM,	'SAVESTREAM'),
        (@hashONPASSWORD,	'ONPASSWORD'),
        (@hashLINKVAR,		'LINKVAR'),
        (@hashUNLINKVAR,	'UNLINKVAR'),
        (@hashLIST,			'LIST'),
        (@hashSTATE,		'STATE'),
        (@hashONDATACHANGE,	'ONDATACHANGE'),
        (@hashONSTATECHANGE,'ONSTATECHANGE'),
        (@hashONUPDATEDATA,	'ONUPDATEDATA'));


initialization

    InitializeHashValues(HashArray, pHashArray(@cHashValues), True);
	TslcPrepareCritical;
/////////////////////////////////////////////////////////////////////////////////////
//  Uncomment next line to check for any hash collisions within the array
//	CheckHashCollisions(HashArray);

/////////////////////////////////////////////////////////////////////////////////////
//  Move into main program file and check for unit collisions. This can't be
//  performed in unit initialization since the other unit may not be initialized.
//
//  Uses BdeMisc, TclDbTbl, TclDbDef;
//  CheckHashCollisions2(TclDbTbl.HashArray, TclDbDef.HashArray);
//
//   - or -
//
//  Call CheckHashCollisionsAll after all units are initialized for comprehensive Collision Check
//  in HashArrays that were InitializeHashValues(..., True)
//

finalization
	TslcDoneCritical;

end.

