{ -----------------------------------------------------------------------
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 uMakeTbl;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    AliasLabel: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses TclDbTbl, TclDbDef, BDE, Db;
{$R *.DFM}


type
	TTclCmdDbQuick = class(TTclCmdDbDef)
    protected
    	function GethDb: hDbiDb; override;
        function GetTableType: string; override;
        function GetLocale: pointer; override;
    end;

function TTclCmdDbQuick.GethDb: hDbiDb;
begin
	result := nil;
end;

function TTclCmdDbQuick.GetTableType: string;
begin
	result := 'PARADOX';
end;

function TTclCmdDbQuick.GetLocale: pointer;
begin
	result := nil;
end;

function GetTempDir: string;
var
	len: integer;
begin
	len := GetTempPath(0, nil);
	if len < 1 then
    	Exception.Create('Cannot get temp directory');
    SetString(result, nil, len);
    len := GetTempPath(len, pChar(result));
    if len < 1 then
    	Exception.Create('Error getting temp directory');
end;

const
	cPrivAlias = 'PrivMakeTable';

procedure TForm1.Button1Click(Sender: TObject);
var
	cmd: TTclCmdDbQuick;
    cmdSession: TTclCmdSession;
    tmp, str, opt1, opt2: string;
    ok: boolean;
begin
    tmp := GetTempDir;
	opt1 := format('-o%s=%s',[szCFGDBPATH, tmp]);
    opt2 := format('-o%s=%s',[szCFGDBDEFAULTDRIVER, szPARADOX]);
    cmdSession := TTclCmdSession.Create(nil, 'Default', true, false);
	cmd := TTclCmdDbQuick.Create(nil);
    try
		cmdSession.Command := 'Session';
    	cmd.Command := 'Table';
        ok := cmdSession.EmulateArray(str, ['Open']);
        if ok then
	        ok := cmdSession.EmulateArray(str, ['IsAlias', cPrivAlias]);
        if ok and (str = '0') then
        	ok := cmdSession.EmulateArray(str, ['AddAlias', cPrivAlias, 'STANDARD', pChar(opt1), pChar(opt2)]);
		if ok then
        	AliasLabel.Caption := 'Temporary Alias Path: ' + tmp;
        if  not ok
        	or not cmd.EmulateArray(str, ['FldDesc','Add'])
        	or not cmd.EmulateArray(str, ['FldDesc', '0', 'Name', 'AccountNo'])
            or not cmd.EmulateArray(str, ['FldDesc', '0', 'FldType', 'int32'])
            or not cmd.EmulateArray(str, ['IdxDesc', 'Add'])
            or not cmd.EmulateArray(str, ['IdxDesc', '0', 'Primary', 'True'])
            or not cmd.EmulateArray(str, ['IdxDesc', '0', 'Unique', 'True'])
            or not cmd.EmulateArray(str, ['IdxDesc', '0', 'FldsInKey', '1'])
            or not cmd.EmulateArray(str, ['IdxDesc', '0', 'KeyFld', '0', '1'])
            or not cmd.EmulateArray(str, ['CreateTable', cPrivAlias,'account.tmp', '-w+', '-f', '-i']) then
		ShowMessage(str);
	finally
    	cmd.Free;
        cmdSession.Free;
    end;
end;

procedure DoPrivAlias;
begin
	Session.Open;
	if not Session.IsAlias(cPrivAlias) then
		Session.AddStandardAlias(cPrivAlias, GetTempDir, 'PARADOX');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
	cmd: TTclCmdDbQuick;
    db: hDbiDb;
begin
	cmd := TTclCmdDbQuick.Create(nil);
    try
		cmd.FldDsc.Inflate(1);
        cmd.FldDsc.Name[0] := 'AccountNo';
        cmd.FldDsc.FldType[0] := fldINT32;
        cmd.IdxDsc.Inflate(1);
        cmd.IdxDsc.Primary[0] := True;
        cmd.IdxDsc.Unique[0] := True;
        cmd.IdxDsc.FldsInKey[0] := 1;
        cmd.IdxDsc.KeyFld[0,0] := 1;
        DoPrivAlias;
   	   	Check(DbiOpenDatabase(cPrivAlias, nil, dbiReadWrite, dbiOpenShared, nil, 0, nil, nil, db));
		try
			cmd.CreateTable(db, 'Account.tmp', 'PARADOX', '', True, [roFields, roIndexes]);
        finally
        	Check(DbiCloseDatabase(db));
        end;
	finally
    	cmd.Free;
    end;
end;

end.
