Sybase NNTP forums - End Of Life (EOL)

The NNTP forums from Sybase - forums.sybase.com - are now closed.

All new questions should be directed to the appropriate forum at the SAP Community Network (SCN).

Individual products have links to the respective forums on SCN, or you can go to SCN and search for your product in the search box (upper right corner) to find your specific developer center.

CodeGear RAD Studio 2007 - VCL Forms Application - Delphi for .NET

12 posts in DelphidotNet Last posting was on 2008-03-24 14:22:46.0Z
Philip L Jackson Posted on 2007-10-28 21:07:24.0Z
Reply-To: "Philip L Jackson" <philip@pcdata.co.uk>
From: "Philip L Jackson" <philip@pcdata.co.uk>
Newsgroups: Advantage.DelphidotNet
Subject: CodeGear RAD Studio 2007 - VCL Forms Application - Delphi for .NET
Date: Sun, 28 Oct 2007 21:07:24 -0000
Lines: 16
Organization: PC Data Services
MIME-Version: 1.0
Content-Type: text/plain; format=flowed; charset="iso-8859-1"; reply-type=original
Content-Transfer-Encoding: 7bit
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Windows Mail 6.0.6000.16480
X-MimeOLE: Produced By Microsoft MimeOLE V6.0.6000.16480
NNTP-Posting-Host: 213.249.225.65
Message-ID: <4724f898@solutions.advantagedatabase.com>
X-Trace: 28 Oct 2007 15:01:12 -0700, 213.249.225.65
Path: solutions.advantagedatabase.com!solutions.advantagedatabase.com!213.249.225.65
Xref: solutions.advantagedatabase.com Advantage.DelphidotNet:111
Article PK: 1108544

All

ADAC.EXE has installed all the expected components into the CodeGear RAD
Studio 2007 - VCL Forms Application - Delphi for Win32 application - but
none into the Delphi for .NET.

I have also installed the Advantage .NET Data Provider but can not find
instructions on how to install this into Studio 2007.

Advice on which component to instal into Delphi for .NET and how, would be
very welcome so that I can write a VCL Forms Application but in .NET

Thanks in advance

Philip L Jackson


Joachim Duerr (ADS) Posted on 2007-10-29 10:46:05.0Z
From: "Joachim Duerr (ADS)" <jojo.duerr@gmx.de>
Subject: Re: CodeGear RAD Studio 2007 - VCL Forms Application - Delphi for .NET
Newsgroups: Advantage.DelphidotNet
References: <4724f898@solutions.advantagedatabase.com>
Organization: iAnywhere
User-Agent: XanaNews/1.18.1.2
X-Face: ,QMv7[luB)BpWAQ~:"kw6n%0ieY63.:g2K3n~8ky0;||5Xle*Xq+=~<Fy:0CVC2nx@8~vZ
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
NNTP-Posting-Host: 10.56.66.108
Message-ID: <4725abdd@solutions.advantagedatabase.com>
Date: 29 Oct 2007 03:46:05 -0700
X-Trace: 29 Oct 2007 03:46:05 -0700, 10.56.66.108
Lines: 21
Path: solutions.advantagedatabase.com!solutions.advantagedatabase.com!10.56.66.108
Xref: solutions.advantagedatabase.com Advantage.DelphidotNet:112
Article PK: 1108547


Philip L Jackson wrote in <4724f898@solutions.advantagedatabase.com>:

> ADAC.EXE has installed all the expected components into the CodeGear
> RAD Studio 2007 - VCL Forms Application - Delphi for Win32
> application - but none into the Delphi for .NET.
>
> I have also installed the Advantage .NET Data Provider but can not
> find instructions on how to install this into Studio 2007.
>
> Advice on which component to instal into Delphi for .NET and how,
> would be very welcome so that I can write a VCL Forms Application but
> in .NET

we do currently not support RAD Studio 2007, only Delphi 2007 (which
was the release without the .NET part).

--
Joachim Duerr
System Consultant (Advantage Database Server)
Sybase iAnywhere
advantagesupport[AT]ianywhere.com


Tony Bretado Posted on 2007-11-08 19:19:34.0Z
Reply-To: "Tony Bretado" <tony@bretado.com>
From: "Tony Bretado" <tony@lacuracao.net>
Newsgroups: Advantage.DelphidotNet
References: <4724f898@solutions.advantagedatabase.com> <4725abdd@solutions.advantagedatabase.com>
Subject: Re: CodeGear RAD Studio 2007 - VCL Forms Application - Delphi for .NET
Date: Thu, 8 Nov 2007 11:19:34 -0800
Lines: 13
Organization: La Curacao
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 6.00.2900.3138
X-RFC2646: Format=Flowed; Original
X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2900.3198
NNTP-Posting-Host: 206.170.79.5
Message-ID: <47335ff0@solutions.advantagedatabase.com>
X-Trace: 8 Nov 2007 12:13:52 -0700, 206.170.79.5
Path: solutions.advantagedatabase.com!solutions.advantagedatabase.com!206.170.79.5
Xref: solutions.advantagedatabase.com Advantage.DelphidotNet:113
Article PK: 1108548

Hi Philip,

you said "we do currently not support RAD Studio 2007" (Delphi dot net part)

I would like to know if you plan to support it in the future.
and also if you have a date for future release.

I know i might be asking too much, but I really needed!!


thank you in advanced for any info you can provide


Jeremy Mullin Posted on 2007-11-12 23:15:10.0Z
Date: Mon, 12 Nov 2007 23:15:10 +0000 (UTC)
Message-ID: <1b468bc82d4a58c9f35e5573b956@devzone.advantagedatabase.com>
From: Jeremy Mullin <no@email.com>
Subject: Re: CodeGear RAD Studio 2007 - VCL Forms Application - Delphi for .NET
Newsgroups: Advantage.DelphidotNet
References: <47335ff0@solutions.advantagedatabase.com>
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
Content-Type: text/plain; charset=iso-8859-1; format=flowed
X-Newsreader: JetBrains Omea Reader 1098.1
NNTP-Posting-Host: 10.24.38.114
X-Trace: 12 Nov 2007 16:09:54 -0700, 10.24.38.114
Lines: 28
Path: solutions.advantagedatabase.com!solutions.advantagedatabase.com!10.24.38.114
Xref: solutions.advantagedatabase.com Advantage.DelphidotNet:114
Article PK: 1108549

Hi Tony,

Support for the .net personality will be in our 9.0 beta, which should be
out at the very end of this month. After that we will be adding support to
v8.1 as well, but I do not have a firm timeframe on it yet. Probably not
until the beginning of next year.

The only work left to be done is on the installation, however. If you are
handy at compiling packages and installing them manually, I can post the
source code.

J.D. Mullin
Advantage R&D

> Hi Philip,
>
> you said "we do currently not support RAD Studio 2007" (Delphi dot net
> part)
>
> I would like to know if you plan to support it in the future. and also
> if you have a date for future release.
>
> I know i might be asking too much, but I really needed!!
>
> thank you in advanced for any info you can provide
>


"Philip L Jackson" <philip Posted on 2007-11-16 18:21:42.0Z
From: "Philip L Jackson" <philip@pcdata<removeme>.co.uk>
Newsgroups: Advantage.DelphidotNet
References: <47335ff0@solutions.advantagedatabase.com> <1b468bc82d4a58c9f35e5573b956@devzone.advantagedatabase.com>
Subject: Re: CodeGear RAD Studio 2007 - VCL Forms Application - Delphi for .NET
Date: Fri, 16 Nov 2007 18:21:42 -0000
Lines: 45
Organization: PC Data Services
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 6.00.2900.3138
X-RFC2646: Format=Flowed; Response
X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2900.3198
NNTP-Posting-Host: 213.249.186.153
Message-ID: <473dde76@solutions.advantagedatabase.com>
X-Trace: 16 Nov 2007 11:16:22 -0700, 213.249.186.153
Path: solutions.advantagedatabase.com!solutions.advantagedatabase.com!213.249.186.153
Xref: solutions.advantagedatabase.com Advantage.DelphidotNet:116
Article PK: 1108550

Hi

Same response - if it works with 8.1 then I am also very interested as it
will save me having to get a shed load of Visual Basic Code written.

If its only for 9.0 then no point as I could not use this in a production
environment.

Regards

PLJ

"Jeremy Mullin" <no@email.com> wrote in message
news:1b468bc82d4a58c9f35e5573b956@devzone.advantagedatabase.com...
> Hi Tony,
>
> Support for the .net personality will be in our 9.0 beta, which should be
> out at the very end of this month. After that we will be adding support to
> v8.1 as well, but I do not have a firm timeframe on it yet. Probably not
> until the beginning of next year.
>
> The only work left to be done is on the installation, however. If you are
> handy at compiling packages and installing them manually, I can post the
> source code.
>
> J.D. Mullin
> Advantage R&D
>
>> Hi Philip,
>>
>> you said "we do currently not support RAD Studio 2007" (Delphi dot net
>> part)
>>
>> I would like to know if you plan to support it in the future. and also
>> if you have a date for future release.
>>
>> I know i might be asking too much, but I really needed!!
>>
>> thank you in advanced for any info you can provide
>>
>
>


Tony Bretado Posted on 2007-11-16 01:56:42.0Z
Reply-To: "Tony Bretado" <tony@bretado.com>
From: "Tony Bretado" <tony@lacuracao.net>
Newsgroups: Advantage.DelphidotNet
References: <47335ff0@solutions.advantagedatabase.com> <1b468bc82d4a58c9f35e5573b956@devzone.advantagedatabase.com>
Subject: Re: CodeGear RAD Studio 2007 - VCL Forms Application - Delphi for .NET
Date: Thu, 15 Nov 2007 17:56:42 -0800
Lines: 48
Organization: La Curacao
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 6.00.2900.3138
X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2900.3198
X-RFC2646: Format=Flowed; Response
NNTP-Posting-Host: 206.170.79.5
Message-ID: <473cf79d@solutions.advantagedatabase.com>
X-Trace: 15 Nov 2007 18:51:25 -0700, 206.170.79.5
Path: solutions.advantagedatabase.com!solutions.advantagedatabase.com!206.170.79.5
Xref: solutions.advantagedatabase.com Advantage.DelphidotNet:115
Article PK: 1108552

Hi Jeremy,

Thank you for replying.

you said "The only work left to be done is on the installation, however. If
you are handy at compiling packages and installing them manually, I can post
the source code"

If the package is for Advantage v8.1, I can compile and install it with no
problem at all.
But if the package will work only with Advantage v.9(b) I prefer to wait.

In any case, thank you.

Tony

"Jeremy Mullin" <no@email.com> wrote in message
news:1b468bc82d4a58c9f35e5573b956@devzone.advantagedatabase.com...
> Hi Tony,
>
> Support for the .net personality will be in our 9.0 beta, which should be
> out at the very end of this month. After that we will be adding support to
> v8.1 as well, but I do not have a firm timeframe on it yet. Probably not
> until the beginning of next year.
>
> The only work left to be done is on the installation, however. If you are
> handy at compiling packages and installing them manually, I can post the
> source code.
>
> J.D. Mullin
> Advantage R&D
>
>> Hi Philip,
>>
>> you said "we do currently not support RAD Studio 2007" (Delphi dot net
>> part)
>>
>> I would like to know if you plan to support it in the future. and also
>> if you have a date for future release.
>>
>> I know i might be asking too much, but I really needed!!
>>
>> thank you in advanced for any info you can provide
>>
>
>


Jeremy Mullin Posted on 2007-11-21 15:29:18.0Z
Date: Wed, 21 Nov 2007 15:29:18 +0000 (UTC)
Message-ID: <1b468bc82ddf28c9fa2fbe72be1f@devzone.advantagedatabase.com>
From: Jeremy Mullin <no@email.com>
Subject: Re: CodeGear RAD Studio 2007 - VCL Forms Application - Delphi for .NET
Newsgroups: Advantage.DelphidotNet
References: <473cf79d@solutions.advantagedatabase.com>
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
Content-Type: text/plain; charset=iso-8859-1; format=flowed
X-Newsreader: JetBrains Omea Reader 1098.1
NNTP-Posting-Host: 10.24.38.114
X-Trace: 21 Nov 2007 08:24:00 -0700, 10.24.38.114
Lines: 55
Path: solutions.advantagedatabase.com!solutions.advantagedatabase.com!10.24.38.114
Xref: solutions.advantagedatabase.com Advantage.DelphidotNet:120
Article PK: 1108555

It will work with 8.1.

Swamped trying to get the 9.0 beta out right now, but I will post it when
I have some time.

J.D. Mullin
Advantage R&D

> Hi Jeremy,
>
> Thank you for replying.
>
> you said "The only work left to be done is on the installation,
> however. If you are handy at compiling packages and installing them
> manually, I can post the source code"
>
> If the package is for Advantage v8.1, I can compile and install it
> with no
> problem at all.
> But if the package will work only with Advantage v.9(b) I prefer to
> wait.
> In any case, thank you.
>
> Tony
>
> "Jeremy Mullin" <no@email.com> wrote in message
> news:1b468bc82d4a58c9f35e5573b956@devzone.advantagedatabase.com...
>
>> Hi Tony,
>>
>> Support for the .net personality will be in our 9.0 beta, which
>> should be out at the very end of this month. After that we will be
>> adding support to v8.1 as well, but I do not have a firm timeframe on
>> it yet. Probably not until the beginning of next year.
>>
>> The only work left to be done is on the installation, however. If you
>> are handy at compiling packages and installing them manually, I can
>> post the source code.
>>
>> J.D. Mullin
>> Advantage R&D
>>> Hi Philip,
>>>
>>> you said "we do currently not support RAD Studio 2007" (Delphi dot
>>> net part)
>>>
>>> I would like to know if you plan to support it in the future. and
>>> also if you have a date for future release.
>>>
>>> I know i might be asking too much, but I really needed!!
>>>
>>> thank you in advanced for any info you can provide
>>>


Jeremy Mullin Posted on 2007-11-21 23:12:01.0Z
Date: Wed, 21 Nov 2007 23:12:01 +0000 (UTC)
Message-ID: <1b468bc82e2648c9fa70627f5701@devzone.advantagedatabase.com>
From: Jeremy Mullin <no@email.com>
Subject: Re: CodeGear RAD Studio 2007 - VCL Forms Application - Delphi for .NET
Newsgroups: Advantage.DelphidotNet
References: <473cf79d@solutions.advantagedatabase.com>
MIME-Version: 1.0
Content-Transfer-Encoding: Quoted-Printable
Content-Type: multipart/mixed; boundary="--++Omea_Parts_Splitter.222732345211661"
X-Newsreader: JetBrains Omea Reader 1098.1
NNTP-Posting-Host: 10.24.38.114
X-Trace: 21 Nov 2007 16:06:43 -0700, 10.24.38.114
Lines: 2870
Path: solutions.advantagedatabase.com!solutions.advantagedatabase.com!10.24.38.114
Xref: solutions.advantagedatabase.com Advantage.DelphidotNet:124
Article PK: 1108570

I have attached the 2 files that required updates (adscnnct.pas and versions.inc). Replace your existing versions with these.

I have also attached the new project files. Copy those in to the same directory as the existing source.

Go to the component->installed packages menu and remove your existing Advantage components
Open Advantage.vcl.adsd2007studio.dproj and build it.
Close that project.
Open Advantage.vcl.adsd2007dstudio.dproj and build and install it.

That should be it. Let me know if you run into any problems.

J.D. Mullin
Advantage R&D


Tony Bretado Posted on 2007-11-30 06:57:43.0Z
Reply-To: "Tony Bretado" <tony@bretado.com>
From: "Tony Bretado" <tony@bretado.com>
Newsgroups: Advantage.DelphidotNet
References: <473cf79d@solutions.advantagedatabase.com> <1b468bc82e2648c9fa70627f5701@devzone.advantagedatabase.com>
In-Reply-To: <1b468bc82e2648c9fa70627f5701@devzone.advantagedatabase.com>
Subject: Re: CodeGear RAD Studio 2007 - VCL Forms Application - Delphi for .NET
Date: Thu, 29 Nov 2007 22:57:43 -0800
Lines: 8701
Organization: Bretado Software
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="----=_NextPart_000_00AF_01C832DB.4135F160"
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Windows Mail 6.0.6000.16480
X-MimeOLE: Produced By Microsoft MimeOLE V6.0.6000.16545
NNTP-Posting-Host: 75.47.144.183
Message-ID: <474fb339@solutions.advantagedatabase.com>
X-Trace: 29 Nov 2007 23:52:41 -0700, 75.47.144.183
Path: solutions.advantagedatabase.com!solutions.advantagedatabase.com!75.47.144.183
Xref: solutions.advantagedatabase.com Advantage.DelphidotNet:125
Article PK: 1108574

Hi Jeremy!!

Thank you very "mucho" for dropping this Ads/vcl/net for Delphi 2007 .NET!

I adjusted a couple of things and now is working!

there were 2 missing files:
advantage.vcl.adsd2007.assemblyinfo.pas
& advantage.vcl.adsd2007d.assemblyinfo.pas
but I got'em from delphi2006\dotNet folder and edited 'em.

Also I needed to edit:
advantage.vcl.adscnnct.pas:
procedure SetQueryParams
procedure TAdsConnection.GetTableNames
procedure TAdsConnection.GetTableAndLinkNames

advantage.vcl.adstable.pas:
function TAdsQuery.InternalExecute
procedure TAdsStoredProc.BindParams

After this few edited lines I follow your instructions and everythins seems
to be OK.

Again, thanks U so much.

Tony Bretado

P.S. I attach this files so you can examine them and correct them if needed
it, and make them available for other people.


"Jeremy Mullin" <no@email.com> wrote in message
news:1b468bc82e2648c9fa70627f5701@devzone.advantagedatabase.com...
I have attached the 2 files that required updates (adscnnct.pas and
versions.inc). Replace your existing versions with these.

I have also attached the new project files. Copy those in to the same
directory as the existing source.

Go to the component->installed packages menu and remove your existing
Advantage components
Open Advantage.vcl.adsd2007studio.dproj and build it.
Close that project.
Open Advantage.vcl.adsd2007dstudio.dproj and build and install it.

That should be it. Let me know if you run into any problems.

J.D. Mullin
Advantage R&D

// Copyright (c) 2002-2005 Extended Systems, Inc. ALL RIGHTS RESERVED.
//
// This source code can be used, modified, or copied by the licensee as long as
// the modifications (or the new binary resulting from a copy or modification of
// this source code) are used with Extended Systems' products. The source code
// is not redistributable as source code, but is redistributable as compiled
// and linked binary code. If the source code is used, modified, or copied by
// the licensee, Extended Systems Inc. reserves the right to receive from the
// licensee, upon request, at no cost to Extended Systems Inc., the modifications.
//
// Extended Systems Inc. does not warrant that the operation of this software
// will meet your requirements or that the operation of the software will be
// uninterrupted, be error free, or that defects in software will be corrected.
// This software is provided "AS IS" without warranty of any kind. The entire
// risk as to the quality and performance of this software is with the purchaser.
// If this software proves defective or inadequate, purchaser assumes the entire
// cost of servicing or repair. No oral or written information or advice given
// by an Extended Systems Inc. representative shall create a warranty or in any
// way increase the scope of this warranty.
{*******************************************************************************
* Source File : adscnnct.pas
* Description : Implementation of AdsConnection component
* Notes :
*******************************************************************************}
unit Advantage.Vcl.AdsCnnct;

{* Override any compiler directives we don't want, but that that user might have
* defined in their project. *}
{$T-} // turns off typed @ operator
{$B-} // use short-circuit boolean expressions
{$R-} // no range checking
{$V-} // no var-string checking

{$INCLUDE Advantage.Delphi.Versions.inc}

{$WARN UNIT_PLATFORM OFF}

interface

uses
SysUtils,
Classes,
ace,
adsset,
DB,
System.Runtime.InteropServices,
Borland.Vcl.DBCommon,
IniFiles,
System.Threading;


type

{* Options for creating Data Dictionary links *}
TAdsLinkOption = ( loGlobal, loAuthenticateActiveUser, loPathIsStatic );
TAdsLinkOptions = set of TAdsLinkOption;

{* Class for errors in the AdsConnection component *}
AdsConnectionError = class(Exception)
public
constructor Create( acMsg: String );
destructor Destroy; override;
end; {* AdsConnectionError *}


{* Possible settings for the communications compression *}
TAdsCompressionTypes = ( ccAdsCompressionNotSet, ccAdsCompressInternet, ccAdsCompressAlways, ccAdsCompressNever );

TAdsConnectionTableTypes = ( ttAdsConnectUnspecified, ttAdsConnectCDX, ttAdsConnectNTX, ttAdsConnectADT );

TAdsCommunicationType = ( ctAdsDefault, ctAdsUDPIP, ctAdsIPX, ctAdsTCPIP );

{* This type is used by the TAdsConnection.Execute method *}
PStmtInfo = IntPtr; // pointer to TStmtInfo
TStmtInfo = packed record
HashCode: Int32; // offset 0
StmtHandle: ADSHANDLE; // offset 4
SQLText: IntPtr; // offset 8
end;

{* Forward Declarations *}
TAdsConnection = class;

{* TAdsConnection-specific events *}
TAdsDatabaseLoginEvent = procedure( AdsConnection: TAdsConnection;
var Username : String;
var Password : String ) of object;

{ This is a class to encapsulate the ADS options }
TAdsDatasetOptions = record
musAdsLockType : UNSIGNED16; { Specific table lock type }
musAdsCharType : UNSIGNED16; { Specific char type }
musAdsRightsCheck : UNSIGNED16; { rights checking is enabled }
musAdsTableType : UNSIGNED16; { Table type }
end;

{*
* TAdsConnection class - instances represent connection to an Advantage
* server.
*}
TAdsConnection = class(TComponent)
protected

FAliasName : String;
FValidAlias : Boolean;
FConnected : Boolean;
FConnectString : String;
FTransactionActive: Boolean;
FhConnection : ADSHANDLE;
FTablesList : TList; {* A list of tables attached to the connection *}
bConnectAfterLoad : Boolean;
mstrAliasPath : String; {* The path associated to an alias *}
meAliasTableType : TAdsConnectionTableTypes;
mFormName : String; {* Name of the form attached to *}
FIsDictionaryConn : Boolean;
FLoginPrompt : Boolean;
FUsername : String;
FPassword : String;
FAdsServerTypes : TAdsServerTypes;
FStmtList : TList;
FMiddleTierConn : Boolean;
FStoredProcConn : Boolean;
FbStoreConnected : Boolean;
FAdsCompression : TAdsCompressionTypes;
FAdsCommunicationType : TAdsCommunicationType;
FReadOnly : Boolean;
FThreadID : Longint;
FGivenConnection : ADSHANDLE; {* connection given to SetHandle *}
{$IFDEF ADSDELPHI6_OR_NEWER}
FUserGroups : TStringList;
{$ENDIF}
FUserGroupsString : string;
FReadUserGroups : Boolean;

{* Declaration of events *}
FAfterCommit: TNotifyEvent;
FBeforeCommit: TNotifyEvent;
FAfterRollback: TNotifyEvent;
FBeforeRollback: TNotifyEvent;
FOnConnect: TNotifyEvent;
FOnDisconnect: TNotifyEvent;
FOnLogin: TAdsDatabaseLoginEvent;
FAfterConnect: TNotifyEvent;
FAfterDisconnect: TNotifyEvent;
FBeforeConnect: TNotifyEvent;
FBeforeDisconnect: TNotifyEvent;

procedure SetAliasName( strAlias : String ); virtual;
procedure SetConnected( bActive: Boolean ); virtual;
function GetConnectionType : String; virtual;
function GetConnectString : String; virtual;
procedure SetConnectString( strConnect: String ); virtual;
function GetServerName : String; virtual;
function GetTransactionActive : Boolean; virtual;
function GetIsConnectionAlive : Boolean; virtual;
function GetConnectionHandle : LongInt; virtual;
function GetDataSet(Index: Integer): TDataSet; virtual;
function GetDataSetCount : Integer; virtual;
procedure ClearStatements; virtual;
procedure PerformRollback; virtual;

{* event handler functions *}
procedure DoAfterCommit; virtual;
procedure DoBeforeCommit; virtual;
procedure DoAfterRollback; virtual;
procedure DoBeforeRollback; virtual;
procedure DoOnConnect; virtual;
procedure DoOnDisconnect; virtual;

procedure Loaded; override;
procedure SetName(const Value: TComponentName); override;
function GetDictionaryFlag : Boolean; virtual;
procedure GetAdsConnection( strPath : String ); virtual;
function GetVersionMajor : Integer;
function GetVersionMinor : Integer;
{$IFDEF ADSDELPHI6_OR_NEWER}
function GetUserGroups : TStringList; virtual;
{$ENDIF}
function GetUserGroupsString : string; virtual;
procedure RefreshUserGroups; virtual;

public
constructor Create(Owner: TComponent); override;
constructor CreateWithHandle(Owner: TComponent; Handle : cardinal );
destructor Destroy; override;
procedure Initialize;

{* properties *}
property ConnectionType: String read GetConnectionType;
property TransactionActive: Boolean read GetTransactionActive;
property IsDictionaryConn: Boolean read GetDictionaryFlag;
property IsConnectionAlive: Boolean read GetIsConnectionAlive;
property DataSets[Index: Integer]: TDataSet read GetDataSet;
property DataSetCount: Integer read GetDataSetCount;
property Handle : ADSHANDLE read FhConnection;
property ConnectionThreadID : Longint read FThreadID;
property DDVersionMajor : Integer read GetVersionMajor;
property DDVersionMinor : Integer read GetVersionMinor;
{$IFDEF ADSDELPHI6_OR_NEWER}
property UserGroups: TStringList read GetUserGroups;
{$ENDIF}
property UserGroupsString: string read GetUserGroupsString;

{* methods *}
procedure Connect; virtual;
procedure Disconnect; virtual;
procedure AddTableToConnectList( Table: TDataSet ); virtual;
function GetConnectionPath : string; virtual;
function GetConnectionWithDDPath : string; virtual;
function GetAdsTableType : TAdsConnectionTableTypes; virtual;
procedure RemoveTableFromConnectList( oCallee : TDataSet ); virtual;
procedure BeginTransaction; virtual;
procedure Commit; virtual;
procedure GetTableNames( poList : TStrings; strFileMask : String ); virtual;
procedure GetTableAndLinkNames( poLinkNames : TStrings; poTableNames : TStrings; strFileMask : String ); virtual;
procedure GetProcedureNames( poList : TStrings ); virtual;

procedure CreateSavepoint( strSavepoint : string ); virtual;
{$IFDEF ADSDELPHI4_OR_NEWER}

procedure Rollback; overload; virtual;
procedure Rollback( strSavepoint : string ); overload; virtual;

function Execute( oAdsDatasetOptions : TAdsDatasetOptions; const SQL: string;
Params: TParams; Cache: Boolean; var Cursor: cardinal): Integer; overload; virtual;
function Execute( oAdsDatasetOptions : TAdsDatasetOptions; const SQL: string
): Integer; overload; virtual;
function Execute( oAdsDatasetOptions : TAdsDatasetOptions; const SQL: string;
Params: TParams ): Integer; overload; virtual;
function Execute( oAdsDatasetOptions : TAdsDatasetOptions; const SQL: string;
Params: TParams; Cache: Boolean): Integer; overload; virtual;

function Execute( const SQL: string; Params: TParams;
Cache: Boolean; var Cursor: cardinal ): Integer; overload; virtual;
function Execute( const SQL: string ): Integer; overload; virtual;
function Execute( const SQL: string; Params: TParams ): Integer; overload; virtual;
function Execute( const SQL: string; Params: TParams;
Cache: Boolean ): Integer; overload; virtual;
{$ELSE}
procedure Rollback; virtual;
{$ENDIF}
function GetNumActiveDDLinks : integer; virtual;
procedure GetActiveDDLinkInfo( iLinkNum : integer; poList : TStrings ); virtual;
procedure CreateDDLink( strLinkAlias : string;
strLinkedDDPath : string;
strUserName : string;
strPassword : string;
Options : TAdsLinkOptions );
procedure DropDDLink( strLinkedDD : string;
bDropGlobal : boolean );
procedure SetHandle( hConnection : ADSHANDLE );
procedure ClearHandle;
function GetServerTime : TDateTime; virtual;
procedure CloseCachedTables; virtual;

published
{* published properties *}
property AliasName: String read FAliasName write SetAliasName;
property IsConnected: Boolean read FConnected write SetConnected stored FbStoreConnected;
property ConnectPath: String read GetConnectString write SetConnectString;
property ServerName: String read GetServerName;
property ConnectionHandle: LongInt read GetConnectionHandle;
property AdsServerTypes: TAdsServerTypes read FAdsServerTypes write FAdsServerTypes;
property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt;
property Username: String read FUsername write FUsername;
property Password: String read FPassword write FPassword;
property MiddleTierConnection: Boolean read FMiddleTierConn write FMiddleTierConn default FALSE;
property StoreConnected : Boolean read FbStoreConnected write FbStoreConnected default TRUE;
property StoredProcedureConnection: Boolean read FStoredProcConn write FStoredProcConn default FALSE;
property Compression: TAdsCompressionTypes read FAdsCompression write FAdsCompression;
property CommunicationType: TAdsCommunicationType read FAdsCommunicationType write FAdsCommunicationType;
property ReadOnly : Boolean read FReadOnly write FReadOnly default FALSE;

{* events *}
property AfterCommit: TNotifyEvent read FAfterCommit write FAfterCommit;
property BeforeCommit: TNotifyEvent read FBeforeCommit write FBeforeCommit;
property AfterRollback: TNotifyEvent read FAfterRollback write FAfterRollback;
property BeforeRollback: TNotifyEvent read FBeforeRollback write FBeforeRollback;
property OnConnect: TNotifyEvent read FOnConnect write FOnConnect;
property OnDisconnect: TNotifyEvent read FOnDisconnect write FOnDisconnect;
property AfterConnect: TNotifyEvent read FAfterConnect write FAfterConnect;
property BeforeConnect: TNotifyEvent read FBeforeConnect write FBeforeConnect;
property AfterDisconnect: TNotifyEvent read FAfterDisconnect write FAfterDisconnect;
property BeforeDisconnect: TNotifyEvent read FBeforeDisconnect write FBeforeDisconnect;
property OnLogin: TAdsDatabaseLoginEvent read FOnLogin write FOnLogin;

end; {* TAdsConnection class *}

function GetConnectionList : TThreadList;
function LockConnectionList : TList;
procedure UnlockConnectionList;
procedure DDCreateLink( hConnection : cardinal;
strLinkAlias : string;
strLinkedDDPath : string;
strUserName : string;
strPassword : string;
Options : TAdsLinkOptions );
procedure DDDropLink( hConnection : cardinal;
strLinkedDD : string;
bDropGlobal : boolean );
function GetThreadID : Longint;

implementation

uses
adsfunc,
adsdata,
{$IFNDEF ADSDELPHI6_OR_NEWER}
DBLogDlg,
{$ENDIF}
{$IFDEF LINUX}
Libc, // for pthread_self.. ie CurrentThreadID
{$ENDIF}
aceunpub;

function GetAliasInfo( strAlias : string; var strPath : string;
var eTableType : TAdsConnectionTableTypes ) : boolean; forward;

var
oAdsConnections : TThreadList;
gDefaultStmtOptions : TAdsDatasetOptions;

{*******************************************************************************
* Module : GetThreadID
* Parameters :
* Returns : Return the current executing threadID
* Description :
*******************************************************************************}
function GetThreadID : Longint;
begin
{$IFDEF ADSDELPHI2007_OR_NEWER}
Result := Thread.CurrentThread.ManagedThreadId;
{$ELSE}
Result := AppDomain.GetCurrentThreadID;
{$ENDIF}
end;

{*******************************************************************************
* Module : GetConnectionList
* Parameters :
* Returns : Return a reference to the oAdsConnections object
* Description :
*******************************************************************************}
function GetConnectionList: TThreadList;
begin
Result := oAdsConnections;
end;


{*******************************************************************************
* Module : LockConnectionList
* Parameters :
* Returns : TList object that the TThreadList contains
* Description : Locks the TThreadList and returns the TList object it's
* protecting
*******************************************************************************}
function LockConnectionList : TList;
begin
Result := oAdsConnections.LockList;
end;


{*******************************************************************************
* Module : UnlockConnectionList
* Parameters :
* Returns :
* Description : Unlocks the TThreadList (leaves critical section)
*******************************************************************************}
procedure UnlockConnectionList;
begin
oAdsConnections.UnlockList;
end;


{* AdsConnectionError exeption handler class implementation *}

{*******************************************************************************
* Module: : AdsConnectionError.Create
* Parameters : Msg - Error message
* Returns : void
* Description :
*******************************************************************************}
constructor AdsConnectionError.Create( acMsg: String );
begin
inherited create( string( acMsg ) );
end; {* AdsConnectionError::Create *}



{*******************************************************************************
* Module: : AdsConnectionError.Destroy
* Parameters : none
* Returns : void
* Description :
*******************************************************************************}
destructor AdsConnectionError.Destroy;
begin
inherited Destroy;
end; {* AdsConnectionError::Destroy *}



{* TAdsConnection class implementation *}

{*******************************************************************************
* Module : TAdsConnection::Initialize
* Parameters :
* Returns : void
* Description : used by the Create constructor and the CreateWithHandle
* constructor because delphi.net doesn't support virtual
* constructors like win32 does (this code used to be in
* the base constructor).
*******************************************************************************}
procedure TAdsConnection.Initialize;
begin
{* Initialize component values *}
FAliasName := '';
FValidAlias := TRUE;
FConnectString := '';
FConnected := FALSE;
FhConnection := 0;
FTransactionActive := FALSE;
FTablesList := TList.Create;
bConnectAfterLoad := False;
mstrAliasPath := '';
meAliasTableType := ttAdsConnectUnspecified;
AdsServerTypes := [];
if ( Owner <> nil ) then
mFormName := owner.name;
FIsDictionaryConn := FALSE;
FLoginPrompt := TRUE;
FMiddleTierConn := FALSE;
FStoredProcConn := FALSE;
FbStoreConnected := TRUE;
FReadOnly := FALSE;
FAdsCompression := ccAdsCompressionNotSet;
FAdsCommunicationType := ctAdsDefault;
FThreadID := GetThreadID;
FGivenConnection := 0;
FReadUserGroups := FALSE;

{* maintain a list of all TAdsConnecion instances *}
if ( oAdsConnections = nil ) then
oAdsConnections := TThreadList.Create();

oAdsConnections.Add( self );

{* maintain a list of groups this user belongs to (if dd connection). In
* older version of delphi where the TStringList doesn't have a delimiter
* property, we provide a string of ; delimited names, instead of the
* nice string list *}
{$IFDEF ADSDELPHI6_OR_NEWER}
FUserGroups := TStringList.Create();
if not assigned( FUserGroups ) then
raise Exception.Create( 'Error allocating internal group list.' );
FUserGroups.Delimiter := ';';
{$ENDIF}
FUserGroupsString := '';
end;

{*******************************************************************************
* Module : TAdsConnection::Create
* Parameters : Owner - component that owns this instance
* Returns : void
* Description : constructor for the TAdsConnection class
*******************************************************************************}
constructor TAdsConnection.Create(Owner: TComponent);
begin
inherited Create(Owner); { Initialize inherited parts }
Initialize;
{* Don't add code here, add it to the Initialize method *}
end; {* TAdsConnection::Create *}


{*******************************************************************************
* Module : TAdsConnection::CreateWithHandle
* Parameters : Owner - component that owns this instance
* : Handle - Active ACE connection handle
* Returns : void
* Description : constructor for the TAdsConnection class, used to setup
* an active connection from an existing ACE handle.
*******************************************************************************}
constructor TAdsConnection.CreateWithHandle(Owner: TComponent; Handle : cardinal );
begin
inherited Create(Owner); { Initialize inherited parts }
Initialize;

SetHandle( Handle );
end;



{*******************************************************************************
* Module : TAdsConnection::Destroy
* Parameters : none
* Returns : void
* Description : destructor for the TAdsConnection class
*******************************************************************************}
destructor TAdsConnection.Destroy;
var ulRetVal: LongInt;
i : integer;
begin
{* clean up connection is one is held by the component *}
if ( FConnected ) then
begin
{* before we destroy we need to make sure to close all associated tables *}
for i := 0 to FTablesList.Count - 1 do
begin
TDataSet(FTablesList[i]).Active := False;
TAdsDataSet(FTablesList[i]).InvalidateAceHandles;
TAdsDataSet(FTablesList[i]).mpoAdsConnection := nil;
end;
FTablesList.Free;

{* Clear any cached statement handles *}
ClearStatements;

{* drop the connection to Ads *}
{* don't disconnect if this connection was set using SetHandle *}
ulRetVal := AE_SUCCESS;
if ( FGivenConnection = 0 ) then
ulRetVal := ACE.AdsDisconnect( FhConnection );

{* if it is already disconnected don't raise exception *}
if ( ( ulRetVal <> AE_SUCCESS ) And ( ulRetVal <> AE_INVALID_CONNECTION_HANDLE ) ) then
raise AdsError.Create( ulRetVal, TRUE );

{* Fire a disconnect event *}
DoOnDisconnect;

{* this probably isn't needed, but it's not going to hurt *}
FhConnection := 0;
FConnected := FALSE;
end
else
begin
{* before we destroy we need to make sure to close all associated tables *}
for i := 0 to FTablesList.Count - 1 do
TAdsDataSet(FTablesList[i]).mpoAdsConnection := nil;
FTablesList.Free;

end;

if assigned( oAdsConnections ) then
begin
oAdsConnections.Remove( self );
with oAdsConnections.LockList do
try
Pack;
finally
oAdsConnections.UnlockList;
end; {* With locklist *}
end;

{$IFDEF ADSDELPHI6_OR_NEWER}
if assigned( FUserGroups ) then
FreeAndNil( FUserGroups );
{$ENDIF}

inherited Destroy;

end; {* TAdsConnection::Destroy *}


{*******************************************************************************
* Module : TAdsConnection.RefreshUserGroups
* Description : Reads groups user belongs to from the dictionary
* Note :
*******************************************************************************}
procedure TAdsConnection.RefreshUserGroups;
var
usLen : word;
pucGroups : array of char;
ulRetVal : UNSIGNED32;
hTempConn : cardinal;
begin
{$IFDEF ADSDELPHI6_OR_NEWER}
FUserGroups.Clear;
{$ENDIF}
FUserGroupsString := '';

hTempConn := FhConnection;
SetLength( pucGroups, 0 );

if ( IsDictionaryConn and IsConnected ) then
begin
usLen := 0;
ulRetVal := ACE.AdsDDGetUserProperty( hTempConn,
FUsername,
ADS_DD_USER_GROUP_MEMBERSHIP,
pucGroups,
usLen );
if ( ( ulRetVal <> AE_INSUFFICIENT_BUFFER ) and
( ulRetVal <> AE_PROPERTY_NOT_SET ) ) then
ACECheck( nil, ulRetVal );

if ( usLen > 0 ) then
begin
{* This user belongs to one or more groups. We have more work to do. *}
SetLength( pucGroups, usLen );
try
ACECheck( nil, ACE.AdsDDGetUserProperty( FhConnection,
FUsername,
ADS_DD_USER_GROUP_MEMBERSHIP,
pucGroups,
usLen ) );
{$IFDEF ADSDELPHI6_OR_NEWER}
FUserGroups.DelimitedText := pucGroups;
{$ENDIF}
FUserGroupsString := pucGroups;

FReadUserGroups := TRUE;
finally
pucGroups := nil;
end;
end;
end;

end;


{*******************************************************************************
* Module : TAdsConnection.GetUserGroupsString
* Description : Refresh groups, then return them.
* Note :
*******************************************************************************}
function TAdsConnection.GetUserGroupsString : string;
begin
if not FReadUserGroups then
RefreshUserGroups;
Result := FUserGroupsString;
end;


{*******************************************************************************
* Module : TAdsConnection.GetUserGroups
* Description : Refresh groups, then return them.
* Note :
*******************************************************************************}
{$IFDEF ADSDELPHI6_OR_NEWER}
function TAdsConnection.GetUserGroups : TStringList;
begin
if not FReadUserGroups then
RefreshUserGroups;
Result := FUserGroups;
end;
{$ENDIF}


{*******************************************************************************
* Module : TAdsConnection::GetDataSet
* Parameters : Index - index into table list
* Returns : pointer to TAdsDataSet object
* Description : Returns a pointer to the dataset in question
* Note :
*******************************************************************************}
function TAdsConnection.GetDataSet(Index: Integer): TDataSet;
begin
Result := TDataSet( FTablesList[Index] );
end;



{*******************************************************************************
* Module : TAdsConnection::GetDataSetCount
* Parameters :
* Returns : Number of datasets in the list
* Description :
* Note :
*******************************************************************************}
function TAdsConnection.GetDataSetCount : Integer;
begin
Result := FTablesList.Count;
end;


{*******************************************************************************
* Module : TAdsConnection::GetVersionMajor
* Parameters :
* Returns : Returns Major Version Integer if this is a Dictionary Conn
* Description :
* Note :
*******************************************************************************}
function TAdsConnection.GetVersionMajor : Integer;
var ulMajor, ulLength : UNSIGNED16;
begin
if( FConnected and FIsDictionaryConn ) then
begin
ulLength := SizeOf( UNSIGNED16 );
ACECheck( nil, ACE.AdsDDGetDatabaseProperty( Handle,
ADS_DD_VERSION_MAJOR,
ulMajor,
ulLength ));
Result := ulMajor;
end
else
Result := 0;
end;


{*******************************************************************************
* Module : TAdsConnection::GetVersionMinor
* Parameters :
* Returns : Returns Minor Version Integer if this is a Dictionary Conn
* Description :
* Note :
*******************************************************************************}
function TAdsConnection.GetVersionMinor : Integer;
var ulMinor, ulLength : UNSIGNED16;
begin
if( FConnected and FIsDictionaryConn ) then
begin
ulLength := SizeOf( UNSIGNED16 );
ACECheck( nil, ACE.AdsDDGetDatabaseProperty( Handle,
ADS_DD_VERSION_MINOR,
ulMinor,
ulLength ));
Result := ulMinor;
end
else
Result := 0;
end;


{*******************************************************************************
* Module : TAdsConnection::GetDictionaryFlag
* Parameters :
* Returns :
* Description : Return internal member, FIsDictionaryConn
* Note :
*******************************************************************************}
function TAdsConnection.GetDictionaryFlag : Boolean;
begin
Result := FIsDictionaryConn;
end; {* TAdsConnection.GetDictionaryFlag *}



{*******************************************************************************
* Module : TAdsConnection::GetAdsConnection
* Parameters : pcPath - path to connect to
* Returns :
* Description : Get an ACE connection. Used to abstract the new login
* prompt and dictionary stuff introduced in ADS 6.0
* Note : Most of the login prompt logic in here came from the
* "Controlling Server Login" page in the Delphi 5 help file.
*******************************************************************************}
procedure TAdsConnection.GetAdsConnection( strPath : String );
var
usServerType : UNSIGNED16;
strUserName : String;
strPasswd : String;
ulOptions : UNSIGNED32;
begin

strUserName := '';
strPasswd := '';

{*
* If the FLoginPrompt value is true, and this is a dictionary connection, then show a login prompt.
*}
if ( FLoginPrompt and IsDictionaryConn ) then
begin
{* If an OnLogin event is defined then use that to get the username/passwd *}
if Assigned( FOnLogin ) then
FOnLogin( self, strUserName, strPasswd )
else
begin
strUserName := FUsername;
{$IFNDEF ADSDELPHI6_OR_NEWER}
if not LoginDialogEx( Name, strUserName, strPasswd, FALSE ) then
DatabaseError('Cannot connect to database ''' + Name + '''' );
{$ENDIF}
{$IFDEF ADSDELPHI6_OR_NEWER}
{* Starting with D6 users have to include DBLogDlg in THEIR uses clause if
* they want to see the default login dialog. This is good because it lets
* us remove our dependency on the windows and qt libraries. *}
if Assigned(LoginDialogExProc) then
begin
if not LoginDialogExProc( Name, strUserName, strPasswd, FALSE ) then
DatabaseError('Cannot connect to database ''' + Name + '''' );
end
else
{* The user has loginprompt set to true, but didn't include the
* DBLogDlg unit. Use the password in the component since there's
* no way to prompt. *}
strPasswd := FPassword;
{$ENDIF}
end; {* if assigned FOnLogin, else *}

{* Set the username in the TAdsConnection object, so the user can retrieve it
* if they want to use it for something else. *}
FUsername := strUserName;

{* Only set the password if this is run-time. At design time we don't want to do
* this becuase the developer wouldn't know it happened, and they could then
* save the form with a clear text password in it. This would eventually be
* placed in the executable. *}
if not ( csDesigning in ComponentState ) then
FPassword := strPasswd;
end
else
begin
{* If FLoginPrompt is FALSE then use the values in the username and passwd properties *}
strUserName := FUsername;
strPasswd := FPassword;
end; {* if FLoginPrompt, else *}


{*
* If ACE sees a username or password it assumes the caller is attempting a dictionary
* connection. If this is not a dictionary connection then clear those values, so they
* aren't used if connecting to a non-dd path, but the username property is set.
*}
if not IsDictionaryConn then
begin
strUserName := '';
strPasswd := '';
end;

{*
* Get the server type to send, if usOption ends up being zero then ACE
* will ignore this parameter and use it's global server type for this task.
*}
usServerType := 0;

if stADS_REMOTE in FAdsServerTypes then
usServerType := usServerType or ADS_REMOTE_SERVER;

if stADS_LOCAL in FAdsServerTypes then
usServerType := usServerType or ADS_LOCAL_SERVER;

if stADS_AIS in FAdsServerTypes then
usServerType := usServerType or ADS_AIS_SERVER;

{* Set up any connection options *}
ulOptions := ADS_DEFAULT;
if FMiddleTierConn then
ulOptions := ulOptions or ADS_INC_USERCOUNT;

if FStoredProcConn then
ulOptions := ulOptions or ADS_STORED_PROC_CONN;

{*
* Set the compression option. If the value is "notset", then don't pass
* any option down to ACE. That will let the ads.ini "compression=" setting
* control it. If it is specified here, then it overrides the ini file.
*}
if FAdsCompression = ccAdsCompressInternet then
ulOptions := ulOptions or ADS_COMPRESS_INTERNET
else if FAdsCompression = ccAdsCompressAlways then
ulOptions := ulOptions or ADS_COMPRESS_ALWAYS
else if FAdsCompression = ccAdsCompressNever then
ulOptions := ulOptions or ADS_COMPRESS_NEVER;

{*
* Set the communiction type. If the value is the default, then don't pass
* any option down to ACE. That will let the ads.ini setting
* control it. If it is specified here, then it overrides the ini file.
*}
if ( FAdsCommunicationType = ctAdsUDPIP ) then
begin
ulOptions := ulOptions or ADS_UDP_IP_CONNECTION;
end
else if ( FAdsCommunicationType = ctAdsIPX ) then
begin
ulOptions := ulOptions or ADS_IPX_CONNECTION;
end
else if ( FAdsCommunicationType = ctAdsTCPIP ) then
begin
ulOptions := ulOptions or ADS_TCP_IP_CONNECTION;
end;

{* NOTE : username and passwd will be ignored if this is not a DD connection *}
ACECheck( nil, AdsConnect60( strPath, usServerType, strUserName, strPasswd, ulOptions, FhConnection ) );

end; {* TAdsConnection.GetAdsConnection *}



{*******************************************************************************
* Module : TAdsConnection::Loaded
* Parameters :
* Returns : void
* Description : Reestablishes connections after all is loaded
*******************************************************************************}
procedure TAdsConnection.Loaded;
begin
inherited Loaded; { call the inherited method first}
try
if ( bConnectAfterLoad ) And ( Not FConnected ) then
begin
{ If we are to be connected after loading then FConnected should be
false and pass true }
SetConnected( True ); { reestablish connections }
end;
except
if csDesigning in ComponentState then { at design time... }
begin
if assigned( HandleExceptionProc ) then
HandleExceptionProc(Self); { let Delphi handle the exception }
end
else
raise; { otherwise, reraise }
end;
end;

{*******************************************************************************
* Module : TAdsConnection::SetName
* Parameters : Value - new name
* Returns : void
* Description : Modifies the name of the component
*******************************************************************************}
procedure TAdsConnection.SetName(const Value: TComponentName);
var
iIndex : Integer;
oAdsDataset : TAdsDataSet;
strOldName : string;
begin
strOldName := self.Name;
inherited SetName( Value );

{ search through all TAdsDataSet objects for any that have Value (this
instances name ) in the DatabaseName property }
if ( GetAdsDatasetList <> nil ) and ( self.Owner <> nil ) then
begin
with LockAdsDataSetList do
begin
try
for iIndex := 0 to Count - 1 do
begin
oAdsDataset := TAdsDataSet( Items[ iIndex ] );

{* If a dataset was pointing at this old connection name then
* update it to use the new name *}
if ( strOldName <> '' ) then
begin
if ( UpperCase( strOldName ) = UpperCase( oAdsDataset.DatabaseName ) ) and
( ( oAdsDataSet.AdsConnection = nil ) or ( self = oAdsDataSet.AdsConnection ) ) then
oAdsDataset.DatabaseName := Value
else if ( UpperCase( self.Owner.Name + '.' + strOldName ) =
UpperCase( oAdsDataset.DatabaseName ) ) and
( ( oAdsDataSet.AdsConnection = nil ) or ( self = oAdsDataSet.AdsConnection ) ) then
oAdsDataset.DatabaseName := self.Owner.Name + '.' + Value;
end;

{* NOTE: This will not find tables that have nil as their owner, so if they are
* pointing at this connection, their connection name will not be updated. This
* is a known issue, and has been entered into the bug tracking system. *}

{* This second check is for the case where the dataset was loaded from the
* dfm and created before the connection object existed. We run through and
* set the database name again, so this time the code will finish correctly
* and point the dataset at this connection. *}
if ( oAdsDataset.Owner <> nil ) then
if ( UpperCase( self.Owner.Name + '.' + self.Name ) =
UpperCase( oAdsDataset.Owner.Name + '.' + oAdsDataset.DatabaseName ) ) then
{* We've found a dataset that points to a connection with our name. In a multi-threaded
* app, however, there can be multiple dm1.adsconnection1 instances. In this case
* we need to make sure the dataset is pointing at us, and not at another connection
* instance that has the same name and owner. If oAdsDataSet.AdsConnection is nil then
* don't check, and assume that this is the IDE load-time situation described above. *}
if ( oAdsDataSet.AdsConnection = nil ) or
( self = oAdsDataSet.AdsConnection ) then
{ set it again, now that the database lookup will work }
oAdsDataset.DatabaseName := Self.Name;

end;
finally
UnlockAdsDataSetList;
end; {* try/finally *}
end; {* with LockAdsDataSetList *}

end;
end;

{*******************************************************************************
* Module : TAdsConnection::RemoveTableFromConnectList
* Parameters : oCallee - The TAdsTable object calling this function
* Returns : void
* Description : Removes the table from the list
*******************************************************************************}
procedure TAdsConnection.RemoveTableFromConnectList( oCallee : TDataSet );
var
i : integer;
curDataSet : TDataSet;
begin
for i := 0 to FTablesList.Count - 1 do
begin
curDataSet := TDataSet( FTablesList[i] );

if ( curDataSet = oCallee ) then
begin
FTablesList.Delete(i);
break;
end;
end;
end;



{*******************************************************************************
* Module : TAdsConnection::AddTableToConnectList
* Parameters : Table - handle to a TDataSet
* Returns : void
* Description : Adds the table to an open connection list
*******************************************************************************}
procedure TAdsConnection.AddTableToConnectList( Table: TDataSet );
begin
FTablesList.Add( Table );
end;



{*******************************************************************************
* Module : TAdsConnection::SetConnected
* Parameters : bActive - TRUE or FALSE
* Returns : void
* Description : Sets the connected property and gets or release connection
* to Advantage server.
*******************************************************************************}
procedure TAdsConnection.SetConnected( bActive: Boolean );
var ulRetVal : Integer;
i : integer;
ErrObj : AdsError;
begin
if ( bActive <> FConnected ) then
begin
if ( csReading in ComponentState ) And ( bActive ) then
begin
{* Update the component's Connected value *}
bConnectAfterLoad := True;
exit;
end;

{* Clear flag so we'll refresh the user groups next time they're asked for. *}
FReadUserGroups := FALSE;

if ( Not FConnected ) then
begin
{* If there's a BeforeConnect event assigned then fire it *}
if Assigned( BeforeConnect ) then BeforeConnect( Self );

{* If an invalid alias has been specified at some time in this TAdsConnection
* component's life try to set it one more time. It's possible the developer
* had their application create the alias between the setting of the aliasname
* property and this connect call. *}
if ( not FValidAlias ) then
begin
SetAliasName( FAliasName );
{* OK, if it's still not valid this is a problem. *}
if ( not FValidAlias ) then
raise AdsConnectionError.Create( 'TAdsConnection.AliasName is not valid' );
end;

{* Make sure there's a connection string specified *}
if ( Length( GetConnectionWithDDPath ) > 0 ) then
begin
{* try to grab an Advantage connection *}
{* Use FGivenConnection if one was provided by SetHandle() *}
if ( FGivenConnection = 0 ) then
GetAdsConnection( GetConnectionWithDDPath )
else
FhConnection := FGivenConnection;

{* Update the component's Connected value *}
FConnected := bActive;

{* If this is a dictionary connection then loop through all tables and set their default indexes. *}
if IsDictionaryConn then
for i := 0 to ( DataSetCount - 1 ) do
TAdsDataSet(DataSets[i]).UpdateDefaultIndex;

{* If there's an AfterConnect event, and we didn't get an error, then fire it *}
if Assigned( AfterConnect ) then AfterConnect( Self );

{* trigger the OnConnect event *}
DoOnConnect;
end
else
begin
FConnected := False;
raise AdsConnectionError.Create( 'Must specify connection string ' +
'before getting a server connection.' );
end;
end
else
{* already connected *}
begin
if Assigned( BeforeDisconnect ) then BeforeDisconnect( Self );

{* before we disconnect we need to make sure to close all associated tables
* and to invalidate any ace handles our datasets are currently using *}
for i := 0 to FTablesList.Count - 1 do
begin
try
TDataSet(FTablesList[i]).Active := False;
except on E : Exception do
begin
{* Do nothing since the table is still closed. Just
* continue in closing the tables.
*}
end;
end;
TAdsDataSet(FTablesList[i]).InvalidateAceHandles;
end;

{* Clear any cached statement handles *}
ClearStatements;

{* disconnect from the Advantage Server *}
{* don't disconnect if this connection was set using SetHandle *}
ulRetVal := AE_SUCCESS;
ErrObj := nil;
if ( FGivenConnection = 0 ) then
begin
ulRetVal := ACE.AdsDisconnect( FhConnection );
if ( ulRetVal <> AE_SUCCESS ) then
{* create exception object now, while ace has the error text *}
ErrObj := AdsError.Create( ulRetVal, TRUE );
end;

{* The disconnect may have failed but if it did then we are still disconnected
* so do all the housekeeping and then raise an exception if an error occurred. *}
FConnected := bActive;

{* reinitialize the connection handle to 0 *}
FhConnection := 0;

if Assigned( AfterDisconnect ) then AfterDisconnect( Self );

{* Send OnDisconnect event *}
DoOnDisconnect;

{* NOW raise the error if necessary *}
if ( ( ulRetVal <> AE_SUCCESS ) and ( assigned( ErrObj ) ) ) then
raise ErrObj;
end;

{* Update the component's Connected value *}
FConnected := bActive;
end;

end; {* TAdsConnection::SetConnected *}



{*******************************************************************************
* Module : TAdsConnection::GetConnectionHandle
* Parameters :
* Returns : hConnection
* Description : ACE Connection handle for current connection
*******************************************************************************}
function TAdsConnection.GetConnectionHandle: LongInt;
begin
if ( Not FConnected ) then
{* We had better be connected for this to work *}
Result := 0
else
Result := FhConnection;
end; {* TAdsConnection::GetConnectionHandle *}



{*******************************************************************************
* Module : TAdsConnection::GetConnectionType
* Parameters : none
* Returns : LOCAL, AIS, or REMOTE
* Description :
*******************************************************************************}
function TAdsConnection.GetConnectionType: String;
var
ulRetVal : UNSIGNED32;
usConnectType : UNSIGNED16;
begin
if ( FConnected ) then
begin
ulRetVal := ACE.AdsGetConnectionType( FhConnection, usConnectType );
if ( ulRetVal <> AE_SUCCESS ) then
raise AdsError.Create( ulRetVal, TRUE );
case( usConnectType ) of
ADS_REMOTE_SERVER :
begin
Result := 'Remote';
end;
ADS_LOCAL_SERVER :
begin
Result := 'Local';
end;
ADS_AIS_SERVER :
begin
Result := 'Internet';
end;
else
begin
Result := '';
end;
end;
end
else
Result := '';
end; {* TAdsConnection::GetConnectionType *}



{*******************************************************************************
* Module : TAdsConnection::GetConnectString
* Parameters : none
* Returns : Connection string
* Description :
*******************************************************************************}
function TAdsConnection.GetConnectString: String;
begin
Result := FConnectString;
end; {* TAdsConnection::GetConnectString *}



{*******************************************************************************
* Module : TAdsConnection::SetConnectString
* Parameters : strConnect - server to connect to
* Returns : void
* Description :
*******************************************************************************}
procedure TAdsConnection.SetConnectString( strConnect: String );
begin
if IsConnected then
raise AdsConnectionError.Create( 'The TAdsConnection.ConnectPath may not ' +
'be changed when IsConnected is TRUE' );

{* now the connection string can safely be changed *}
FConnectString := strConnect;

{*
* If there is a '.add' at the end of the new connection string then
* set the FIsDictionaryConn flag to TRUE.
*}
if ( Pos( '.ADD', UpperCase(FConnectString) ) <> 0 ) then
FIsDictionaryConn := TRUE
else
FIsDictionaryConn := FALSE;

{ zap the AliasName because it and the connect path are mutually exclusive }
FAliasName := '';
mstrAliasPath := '';
meAliasTableType := ttAdsConnectUnspecified;
end; {* TAdsConnection::SetConnectString *}



{*******************************************************************************
* Module : TAdsConnection::SetAliasName
* Parameters : strAlias - Alias name
* Returns : void
* Description :
*******************************************************************************}
procedure TAdsConnection.SetAliasName( strAlias: String );
var
eTableType : TAdsConnectionTableTypes;
strAliasPath : string;
sIndex : SIGNED16;
poTable : TAdsDataSet;
begin
if IsConnected then
raise AdsConnectionError.Create( 'The TAdsConnection.AliasName may not be ' +
'changed when IsConnected is TRUE' );

{* Assume the alias is valid, until we determine otherwise. *}
FValidAlias := TRUE;

if strAlias = '' then
begin
{ set the members }
FAliasName := strAlias;
mstrAliasPath := '';
meAliasTableType := ttAdsConnectUnspecified;
end
else
begin
{ ensure that the alias is valid }
if GetAliasInfo( strAlias, strAliasPath, eTableType ) then
begin
{ it is valid }

{ clear the FConnectString since they are mutually exclusive }
FConnectString := '';

{ set the members }
FAliasName := strAlias;
mstrAliasPath := strAliasPath;
meAliasTableType := eTableType;

{*
* If there is a '.add' at the end of the new connection string then
* set the FIsDictionaryConn flag to TRUE.
*}
if ( Pos( '.ADD', UpperCase(mstrAliasPath) ) <> 0 ) then
FIsDictionaryConn := TRUE
else
FIsDictionaryConn := FALSE;

{ iterate through all components on the immediate form and modify the
table type
}
if ( Owner <> nil ) then
begin
for sIndex := 0 to Owner.ComponentCount - 1 do
if ( Owner.Components[sIndex] is TAdsDataSet ) then
begin
poTable := Owner.Components[sIndex] as TAdsDataSet;

{ only mess with the table if it has no databasename and
if references this AdsConnection instance }
if ( poTable.AdsConnection = self ) and
(( poTable.DatabaseName = '' ) or
( poTable.DatabaseName = self.Name )) then
begin
{ set the table type property }
case meAliasTableType of
ttAdsConnectADT : poTable.TableType := ttAdsADT;
ttAdsConnectNTX : poTable.TableType := ttAdsNTX;
ttAdsConnectCDX : poTable.TableType := ttAdsCDX;
ttAdsConnectUnspecified : { do nothing }
end;
end;
end; { if is TAdsDataSet }
end; { if owner is nil }
end { GetAliasInfo }
else
begin
{* NOTE : We used to raise an exception here, but that's not how the BDE
* behaves, and it makes it hard for customers to design an app that
* doesn't require the user the have the alias initially created. Set
* a flag indicating this is an invalid alias, then we'll attemp to set
* the alias again right before we connect.
*}
FValidAlias := FALSE;
{* We still need to keep the alias name around, even though we've determined
* it isn't currently valid. *}
FAliasName := strAlias;
mstrAliasPath := '';
meAliasTableType := ttAdsConnectUnspecified;
end;
end;
end; {* TAdsConnection::SetAliasName *}


{*******************************************************************************
* Module : TAdsConnection::GetServerName
* Parameters :
* Returns :
* Description :
*******************************************************************************}
function TAdsConnection.GetServerName: String;
var aucAdsPtr: Array[1..255] of Char;
usNameLen: word;
ulRetVal: LongInt;
hTempConn: cardinal;
begin
if ( Not FConnected ) then
{* If design-time return an empty string, if runtime raise exception *}
if ( csDesigning in ComponentState ) then
Result := ''
else
raise AdsConnectionError.Create( 'Must be connected to get Advantage ' +
'server name.' )
else
begin
usNameLen := 255;
{* Call Ads to get the server name *}
hTempConn := FhConnection;
ulRetVal := ACE.AdsGetServerName( hTempConn, aucAdsPtr, usNameLen );
if ( ulRetVal <> AE_SUCCESS ) then
raise AdsError.Create( ulRetVal, TRUE );

{* Convert the server name to a Delphi string and return it *}
Result := String( aucAdsPtr );
end;

end; {* TAdsConnection::GetServerName *}


{*******************************************************************************
* Module : TAdsConnection::GetIsConnectionAlive
* Parameters :
* Returns :
* Description : Determine if connection is still functional
*******************************************************************************}
function TAdsConnection.GetIsConnectionAlive: Boolean;
var
ulRetVal: LongInt;
usAlive: word;
begin { TAdsConnection.GetIsConnectionAlive }
{* make sure we think we have a connection *}
if ( Not FConnected ) then
Result := false
else
begin
{* we think we have a connection, check to make sure it is okay *}
ulRetVal := ACE.AdsIsConnectionAlive( FhConnection, usAlive );
if ( ulRetVal <> AE_SUCCESS ) then
raise AdsError.Create( ulRetVal, TRUE );

if usAlive = 0 then
Result := false
else
Result := true;
end;

end; {* TAdsConnection::GetIsConnectionAlive *}



{*******************************************************************************
* Module : TAdsConnection::GetTransactionActive
* Parameters :
* Returns :
* Description :
*******************************************************************************}
function TAdsConnection.GetTransactionActive: Boolean;
begin
{* make sure we're connected to an Advantage Server *}
if ( Not FConnected ) then
raise AdsConnectionError.Create( 'No connection to Advantage server.' );

Result := FTransactionActive;
end; {* TAdsConnection::GetTransactionActive *}



{*******************************************************************************
* Module : TAdsConnection::BeginTransaction
* Parameters :
* Returns :
* Description :
*******************************************************************************}
procedure TAdsConnection.BeginTransaction;
var ulRetVal: LongInt;
begin
{* make sure we're connected to an Advantage Server *}
if ( Not FConnected ) then
raise AdsConnectionError.Create( 'No connection to Advantage server.' );

{* begin a transaction on this connection *}
ulRetVal := ACE.AdsBeginTransaction( FhConnection );
if ( ulRetVal <> AE_SUCCESS ) then
raise AdsError.Create( ulRetVal, TRUE )
else
FTransactionActive := TRUE;
end; {* TAdsConnection.BeginTransaction *}



{*******************************************************************************
* Module : TAdsConnection::Commit
* Parameters :
* Returns :
* Description :
*******************************************************************************}
procedure TAdsConnection.Commit;
var
ulRetVal: LongInt;
begin
{* make sure we're connected to an Advantage Server *}
if ( Not FConnected ) then
raise AdsConnectionError.Create( 'No connection to Advantage server.' );

{* Trigger the BeforeCommit event *}
DoBeforeCommit;

{* Clear any cached statements, just like TDBDataSet does *}
ClearStatements;

ulRetVal := ACE.AdsCommitTransaction( FhConnection );
if ( ulRetVal <> AE_SUCCESS ) then
raise AdsError.Create( ulRetVal, TRUE )
else
FTransactionActive := FALSE;

{* Do the after commit event *}
DoAfterCommit;
end; {* TAdsConnection.Commit *}



{*******************************************************************************
* Module : TAdsConnection.PerformRollback
* Parameters :
* Returns :
* Description : Performs the actual work of rolling back a statement.
*******************************************************************************}
procedure TAdsConnection.PerformRollback;
var
ulRetVal : LongInt;
i : integer;
begin
{* make sure we're connected to an Advantage Server *}
if ( Not FConnected ) then
raise AdsConnectionError.Create( 'No connection to Advantage server.' );

{* Trigger the BeforeRollback event *}
DoBeforeRollback;

{* Clear any cached statements, just like TDBDataSet does *}
ClearStatements;

{* Cancel pending updates *}
for i := 0 to ( DataSetCount - 1 ) do
DataSets[i].Cancel;

ulRetVal := ACE.AdsRollbackTransaction( FhConnection );
if ( ulRetVal <> AE_SUCCESS ) then
raise AdsError.Create( ulRetVal, TRUE )
else
FTransactionActive := FALSE;

{*
* The cancelled updates we did before the rollback can cause us to now
* be sitting on a deleted record (if an insert was cancelled). We are
* basically unpositioned. Need to do a refresh to position each dataset
* to avoid errors later when we try to move, or check eof/bof, etc.
* bug #2525
*}
for i := 0 to ( DataSetCount - 1 ) do
if ( DataSets[i].Active ) then
DataSets[i].Refresh;

{* Do the after rollback event *}
DoAfterRollback;

end; {* TAdsConnection.PerformRollback *}


{*******************************************************************************
* Module : TAdsConnection::Rollback
* Parameters :
* Returns :
* Description :
*******************************************************************************}
procedure TAdsConnection.Rollback;
begin

PerformRollback();

end; {* TAdsConnection.Rollback *}

{$IFDEF ADSDELPHI4_OR_NEWER}
{*******************************************************************************
* Module : TAdsConnection.Rollback
* Parameters : strSavepoint - Name of savepoint to rollback to.
* Returns :
* Description : Rollsback to a given savepoint.
*******************************************************************************}
procedure TAdsConnection.Rollback( strSavepoint : string );
begin

{* If no name is given just rollback the entire transaction *}
if ( strSavepoint = '' ) then
begin
PerformRollback();
end
else
begin

{* make sure we're connected to an Advantage Server *}
if ( Not FConnected ) then
raise AdsConnectionError.Create( 'No connection to Advantage server.' );

ACECheck( nil, ACE.AdsRollbackTransaction80( FhConnection,
strSavepoint,
0 {* No Options *} ) );
end;

end; {* TAdsConnection.Rollback *}
{$ENDIF}


{*******************************************************************************
* Module : TAdsConnection.CreateSavepoint
* Parameters : strSavepoint - Name of savepoint to create.
* Returns :
* Description : Creates a savepoint with given name.
*******************************************************************************}
procedure TAdsConnection.CreateSavepoint( strSavepoint : string );
begin
{* make sure we're connected to an Advantage Server *}
if ( Not FConnected ) then
raise AdsConnectionError.Create( 'No connection to Advantage server.' );

ACECheck( nil, ACE.AdsCreateSavepoint( FhConnection,
strSavepoint,
0 {* No Options *} ) );
end; {* TAdsConnection.Rollback *}


{*******************************************************************************
* Module : TAdsConnection::GetProcedureNames
* Parameters :
* Returns :
* Description : Retrieve a list of procedures in the database
*******************************************************************************}
procedure TAdsConnection.GetProcedureNames( poList : TStrings );
var
ulRetVal : UNSIGNED32;
hFindHandle : cardinal;
aucName : array [0..ADS_DD_MAX_OBJECT_NAME_LEN] of char;
usLen : UNSIGNED16;
begin
{* make sure we're connected to an Advantage Server *}
if ( Not FConnected ) then
IsConnected := TRUE;

if not Assigned( poList ) then
exit;

{* If this isn't a dictionary connection then don't return anything *}
if not IsDictionaryConn then
exit;

hFindHandle := 0;

try
{* Get each procedure name from the dictionary *}
usLen := ADS_DD_MAX_OBJECT_NAME_LEN;
ulRetVal := ACE.AdsDDFindFirstObject( FhConnection, ADS_DD_PROCEDURE_OBJECT, '', aucName, usLen, hFindHandle );
if ( ulRetVal <> AE_SUCCESS ) and ( ulRetVal <> AE_NO_OBJECT_FOUND ) then
ACECHECK( nil, ulRetVal );

while ( ulRetVal <> AE_NO_OBJECT_FOUND ) do
begin
poList.Add( string( aucName ) );

{* Get the next procedure *}
usLen := ADS_DD_MAX_OBJECT_NAME_LEN;
ulRetVal := ACE.AdsDDFindNextObject( FhConnection, hFindHandle, aucName, usLen );
if ( ulRetVal <> AE_SUCCESS ) and ( ulRetVal <> AE_NO_OBJECT_FOUND ) then
ACECHECK( nil, ulRetVal );
end;

finally
if ( hFindHandle <> 0 ) then
ACE.AdsDDFindClose( FhConnection, hFindHandle );
end;

end; {* TAdsConnection.GetProcedureNames *}


{*******************************************************************************
* Module : TAdsConnection::GetTableNames
* Parameters :
* Returns :
* Description : Retrieve a list of tables in the database
*******************************************************************************}
procedure TAdsConnection.GetTableNames( poList : TStrings; strFileMask : String );
var
strPath : String;
strMask : String;
strPathAndMask : String;
strFilename : String;
usLen : UNSIGNED16;
ulRetVal : UNSIGNED32;
acFile : array[0..ADS_MAX_PATH] of char;
hFindHandle : SIGNED32;
begin

{* make sure we're connected to an Advantage Server *}
if ( Not FConnected ) then
raise AdsConnectionError.Create( 'No connection to Advantage server.' );

if not Assigned( poList ) then
exit;

try
{*
* If this is a dictionary connection then set the path and mask to '', which will
* signal AdsFindFirstTable to only retrieve dictionary files.
*}
if IsDictionaryConn then
strPathAndMask := ''
else
begin
if ( FConnectString <> '' ) then
strPath := FConnectString
else
strPath := mstrAliasPath;

{* If we know the connection type then append a mask, o/w use the mask passed in *}
if ( meAliasTableType = ttAdsConnectUnspecified ) then
strMask := strFileMask
else if ( meAliasTableType = ttAdsConnectADT ) then
strMask := '*.adt'
else
strMask := '*.dbf';

if IsSlash( strPath[ length(strPath) ] ) then
delete( strPath, length(strPath), 1 );

strPathAndMask := strPath + ADS_PATH_DELIMITER + strMask;
end;

{* Find the first file *}
usLen := ADS_MAX_PATH;
ulRetVal := AdsFindFirstTable( FhConnection, strPathAndMask, acFile, usLen, hFindHandle );
if ( ulRetVal <> AE_SUCCESS ) and ( ulRetVal <> AE_NO_FILE_FOUND ) then
raise AdsError.Create( ulRetVal, TRUE );

{ while more files found, add them to the StringList }
while ( ulRetVal <> AE_NO_FILE_FOUND ) do
begin
strFileName := string( acFile );
poList.Add( strFileName );
usLen := ADS_MAX_PATH;
ulRetVal := AdsFindNextTable( FhConnection, hFindHandle, acFile, usLen );
if ( ulRetVal <> AE_SUCCESS ) and ( ulRetVal <> AE_NO_FILE_FOUND ) then
raise AdsError.Create( ulRetVal, TRUE );
end;

finally
if hFindHandle <> 0 then
AdsFindClose( FhConnection, hFindHandle );

end;

end; {* TAdsConnection::GetTableNames *}



{*******************************************************************************
* Module : TAdsConnection::GetTableAndLinkNames
* Parameters :
* Returns :
* Description : Retrieve a list of tables and linked tables in
* the database.
*******************************************************************************}
procedure TAdsConnection.GetTableAndLinkNames( poLinkNames : TStrings; poTableNames : TStrings;
strFileMask : String );
var
strPath : String;
strMask : String;
strPathAndMask : String;
strTemp : String;
usLinkLen : UNSIGNED16;
usTableLen : UNSIGNED16;
ulRetVal : UNSIGNED32;
acTable : array[0..ADS_MAX_PATH] of char;
acLink : array[0..ADS_MAX_PATH] of char;
hFindHandle : SIGNED32;
begin

{* make sure we're connected to an Advantage Server *}
if ( Not FConnected ) then
raise AdsConnectionError.Create( 'No connection to Advantage server.' );

try
{*
* If this is a dictionary connection then set the path and mask to '', which will
* signal AdsFindFirstTable to only retrieve dictionary files.
*}
if IsDictionaryConn then
strPathAndMask := ''
else
begin
if ( FConnectString <> '' ) then
strPath := FConnectString
else
strPath := mstrAliasPath;

{* If we know the connection type then append a mask, o/w use the mask passed in *}
if ( meAliasTableType = ttAdsConnectUnspecified ) then
strMask := strFileMask
else if ( meAliasTableType = ttAdsConnectADT ) then
strMask := '*.adt'
else
strMask := '*.dbf';

if IsSlash( strPath[ length(strPath) ] ) then
delete( strPath, length(strPath), 1 );

strPathAndMask := strPath + ADS_PATH_DELIMITER + strMask;
end;

{* Find the first file *}
usLinkLen := ADS_MAX_PATH;
usTableLen := ADS_MAX_PATH;
ulRetVal := AdsFindFirstTable62( FhConnection, strPathAndMask, acLink, usLinkLen,
acTable, usTableLen, hFindHandle );
if ( ulRetVal <> AE_SUCCESS ) and ( ulRetVal <> AE_NO_FILE_FOUND ) then
raise AdsError.Create( ulRetVal, TRUE );

{ while more files found, add them to the StringList }
while ( ulRetVal <> AE_NO_FILE_FOUND ) do
begin
if Assigned( poLinkNames ) then
begin
strTemp := String( acLink );
poLinkNames.Add( strTemp );
end;
if Assigned( poTableNames ) then
begin
strTemp := String( acTable );
poTableNames.Add( strTemp );
end;

usLinkLen := ADS_MAX_PATH;
usTableLen := ADS_MAX_PATH;
ulRetVal := AdsFindNextTable62( FhConnection, hFindHandle, acLink, usLinkLen,
acTable, usTableLen );
if ( ulRetVal <> AE_SUCCESS ) and ( ulRetVal <> AE_NO_FILE_FOUND ) then
raise AdsError.Create( ulRetVal, TRUE );
end;

finally
if hFindHandle <> 0 then
AdsFindClose( FhConnection, hFindHandle );

end;

end; {* TAdsConnection::GetTableAndLinkNames *}



{*******************************************************************************
* Module : TAdsConnection::DoAfterCommit
* Parameters : none
* Returns : void
* Description : Fires AfterCommit event if it is assigned
* Notes :
*******************************************************************************}
procedure TAdsConnection.DoAfterCommit;
begin
if Assigned( FAfterCommit ) then FAfterCommit( Self );
end; {* TAdsConnection::DoAfterCommit *}



{*******************************************************************************
* Module : TAdsConnection::DoBeforeCommit
* Parameters : none
* Returns : void
* Description : Fires BeforeCommit event if it is assigned
* Notes :
*******************************************************************************}
procedure TAdsConnection.DoBeforeCommit;
begin
if Assigned( FBeforeCommit ) then FBeforeCommit( Self );
end; {* TAdsConnection::DoBeforeCommit *}



{*******************************************************************************
* Module : TAdsConnection::DoAfterRollback
* Parameters : none
* Returns : void
* Description : Fires AfterRollback event if it is assigned
* Notes :
*******************************************************************************}
procedure TAdsConnection.DoAfterRollback;
begin
if Assigned( FAfterRollback ) then FAfterRollback( Self );
end; {* TAdsConnection::DoAfterRollback *}



{*******************************************************************************
* Module : TAdsConnection::DoBeforeRollback
* Parameters : none
* Returns : void
* Description : Fires BeforeRollback event if it is assigned
* Notes :
*******************************************************************************}
procedure TAdsConnection.DoBeforeRollback;
begin
if Assigned( FBeforeRollback ) then FBeforeRollback( Self );
end; {* TAdsConnection::DoBeforeRollback *}



{*******************************************************************************
* Module : TAdsConnection::DoOnConnect
* Parameters : none
* Returns : void
* Description : Fires OnConnect event when connection happens
* Notes :
*******************************************************************************}
procedure TAdsConnection.DoOnConnect;
begin
if Assigned( FOnConnect ) then FOnConnect( Self );
end; {* TAdsConnection::DoOnConnect *}



{*******************************************************************************
* Module : TAdsConnection::DoOnDisconnect
* Parameters : none
* Returns : void
* Description : Fires BeforeRollback event if it is assigned
* Notes :
*******************************************************************************}
procedure TAdsConnection.DoOnDisconnect;
begin
if Assigned( FOnDisconnect ) then FOnDisconnect( Self );
end; {* TAdsConnection::DoOnDisconnect *}



{*******************************************************************************
* Module : TAdsConnection::GetConnectionPath
* Parameters : none
* Returns : The connection path
* Description : The connection path is either the value stored in
* FConnectString or referenced by the alias stored in the
* FAliasName property
* Notes :
*******************************************************************************}
function TAdsConnection.GetConnectionPath : string;
begin
if FConnectString <> '' then
Result := FConnectString
else
Result := mstrAliasPath;

{* remove database dictionary name, if it exists *}
if ( Length(Result) > 4 ) then
begin
if ( Result[Length(Result)-3] = '.' ) then
{* Double check that this is actually a database name. *}
if ( UpperCase( copy( Result, Length(Result)-2, 3 ) ) = 'ADD' ) then
{*
* If there's a backslash or a forward slash in the path then delete
* from the last one to the end of the string.
*}
if ( Pos( '/', Result ) > 0 ) then
Delete( Result, LastDelimiter( '/', Result), Length( Result ) )
else if ( Pos( '\', Result ) > 0 ) then
Delete( Result, LastDelimiter( '\', Result), Length( Result ) )
else
Result := '.' + ADS_PATH_DELIMITER;
end;
end;



{*******************************************************************************
* Module : TAdsConnection::GetConnectionWithDDPath
* Parameters : none
* Returns : The connection path and dictionary (e.g. - x:\w89p1\sampledb.add)
* Description :
* Notes :
*******************************************************************************}
function TAdsConnection.GetConnectionWithDDPath : string;
begin
if FConnectString <> '' then
Result := FConnectString
else
Result := mstrAliasPath;
end;


{*******************************************************************************
* Module : TAdsConnection::GetAdsTableType
* Parameters : none
* Returns : The table type associated to an alias
* Description :
* Notes :
*******************************************************************************}
function TAdsConnection.GetAdsTableType : TAdsConnectionTableTypes;
begin
Result := meAliasTableType;
end;


{$IFDEF ADSDELPHI4_OR_NEWER}

{****************************************************************************************
* Module: SetQueryParams
* Input: StmtHandle - ACE statement handle
* Params - Parameters to set
* Output:
* Return:
* Description: Set parameters in a statement before its execution.
* NOTE: Any modifications made to this code should also be considered for addition
* in TADSQuery.InternalExecute
****************************************************************************************}
procedure SetQueryParams( StmtHandle: ADSHANDLE; Params: TParams);
type
TAdsTimeStampRec = record
lDate: Longint;
lTime: Longint;
end;
var
I : integer;
lAdsDate : SIGNED32;
lMilliSec : SIGNED32;
stDateType : TAdsTimeStampRec;
ulDataSize : UNSIGNED32;
TempBuffer : IntPtr;
begin

{ assign all parameters' values within ACE }
for I := 0 to Params.Count - 1 do
begin
if Params[i].IsNull then
ACECheck( nil, ACE.AdsSetEmpty( StmtHandle, ( I + 1 )))
else
begin
case Params[I].DataType of
ftUnknown:
raise EADSDatabaseError.create( nil, AE_TADSDATASET_GENERAL,
'The field named: ''' + Params[i].Name +
''' has the DataType of ftUnknown, which is invalid.' );

ftString,
{$IFDEF ADSDELPHI4_OR_NEWER}
ftFixedChar,
ftLargeint,
{$ENDIF}
ftWord,
ftSmallint,
ftInteger,
ftBCD,
ftMemo,
ftFmtMemo,
ftAutoInc:
begin
ACECheck( nil, ACE.AdsSetString( StmtHandle, ( I + 1 ), Params[i].AsString,
Length( Params[i].AsString ) ));
end;

ftTime:
begin
lMilliSec := ROUND( Frac( Params[i].AsDateTime ) *
MSEC_PER_DAY );
ACECheck( nil, ACE.AdsSetMilliseconds( StmtHandle, ( I + 1 ), lMilliSec ));
end;

ftDate:
begin
lAdsDate := Trunc( Params[i].AsDateTime ) + DELPHI_DATETIME_TO_JULIAN;
ACECheck( nil, ACE.AdsSetJulian( StmtHandle, ( I + 1 ), lAdsDate ));
end;

ftDateTime:
begin
stDateType.lTime := ROUND( Frac( Params[i].AsDateTime ) *
MSEC_PER_DAY );
stDateType.lDate := Trunc( Params[i].AsDateTime ) + DELPHI_DATETIME_TO_JULIAN;

TempBuffer := Marshal.AllocHGlobal( 2 * sizeof( Int32 ) );
try
Marshal.WriteInt32( TempBuffer, stDateType.lDate );
Marshal.WriteInt32( TempBuffer, 4, stDateType.lTime );

ACECheck( nil, ACEUNPUB.AdsSetTimeStampRaw( StmtHandle, ( I + 1 ),
TempBuffer,
8 ) );
finally
Marshal.FreeHGlobal( TempBuffer );
end;
end;

ftCurrency,
ftFloat:
ACECheck( nil, AdsSetDouble( StmtHandle, ( I + 1 ),
Params[i].AsFloat ));

ftBoolean:
if ( Params[i].AsBoolean ) then
ACECheck( nil, AdsSetLogical( StmtHandle, ( I + 1 ), ADS_TRUE ))
else
ACECheck( nil, AdsSetLogical( StmtHandle, ( I + 1 ), ADS_FALSE ));


ftBytes,
ftVarBytes,
ftBlob,
ftGraphic :
begin
ulDataSize := Params[i].GetDataSize();
TempBuffer := Marshal.AllocHGlobal( ulDataSize );
try
Params[i].GetData( TempBuffer );
ACECheck( nil, ACE.AdsSetBinary( StmtHandle, ( I + 1 ), ADS_BINARY,
ulDataSize, 0, TempBuffer,
ulDataSize ));
finally
Marshal.FreeHGlobal( TempBuffer );
end;
end;

{$IFDEF ADSDELPHI4_OR_NEWER}
ftWideString,
ftADT,
ftArray,
ftReference,
ftDataSet,
{$ENDIF}
ftParadoxOle,
ftDBaseOle,
ftTypedBinary,
ftCursor:
raise EADSDatabaseError.create( nil, AE_TADSDATASET_GENERAL, 'The field named: ''' +
Params[i].Name + ''' has a DataType that is not supported.' );
end; {case}
end; {if not empty}
end; {for}

end; {* SetQueryParams *}

{$ENDIF} {* IFDEF DELPHI4_OR_NEWER *}


{****************************************************************************************
* Module: TAdsConnection.ClearStatements
* Input:
* Output:
* Return:
* Description: Close all statement handles cached by TAdsConnection.Execute
****************************************************************************************}
procedure TAdsConnection.ClearStatements;
var
i : Integer;
hStmt : ADSHANDLE;
SQL : IntPtr;
begin
if Assigned(FStmtList) then
begin
for i := 0 to FStmtList.Count - 1 do
begin
hStmt := Marshal.ReadInt32( PStmtInfo(FStmtList[i]), 4 ); // 4 is StmtHandle
ACECHECK( nil, ACE.AdsCloseSQLStatement( hStmt ) );

// free the string stored in the struct
SQL := Marshal.ReadIntPtr( PStmtInfo(FStmtList[i]), 8 ); // 8 is the sql text
Marshal.FreeHGlobal( SQL );
end;
FStmtList.Clear;
end;
end;


{$IFDEF ADSDELPHI4_OR_NEWER}


{****************************************************************************************
* Module: TAdsConnection.Execute
* Input: SQL - statement to execute
* Params - parameters for statement (if any)
* Cache - if TRUE cache statement handles
* Cursor - if not zero return dataset from SELECT statement
* Output:
* Return: number of rows affected by statement execution
* Description: Executes an SQL statement. No need for TAdsQuery object. Used by
* TAdsDataSet IProviderSupport interface for MIDAS/ClientDataset updates.
****************************************************************************************}
function TAdsConnection.Execute(oAdsDatasetOptions : TAdsDatasetOptions;
const SQL: string; Params: TParams;
Cache: Boolean; var Cursor: cardinal): Integer;

function GetStmtInfo(SQL: string): PStmtInfo;

function GetHashCode(Str: string): Integer;
var
Off, Len, Skip, I: Integer;
begin
Result := 0;
Off := 1;
Len := Length(Str);
if Len < 16 then
for I := Len downto 1 do
begin
Result := (Result * 37) + Ord(Str[Off]);
Inc(Off);
end
else
begin
{ Only sample some characters }
Skip := Len div 8;
I := Len;
while I >= 1 do
begin
Result := (Result * 39) + Ord(Str[Off]);
Dec(I, Skip);
Inc(Off, Skip);
end;
end;
end;

var
HashCode, i : Integer;
InfoHashCode : Integer;
InfoSQLText : string;
Info : PStmtInfo;
begin
if not Assigned(FStmtList) then
FStmtList := TList.Create;
Result := nil;
HashCode := GetHashCode(SQL);
for i := 0 to FStmtList.Count - 1 do
begin
Info := PStmtInfo(FStmtList[i]);
InfoHashCode := Marshal.ReadInt32( Info ); // offset 0 is HashCode
InfoSQLText := Marshal.PtrToStringAuto( Marshal.ReadIntPtr( Info, 8 ) ); // offset 8 is sqltext
if (InfoHashCode = HashCode) and
(System.String.Compare( InfoSQLText, SQL, true ) = 0) then
begin
Result := Info;
break;
end;
end;
if not Assigned(Result) then
begin
Result := Marshal.AllocHGlobal( sizeof( typeof( TStmtInfo ) ) );
FStmtList.Add(Result);
InitializeBuffer( Result, sizeof( TStmtInfo ), 0 );
Marshal.WriteInt32( Result, HashCode );
end;
end;

function GetStatementHandle: cardinal;
var
Info : PStmtInfo;
TempBuffer : IntPtr;
begin
Info := nil;
Result := 0;
if Cache then
begin
Info := GetStmtInfo(SQL);
Result := Marshal.ReadInt32( Info, 4 ); // 4 is the statement handle
end;
if ( Result = 0 ) then
begin
{* Allocate a statement handle *}
ACECHECK( nil, ACE.AdsCreateSQLStatement( FhConnection, Result ) );
if Cursor <> 0 then
{* Request a read-only result set *}
ACECHECK( nil, ACE.AdsStmtSetTableReadOnly( Result, ADS_CURSOR_READONLY ) );

{ Set the statement options received from the calling DataSet }
ACECHECK( nil, ACE.AdsStmtSetTableType( Result, oAdsDatasetOptions.musAdsTableType ) );
ACECHECK( nil, ACE.AdsStmtSetTableCharType( Result, oAdsDatasetOptions.musAdsCharType ) );
ACECHECK( nil, ACE.AdsStmtSetTableLockType( Result, oAdsDatasetOptions.musAdsLockType ) );
ACECHECK( nil, ACE.AdsStmtSetTableRights( Result, oAdsDatasetOptions.musAdsRightsCheck ) );

{* Prepare the statement *}
ACECHECK( nil, ACE.AdsPrepareSQL( Result, SQL ) );

{* If info pointer is not nil then we are caching this statement *}
if Assigned(Info) then
begin
TempBuffer := Marshal.StringToHGlobalAuto( SQL );
Marshal.WriteInt32( Info, 8, TempBuffer.ToInt32 ); // 8 is SQLText
Marshal.WriteInt32( Info, 4, Result ); // 4 is the statement handle
end;
end;
end;


var
StmtHandle : ADSHANDLE;
ulRowCount : UNSIGNED32;
ulRetVal : UNSIGNED32;
begin
{* If not connected already then do so here *}
if not IsConnected then
IsConnected := TRUE;

{* Get a statement handle *}
StmtHandle := GetStatementHandle;

try
if Assigned(Params) and (Params.Count > 0) then
begin
{* Set the parameters and execute the prepared query *}
SetQueryParams( StmtHandle, Params);
ACECHECK( nil, ACE.AdsExecuteSQL( StmtHandle, Cursor ) );
end
else
{* Execute the query *}
ACECHECK( nil, ACE.AdsExecuteSQLDirect( StmtHandle, SQL, Cursor ) );

{* IF DML statement get the number of rows affected, o/w return 0 *}
Result := 0;
if ( Cursor = 0 ) then
begin
ulRetVal := ACE.AdsGetRecordCount( StmtHandle, ADS_IGNOREFILTERS, ulRowCount );
{*
* If we just executed a script of statements this call will return an AE_NOT_DML
* error.
*}
if ( ulRetVal <> AE_NOT_DML ) then
begin
ACECHECK( nil, ulRetVal );
Result := Integer( ulRowCount );
end;
end;

finally
if not Cache then
ACECHECK( nil, ACE.AdsCloseSQLStatement( StmtHandle ) );
end; {* try/finally *}

end; {* TAdsConnection.Execute *}


{**********************************************************
* Module: TAdsConnection.Execute
* Description: On of the many overloads of this function
**********************************************************}
function TAdsConnection.Execute( oAdsDatasetOptions : TAdsDatasetOptions; const SQL: string
): Integer;
var
Cursor : cardinal;
begin
Cursor := 0;
Result := Execute( oAdsDatasetOptions, SQL, nil, false, Cursor );
end;


{**********************************************************
* Module: TAdsConnection.Execute
* Description: On of the many overloads of this function
**********************************************************}
function TAdsConnection.Execute( oAdsDatasetOptions : TAdsDatasetOptions; const SQL: string;
Params: TParams ): Integer;
var
Cursor : cardinal;
begin
Cursor := 0;
Result := Execute( oAdsDatasetOptions, SQL, Params, false, Cursor );
end;


{**********************************************************
* Module: TAdsConnection.Execute
* Description: On of the many overloads of this function
**********************************************************}
function TAdsConnection.Execute( oAdsDatasetOptions : TAdsDatasetOptions; const SQL: string;
Params: TParams; Cache: Boolean): Integer;
var
Cursor : cardinal;
begin
Cursor := 0;
Result := Execute( oAdsDatasetOptions, SQL, Params, Cache, Cursor );
end;


{**********************************************************
* Module: TAdsConnection.Execute
* Description: On of the many overloads of this function
**********************************************************}
function TAdsConnection.Execute( const SQL: string; Params: TParams;
Cache: Boolean; var Cursor: cardinal): Integer;
begin
Result := Execute( gDefaultStmtOptions, SQL, Params, Cache, Cursor );
end;


{**********************************************************
* Module: TAdsConnection.Execute
* Description: On of the many overloads of this function
**********************************************************}
function TAdsConnection.Execute( const SQL: string ): Integer;
var
Cursor : cardinal;
begin
Cursor := 0;
Result := Execute( gDefaultStmtOptions, SQL, nil, false, Cursor );
end;


{**********************************************************
* Module: TAdsConnection.Execute
* Description: On of the many overloads of this function
**********************************************************}
function TAdsConnection.Execute( const SQL: string; Params: TParams ): Integer;
var
Cursor : cardinal;
begin
Cursor := 0;
Result := Execute( gDefaultStmtOptions, SQL, Params, false, Cursor );
end;


{**********************************************************
* Module: TAdsConnection.Execute
* Description: On of the many overloads of this function
**********************************************************}
function TAdsConnection.Execute( const SQL: string; Params: TParams;
Cache: Boolean ): Integer;
var
Cursor : cardinal;
begin
Cursor := 0;
Result := Execute( gDefaultStmtOptions, SQL, Params, Cache, Cursor );
end;

{$ENDIF} {* IFDEF DELPHI4_OR_NEWER *}


{**********************************************************
* Module: GetAliasInfo
* Input: strAlias -- the alias value to lookup in the .INI file
* Output strPath -- the path associated with the alias or '' if the alias
* does not exist
* eTableType -- the table type of the database
* Return: TRUE if the alias was found and returned, false otherwise
* Description: Looks up the information for an alias from an ADS.INI
* file and returns the alias path
**********************************************************}
function GetAliasInfo( strAlias : string; var strPath : string;
var eTableType : TAdsConnectionTableTypes ) : boolean;
var
poIniFile : TIniFile;
sPos : SIGNED16;
begin
poIniFile := TIniFile.Create( GetAliasPathAndFileName );
{$IFDEF LINUX}
poIniFile.CaseSensitive := false;
{$ENDIF}
strPath := poIniFile.ReadString( 'Databases', strAlias, '' );
poIniFile.Free;

{ parse the value stored in strPath to remove the database type }
sPos := pos( ';', strPath );

{ Initialize the default driver type to ADT in case driver type isn't found }
eTableType := ttAdsConnectUnspecified;

if ( sPos <> 0 ) then
begin
if ( UpCase( strPath[ sPos+1 ]) = 'N' ) then
eTableType := ttAdsConnectNTX
else if ( UpCase( strPath[ sPos+1 ]) = 'C' ) then
eTableType := ttAdsConnectCDX
else if ( UpCase( strPath[ sPos+1 ]) = 'A' ) then
eTableType := ttAdsConnectADT;

delete( strPath, sPos, Length( strPath ) );
end;

Result := strPath <> '';
end;



{**********************************************************
* Module: TAdsConnection.Connect
* Description: set IsConnected to TRUE
**********************************************************}
procedure TAdsConnection.Connect;
begin
SetConnected( TRUE );
end;



{**********************************************************
* Module: TAdsConnection.Disconnect
* Description: set IsConnected to FALSE
**********************************************************}
procedure TAdsConnection.Disconnect;
begin
SetConnected( FALSE );
end;


{**********************************************************
* Module: TAdsConnection.GetNumActiveDDLinks
* Parameters:
* Returns: integer - number of active links on dictionary
* connection.
* Description: Returns the number of active links on a
* dictionary connection.
**********************************************************}
function TAdsConnection.GetNumActiveDDLinks : integer;
var
usActiveLinks : UNSIGNED16;
begin

ACECheck( nil, ACE.AdsGetNumActiveLinks( FhConnection, usActiveLinks ) );

result := integer( usActiveLinks );

end; {* TAdsConnection.GetNumActiveLinks *}


{**********************************************************
* Module : TAdsConnection.GetActiveDDLinkInfo
* Parameters : iLinkNum - Number the active link to return
* information on.
* poList - List of strings that contains
* information on the active connection.
* Returns :
* Description: poList is popluated with the contents of
* semi-colon delimited list of information
* returned from ACE about an active link.
**********************************************************}
procedure TAdsConnection.GetActiveDDLinkInfo( iLinkNum : integer;
poList : TStrings);
var
aucLinkInfo : array of char;
usBufferLen : UNSIGNED16;
strInfo : string;
iIndex : integer;
iLastDelim : integer;
ulRetVal : UNSIGNED32;
begin

{* Make sure a valid was passed in. *}
if ( not Assigned( poList ) ) then
exit;

{* Set the length of the buffer *}
usBufferLen := 0;
SetLength( aucLinkInfo, 0 );

// find out how much room we need
ulRetVal := ACE.AdsGetActiveLinkInfo( FhConnection,
UNSIGNED16( iLinkNum ),
aucLinkInfo,
usBufferLen );
if ( ulRetVal <> AE_INSUFFICIENT_BUFFER ) then
ACECheck( nil, ulRetVAl );

if ( usBufferLen > 0 ) then
begin
SetLength( aucLinkInfo, usBufferLen );
ACECheck( nil, ACE.AdsGetActiveLinkInfo( FhConnection,
UNSIGNED16( iLinkNum ),
aucLinkInfo,
usBufferLen ) );
end;

{* Place the returned information into a string *}
strInfo := string( aucLinkInfo );

iLastDelim := 0;
for iIndex := 1 to length( strInfo ) do
begin
if ( IsDelimiter( ';', strInfo, iIndex ) ) then
begin
poList.Add( Copy( strInfo, iLastDelim + 1, iIndex - (iLastDelim + 1) ) );
iLastDelim := iIndex;
end;
end;


end;


{******************************************************************************
* Module : DDCreateLink
* Input : hConnection : Dictionary connection to use for creating the
* link
* strLinkAlias : Alias of link in the data dictionary.
* strLinkedDDPath : Path to the linked DD.
* strUserName : User name for the link to use.
* strPassword : Password associated with the user.
* Options : Set of options used when creating the link.
* Output :
* Description : Creates a link to a Data Dictionary on the given connection.
*****************************************************************************}
procedure DDCreateLink( hConnection : cardinal;
strLinkAlias : string;
strLinkedDDPath : string;
strUserName : string;
strPassword : string;
Options : TAdsLinkOptions );
var
ulOptions : UNSIGNED32;
begin

{* Set the options for creating the link *}
ulOptions := 0;

if ( loGlobal in Options ) then
begin
ulOptions := ulOptions OR ADS_LINK_GLOBAL;
end;

if ( loAuthenticateActiveUser in Options ) then
begin
ulOptions := ulOptions OR ADS_LINK_AUTH_ACTIVE_USER;
end;

if ( loPathIsStatic in Options ) then
begin
ulOptions := ulOptions OR ADS_LINK_PATH_IS_STATIC;
end;

{* Create the link. *}
ACECheck( nil, ACE.AdsDDCreateLink( hConnection,
strLinkAlias,
strLinkedDDPath,
strUserName,
strPassword,
ulOptions ) );

end; {* DDCreateLink *}


{******************************************************************************
* Module : DDDropLink
* Input : hConnection : Dictionary connection to use for dropping the
* link
* strLinkedDD : Path or Alias of the link to drop.
* bDropGlobal : Whether to Remove the link from
* the data dictionary.
* Output :
* Description : Drops a link to Data Dictionary on the given connection.
* If bDropGlobal is true then the link is also removed from
* the data dictionary.
*****************************************************************************}
procedure DDDropLink( hConnection : cardinal;
strLinkedDD : string;
bDropGlobal : boolean );
var
usDropGlobal : UNSIGNED16;
begin

usDropGlobal := UNSIGNED16( bDropGlobal );

{* Create the link. *}
ACECheck( nil, ACE.AdsDDDropLink( hConnection,
strLinkedDD,
usDropGlobal ) );

end; {* DDDropLink *}


{******************************************************************************
* Module : TAdsConnection.CreateDDLink
* Input : strLinkAlias : Alias of link in the data dictionary.
* strLinkedDDPath : Path to the linked DD.
* strUserName : User name for the link to use.
* strPassword : Password associated with the user.
* Options : Set of options used when creating the link.
* Output :
* Description : Creates a link to a Data Dictionary.
*****************************************************************************}
procedure TAdsConnection.CreateDDLink( strLinkAlias : string;
strLinkedDDPath : string;
strUserName : string;
strPassword : string;
Options : TAdsLinkOptions );
begin

{* Call the helper function to create the link. *}
DDCreateLink( FhConnection,
strLinkAlias,
strLinkedDDPath,
strUserName,
strPassword,
Options );

end; {* TAdsConnection.CreateDDLink *}


{******************************************************************************
* Module : TAdsConnection.DropDDLink
* Input : strLinkedDD : Path or Alias of the link to drop.
* bDropGlobal : Whether to Remove the link from
* the data dictionary.
* Output :
* Description : Drops a link to Data Dictionary on the given connection.
* If bDropGlobal is true then the link is also removed from
* the data dictionary.
*****************************************************************************}
procedure TAdsConnection.DropDDLink( strLinkedDD : string;
bDropGlobal : boolean);
begin

{* Call the helper function to create the link. *}
DDDropLink( FhConnection,
strLinkedDD,
bDropGlobal );

end; {* TAdsConnection.DropDDLink *}


{******************************************************************************
* Module : TAdsConnection.ClearHandle
* Input :
* Output :
* Description : Clears a handle previously set by SetHandle. Undocumented.
* Used by ARC remote management utility.
*****************************************************************************}
procedure TAdsConnection.ClearHandle;
begin
FGivenConnection := 0;
end;


{******************************************************************************
* Module : TAdsConnection.SetHandle
* Input : hConnection : Connection handle to ADS
* Output :
* Description : Assigns an already working connection to this connection
* object.
*****************************************************************************}
procedure TAdsConnection.SetHandle( hConnection : cardinal );
var aucConnectPath : array[0..ADS_MAX_PATH] of char;
usLen : UNSIGNED16;
ulLen : UNSIGNED32;
ulRetVal : UNSIGNED32;
begin

{* Make sure this connection object hasn't already got a working connection *}
if ( ( FConnected = TRUE ) or ( FhConnection <> 0 ) ) then
raise AdsConnectionError.Create( 'TAdsConnection already has a working connection' );

{* Get the connection's path and use it to set this object's path *}
usLen := ADS_MAX_PATH - 1;
ulRetVal := ACE.AdsGetConnectionPath( hConnection, aucConnectPath, usLen );
if ( ulRetVal = AE_SUCCESS ) then
SetConnectString( String( aucConnectPath ))
else
raise AdsConnectionError.Create( 'TAdsConnection cannot resolve the connection' +
' path from the given connection handle.' );

{* Grab the username and password from the connection, so the user has those
* available to them. *}
ulLen := ADS_MAX_PATH;
ACECheck( nil, ACE.AdsGetConnectionProperty( hConnection, ADS_CONNECTIONPROP_USERNAME,
aucConnectPath, ulLen ) );
FUsername := aucConnectPath;

ulLen := ADS_MAX_PATH;
ACECheck( nil, ACE.AdsGetConnectionProperty( hConnection, ADS_CONNECTIONPROP_PASSWORD,
aucConnectPath, ulLen ) );
FPassword := aucConnectPath;

{* Set the given connection member so SetConnected knows to use this conn *}
FGivenConnection := hConnection;

{* Call SetConnected to ready this connection *}
SetConnected( TRUE );

end; {* TAdsConnection.SetHandle *}


{******************************************************************************
* Module : TAdsConnection.GetServerTime
* Input :
* Output : TDateTime : the current server time.
* Description : Retrieves the current time from the server using
* AdsGetServerTime.
*****************************************************************************}
function TAdsConnection.GetServerTime: TDateTime;
var
usDateLen : UNSIGNED16;
usTimeLen : UNSIGNED16;
lTime : SIGNED32;
pcDate : IntPtr;
pcTime : IntPtr;
strDate : string;
dDate : Double;
iYear : integer;
iMonth : integer;
iDay : integer;
stTimeStamp : TTimeStamp;
begin
{* If not connected already then do so here *}
if ( not IsConnected ) then
IsConnected := True;

{* Make sure to have enough room for any date or time format. *}
usDateLen := 69;
usTimeLen := 69;

pcDate := Marshal.AllocHGlobal( usDateLen );
pcTime := Marshal.AllocHGlobal( usTimeLen );

try
{*
* You must pass a buffer in for the time portion of the date even if you don't plan to
* use it.
*}
ACECheck( nil, ace.AdsGetServerTime( FhConnection, pcDate, usDateLen, lTime, pcTime, usTimeLen ) );

{*
* Convert the date string returned by AdsGetServerTime into a Julian date value.
* This prevents problems when Delphi's date format is different than ACE's
* date format.
*}
ACECheck( nil, aceunpub.AdsConvertDateToJulian( FhConnection, pcDate, usDateLen, dDate ) );

{*
* Now convert the julian to a string with the DBF date format. This works
* out for the best because parsing it is easy. Converting Julians to a
* Delphi Date Format is troublesome to say the least.
*}
usDateLen := 69;
ACECheck( nil, AdsConvertJulianToString( dDate, pcDate, usDateLen ) );

strDate := Marshal.PtrToStringAnsi( pcDate );

{* The date is formatted as the following YYYYMMDDD *}
iYear := StrToInt( Copy( strDate, 1, 4 ) );
iMonth := StrToInt( Copy( strDate, 5, 2 ) );
iDay := StrToInt( Copy( strDate, 7, 2 ) );

{*
* Setup the time portion as a TimeStamp. Set the Date to the first
* day that a TDateTime will recognize.
*}
stTimeStamp.Time := lTime;
stTimeStamp.Date := DateDelta;

{* Now encode the date and tack on the time *}
result := EncodeDate( iYear, iMonth, iDay ) + TimeStampToDateTime( stTimeStamp );

finally
Marshal.FreeHGlobal( pcDate );
Marshal.FreeHGlobal( pcTime );
end;

end; {* TAdsConnection.GetServerTime *}


{******************************************************************************
* Module : TAdsConnection.CloseCachedTables
* Input :
* Output :
* Description : Close all cached tables on this connection.
*****************************************************************************}
procedure TAdsConnection.CloseCachedTables;
begin
{* If not connected, this is a no-op. *}
if not IsConnected then
exit;

AceCheck( nil, AdsCloseCachedTables( FhConnection ) );
end;


initialization
gDefaultStmtOptions.musAdsLockType := ADS_PROPRIETARY_LOCKING;
gDefaultStmtOptions.musAdsCharType := ADS_ANSI;
gDefaultStmtOptions.musAdsRightsCheck := ADS_CHECKRIGHTS;
gDefaultStmtOptions.musAdsTableType := ADS_ADT;

finalization
if ( oAdsConnections <> nil ) then
FreeAndNil( oAdsConnections );

{ EOF }
end.

// Copyright (c) 2002-2007 Extended Systems, Inc. ALL RIGHTS RESERVED.
//
// This source code can be used, modified, or copied by the licensee as long as
// the modifications (or the new binary resulting from a copy or modification of
// this source code) are used with Extended Systems' products. The source code
// is not redistributable as source code, but is redistributable as compiled
// and linked binary code. If the source code is used, modified, or copied by
// the licensee, Extended Systems Inc. reserves the right to receive from the
// licensee, upon request, at no cost to Extended Systems Inc., the modifications.
//
// Extended Systems Inc. does not warrant that the operation of this software
// will meet your requirements or that the operation of the software will be
// uninterrupted, be error free, or that defects in software will be corrected.
// This software is provided "AS IS" without warranty of any kind. The entire
// risk as to the quality and performance of this software is with the purchaser.
// If this software proves defective or inadequate, purchaser assumes the entire
// cost of servicing or repair. No oral or written information or advice given
// by an Extended Systems Inc. representative shall create a warranty or in any
// way increase the scope of this warranty.

unit Advantage.Vcl.AdsD2007.AssemblyInfo;

interface

uses
System.Reflection, System.Runtime.CompilerServices;

//
// General Information about an assembly is controlled through the following
// set of attributes. Change these attribute values to modify the information
// associated with an assembly.
//
[assembly: AssemblyTitle('Advantage TDataSet Descendant Components')]
[assembly: AssemblyDescription('')]
[assembly: AssemblyConfiguration('')]
[assembly: AssemblyCompany('iAnywhere, Inc.')]
[assembly: AssemblyProduct('')]
[assembly: AssemblyCopyright('2004-2007')]
[assembly: AssemblyTrademark('')]
[assembly: AssemblyCulture('')]

//
// Version information for an assembly consists of the following four values:
//
// Major Version
// Minor Version
// Build Number
// Revision
//
// You can specify all the values or you can default the Revision and Build Numbers
// by using the '*' as shown below:

[assembly: AssemblyVersion('8.10.0.18')]

//
// In order to sign your assembly you must specify a key to use. Refer to the
// Microsoft .NET Framework documentation for more information on assembly signing.
//
// Use the attributes below to control which key is used for signing.
//
// Notes:
// (*) If no key is specified, the assembly is not signed.
// (*) KeyName refers to a key that has been installed in the Crypto Service
// Provider (CSP) on your machine. KeyFile refers to a file which contains
// a key.
// (*) If the KeyFile and the KeyName values are both specified, the
// following processing occurs:
// (1) If the KeyName can be found in the CSP, that key is used.
// (2) If the KeyName does not exist and the KeyFile does exist, the key
// in the KeyFile is installed into the CSP and used.
// (*) In order to create a KeyFile, you can use the sn.exe (Strong Name) utility.
// When specifying the KeyFile, the location of the KeyFile should be
// relative to the project output directory which is
// %Project Directory%\bin\<configuration>. For example, if your KeyFile is
// located in the project directory, you would specify the AssemblyKeyFile
// attribute as [assembly: AssemblyKeyFile('..\\..\\mykey.snk')]
// (*) Delay Signing is an advanced option - see the Microsoft .NET Framework
// documentation for more information on this.
//
[assembly: AssemblyDelaySign(false)]
[assembly: AssemblyKeyFile('')]
[assembly: AssemblyKeyName('')]

implementation

end.

// Copyright (c) 2002-2007 Extended Systems, Inc. ALL RIGHTS RESERVED.
//
// This source code can be used, modified, or copied by the licensee as long as
// the modifications (or the new binary resulting from a copy or modification of
// this source code) are used with Extended Systems' products. The source code
// is not redistributable as source code, but is redistributable as compiled
// and linked binary code. If the source code is used, modified, or copied by
// the licensee, Extended Systems Inc. reserves the right to receive from the
// licensee, upon request, at no cost to Extended Systems Inc., the modifications.
//
// Extended Systems Inc. does not warrant that the operation of this software
// will meet your requirements or that the operation of the software will be
// uninterrupted, be error free, or that defects in software will be corrected.
// This software is provided "AS IS" without warranty of any kind. The entire
// risk as to the quality and performance of this software is with the purchaser.
// If this software proves defective or inadequate, purchaser assumes the entire
// cost of servicing or repair. No oral or written information or advice given
// by an Extended Systems Inc. representative shall create a warranty or in any
// way increase the scope of this warranty.

unit Advantage.Vcl.AdsD2007d.AssemblyInfo;

interface

uses
System.Reflection, System.Runtime.CompilerServices;

//
// General Information about an assembly is controlled through the following
// set of attributes. Change these attribute values to modify the information
// associated with an assembly.
//
[assembly: AssemblyTitle('Advantage TDataSet Descendant Components')]
[assembly: AssemblyDescription('')]
[assembly: AssemblyConfiguration('')]
[assembly: AssemblyCompany('iAnywhere, Inc.')]
[assembly: AssemblyProduct('')]
[assembly: AssemblyCopyright('2004-2007')]
[assembly: AssemblyTrademark('')]
[assembly: AssemblyCulture('')]

//
// Version information for an assembly consists of the following four values:
//
// Major Version
// Minor Version
// Build Number
// Revision
//
// You can specify all the values or you can default the Revision and Build Numbers
// by using the '*' as shown below:

[assembly: AssemblyVersion('8.10.0.18')]

//
// In order to sign your assembly you must specify a key to use. Refer to the
// Microsoft .NET Framework documentation for more information on assembly signing.
//
// Use the attributes below to control which key is used for signing.
//
// Notes:
// (*) If no key is specified, the assembly is not signed.
// (*) KeyName refers to a key that has been installed in the Crypto Service
// Provider (CSP) on your machine. KeyFile refers to a file which contains
// a key.
// (*) If the KeyFile and the KeyName values are both specified, the
// following processing occurs:
// (1) If the KeyName can be found in the CSP, that key is used.
// (2) If the KeyName does not exist and the KeyFile does exist, the key
// in the KeyFile is installed into the CSP and used.
// (*) In order to create a KeyFile, you can use the sn.exe (Strong Name) utility.
// When specifying the KeyFile, the location of the KeyFile should be
// relative to the project output directory which is
// %Project Directory%\bin\<configuration>. For example, if your KeyFile is
// located in the project directory, you would specify the AssemblyKeyFile
// attribute as [assembly: AssemblyKeyFile('..\\..\\mykey.snk')]
// (*) Delay Signing is an advanced option - see the Microsoft .NET Framework
// documentation for more information on this.
//
[assembly: AssemblyDelaySign(false)]
[assembly: AssemblyKeyFile('')]
[assembly: AssemblyKeyName('')]

implementation

end.

// Copyright (c) 2002-2005 Extended Systems, Inc. ALL RIGHTS RESERVED.
//
// This source code can be used, modified, or copied by the licensee as long as
// the modifications (or the new binary resulting from a copy or modification of
// this source code) are used with Extended Systems' products. The source code
// is not redistributable as source code, but is redistributable as compiled
// and linked binary code. If the source code is used, modified, or copied by
// the licensee, Extended Systems Inc. reserves the right to receive from the
// licensee, upon request, at no cost to Extended Systems Inc., the modifications.
//
// Extended Systems Inc. does not warrant that the operation of this software
// will meet your requirements or that the operation of the software will be
// uninterrupted, be error free, or that defects in software will be corrected.
// This software is provided "AS IS" without warranty of any kind. The entire
// risk as to the quality and performance of this software is with the purchaser.
// If this software proves defective or inadequate, purchaser assumes the entire
// cost of servicing or repair. No oral or written information or advice given
// by an Extended Systems Inc. representative shall create a warranty or in any
// way increase the scope of this warranty.
{*******************************************************************************
* Source File : adstable.pas
* Date Created: 03/26/99
* Description : This is the TAdsTable and TAdsQuery component source
* Notes :
*******************************************************************************}
unit Advantage.Vcl.AdsTable;

{* Override any compiler directives we don't want, but that that user might have
* defined in their project. *}
{$T-} // turns off typed @ operator
{$B-} // use short-circuit boolean expressions
{$V-} // no var-string checking

{$INCLUDE Advantage.Delphi.Versions.inc}

{$WARN UNIT_PLATFORM OFF}

{ Range checking ( + is on and - is off ) }
{$R+}

interface

uses
SysUtils,
Classes,
DB,
ace,
aceunpub,
adsdata,
adscnnct,
adsfunc,
Borland.Vcl.Contnrs,
System.Runtime.InteropServices,
IniFiles,
syncobjs,
System.IO;

type

TUpdateMode = (upWhereAll, upWhereChanged, upWhereKeyOnly);

TIndexCollationMismatchOptions = (icmError, icmIgnore, icmReindex);

{* TAdsTimeStampRec is used in TAdsQuery when binding params and in TAdsStoredProc.BindParams *}
TAdsTimeStampRec = record
lDate: Longint;
lTime: Longint;
end;

{$IFNDEF ADSDELPHI5_OR_NEWER} {Delphi 4 or earlier}
{* This is in dbcommon for D5 and higher *}
TFieldMap = array [1..1024] of Word;
{$ENDIF}

{******************************************************************************}
{******************************************************************************}

{* TAdsStoredProc *}

TParamBindMode = (pbByName, pbByNumber);

TAdsStoredProc = class(TAdsExtendedDataSet)
private
FHandle : ADSHANDLE;
FStmtHandle : ADSHANDLE;
FProcName : string;
FParams : TParams;
FPrepared : Boolean;
FQueryMode : Boolean;
FBindMode : TParamBindMode;
FHasResultParam : Boolean;
FRefreshParams : string;
procedure BindParams;
function CreateCursor(GenHandle: Boolean): ADSHANDLE;
procedure FreeStatement;
function GetCursor(GenHandle: Boolean): LongInt;
procedure PrepareProc;
procedure SetParamsList(Value: TParams);
{$IFDEF ADSDELPHI4_OR_NEWER}
procedure ReadParamData(Reader: TReader);
procedure WriteParamData(Writer: TWriter);
{$ENDIF}
procedure ReadWaitCursor(Reader: TReader);
protected
procedure SetWaitCursor( val : integer );
function GetWaitCursor : integer;
{$IFDEF ADSDELPHI5_OR_NEWER}
{ IProviderSupport }
procedure PSExecute; override;
function PSGetTableName: string; override;
function PSGetParams: TParams; override;
procedure PSSetCommandText(const CommandText: string); override;
procedure PSSetParams(AParams: TParams); override;
{$ENDIF}
protected
function OpenAdvantageFiles : ADSHANDLE; override;
procedure InternalClose; override;
function GetLastAutoinc: Integer; override;
procedure PrepareAdvantageProcedure; virtual;
function CreateHandle: ADSHANDLE;
procedure DefineProperties(Filer: TFiler); override;
procedure Disconnect;
function GetParamsCount: Word;
procedure SetProcName(const Value: string);
procedure SetPrepared(Value: Boolean);
procedure SetPrepare(Value: Boolean);
procedure AddFieldsToParams( pcBuffer : array of char; eParamType : TParamType );
function BuildACEParamsList : string;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CopyParams(Value: TParams);
function DescriptionsAvailable: Boolean;
procedure ExecProc;
function ParamByName(const Value: string): TParam;
procedure Prepare;
procedure GetResults;
procedure UnPrepare;
procedure LoadParamsFromDictionary;
procedure InvalidateAceHandles; override;
property Handle: ADSHANDLE read FHandle;
property ParamCount: Word read GetParamsCount;
property StmtHandle: ADSHANDLE read FStmtHandle;
property Prepared: Boolean read FPrepared write SetPrepare;
property WaitCursor: integer read GetWaitCursor write SetWaitCursor;
published
property StoredProcName: string read FProcName write SetProcName;
property Params: TParams read FParams write SetParamsList
{$IFNDEF ADSDELPHI4_OR_NEWER} {Delphi 3 or CBuilder 3}
;
{$ENDIF}
{$IFDEF ADSDELPHI4_OR_NEWER}
stored False;
{$ENDIF}
property ParamBindMode: TParamBindMode read FBindMode write FBindMode default pbByName;
property RefreshParams: string read FRefreshParams write FRefreshParams stored false;
end;


{******************************************************************************}
{******************************************************************************}

{* TAdsQuery *}
TAdsQuery = class(TAdsExtendedDataSet)
private
mSQL: TStrings;
mbPrepared: Boolean;
mbReadAllColumns: Boolean;
moParams: TParams;
mbRequestLive: Boolean;
mbConstrained: Boolean; { ADS acts like delphi, the value of this }
{ field has no immediate affect, it does affect }
{ the next ExecuteSQL command }
mbParamCheck: Boolean;
moDataLink: TDataLink;
mhStmt : LongInt;
mhConnection : ADSHANDLE;
mlRowsAffected: LongInt;
FSQLBinary: TBytes;

function GetRowsAffected: Integer;
function GetQueryDataSource: TDataSource;
function GetSqlText : string;
procedure SetQueryDataSource(Value: TDataSource);
procedure SetQuery(Value: TStrings);
procedure SetParamsList(Value: TParams);
procedure QueryChanged(Sender: TObject);
procedure SetPrepare(Value: Boolean);
procedure SetReadAllColumns(Value: Boolean);
procedure ReadBinaryData(Stream: TStream);
procedure RefreshParams;
procedure SetParamsFromCursor;
procedure WriteBinaryData(Stream: TStream);
function InternalExecute: Longint;
procedure InternalExecuteScript(bExecute: Boolean);
procedure ValidateHandles;
procedure ReadWaitCursor(Reader: TReader);
procedure ReadParamData(Reader: TReader);
procedure WriteParamData(Writer: TWriter);

protected
procedure SetWaitCursor( val : integer );
function GetWaitCursor : integer;
procedure DefineProperties(Filer: TFiler); override;
function OpenAdvantageFiles : ADSHANDLE; override;
procedure InternalClose; override;
function GetParamsCount: Word;
procedure Disconnect;
procedure SetDatabaseName( strValue: String ); override;
property DataLink: TDataLink read moDataLink;
function CalculateSequenceNumber : UNSIGNED32; override;
function GetLastAutoinc: Integer; override;
procedure SetTableType( eValue: TAdsTableTypes ); override;
{ IProviderSupport }
procedure PSExecute; override;
function PSGetDefaultOrder: TIndexDef; override;
function PSGetParams: TParams; override;
function PSGetTableName: string; override;
procedure PSSetCommandText(const CommandText: string); override;
procedure PSSetParams(AParams: TParams); override;

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

property ParamCount: Word read GetParamsCount;
property Prepared: Boolean read mbPrepared write SetPrepare;
property RowsAffected: Integer read GetRowsAffected;
property SQLBinary: TBytes read FSQLBinary write FSQLBinary;
property StmtHandle: LongInt read mhStmt;

procedure ExecSQL;
procedure ExecSQLScript;
function ParamByName(const Value: string): TParam;
procedure Prepare;
procedure VerifySQL;
procedure UnPrepare;
procedure GetDetailLinkFields(MasterFields, DetailFields: TObjectList); override;

procedure AdsStmtEnableEncryption( const strPassword : string );
procedure AdsStmtDisableEncryption;
procedure AdsStmtSetTablePassword( const strTableName : string;
const strPassword : string );
procedure AdsStmtClearTablePasswords;
procedure AdsCloseSQLStatement;
procedure InvalidateAceHandles; override;

property LastAutoincVal: Integer read GetLastAutoinc;
property Text: string read GetSqlText;
property WaitCursor: integer read GetWaitCursor write SetWaitCursor default 0;

published
property AdsConnection: TAdsConnection read GetAdsConnection write SetAdsConnection;
property AdsTableOptions;
property ReadAllColumns: Boolean read mbReadAllColumns write SetReadAllColumns default False;
property Constrained: Boolean read mbConstrained write mbConstrained default False;
property DataSource: TDataSource read GetQueryDataSource write SetQueryDataSource;
property ParamCheck: Boolean read mbParamCheck write mbParamCheck default True;
property Params: TParams read moParams write SetParamsList stored False;
property RequestLive: Boolean read mbRequestLive write mbRequestLive default False;
property SQL: TStrings read mSQL write SetQuery;
property SourceTableType: TAdsTableTypes read GetAdsTableType write SetTableType
default ttAdsADT;




{******************************************}
{ These members/functions/properties are }
{ stubs that provide no functionality }
{******************************************}
private
moUpdateMode: TUpdateMode;
mbUniDirectional: Boolean;
mbLocal: Boolean;

function ConstraintsRaiseError : Boolean;
function UpdateObjectRaiseError : TComponent;


protected
public
property UpdateMode: TUpdateMode read moUpdateMode write moUpdateMode default upWhereAll;
property UniDirectional: Boolean read mbUniDirectional write mbUniDirectional default False;
property Local: Boolean read mbLocal;
property Constraints: Boolean read ConstraintsRaiseError;
property UpdateObject : TComponent read UpdateObjectRaiseError;
end;


{******************************************************************************}
{******************************************************************************}

TAdsTable = class(TAdsExtendedTable)
private
meIndexCollationMismatch : TIndexCollationMismatchOptions; { Specify what action to take when opening
indexes built with a different collation
sequence. }
FstrEncryptionPassword : string;
{$IFDEF ADSCBUILDER3_OR_NEWER}
FStoreDefs: Boolean;
{$ENDIF}
function GetExists : Boolean;
function GetFileName: string;
{$IFDEF ADSCBUILDER3_OR_NEWER}
function FieldDefsStored: Boolean;
function IndexDefsStored: Boolean;
{$ENDIF}
procedure SetIndexCollationMismatchOption( eValue: TIndexCollationMismatchOptions );

protected
function GetLastAutoinc: Integer; override;

public
constructor Create( AOwner: TComponent ); override;
destructor Destroy; override;
{$IFDEF ADSDELPHI4_OR_NEWER}
procedure GetDetailLinkFields(MasterFields, DetailFields: TObjectList); override;
{$ENDIF}
property Exists: Boolean read GetExists;
property LastAutoincVal: Integer read GetLastAutoinc;
procedure Restructure( const strAddFields, strDeleteFields, strChangeFields : string );

protected
function OpenAdvantageFiles : ADSHANDLE; override;
{$IFDEF ADSCBUILDER3_OR_NEWER}
procedure DefChanged(Sender: TObject); override;
{$ENDIF}
{$IFDEF ADSDELPHI5_OR_NEWER}
{ IProviderSupport }
function PSGetDefaultOrder: TIndexDef; override;
function PSGetKeyFields: string; override;
function PSGetTableName: string; override;
function PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs; override;
procedure PSSetCommandText(const CommandText: string); override;
procedure PSSetParams(AParams: TParams); override;
{$ENDIF} {* IFDEF ADSDELPHI5_OR_NEWER *}

published
property AdsConnection: TAdsConnection read GetAdsConnection write SetAdsConnection;
property AdsTableOptions;
{$IFDEF ADSCBUILDER3_OR_NEWER}
property FieldDefs stored FieldDefsStored;
property IndexDefs stored IndexDefsStored;
property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
{$ENDIF}
property IndexFiles;
property InfoExpression;
property Exclusive;
property ReadOnly;

property TableName;
property TableType;
property IndexCollationMismatch: TIndexCollationMismatchOptions read meIndexCollationMismatch
write SetIndexCollationMismatchOption default icmError;
property EncryptionPassword: string read FstrEncryptionPassword write FstrEncryptionPassword;
end;


{******************************************************************************}
{******************************************************************************}
implementation

uses
{$IFDEF ADSDELPHI4_OR_NEWER}
DBCommon
{$ELSE} {* Delphi/CBuilder 3 *}
AdsParam
{$ENDIF}

{$IFDEF ADSDELPHI6_OR_NEWER}
,variants
{$ENDIF}
;

const
NO_ROWS_AFFECTED = -1;

{ TAdsQueryDataLink }

type
TAdsQueryDataLink = class(TDetailDataLink)
private
FQuery: TAdsQuery;
protected
procedure ActiveChanged; override;
procedure RecordChanged(Field: TField); override;
function GetDetailDataSet: TDataSet; override;
procedure CheckBrowseMode; override;
public
constructor Create(AQuery: TAdsQuery);
end;

PDynamicConn = ^TDynamicConn;
TDynamicConn = class
private
FhAceConn : ADSHANDLE;
FstrDatabasename : string;
end;

PDyanmicConnLIst = ^TDynamicConnList;
TDynamicConnList = class
private
FItems : TList;
FSync : TCriticalSection;
public
constructor Create;
destructor Destroy; override;
function Add( strDatabasename : string ) : ADSHANDLE;
function FindSameDatabasename( strDatabasename : string ) : ADSHANDLE;
end;

var
goDynamicConnList : TDynamicConnList;



{*******************************************************************************
* Module: TDynamicConnList.Create
* Input:
* Output:
* Description: constructor for our dynamic-connection
* list.
*******************************************************************************}
constructor TDynamicConnList.Create;
begin
inherited Create;
FItems := TList.Create;
FSync := TCriticalSection.Create;
end; {* TDynamicConnList.Create *}



{*******************************************************************************
* Module: TDynamicConnList.Destroy
* Input:
* Output:
* Description: Destructor for out dynamic-conn list.
* Explicitly closes all connections and then
* frees the memory associated with them.
*******************************************************************************}
destructor TDynamicConnList.Destroy;
var
iCount : integer;
begin
{*
* Free the struct associated with each entry. Note that when using a
* TList it is possible to have nil pointers mixed in the list. We never
* remove entries from this list until right here though, so there is no
* need to pack the list. See Delphi help on TList if you need more
* clarification.
*}
for iCount := 0 to (FItems.Count - 1) do
begin
ACECHECK( nil,
AdsDisconnect( TDynamicConn( FItems.Items[iCount] ).FhAceConn ) );
TDynamicConn( FItems[iCount] ).Free;
end;

FItems.Free;
FSync.Free;
end; {* TDynamicConnList.Destroy *}



{*******************************************************************************
* Module: TDynamicConnList.Add
* Input: strDatabasename : databasename to add to the list
* Output: ACE connection handle established, or 0 if error
* Description: Get a new ace connection, add to the list and return its handle
*******************************************************************************}
function TDynamicConnList.Add( strDatabasename : string ) : ADSHANDLE;
var
hConn : cardinal;
oConn : TDynamicConn;
begin

{* Enter critical section *}
FSync.enter;
try
oConn := nil;
hConn := 0;

{* get a connection *}
ACECHECK( nil, AdsConnect( strDatabasename, hConn ) );

try
{* OK, we got a connection, now allocate the memory for it *}
oConn := TDynamicConn.Create;

{* add it to the TList *}
FItems.Add( oConn );

{* and fill it up *}
oConn.FhAceConn := hConn;
oConn.FstrDatabasename := strDatabasename;

{* return the ACE handle *}
result := hConn;
except
on E: Exception do
begin
if ( assigned( oConn ) ) then
oConn.Free;
if ( hConn <> 0 ) then
AdsDisconnect( hConn );
{* just keep result at zero, this will flag the caller to raise an exception *}
result := 0;
end;
end;

finally
{* Leave critical section *}
FSync.leave;
end;

end; {* TDynamicConnList.Add *}



{*******************************************************************************
* Module: TDynamicConnList.FindSameDatabasename
* Input: strDatabasename : name to find in list
* Output: ACE conn handle if found, o/w zero
* Description: Search the list for an entry with this databasename.
* NOTE paths are not converted to UNC or anything, we just use the string
* as it lives in the databasepath property (or the alias). This means if the
* user has one table with 'x:\w89p1' and one with '.\w89p1' we will create
* TWO connections for them. This is not entirly complete, but MUCH easier
* than dealing with the UNC conversions. If this is ever changed then it would
* be nice to implement two methods: one for finding a connection on the same
* server (for TAdsTable instances), and on for finding an exact connection
* (for TAdsQuery instances).
*******************************************************************************}
function TDynamicConnList.FindSameDatabasename( strDatabasename : string ) : ADSHANDLE;
var
i : integer;
oConn : TDynamicConn;
begin

{* Enter critical section. *}
FSync.enter;

try
result := 0;

try
if ( FItems.Count = 0 ) then
exit;

{* just do a linear search *}
for i := 0 to (FItems.Count-1) do
begin
oConn := TDynamicConn( FItems.Items[i] );
{*
* Throw in an UPPER so 'x:\w89p1' and 'X:\W89p1' don't grab
* different connections.
*}
if ( UpperCase( oConn.FstrDatabasename ) =
UpperCase( strDatabasename ) ) then
begin
result := oConn.FhAceConn;
exit;
end;
end;
except
on E: Exception do
{* just keep result at zero, this will flag the caller to raise an exception *}
result := 0;
end;

finally
{* Leave critical section *}
FSync.leave;
end;

end;



{$IFDEF ADSCBUILDER3_OR_NEWER}
function TAdsTable.FieldDefsStored: Boolean;
begin
Result := StoreDefs and (FieldDefs.Count > 0);
end;

function TAdsTable.IndexDefsStored: Boolean;
begin
Result := StoreDefs and (IndexDefs.Count > 0);
end;


procedure TAdsTable.DefChanged(Sender: TObject);
begin
StoreDefs := True;
end;
{$ENDIF}


{$IFDEF ADSDELPHI4_OR_NEWER}
{*******************************************************************************
* Module: TAdsQuery.ReadParamData
* Input: Reader -- read the local member values from the DFM
* Output:
* Description: this is the same as TQuery
*******************************************************************************}
procedure TAdsQuery.ReadParamData(Reader: TReader);
begin
Reader.ReadValue;
Reader.ReadCollection(moParams);
end;



{*******************************************************************************
* Module: TAdsQuery.WriteParamData
* Input: Writer -- write the local member values from the DFM
* Output:
* Description: this is the same as TQuery
*******************************************************************************}
procedure TAdsQuery.WriteParamData(Writer: TWriter);
begin
Writer.WriteCollection(Params);
end;
{$ENDIF}



{*******************************************************************************
* Module: TAdsQuery.ReadBinaryData
* Input: Stream -- read the local member values from the DFM
* Output:
* Description: this is the same as TQuery
*******************************************************************************}
procedure TAdsQuery.ReadBinaryData(Stream: TStream);
begin
SetLength( FSQLBinary, Stream.Size );
Stream.ReadBuffer( SQLBinary, Stream.Size );
end;



{*******************************************************************************
* Module: TAdsQuery.WritebinaryData
* Input: Stream -- write the local member values from the DFM
* Output:
* Description: this is the same as TQuery
*******************************************************************************}
procedure TAdsQuery.WriteBinaryData(Stream: TStream);
begin
Stream.WriteBuffer( SQLBinary, Length( SQLBinary ) );
end;



{*******************************************************************************
* Module: TAdsQuery.DefineProperties
* Input: Filer -- ??
* Output:
* Description: this is the same as TQuery
*******************************************************************************}
procedure TAdsQuery.DefineProperties(Filer: TFiler);
begin
inherited DefineProperties(Filer);
Filer.DefineBinaryProperty('Data', ReadBinaryData, WriteBinaryData, SQLBinary <> nil);
{$IFDEF ADSDELPHI4_OR_NEWER}
Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, True);
{$ENDIF}
Filer.DefineProperty('WaitCursor', ReadWaitCursor ,nil,false);
end;



{*******************************************************************************
* Module: TAdsQuery.SetQuery
* Input: Value -- set the SQL query text
* Output:
* Description: this is the same as TQuery
*******************************************************************************}
procedure TAdsQuery.SetQuery(Value: TStrings);
begin
if SQL.Text <> Value.Text then
begin
Disconnect;
SQL.BeginUpdate;
try
SQL.Assign(Value);
finally
SQL.EndUpdate;
end;
end;
end;



{*******************************************************************************
* Module: TAdsQuery.SetParamsList
* Input: Value -- set the SQL params values
* Output:
* Description: this is the same as TQuery
*******************************************************************************}
procedure TAdsQuery.SetParamsList(Value: TParams);
begin
moParams.AssignValues(Value);
end;



{*******************************************************************************
* Module: TAdsQuery.GetParamsCount
* Input:
* Output: return the # of params in moParams
* Description: this is the same as TQuery
*******************************************************************************}
function TAdsQuery.GetParamsCount: Word;
begin
Result := moParams.Count;
end;



{*******************************************************************************
* Module: TAdsQuery.GetRowsAffected
* Input:
* Output: return the # of rows affect by the last DML command
* Description: this is the same as TQuery
*******************************************************************************}
function TAdsQuery.GetRowsAffected: Integer;
begin
Result := mlRowsAffected;
end;



{*******************************************************************************
* Module: TAdsQuery.Disconnect
* Input:
* Output:
* Description: disconnect from the data source and free resources
*******************************************************************************}
procedure TAdsQuery.Disconnect;
begin
Close;
UnPrepare;
end;


{**********************************************************
* Module: TAdsQuery.GetSqlText
* Description: Returns the SQL statement text.
**********************************************************}
function TAdsQuery.GetSqlText : string;
begin
result := SQL.Text;
end;

{*******************************************************************************
* Module: TAdsQuery.QueryChanged
* Input: Sender -- unused
* Output:
* Description: the SQL query text has changed. Need to
* create new param lists and assign values
*******************************************************************************}
procedure TAdsQuery.QueryChanged(Sender: TObject);
var
List: TParams;
strParams: string;
begin
strParams := SQL.Text;

ACECHECK( self, ACEUNPUB.AdsGetSQLStmtParams( strParams ) );

{$IFNDEF ADSDELPHI4_OR_NEWER} {Delphi 3 or CBuilder 3}
if not (csReading in ComponentState) then
begin
Disconnect;
StrDispose( SQLBinary );
SQLBinary := nil;

if ParamCheck or (csDesigning in ComponentState) then
begin
List := TParams.Create();
try
CreateParams(List, PChar(strParams));
List.AssignValues(moParams);
moParams.Clear;
moParams.Assign(List);
finally
List.Free;
end;
end else
DataEvent(dePropertyChange, 0);
end;
{$ENDIF}
{$IFDEF ADSDELPHI4_OR_NEWER}
if not (csReading in ComponentState) then
begin
Disconnect;
SetLength(FSQLBinary, 0);

if ParamCheck or (csDesigning in ComponentState) then
begin
List := TParams.Create(Self);
try
List.ParseSQL(strParams, True);
List.AssignValues(moParams);
moParams.Clear;
moParams.Assign(List);
finally
List.Free;
end;
end;
DataEvent(dePropertyChange, TObject(Integer(0)));
end;
{$ENDIF}
end;


{$IFNDEF ADSDELPHI4_OR_NEWER} {Delphi 3 or CBuilder 3}

procedure TAdsQuery.CreateParams(List: TParams; const Value: PChar);
var
CurPos, StartPos: PChar;
CurChar: Char;
Literal: Boolean;
EmbeddedLiteral: Boolean;
Name: string;

function NameDelimiter: Boolean;
begin
Result := CurChar in [' ', ',', ';', ')', #13, #10];
end;

function IsLiteral: Boolean;
begin
Result := CurChar in ['''', '"'];
end;

function StripLiterals(Buffer: PChar): string;
var
Len: Word;
TempBuf: PChar;

procedure StripChar(Value: Char);
begin
if TempBuf^ = Value then
StrMove(TempBuf, TempBuf + 1, Len - 1);
if TempBuf[StrLen(TempBuf) - 1] = Value then
TempBuf[StrLen(TempBuf) - 1] := #0;
end;

begin
Len := StrLen(Buffer) + 1;
TempBuf := AllocMem(Len);
Result := '';
try
StrCopy(TempBuf, Buffer);
StripChar('''');
StripChar('"');
Result := StrPas(TempBuf);
finally
FreeMem(TempBuf, Len);
end;
end;

begin
CurPos := Value;
Literal := False;
EmbeddedLiteral := False;
repeat
CurChar := CurPos^;
if (CurChar = ':') and not Literal and ((CurPos + 1)^ <> ':') then
begin
StartPos := CurPos;
while (CurChar <> #0) and (Literal or not NameDelimiter) do
begin
Inc(CurPos);
CurChar := CurPos^;
if IsLiteral then
begin
Literal := Literal xor True;
if CurPos = StartPos + 1 then EmbeddedLiteral := True;
end;
end;
CurPos^ := #0;
if EmbeddedLiteral then
begin
Name := StripLiterals(StartPos + 1);
EmbeddedLiteral := False;
end
else Name := StrPas(StartPos + 1);
if Assigned(List) then
List.CreateParam(ftUnknown, Name, ptUnknown);
CurPos^ := CurChar;
StartPos^ := '?';
Inc(StartPos);
StrMove(StartPos, CurPos, StrLen(CurPos) + 1);
CurPos := StartPos;
end
else if (CurChar = ':') and not Literal and ((CurPos + 1)^ = ':') then
StrMove(CurPos, CurPos + 1, StrLen(CurPos) + 1)
else if IsLiteral then Literal := Literal xor True;
Inc(CurPos);
until CurChar = #0;
end;
{$ENDIF}



{*******************************************************************************
* Module: TAdsQuery.SetPrepare
* Input: Value - setting prepared to TRUE or FALSE
* Output:
* Description: indicate prepared or unprepared, but really do nothing
*******************************************************************************}
procedure TAdsQuery.SetPrepare(Value: Boolean);
begin
if Value then Prepare
else UnPrepare;
end;


{*******************************************************************************
* Module: TAdsQuery.SetReadAllColumns
* Input: Value - setting Select Field Reads to TRUE or FALSE
* Output:
* Description: Indicate if select field reads should be turned on or off.
*******************************************************************************}
procedure TAdsQuery.SetReadAllColumns(Value: Boolean);
begin
mbReadAllColumns := Value;
end;


{*******************************************************************************
* Module: TAdsQuery.Prepare
* Input:
* Output:
* Description: indicate prepared, but really do nothing
*******************************************************************************}
procedure TAdsQuery.Prepare;
begin
{ if there is a cursor handle, then raise an error }
if Handle <> ADSHANDLE( INVALID_ACE_HANDLE ) then
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL,
'Cannot perform this operation on an open dataset' );

mlRowsAffected := NO_ROWS_AFFECTED;
mbPrepared := True;
end;


{*******************************************************************************
* Module: TAdsQuery.VeryifySQL
* Input:
* Output:
* Description: Verify the validity of an SQL statement
* Note: This implementation has some limitations with comments and trailing
* semi-colons, See bug pad entry #1530. We know this is slow, it will
* be investigated/addressed for 7.0 with the bug fix.
*******************************************************************************}
procedure TAdsQuery.VerifySQL;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.VerifySQL' );
{$ENDIF }

ValidateHandles; {* make sure we have a valid SQL statement hadle *}

{ Set the Lock type from the properties associated to the table }
if mpoAdsTableOptions.AdsLockType = Proprietary then
ACECheck( self, AdsStmtSetTableLockType( mhStmt, ADS_PROPRIETARY_LOCKING ))
else
ACECheck( self, AdsStmtSetTableLockType( mhStmt, ADS_COMPATIBLE_LOCKING ));

{ Set the Character type from the properties associated to the table }
if mpoAdsTableOptions.AdsCharType = ANSI then
ACECheck( self, AdsStmtSetTableCharType( mhStmt, ADS_ANSI ))
else
ACECheck( self, AdsStmtSetTableCharType( mhStmt, ADS_OEM ));

{ Set the Rights checking from the property associated to the table }
if mpoAdsTableOptions.AdsRightsCheck then
ACECheck( self, AdsStmtSetTableRights( mhStmt, ADS_CHECKRIGHTS ))
else
ACECheck( self, AdsStmtSetTableRights( mhStmt, ADS_IGNORERIGHTS ));

{ Set the read only option }
if ( mbRequestLive ) then
ACECheck( self, AdsStmtSetTableReadOnly( mhStmt, ADS_CURSOR_READWRITE ))
else
ACECheck( self, AdsStmtSetTableReadOnly( mhStmt, ADS_CURSOR_READONLY ));

{* If this query has a connection object, and it is set to be readonly, then override
* the readonly flag on this query instance. *}
if ( ( mpoAdsConnection <> nil ) and ( mpoAdsConnection.ReadOnly ) ) then
ACECheck( self, AdsStmtSetTableReadOnly( mhStmt, ADS_CURSOR_READONLY ));

{ Set the table type }
if ( GetAdsTableType = ttAdsADT ) then
ACECheck( self, AdsStmtSetTableType( mhStmt, ADS_ADT ))
else if ( GetAdsTableType = ttAdsCDX ) then
ACECheck( self, AdsStmtSetTableType( mhStmt, ADS_CDX ))
else
ACECheck( self, AdsStmtSetTableType( mhStmt, ADS_NTX ));

{ Set the constrain option }
if ( mbConstrained ) then
ACECheck( self, AdsStmtConstrainUpdates( mhStmt, ADS_CONSTRAIN ))
else
ACECheck( self, AdsStmtConstrainUpdates( mhStmt, ADS_NO_CONSTRAIN ));

{ Set the select field reads option (read selected/all fields in live cursor }
if mbReadAllColumns then
ACECheck( self, AdsStmtReadAllColumns( mhStmt, ADS_READ_ALL_COLUMNS ))
else
ACECheck( self, AdsStmtReadAllColumns( mhStmt, ADS_READ_SELECT_COLUMNS ));

{* Pass FALSE to do a verify, not a full execute *}
InternalExecuteScript( FALSE );
end;


{*******************************************************************************
* Module: TAdsQuery.UnPrepare
* Input:
* Output:
* Description: indicate unprepared, but really do nothing
*******************************************************************************}
procedure TAdsQuery.UnPrepare;
begin
{ if there is a cursor handle, then raise an error }
if Handle <> ADSHANDLE( INVALID_ACE_HANDLE ) then
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL,
'Cannot perform this operation on an open dataset' );

mbPrepared := False;
end;



{*******************************************************************************
* Module: TAdsQuery.SetQueryDataSource
* Input: Value -- The datasource reference for this TAdsQuery instance
* Output:
* Description: Store a reference to a datasrouce objefct
*******************************************************************************}
procedure TAdsQuery.SetQueryDataSource(Value: TDataSource);
begin
if IsLinkedTo(Value) then
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL,
'Circular Data Link');
moDataLink.DataSource := Value;
end;



{*******************************************************************************
* Module: TAdsQuery.GetQueryDataSource
* Input:
* Output: the reference to the datasource object
* Description: this is the same as TQuery
*******************************************************************************}
function TAdsQuery.GetQueryDataSource: TDataSource;
begin
Result := moDataLink.DataSource;
end;



{*******************************************************************************
* Module: TAdsQuery.SetParamsFromCursor
* Input:
* Output:
* Description: This allows for a master-detail type relationship where
* this function is executed for the detail object. The values
* from the master are used as parameters for the query.
*
* This function extracts field values from a remote dataset object
* via a DataSource link object. The values are used to fill in
* values for parameters for the current SQL statement. Only
* parameters that do not have a bound value, will be set.
*******************************************************************************}
procedure TAdsQuery.SetParamsFromCursor;
var
I: Integer;
DataSet: TDataSet;
begin
if moDataLink.DataSource <> nil then
begin
{ reference the remote DataSet object }
DataSet := moDataLink.DataSource.DataSet;
if DataSet <> nil then
begin
DataSet.FieldDefs.Update;

{ for every parameter that does not have a value bound,
store a value from the dataset object }
for I := 0 to moParams.Count - 1 do
if not moParams[I].Bound then
begin
{ store the value into the local parameter }
moParams[I].AssignField(DataSet.FieldByName( moParams[I].Name ));

{ indicate this value is not bound, so that it will be
replaced next time, too }
moParams[I].Bound := False;
end;
end;
end;
end;



{*******************************************************************************
* Module: TAdsQuery.RefreshParams
* Input:
* Output:
* Description: Rerun the query, which will cause new parameter values to be
* used since the master table is on a different row
*******************************************************************************}
procedure TAdsQuery.RefreshParams;
var
DataSet: TDataSet;
begin
DisableControls;
try
if moDataLink.DataSource <> nil then
begin
DataSet := moDataLink.DataSource.DataSet;
if DataSet <> nil then
if DataSet.Active and (DataSet.State <> dsSetKey) then
begin
Close;
Open;
end;
end;
finally
EnableControls;
end;
end;


{*******************************************************************************
* Module: TAdsQuery.AdsStmtEnableEncryption
* Input:
* Output:
* Description: Calls same named ACE function
*******************************************************************************}
procedure TAdsQuery.AdsStmtEnableEncryption( const strPassword : string );
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.AdsStmtEnableEncryption' );
{$ENDIF }

{ Make sure the mhStmt is valid }
ValidateHandles;

{ CAll ACE }
ACECheck( self, Ace.AdsStmtEnableEncryption( mhStmt, strPassword ));
end; { TAdsQuery.AdsStmtEnableEncryption }


{*******************************************************************************
* Module: TAdsQuery.AdsStmtDisableEncryption
* Input:
* Output:
* Description: Calls same named ACE function
*******************************************************************************}
procedure TAdsQuery.AdsStmtDisableEncryption;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.AdsStmtDisableEncryption' );
{$ENDIF }

{ Make sure the mhStmt is valid }
ValidateHandles;

{ CAll ACE }
ACECheck( self, Ace.AdsStmtDisableEncryption( mhStmt ));
end; { TAdsQuery.AdsStmtDisableEncryption }


{*******************************************************************************
* Module: TAdsQuery.AdsStmtSetTablePassword
* Input:
* Output:
* Description: Calls same named ACE function
*******************************************************************************}
procedure TAdsQuery.AdsStmtSetTablePassword( const strTableName : string;
const strPassword : string );
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.AdsStmtSetTablePassword' );
{$ENDIF }

{ Make sure the mhStmt is valid }
ValidateHandles;

{ CAll ACE }
ACECheck( self, Ace.AdsStmtSetTablePassword( mhStmt, strTableName,
strPassword));
end; { TAdsQuery.AdsStmtSetTablePassword }


{*******************************************************************************
* Module: TAdsQuery.AdsStmtClearTablePasswords
* Input:
* Output:
* Description: Calls same named ACE function
*******************************************************************************}
procedure TAdsQuery.AdsStmtClearTablePasswords;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.AdsStmtClearTablePasswords' );
{$ENDIF }

{ Make sure the mhStmt is valid }
ValidateHandles;

{ CAll ACE }
ACECheck( self, Ace.AdsStmtClearTablePasswords( mhStmt ));
end; { TAdsQuery.AdsStmtClearTablePasswords }


{*******************************************************************************
* Module: TAdsQuery.ValidateHandles
* Input:
* Output:
* Description: Make sure the query's connection and statement handles are valid.
* If they have not been initialized, then call ACE to create them.
*******************************************************************************}
procedure TAdsQuery.ValidateHandles;
var
hConnect : ADSHANDLE;
usHandleType : UNSIGNED16;
ulRetCode : UNSIGNED32;
strPath : string;
hTemp : cardinal;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.ValidateHandles' );
{$ENDIF }

{ if there is a valid statement handle, do nothing. }
if ( mhStmt <> ADSHANDLE( INVALID_ACE_HANDLE ) ) then
begin
{ Ensure it is valid. If the user closed the connection and opened it }
{ again, then the statement handle may have been lost }
{* NOTE: This isn't thread safe, because if this query's connection was
* closed (and subsequently its stmt too) another thread may have connected
* and picked up the same statement handle value before we got here. Fixed
* this by having TAdsConnection objects call the InvalidateAceHandles
* method for all of their child datasets when disconnecting. *}
ulRetCode := ACE.AdsGetHandleType( mhStmt, usHandleType );
if ( ulRetCode = AE_SUCCESS ) and ( usHandleType = ADS_STATEMENT ) then
exit;
end;

mhStmt := ADSHANDLE( INVALID_ACE_HANDLE );

{ Get rid of compiler warning }
hConnect := ADSHANDLE( INVALID_ACE_HANDLE );

{ user must specify a database path, alias or a connection component }
if ( DatabaseName = '' ) and ( not assigned( AdsConnection ) ) then
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL,
'The DatabaseName property has not been assigned a value.' );

{ need a connection handle to ACE }
if ( mhConnection = ADSHANDLE( INVALID_ACE_HANDLE ) ) then
if Assigned( AdsConnection ) then
begin
if Not AdsConnection.IsConnected then
AdsConnection.IsConnected := True;

hConnect := AdsConnection.ConnectionHandle;
end
else
begin
{ If this is just a drive letter colon, add a backslash to it. }
{ NOTE: Not sure about this logic, modified it to only happen if }
{ there is actually a colon. At least now it won't happen }
{ for short paths like "/" in linux. }
strPath := GetDatabasePath;
if ( ( Length( strPath ) < 3 ) and
( Length( strPath ) > 1 ) and
( strPath[2] = ':' ) ) then
strPath := strPath + ADS_PATH_DELIMITER;

{ find an existing connection }
mhConnection := goDynamicConnList.FindSameDatabasename( strPath );
if ( mhConnection = 0 ) then
{* we didn't find one, so add one *}
mhConnection := goDynamicConnList.Add( strPath );

hConnect := mhConnection;
end;

{* if hConnect is still INVALID_ACE_HANDLE then something went very wrong *}
if ( ( hConnect = ADSHANDLE( INVALID_ACE_HANDLE ) ) or ( hConnect = 0 ) ) then
raise EADSDatabaseError.Create( self,
AE_TADSDATASET_GENERAL,
'Internal Error: invalid connection handle.' );

{ create an SQL statement object *}
ACECheck( self, Ace.AdsCreateSQLStatement( hConnect, hTemp ));
mhStmt := hTemp;
end;


{*******************************************************************************
* Module: TAdsQuery.InternalExecute
* Input:
* Output: Outputs the ACE cursor handle
* Description: do all ACE stuff necessary to prepare and execute an
* SQL statement which includs:
* connect to the server,
* create a statement
* prepare the statement
* write all params
* execute the statement
* indicate how many rows were affected by the query
* NOTE: Any changes made to the parameter setting in this method should be
* included in adscnnct.pas, SetQueryParams
*******************************************************************************}
function TAdsQuery.InternalExecute : LongInt;
var
I : integer;
lAdsDate : SIGNED32;
lMilliSec : SIGNED32;
stDateType : TAdsTimeStampRec;
ulDataSize : UNSIGNED32;
ulRetCode : UNSIGNED32;
usIsLive : byte;
musOpenCharType : UNSIGNED16;
hTemp : cardinal;
TempBuffer : IntPtr;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.InternalExecute' );
{$ENDIF }

CheckInActive;

ValidateHandles;

{ Set the Lock type from the properties associated to the table }
if mpoAdsTableOptions.AdsLockType = Proprietary then
ACECheck( self, AdsStmtSetTableLockType( mhStmt, ADS_PROPRIETARY_LOCKING ))
else
ACECheck( self, AdsStmtSetTableLockType( mhStmt, ADS_COMPATIBLE_LOCKING ));

{ Set the Character type from the properties associated to the table }
if mpoAdsTableOptions.AdsCharType = ANSI then
ACECheck( self, AdsStmtSetTableCharType( mhStmt, ADS_ANSI ))
else
ACECheck( self, AdsStmtSetTableCharType( mhStmt, ADS_OEM ));

{ Set the Rights checking from the property associated to the table }
if mpoAdsTableOptions.AdsRightsCheck then
ACECheck( self, AdsStmtSetTableRights( mhStmt, ADS_CHECKRIGHTS ))
else
ACECheck( self, AdsStmtSetTableRights( mhStmt, ADS_IGNORERIGHTS ));

{ Set the read only option }
if ( mbRequestLive ) then
ACECheck( self, AdsStmtSetTableReadOnly( mhStmt, ADS_CURSOR_READWRITE ))
else
ACECheck( self, AdsStmtSetTableReadOnly( mhStmt, ADS_CURSOR_READONLY ));

{* If this query has a connection object, and it is set to be readonly, then override
* the readonly flag on this query instance. *}
if ( ( mpoAdsConnection <> nil ) and ( mpoAdsConnection.ReadOnly ) ) then
ACECheck( self, AdsStmtSetTableReadOnly( mhStmt, ADS_CURSOR_READONLY ));

{ Set the table type }
if ( GetAdsTableType = ttAdsADT ) then
ACECheck( self, AdsStmtSetTableType( mhStmt, ADS_ADT ))
else if ( GetAdsTableType = ttAdsCDX ) then
ACECheck( self, AdsStmtSetTableType( mhStmt, ADS_CDX ))
else
ACECheck( self, AdsStmtSetTableType( mhStmt, ADS_NTX ));

{ Set the constrain option }
if ( mbConstrained ) then
ACECheck( self, AdsStmtConstrainUpdates( mhStmt, ADS_CONSTRAIN ))
else
ACECheck( self, AdsStmtConstrainUpdates( mhStmt, ADS_NO_CONSTRAIN ));


{ Set the select field reads option (read selected/all fields in live cursor }
if mbReadAllColumns then
ACECheck( self, AdsStmtReadAllColumns( mhStmt, ADS_READ_ALL_COLUMNS ))
else
ACECheck( self, AdsStmtReadAllColumns( mhStmt, ADS_READ_SELECT_COLUMNS ));

{ prepare the SQL statement }
Prepare();
ACECheck( self, Ace.AdsPrepareSQL( mhStmt, SQL.Text ));

{ set params from the data source into the params object }
if moDataLink.DataSource <> nil then SetParamsFromCursor;

{ assign all parameters' values within ACE }
for I := 0 to moParams.Count - 1 do
begin
if moParams[i].IsNull then
ACECheck( self, ACE.AdsSetEmpty( mhStmt, ( I + 1 )))
else
begin
case moParams[I].DataType of
ftUnknown:
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL,
'The field named: ''' + moParams[i].Name +
''' has the DataType of ftUnknown, which is invalid.' );

ftString,
{$IFDEF ADSDELPHI4_OR_NEWER}
ftFixedChar,
ftLargeint,
{$ENDIF}
ftWord,
ftSmallint,
ftInteger,
ftBCD,
ftMemo,
ftFmtMemo,
ftAutoInc:
begin
ACECheck( self, ACE.AdsSetString( mhStmt, ( I + 1 ), moParams[i].AsString,
Length( moParams[i].AsString ) ));

end;

ftTime:
begin
lMilliSec := ROUND( Frac( moParams[i].AsDateTime ) *
MSEC_PER_DAY );
ACECheck( self, ACE.AdsSetMilliseconds( mhStmt, ( I + 1 ), lMilliSec ));
end;

ftDate:
begin
lAdsDate := Trunc( moParams[i].AsDateTime ) + DELPHI_DATETIME_TO_JULIAN;
ACECheck( self, ACE.AdsSetJulian( mhStmt, ( I + 1 ), lAdsDate ));
end;

ftDateTime:
begin
stDateType.lTime := ROUND( Frac( moParams[i].AsDateTime ) *
MSEC_PER_DAY );
stDateType.lDate := Trunc( moParams[i].AsDateTime ) + DELPHI_DATETIME_TO_JULIAN;

TempBuffer := Marshal.AllocHGlobal( 2 * sizeof( Int32 ) );
try
Marshal.WriteInt32( TempBuffer, stDateType.lDate );
Marshal.WriteInt32( TempBuffer, 4, stDateType.lTime );

ACECheck( self, ACEUNPUB.AdsSetTimeStampRaw( mhStmt, ( I + 1 ),
TempBuffer,
8 ) );
finally
Marshal.FreeHGlobal( TempBuffer );
end;
end;

ftCurrency,
ftFloat:
ACECheck( self, AdsSetDouble( mhStmt, ( I + 1 ),
moParams[i].AsFloat ));

ftBoolean:
if ( moParams[i].AsBoolean ) then
ACECheck( self, AdsSetLogical( mhStmt, ( I + 1 ), ADS_TRUE ))
else
ACECheck( self, AdsSetLogical( mhStmt, ( I + 1 ), ADS_FALSE ));


ftBytes,
ftVarBytes,
ftBlob,
ftGraphic :
begin
ulDataSize := moParams[i].GetDataSize();
TempBuffer := Marshal.AllocHGlobal( ulDataSize );
try
Params[i].GetData( TempBuffer );
ACECheck( nil, ACE.AdsSetBinary( mhStmt, ( I + 1 ), ADS_BINARY,
ulDataSize, 0, TempBuffer,
ulDataSize ));
finally
Marshal.FreeHGlobal( TempBuffer );
end;
end;

{$IFDEF ADSDELPHI4_OR_NEWER}
ftWideString,
ftADT,
ftArray,
ftReference,
ftDataSet,
{$ENDIF}
ftParadoxOle,
ftDBaseOle,
ftTypedBinary,
ftCursor:
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL, 'The field named: ''' +
moParams[i].Name + ''' has a DataType that is not supported.' );
end; {case}
end; {if not empty}
end; {for}


{ execute the SQL }
try
ACECheck( self, Ace.AdsExecuteSQL( mhStmt, hTemp ) );
Result := hTemp;
except
on E : Exception do
begin
{* if user canceled the query then free the statement, because it is in
* an unknown state. A new statement will be allocated the next time
* the user tries to open this query *}
if ( pos( '7209', E.message ) <> 0 ) then
begin
AdsCloseSQLStatement;
raise;
end
else
raise;
end;
end;

{ if Result is a 0 then no cursor resulted }
if Result = 0 then
Result := ADSHANDLE( INVALID_ACE_HANDLE )
else
begin
{ it was a select statement. Is the cursor live? }
ACECheck( self, Aceunpub.AdsSqlPeekStatement( Result, usIsLive ));

{ set the mbReadOnly to affect the GetCanModify Flag }
mbReadOnly := ( usIsLive = 0 );

{ If it was a live cursor, set the char type to match whatever ace is using. }
if ( usIsLive = 1 ) then
begin
ACECheck( self, AdsGetTableCharType( Result, musOpenCharType ) );
if ( musOpenCharType = ADS_OEM ) then
AdsTableOptions.AdsCharType := OEM
else
AdsTableOptions.AdsCharType := ANSI;
end;
end;

{ how many rows were affected }
ulRetCode := Ace.AdsGetRecordCount( mhStmt, ADS_IGNOREFILTERS, hTemp );
mlRowsAffected := LongInt( hTemp );
if ( ulRetCode = AE_NOT_DML ) then
mlRowsAffected := NO_ROWS_AFFECTED
else
ACECheck( self, ulRetCode );

end;



{*******************************************************************************
* Module: TAdsQuery.Create
* Input: TComponent --- Owner ( naming convention specific to Delphi )
* Output:
* Description: Constructor for the TAdsQuery component.
*******************************************************************************}
constructor TAdsQuery.Create( AOwner: TComponent );
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.Create' );
{$ENDIF }

inherited Create( AOwner );

mSQL := TStringList.Create;
{$IFDEF ADSDELPHI4_OR_NEWER}
moParams := TParams.Create( Self );;
{$ENDIF}

{$IFNDEF ADSDELPHI4_OR_NEWER} {Delphi 3 or CBuilder 3}
moParams := TParams.Create();;
{$ENDIF}
moDataLink := TAdsQueryDataLink.Create(Self);

TStringList( mSQL ).OnChange := QueryChanged;

mbPrepared := FALSE;
mbReadAllColumns := FALSE; { do select field reads by default }
mbRequestLive := FALSE;
mbConstrained := FALSE;
mbParamCheck := TRUE;
mhStmt := ADSHANDLE( INVALID_ACE_HANDLE );
mhConnection := ADSHANDLE( INVALID_ACE_HANDLE );

{ unused members for property stubs }
moUpdateMode := upWhereAll;
mbLocal := FALSE;
mbUniDirectional := FALSE;
end;


{*******************************************************************************
* Module: TAdsQuery.Destroy
* Input:
* Output:
* Description: Destructor for the TAdsQuery component.
*******************************************************************************}
destructor TAdsQuery.Destroy;
var
ulRetCode : UNSIGNED32;
bHaveConnection : boolean;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.Destroy' );
{$ENDIF }

mSQL.Free;
moParams.Free;
moDataLink.Free;

{*
* Our parent's destructor will remove us from our TAdsConnection (if
* we are pointing at one). Save the connected property, so we can use it
* in logic below.
*}
if ( ( AdsConnection <> nil ) and ( AdsConnection.IsConnected ) ) then
bHaveConnection := TRUE
else
bHaveConnection := FALSE;

{ close the table, etc }
inherited Destroy;

{*
* Close the SQL statement.
* NOTE: Only close this statement if mhConnection is set (which means we
* were not using a TAdsConnection component) or if we were using a
* TAdsConnection component and it is still active. If we were using a
* TAdsConnection and it has been closed then it already closed our stmt
* handle. This exact handle could now be in use by another thread, and if
* we closed it here we would close the stmt that other thread is currently using.
*}
if ( mhStmt <> ADSHANDLE( INVALID_ACE_HANDLE ) ) then
begin
if ( ( mhConnection > 0 ) or bHaveConnection ) then
begin
ulRetCode := Ace.AdsCloseSQLStatement( mhStmt );
if ulRetCode <> AE_INVALID_SQLSTATEMENT_HANDLE then
ACECheck( self, ulRetCode );
end;
end;
mhStmt := INVALID_ACE_HANDLE;

{ do not close the connection. Orphin it. It will be reused if possible. }
end;



{*******************************************************************************
* Module: TAdsQuery.GetDetailLinkFields
* Input: two TList pointers, expected to already have memory
* associated to them
* Output:
* Return:
* Description: returns one list of TField objects for the master fields, and
* one list of TField objects for the detail fields
*******************************************************************************}
{$IFDEF ADSDELPHI4_OR_NEWER}
procedure TAdsQuery.GetDetailLinkFields(MasterFields, DetailFields: TObjectList);

function AddFieldToList(const strFieldName: string; poDataSet: TDataSet;
poList: TList): Boolean;
var
poField: TField;
begin
poField := poDataSet.FindField(strFieldName);
if (poField <> nil) then
poList.Add(poField);
Result := poField <> nil;
end;

var
i: Integer;
begin
MasterFields.Clear;
DetailFields.Clear;
if (DataSource <> nil) and (DataSource.DataSet <> nil) then
for i := 0 to Params.Count - 1 do
if AddFieldToList(Params[i].Name, DataSource.DataSet, MasterFields) then
AddFieldToList(Params[i].Name, Self, DetailFields);
end;
{$ENDIF}


{*******************************************************************************
* Module: TAdsQuery.ParamByName
* Input:
* Output:
* Description: call the ParamByName method
*******************************************************************************}
function TAdsQuery.ParamByName(const Value: string): TParam;
begin
Result := moParams.ParamByName(Value);
end;



{*******************************************************************************
* Module: TAdsQuery.ExecSQL
* Input:
* Output:
* Return:
* Description: Opens the table and the associated indexes
*******************************************************************************}
procedure TAdsQuery.ExecSQL;
var
hCursor : ADSHANDLE;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.ExecSQL' );
{$ENDIF }

{* Execute the query *}
hCursor := InternalExecute();

if ( hCursor <> INVALID_ACE_HANDLE ) then
ACECheck( self, ACE.AdsCloseTable( hCursor ));
end;


{*******************************************************************************
* Module: TAdsQuery.ExecSQLScript
* Input:
* Output:
* Return:
* Description: Executes an sql script
*******************************************************************************}
procedure TAdsQuery.ExecSQLScript;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.ExecSQLScript' );
{$ENDIF }

{* Execute the query *}
InternalExecuteScript( true ); {* bExecute = true *}

end;



{*******************************************************************************
* Module: TAdsQuery.InternalExecuteScript
* Input: bExecute - true to execute the SQL, false to just verify the SQL
* Output:
* Return:
* Description: Executes or verifies an sql script
*******************************************************************************}
procedure TAdsQuery.InternalExecuteScript(bExecute : Boolean);
var
strCurrentLine : string;
iCurrentLine : integer;
astrScript : TStringList;
begin

{* Get a copy of the string list in the SQL property. *}
astrScript := TStringList.Create;
astrScript.assign( Sql );

{* Clear the sql contents, as we'll be adding stuff line by line. *}
SQL.Clear;

try

for iCurrentLine := 0 to ( astrScript.Count - 1 ) do
begin
strCurrentLine := astrScript[iCurrentLine];

strCurrentLine := Trim( strCurrentLine );

{* Parse older script comments for backwards compatability (the server
* doesn't recognize these). For each comment line, add a blank line
* so the SQL engine can acurately report what line any errors occur on. *}
if (( length( strCurrentLine ) > 0 ) and
(( strCurrentLine[1] = '#' ) or ( strCurrentLine[1] = '[' ))) then
SQL.Add( '' )
else
SQL.Add( strCurrentLine );
end; {* for each line *}

try
if ( bExecute = true ) then {* actually execute the SQL *}
ExecSQL
else {* just verify the SQL *}
ACECHECK( self, ACE.AdsVerifySQL( mhStmt, SQL.Text ));
except
on E : Exception do
begin
{* Raise EDatabaseError, because we are currently executing the
* handler of an EAdsDatabaseError, and 2 at one time doesn't
* work well (do to EADSDatabaseError.Create issues). *}
raise EDatabaseError.Create( 'ERROR IN SCRIPT: ' + E.message );
end;
end;

finally
{* Clear the script and set it back to its original contents. *}
SQL.Clear;
SQL.Assign( astrScript );

{* Free the string list. *}
astrScript.Free;
end;

end;



{*******************************************************************************
* Module: TAdsQuery.OpenTableAndIndexs
* Input:
* Output:
* Return: ADSHANDLE - Handle of open table
* Description: executes the query and opens opens associated indexes
*******************************************************************************}
function TAdsQuery.OpenAdvantageFiles : ADSHANDLE;

var
sIndexCount : SIGNED16;
ahIndex : ADSIndexArray;
usArrayLen : UNSIGNED16;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.OpenTableAndIndexes' );
{$ENDIF }

{ execute the SQL statement }
Result := InternalExecute();

if Result = INVALID_ACE_HANDLE then
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL, 'The SQL statement did not generate a cursor handle. ' +
'Use TAdsQuery.ExecSQL to execute SQL statements that are not SELECT statements' );

{*
* Get the table type of the actual opened table. This may be different from
* the musOpenTableType which is set by the user.
*}
ACECheck( self, Ace.AdsGetTableType( Result, musAceTableType ));

{ Open all of the indexes that were specified in the index files for the }
{ given table }
try
for sIndexCount := 0 to mpoIndexFiles.Count - 1 do
begin
usArrayLen := ARRAY_NDX;
ACECheck( self, ACE.AdsOpenIndex( Result,
GetDatabasePath + ADS_PATH_DELIMITER + mpoIndexFiles[sIndexCount],
ahIndex, usArrayLen));
end;
except
ACE.AdsCloseTable( Result );
raise;
end;

end;



{*******************************************************************************
* Module: TAdsQuery.InternalClose
* Input:
* Output:
* Description: override the TAdsDataSet method so that UnPrepared can be called
*******************************************************************************}
procedure TAdsQuery.InternalClose;
var
ulRetCode : UNSIGNED32;

begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.InternalClose' );
{$ENDIF }

inherited InternalClose;

UnPrepare();

{
if in design mode, destroy the statement to close the file from ASA
}
if csDesigning in ComponentState then
begin
if ( mhStmt <> INVALID_ACE_HANDLE ) then
begin
ulRetCode := Ace.AdsCloseSQLStatement( mhStmt );
if ulRetCode <> AE_INVALID_SQLSTATEMENT_HANDLE then
ACECheck( self, ulRetCode );
end;

mhStmt := INVALID_ACE_HANDLE;

mhConnection := INVALID_ACE_HANDLE;
{ do not close the connection. Orphin it. It will be reused if possible. }
end;

end;



{*******************************************************************************
* Module: TAdsQuery.SetTableType
* Description: Raise an error to signify not supported
*******************************************************************************}
procedure TAdsQuery.SetTableType( eValue: TAdsTableTypes );
var
oConn : TAdsConnection;
bDictionary : boolean;
begin
{* If this is a dictionary connection then let them set the table type to
* NTX, because we really don't care. The tabletype stored in the
* dictionary will be used. *}
bDictionary := FALSE;

oConn := GetAdsConnection;
if ( oConn <> nil ) then
bDictionary := oConn.IsDictionaryConn;

if ( eValue = ttAdsNTX ) and ( not bDictionary ) then
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL, 'The TAdsQuery component does not support the NTX table type' );

inherited SetTableType( eValue );
end;



{**********************************************************
* Module: TAdsQuery.SetDatabaseName
* Input: strValue : String that is the database path
* Output:
* Description: handle implicit ACE connections that need to be changed
* because the path in DatabaseName has changed
**********************************************************}
procedure TAdsQuery.SetDatabaseName( strValue: String );
var
bHasChanged : boolean;

begin
{$IFDEF CALLTRACE}
WriteCallTrace( 'TAdsQuery.SetDatabaseName' );
{$ENDIF}

bHasChanged := DatabaseName <> strValue;
{ call the ancestor }
SetAdsConnection ( nil );
inherited SetDatabaseName( strValue );

{*
* If there is a connection handle in mhConnection, then we need to close
* this statement and clear out the handles. Leave the connection open
* because this is a connection that is in the dynamic connection list,
* and may be being used by other TAdsDataSet instances.
*}
if bHasChanged and ( mhConnection <> INVALID_ACE_HANDLE ) then
begin
ACECheck( self, ACE.AdsCloseSQLStatement( mhStmt ) );
mhConnection := INVALID_ACE_HANDLE;
mhStmt := INVALID_ACE_HANDLE;
end;

end;


{**********************************************************
* Module: TAdsQuery.CalculateSequenceNumber
* Output: a logical record number used to position the scroll bar
* Description: Calculate the sequence number. If there is an index being used
* internally by ACE because of an "Order By", then use it.
**********************************************************}
function TAdsQuery.CalculateSequenceNumber : UNSIGNED32;
var
ulRecNum : UNSIGNED32;
ulRecCount : UNSIGNED32;
dPos : Double;
ulRetVal : UNSIGNED32;
hIndex : cardinal;
begin
{ The logical record number of the record buffer
This value is equal to the physical record number if not index is
active or if Sequenced is false.
The value is an approximate of the key value if both an index is
active and Sequenced is TRUE
}
hIndex := 0;

if ( ( IndexName <> '' ) or ( IndexFieldNames <> '' ) ) then
// use the index handle that they have set
hIndex := ActiveHandle
else
// get the index handle from ACE for the SQL default index
ACECheck( self, ACE.AdsGetIndexHandle( Handle, Nil, hIndex ));

if NOT( Sequenced ) or ( hIndex = 0 ) then
ACECheck( self, ACE.AdsGetRecordNum( Handle, ADS_IGNOREFILTERS, ulRecNum ) )
else
begin
{* If sequenced level is exact, use the slower (but more accurate)
* API AdsGetKeyNum. Otherwise use AdsGetRelKey pos which provides
* better performance. *}
if ( meSeqLevel = slExact ) then
begin
{* NOTE: In the future we could add a different sequenced level and not
* pass ADS_RESPECTFILTERS all the time. *}
ACECheck( self, ACE.AdsGetKeyNum( hIndex, ADS_RESPECTFILTERS, ulRecNum ) );
end
else
begin
ACECheck( self, ACE.AdsGetRecordCount( Handle, ADS_IGNOREFILTERS,
ulRecCount ) );
ulRetVal := ACE.AdsGetRelKeyPos( hIndex, dPos );

{ If the position was not found then it is zero }
if ( ulRetVal <> AE_NOT_FOUND ) then
ACECheck( self, ulRetVal )
else
dPos := 0;

ulRecNum := Trunc( dPos * ulRecCount );
end;
end;

Result := ulRecNum;
end; { TAdsQuery.CalculateSequenceNumber }


{**********************************************************
* Module: TAdsQuery.AdsCloseSQLStatement
* Description: Free the SQL statement. This is useful so that the user can
* force the table closed. He must also set the cache open
* cursors to zero.
**********************************************************}
procedure TAdsQuery.AdsCloseSQLStatement();
var
ulRetCode : UNSIGNED32;
begin
{ if there is a cursor handle, then raise an error }
if Handle <> INVALID_ACE_HANDLE then
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL,
'Cannot perform this operation on an open dataset' );

{ close the SQL statement }
if ( mhStmt <> INVALID_ACE_HANDLE ) then
begin
ulRetCode := Ace.AdsCloseSQLStatement( mhStmt );
if ulRetCode <> AE_INVALID_SQLSTATEMENT_HANDLE then
ACECheck( self, ulRetCode );
end;
mhStmt := INVALID_ACE_HANDLE;

mhConnection := INVALID_ACE_HANDLE;
{ do not close the connection. Orphin it. It will be reused if possible. }
end;


{**********************************************************
* Description: This is a special stub function that raises
* an exception to let the user know that this function is
* not supported. The meaning behind this is that the user
* if trying to convert TAdsQuery code or if using third party
* controls will know that the method is not supported.
**********************************************************}
function TAdsQuery.ConstraintsRaiseError : Boolean;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.ConstraintsRaiseError' );
{$ENDIF }
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL, 'The property "Constraints" is not supported.' );
end;

{***********}

function TAdsQuery.UpdateObjectRaiseError : TComponent;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsQuery.UpdateObjectRaiseError' );
{$ENDIF }
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL, 'The property "UpdateObject" is not supported.' );
end;



{*******************************************************************************
* Module: TAdsQuery.GetLastAutoinc
* Input:
* Output: return the last autoinc value inserted with sql INSERT statement
* Description:
*******************************************************************************}
function TAdsQuery.GetLastAutoinc: Integer;
var
ulRetCode : UNSIGNED32 ;
ulLastAutoincVal : UNSIGNED32;
begin
ulLastAutoincVal := 0;

{*
* If there's a cursor, get the last autoinc from it, otherwise use the
* statment handle. The cursor handle is necessary so they can get the
* last autoinc value if the TAdsQuery.Insert method was used to add
* a record (because no INSERT statement was executed, just a table
* append).
*}
if ( Handle <> INVALID_ACE_HANDLE ) then
ulRetCode := Ace.AdsGetLastAutoinc( Handle, ulLastAutoincVal )
else
ulRetCode := Ace.AdsGetLastAutoinc( mhStmt, ulLastAutoincVal );

ACECheck( self, ulRetCode );

Result := ulLastAutoincVal;
end;



{*******************************************************************************
* Module: TAdsQuery.InvalidateAceHandles
* Input:
* Output:
* Description: Invalidates ace handles in the component. Called by a
* TAdsConnection component when disconnecting. This way the query or proc
* component won't have invalid statement handles referenced inside it (since
* the connection component destroyed them when it closed).
*******************************************************************************}
procedure TAdsQuery.InvalidateAceHandles;
begin
UnPrepare;
mhStmt := INVALID_ACE_HANDLE;
mhConnection := INVALID_ACE_HANDLE;
end;


{******************************************************************************}
{******************************************************************************}
{******************************************************************************}
{******************************************************************************}

{ Overload the TDataLink component to catch events }

constructor TAdsQueryDataLink.Create(AQuery: TAdsQuery);
begin
inherited Create;
FQuery := AQuery;
end;

procedure TAdsQueryDataLink.ActiveChanged;
begin
if FQuery.Active then FQuery.RefreshParams;
end;

{$IFDEF ADSDELPHI4_OR_NEWER}
function TAdsQueryDataLink.GetDetailDataSet: TDataSet;
begin
Result := FQuery;
end;
{$ENDIF}

procedure TAdsQueryDataLink.RecordChanged(Field: TField);
begin
if (Field = nil) and FQuery.Active then FQuery.RefreshParams;
end;

procedure TAdsQueryDataLink.CheckBrowseMode;
begin
if FQuery.Active then FQuery.CheckBrowseMode;
end;



{******************************************************************************}
{******************************************************************************}
{******************************************************************************}
{******************************************************************************}



{*******************************************************************************
* Module: TAdsTable.Create
* Input: TComponent --- Owner ( naming convention specific to Delphi )
* Output:
* Description: Constructor for the TAdsTable component.
*******************************************************************************}
constructor TAdsTable.Create( AOwner: TComponent );
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsTable.Create' );
{$ENDIF }

inherited Create( AOwner );

{ Initialize index collation mismatch behavior }
IndexCollationMismatch := icmError;

FstrEncryptionPassword := '';

end;



{*******************************************************************************
* Module: TAdsTable.Destroy
* Input:
* Output:
* Description: Destructor for the TAdsTable component.
*******************************************************************************}
destructor TAdsTable.Destroy;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsTable.Destroy' );
{$ENDIF }

inherited Destroy;
end;



{**********************************************************
* Module: TAdsTable.GetFileName
* Input:
* Output:
* Description: Get the full databasename, path, and
* extension.
**********************************************************}
function TAdsTable.GetFileName: string;
var
strExtension : string;
begin
if ( TableType = ttAdsADT ) then
strExtension := '.adt'
else
strExtension := '.dbf';

Result := GetNativeDatabasePath + ADS_PATH_DELIMITER;
if ExtractFileExt(TableName) = '' then
Result := Result + TableName + strExtension
else
Result := Result + TableName;
end;


{**********************************************************
* Module: TAdsTable.SetIndexCollationMismatchOption
* Input: eValue - enumerated type to control the desired
* behavior when opening an index that
* was created with a collation sequence
* different from the current sequence.
* Output:
* Description: Set the option if not active
**********************************************************}
procedure TAdsTable.SetIndexCollationMismatchOption( eValue: TIndexCollationMismatchOptions );
begin

{ Make sure it is not active }
if Active then
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL,
'Cannot perform this operation on an open dataset' );

meIndexCollationMismatch := eValue;
end; {* TAdsTable.SetIndexCollationMismatchOption *}



{**********************************************************
* Module: TAdsTable.GetExists
* Input:
* Output:
* Description: Check to see if the table pointed to by
* this table object exists
**********************************************************}
function TAdsTable.GetExists : Boolean;
begin
Result := Active;
if Result or (TableName = '') then Exit;

Result := FileExists( GetFileName );
end; {* TAdsTable.GetExists *}



{*******************************************************************************
* Module: TAdsTable.GetDetailLinkFields
* Input: two TList pointers, expected to already have memory
* associated to them
* Output:
* Return:
* Description: returns one list of TField objects for the master fields, and
* one list of TField objects for the detail fields
*******************************************************************************}
{$IFDEF ADSDELPHI4_OR_NEWER}
procedure TAdsTable.GetDetailLinkFields(MasterFields, DetailFields: TObjectList);
var
poIndex: TIndexDef;
begin
MasterFields.Clear;
DetailFields.Clear;
if (MasterSource <> nil) and (MasterSource.DataSet <> nil) and
(Self.MasterFields <> '') then
begin
poIndex := nil;
MasterSource.DataSet.GetFieldList(MasterFields, Self.MasterFields);
IndexDefs.Update;
{* indexname and indexfieldnames are mutually exclusive *}
if IndexName <> '' then
poIndex := IndexDefs.Find(IndexName)
else if IndexFieldNames <> '' then
poIndex := IndexDefs.GetIndexForFields(IndexFieldNames, False);
if poIndex <> nil then
GetFieldList(DetailFields, poIndex.Fields);
end;
end;
{$ENDIF}


{*******************************************************************************
* Module: TAdsTable.OpenAdvantageFiles
* Input:
* Output:
* Return: ADSHANDLE - Handle of open table
* Description: Opens the table and the associated indexes
*******************************************************************************}
function TAdsTable.OpenAdvantageFiles : ADSHANDLE;
var
sIndexCount : SIGNED16;
ahIndex : ADSIndexArray;
usArrayLen : UNSIGNED16;
ulOptions : UNSIGNED32;
usCharType : UNSIGNED16;
usLockType : UNSIGNED16;
usRights : UNSIGNED16;
usTableType : UNSIGNED16;
hConnect : ADSHANDLE;
ulRetVal : UNSIGNED32;
strTableName : string;
usEncrypted : UNSIGNED16;
usEncryptionEnabled : UNSIGNED16;
musOpenCharType : UNSIGNED16;
hTemp : cardinal;
begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsTable.OpenTableAndIndexes' );
{$ENDIF }

{ If table name is blank then cannot open table so raise exception }
if TableName = '' then
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL, 'Missing TableName property' );

{ Set the options from some of the properties associated to the table }
if Exclusive and ReadOnly then
ulOptions := ADS_READONLY or ADS_EXCLUSIVE
else if Exclusive then
ulOptions := ADS_EXCLUSIVE
else if ReadOnly then
ulOptions := ADS_READONLY
else
ulOptions := ADS_DEFAULT;

{* If this table has a connection object, and it is set to be readonly, then override
* the readonly flag on this table instance. If it's run-time then also change the
* tables readonly property, so data-aware controls don't let the user write to them.
* We don't do this at design-time because we don't want to change the readonly property
* when the user opens a table, and then stream it out to the dfm. *}
if ( ( mpoAdsConnection <> nil ) and ( mpoAdsConnection.ReadOnly ) ) then
begin
ulOptions := ulOptions or ADS_READONLY;
if not ( csDesigning in ComponentState ) then
ReadOnly := TRUE;
end;


{ Set the options flag for indexes created under a different collation sequence }
if meIndexCollationMismatch = icmIgnore then
ulOptions := ulOptions or ADS_IGNORE_COLLATION_MISMATCH
else if meIndexCollationMismatch = icmReindex then
ulOptions := ulOptions or ADS_REINDEX_ON_COLLATION_MISMATCH;

{ Set the Lock type from the properties associated to the table }
if mpoAdsTableOptions.AdsLockType = Proprietary then
usLockType := ADS_PROPRIETARY_LOCKING
else
usLockType := ADS_COMPATIBLE_LOCKING;

{ Set the Character type from the properties associated to the table }
if mpoAdsTableOptions.AdsCharType = ANSI then
usCharType := ADS_ANSI
else
usCharType := ADS_OEM;

{ Set the Rights checking from the property associated to the table }
if mpoAdsTableOptions.AdsRightsCheck then
usRights := ADS_CHECKRIGHTS
else
usRights := ADS_IGNORERIGHTS;

{
get the table name -- this must be done prior to the AdsOpenTable
call because the GetDatabasePath function may change the value of
musOpenTableType
}
if ( GetDatabasePath = '' ) then
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL, 'One of the DatabaseName property or the ' +
'AdsConnection property must have a value.' );

{* If we're on a data dictionary connection then just get the tablename *}
if( ( AdsConnection <> nil ) and
( AdsConnection.IsDictionaryConn ) = TRUE ) then
strTableName := TableName
else
strTableName := GetDatabasePath + ADS_PATH_DELIMITER + TableName;

{ if connection is not assigned set it to 0 otherwise make sure its open and use it }
if Assigned( AdsConnection ) then
begin
if Not AdsConnection.IsConnected then
begin
AdsConnection.IsConnected := True;
{*
* The BeforeConnect event might have changed the database path,
* so reset it. If it didn't change then this won't hurt anything.
*}
if ( AdsConnection.IsDictionaryConn = TRUE ) then
strTableName := TableName
else
strTableName := GetDatabasePath + ADS_PATH_DELIMITER + TableName;
end;
hConnect := AdsConnection.ConnectionHandle;
end
else
begin
{*
* If no connection was explicitly assigned then try to find one
* in our list of dynamically created connections (connections
* we've created ourselves on behalf of the dataset object).
*}
hConnect := goDynamicConnList.FindSameDatabasename( GetDatabasePath );
if ( hConnect = 0 ) then
{* we didn't find one, so add one *}
hConnect := goDynamicConnList.Add( GetDatabasePath );
end;

{* hConnect must have a value by the time we get here *}
if ( hConnect = 0 ) then
raise EADSDatabaseError.Create( self,
AE_TADSDATASET_GENERAL,
'Internal Error: invalid connection handle.' );

{*
* If we are on a database dictionary connection then send a table type of ADS_DEFAULT,
* o/w send musOpenTableType.
* NOTE: We can't simply change musOpenTableType to ADS_DEFAULT, as it is used in
* multiple other places in the code to determine the index type and take
* index-specific actions.
*}
usTableType := musOpenTableType;
if Assigned( AdsConnection ) then
begin
if AdsConnection.IsDictionaryConn then
usTableType := ADS_DEFAULT
end;

ulRetVal := ACE.AdsOpenTable( hConnect,
strTableName,
nil,
usTableType,
usCharType,
usLockType,
usRights,
ulOptions,
hTemp );
Result := hTemp;

{* Special case here: If this table is on a dictionary connection, and the table open
* failed because the table isn't in the dictionary, try one more open, this time
* sending the real tabletype. This allows us to attempt to open a free table, even
* though we are on a dictionary connection. This wasn't in the original design, but
* has been included to help existing AIS users convert to using the new AIS functionality
* in 6.1 *}
if ( ulRetVal = AE_INVALID_OBJECT_NAME ) then
begin
{* NOTE: If we got an AE_INVALID_OBJECT_NAME error this really has to be a dictionary
* connection, but we'll verify just to be safe. *}
if Assigned( AdsConnection ) then
if AdsConnection.IsDictionaryConn then
begin
{* Try one more time, this time don't use ADS_DEFAULT as the table type. *}
strTableName := GetDatabasePath + ADS_PATH_DELIMITER + TableName;
usTableType := musOpenTableType;
ulRetVal := ACE.AdsOpenTable( hConnect,
strTableName,
nil,
usTableType,
usCharType,
usLockType,
usRights,
ulOptions,
hTemp );
Result := hTemp;
end;
end;

ACECheck( self, ulRetVal );


{*
* Get the table type of the actual opened table. This may be different from
* the musOpenTableType which is set by the user. This flag was introduced
* to help determine what to do with numeric adt fields. It's use is different
* than the flag checked in the block below.
*}
ACECheck( self, Ace.AdsGetTableType( Result, musAceTableType ));

{*
* If this was a dictionary open, then the current TableType property might
* be different from the actual table type that was stored in the dictionary
* and used for this open. If that is the case then get the table type from
* ACE and update TAdsDataSet.
*}
if Assigned( AdsConnection ) then
begin
if AdsConnection.IsDictionaryConn then
begin
ACECheck( self, AdsGetTableType( Result, musOpenTableType ) );
{* Only ADT and CDX are supported through dictionary *}
if ( musOpenTableType = ADS_CDX ) then
TableType := ttAdsCDX
else if ( musOpenTableType = ADS_NTX ) then
TableType := ttAdsNTX
else
TableType := ttAdsADT;

{* Get char type. Shouldn't need this for adt. *}
if ( TableType = ttAdsCDX ) or ( TableType = ttAdsNTX ) then
begin
ACECheck( self, AdsGetTableCharType( Result, musOpenCharType ) );
if ( musOpenCharType = ADS_OEM ) then
AdsTableOptions.AdsCharType := OEM
else
AdsTableOptions.AdsCharType := ANSI;
end;
end;
end;

{* If the user supplied an encryption password, enable encryption now. *}
if ( FstrEncryptionPassword <> '' ) then
begin
{*
* If the table isn't encrypted, and we call AdsEnableEncryption, it will
* put the password into the table header, effectively encrypting all new
* record updates. That is not the desired effect here, so first see if
* the table is encrypted. Also check to see if encryption is already
* enabled (which it is if opening a dictionary table) and don't enable
* it twice.
*}
ACECheck( self, ACE.AdsIsTableEncrypted( Result, usEncrypted ) );
ACECheck( self, ACE.AdsIsEncryptionEnabled( Result, usEncryptionEnabled ) );
if ( ( usEncrypted = ADS_TRUE ) and ( usEncryptionEnabled <> ADS_TRUE ) ) then
ACECheck( self, ACE.AdsEnableEncryption( Result, FstrEncryptionPassword ) );
end;

{ Open all of the indexes that were specified in the index files for the }
{ given table }
try
for sIndexCount := 0 to mpoIndexFiles.Count - 1 do
begin
usArrayLen := ARRAY_NDX;
ACECheck( self, ACE.AdsOpenIndex( Result,
GetDatabasePath + ADS_PATH_DELIMITER + mpoIndexFiles[sIndexCount],
ahIndex, usArrayLen));
end;
except
ACE.AdsCloseTable( Result );
raise;
end;
end;


{**********************************************************
* Module: TAdsExtendedTable.Restructure
* Date Created: 11/8/00
* Description:
**********************************************************}
procedure TAdsTable.Restructure( const strAddFields,
strDeleteFields,
strChangeFields : string );

var
usCharType : UNSIGNED16;
usLockType : UNSIGNED16;
usRights : UNSIGNED16;
usTableType : UNSIGNED16;
hConnect : ADSHANDLE;
strTableName : string;

begin
{$IFDEF CALLTRACE }
WriteCallTrace( 'TAdsExtendedTable.AdsRestructureTable' );
{$ENDIF }

{ If the table is open raise the exception }
if Active then
raise EADSDatabaseError.create( self, AE_TAdsDataSet_GENERAL,
'Cannot perform this operation on an open dataset' );





{ If table name is blank then cannot open table so raise exception }
if TableName = '' then
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL, 'Missing TableName property' );

{ Set the Lock type from the properties associated to the table }
if mpoAdsTableOptions.AdsLockType = Proprietary then
usLockType := ADS_PROPRIETARY_LOCKING
else
usLockType := ADS_COMPATIBLE_LOCKING;

{ Set the Character type from the properties associated to the table }
if mpoAdsTableOptions.AdsCharType = ANSI then
usCharType := ADS_ANSI
else
usCharType := ADS_OEM;

{ Set the Rights checking from the property associated to the table }
if mpoAdsTableOptions.AdsRightsCheck then
usRights := ADS_CHECKRIGHTS
else
usRights := ADS_IGNORERIGHTS;

{
get the table name -- this must be done prior to the AdsOpenTable
call because the GetDatabasePath function may change the value of
musOpenTableType
}
if ( GetDatabasePath = '' ) then
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL, 'One of the DatabaseName property or the ' +
'AdsConnection property must have a value.' );

{* If we're on a data dictionary connection then just get the tablename *}
if( ( AdsConnection <> nil ) and
( AdsConnection.IsDictionaryConn ) = TRUE ) then
strTableName := TableName
else
strTableName := GetDatabasePath + ADS_PATH_DELIMITER + TableName;

{ if connection is not assigned set it to 0 otherwise make sure its open and use it }
if Assigned( AdsConnection ) then
begin
if Not AdsConnection.IsConnected then
begin
try
AdsConnection.IsConnected := True;
except
raise;
end;
end;
hConnect := AdsConnection.ConnectionHandle;
end
else
begin
{*
* If no connection was explicitly assigned then try to find one
* in our list of dynamically created connections (connections
* we've created ourselves on behalf of the dataset object).
*}
hConnect := goDynamicConnList.FindSameDatabasename( GetDatabasePath );
if ( hConnect = 0 ) then
{* we didn't find one, so add one *}
hConnect := goDynamicConnList.Add( GetDatabasePath );
end;

{* hConnect must have a value by the time we get here *}
if ( hConnect = 0 ) then
raise EADSDatabaseError.Create( self,
AE_TADSDATASET_GENERAL,
'Internal Error: invalid connection handle.' );

{*
* If we are on a database dictionary connection then send a table type of ADS_DEFAULT,
* o/w send musOpenTableType.
* NOTE: We can't simply change musOpenTableType to ADS_DEFAULT, as it is used in
* multiple other places in the code to determine the index type and take
* index-specific actions.
*}
usTableType := musOpenTableType;
if Assigned( AdsConnection ) then
begin
if AdsConnection.IsDictionaryConn then
usTableType := ADS_DEFAULT
end;

ACECheck( self, ACE.AdsRestructureTable( hConnect,
strTableName,
nil,
usTableType,
usCharType,
usLockType,
usRights,
strAddFields,
strDeleteFields,
strChangeFields));
end;



{*******************************************************************************
* Module: TAdsTable.GetLastAutoinc
* Input:
* Output: return the last autoinc value inserted after an append to the table
* Description:
*******************************************************************************}
function TAdsTable.GetLastAutoinc: Integer;
var
ulRetCode : UNSIGNED32 ;
ulLastAutoincVal : UNSIGNED32;
begin
ulLastAutoincVal := 0;

ulRetCode := Ace.AdsGetLastAutoinc( Handle, ulLastAutoincVal );
ACECheck( self, ulRetCode );

Result := ulLastAutoincVal;
end;

{******************************************************************************}
{******************************************************************************}
{******************************************************************************}
{******************************************************************************}


{* TAdsStoredProc *}


{*******************************************************************************
* Module: TAdsStoredProc.Create
* Input:
* Output:
* Description: Constructor for TAdsStoredProc
*******************************************************************************}
constructor TAdsStoredProc.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{$IFDEF ADSDELPHI4_OR_NEWER}
FParams := TParams.Create(Self);
{$ELSE}
FParams := TParams.Create;
{$ENDIF}
FHandle := INVALID_ACE_HANDLE;
FStmtHandle := INVALID_ACE_HANDLE;
end;



{*******************************************************************************
* Module: TAdsStoredProc.Destroy
* Input:
* Output:
* Description: Destructor for TAdsStoredProc
*******************************************************************************}
destructor TAdsStoredProc.Destroy;
begin
Destroying;
Disconnect;
FParams.Free;
inherited Destroy;
end;



{*******************************************************************************
* Module: TAdsStoredProc.OpenAdvantageFiles
* Input:
* Output:
* Description: Method that begins storedproc execution for a procedure
* that returns a cursor.
*******************************************************************************}
function TAdsStoredProc.OpenAdvantageFiles : ADSHANDLE;
begin

{* Execute the procedure *}
Result := CreateHandle;

end;



{*******************************************************************************
* Module: TAdsStoredProc.GetLastAutoInc
* Input:
* Output:
* Description: Implementation of TAdsDataSet abstract method.
*******************************************************************************}
function TAdsStoredProc.GetLastAutoinc: Integer;
var
ulRetCode : UNSIGNED32;
ulLastAutoincVal : UNSIGNED32;
begin
ulLastAutoincVal := 0;

ulRetCode := Ace.AdsGetLastAutoinc( FStmtHandle, ulLastAutoincVal );
ACECheck( self, ulRetCode );

Result := ulLastAutoincVal;
end;


{*******************************************************************************
* Module: TAdsStoredProc.DefineProperties
* Input:
* Output:
* Description: Utility method, copied from TStoredProc
*******************************************************************************}
procedure TAdsStoredProc.DefineProperties(Filer: TFiler);

function WriteData: Boolean;
begin
if Filer.Ancestor <> nil then
Result := not FParams.IsEqual(TAdsStoredProc(Filer.Ancestor).FParams) else
Result := FParams.Count > 0;
end;

begin
inherited DefineProperties(Filer);
{$IFDEF ADSDELPHI4_OR_NEWER}
Filer.DefineProperty('ParamData', ReadParamData, WriteParamData, WriteData);
{$ENDIF}
Filer.DefineProperty('WaitCursor', ReadWaitCursor ,nil,false);
end;


{$IFDEF ADSDELPHI4_OR_NEWER}

{*******************************************************************************
* Module: TAdsStoredProc.WriteParamData
* Input:
* Output:
* Description: Utility method, copied from TStoredProc
*******************************************************************************}
procedure TAdsStoredProc.WriteParamData(Writer: TWriter);
begin
Writer.WriteCollection(Params);
end;



{*******************************************************************************
* Module: TAdsStoredProc.ReadParamData
* Input:
* Output:
* Description: Utility method, copied from TStoredProc
*******************************************************************************}
procedure TAdsStoredProc.ReadParamData(Reader: TReader);
begin
Reader.ReadValue;
Reader.ReadCollection(Params);
end;
{$ENDIF}



{*******************************************************************************
* Module: TAdsStoredProc.Disconnect
* Input:
* Output:
* Description: Closes and unprepares a procedure
*******************************************************************************}
procedure TAdsStoredProc.Disconnect;
begin
Close;
UnPrepare;
end;



{*******************************************************************************
* Module: TAdsStoredProc.CreateCursor
* Input:
* Output:
* Description: Prepares and executes a procedure
*******************************************************************************}
function TAdsStoredProc.CreateCursor(GenHandle: Boolean): ADSHANDLE;
begin
if StoredProcName <> '' then
begin
SetPrepared(True);
Result := GetCursor(GenHandle);
end else
Result := INVALID_ACE_HANDLE;
end;



{*******************************************************************************
* Module: TAdsStoredProc.CreateHandle
* Input:
* Output:
* Description: Execute procedure that returns a cursor handle.
*******************************************************************************}
function TAdsStoredProc.CreateHandle: ADSHANDLE;
begin
Result := CreateCursor(True);
end;


{*******************************************************************************
* Module: TAdsStoredProc.InternalClose
* Input:
* Output:
* Description: Clear cursor handle.
*******************************************************************************}
procedure TAdsStoredProc.InternalClose;
begin
inherited InternalClose;
FHandle := INVALID_ACE_HANDLE;
end;



{*******************************************************************************
* Module: TAdsStoredProc.GetNativeSQLError
* Input:
* Output:
* Description: Parses a 7200 error and returns the native error code as an
* integer, so it can be assigned to a ptResult parameter.
*******************************************************************************}
function GetNativeSQLError : UNSIGNED32;
var
ulSQLError : UNSIGNED32;
acError : array [0..ADS_MAX_ERROR_LEN] of char;
usLen : UNSIGNED16;
iOffset : integer;
strError : string;
begin

{* Get the error string. *}
usLen := ADS_MAX_ERROR_LEN;
ACECHECK( nil, ACE.AdsGetLastError( ulSQLError, acError, usLen ) );

{* Only parse 7200 errors *}
if ( ulSQLError <> 7200 ) then
begin
Result := AE_SUCCESS;
exit;
end;

{* Get a string representation of the array. *}
strError := string( acError );

iOffset := pos( 'NATIVEERROR = ', UpperCase( strError ) );
if ( iOffset = 0 ) then
begin
Result := AE_SUCCESS;
exit;
end;

{* Remove everything before the error code *}
Delete( strError, 1, iOffset + 13 );

{* chop off the string after the error code *}
iOffset := 1;
while ( strError[iOffset] <> ';' ) do
inc( iOffset );

Delete( strError, iOffset, 6969 );

{* Finally convert to an integer. *}
Result := StrToInt( strError );

end;



{*******************************************************************************
* Module: TAdsStoredProc.GetCursor
* Input:
* Output:
* Description: Code that actually calls ACE to execute the procedure.
*******************************************************************************}
function TAdsStoredProc.GetCursor(GenHandle: Boolean): LongInt;
var
ulRetVal : UNSIGNED32;
i : integer;
hTemp : cardinal;
begin
BindParams;
{*
* Actually execute the statement. If the user has a result parameter then populate
* it with the return value, o/w call ACECHECK.
*}
ulRetVal := ACE.AdsExecuteSQL( FStmtHandle, hTemp );
Result := hTemp;
if ( FHasResultParam ) then
begin
{* Find the result Param, if more than one is defined they'll both get the value. *}
for i := 0 to ( FParams.Count - 1 ) do
if ( FParams[i].ParamType = ptResult ) then
FParams[i].Value := UNSIGNED16( GetNativeSQLError );
end
else
ACECHECK( self, ulRetVal );

FHandle := Result;
{* If the cursor returned was 0 lets put INVALID_ACE_HANDLE into FHandle,
* so we stay consitent. *}
if ( FHandle = 0 ) then FHandle := INVALID_ACE_HANDLE;

{*
* If FHandle is INVALID_ACE_HANDLE and the user was expecting a cursor raise an
* exception.
*}
if ( GenHandle ) and ( FHandle = INVALID_ACE_HANDLE ) then
raise EADSDatabaseError.Create( self, AE_TADSDATASET_GENERAL, 'The procedure did not generate a cursor handle. ' +
'Use TAdsStoredProc.ExecProc to execute procedures that do not return a result.' );

if ( FHandle <> INVALID_ACE_HANDLE ) then
begin
{*
* Get the table type of the actual opened table. This may be different from
* the musOpenTableType which is set by the user.
*}
ACECheck( self, Ace.AdsGetTableType( FHandle, musAceTableType ));
GetResults;
end;

if ( ( not GenHandle ) and ( FHandle <> INVALID_ACE_HANDLE ) ) then
begin
{* We've read the param values out, so now close the cursor. *}
ACECHECK( self, AdsCloseTable( FHandle ) );
FHandle := INVALID_ACE_HANDLE;
end;
end;



{*******************************************************************************
* Module: TAdsStoredProc.ExecProc
* Input:
* Output:
* Description: Executes a procedure that does not expect a cursor to be
* returned.
*******************************************************************************}
procedure TAdsStoredProc.ExecProc;
begin
CheckInActive;
CreateCursor(False);
end;



{*******************************************************************************
* Module: TAdsStoredProc.SetProcName
* Input:
* Output:
* Description: Assigns the StoredProcName parameter. Also reads parameter
* information from the dictionary and populates the FParams member.
*******************************************************************************}
procedure TAdsStoredProc.SetProcName(const Value: string);
begin
if not (csReading in ComponentState) then
begin
CheckInactive;
if Value <> FProcName then
begin
FProcName := Value;
FreeStatement;
FParams.Clear;
{* If there is a connection and it is active then read the param values, o/w it is the users
* responsibility to define them, or call LoadParamsFromDictionary themselves. *}
if ( GetAdsConnection <> nil ) then
if ( GetAdsConnection.IsConnected ) then
LoadParamsFromDictionary;
end;
end else
FProcName := Value;
end;



{*******************************************************************************
* Module: TAdsStoredProc.GetParamsCount
* Input:
* Output:
* Description: Returns the number of parameters in FParams member.
*******************************************************************************}
function TAdsStoredProc.GetParamsCount: Word;
begin
Result := FParams.Count;
end;



{*******************************************************************************
* Module: TAdsStoredProc.DescriptionsAvailable
* Input:
* Output:
* Description: Returns boolean indicating if param descs are available.
*******************************************************************************}
function TAdsStoredProc.DescriptionsAvailable: Boolean;
begin
{* Parameter descriptions will always be available with Advantage, because we
* can always get them from the dictionary. *}
Result := TRUE;
end;




{* TStoredProc utilty functions *}

{$IFDEF NEVER}
{*******************************************************************************
* Module: GetParamDataSize
* Input:
* Output:
* Description:
*******************************************************************************}
function GetParamDataSize(Param: TParam): Integer;
begin
with Param do
{* NOTE : If supporting blobs or datasets we may have to do some extra work here in the future. *}
Result := GetDataSize;
end;



{*******************************************************************************
* Module: GetParamData
* Input:
* Output:
* Description:
*******************************************************************************}
procedure GetParamData(Param: TParam; Buffer: Pointer );
begin
{* NOTE : If supporting blobs or datasets we may have to do some extra work here in the future. *}
with Param do
GetData(Buffer);
end;
{$ENDIF} // WE DON'T CURRENTLY USE THESE 2 METHODS



{*******************************************************************************
* Module: TAdsStoredProc.PrepareProc
* Input:
* Output:
* Description: Verifies parameter data is correct, then calls
* PrepareAdvantageProcedure.
*******************************************************************************}
procedure TAdsStoredProc.PrepareProc;
var
I: Integer;
begin

for I := 0 to FParams.Count - 1 do
begin
with Params[I] do
begin
if DataType = ftUnknown then
raise EADSDatabaseError.Create( self, AE_TADSDATASET_GENERAL, 'No parameter value set for ' + Name );
if ParamType = ptUnknown then
raise EADSDatabaseError.Create( self, AE_TADSDATASET_GENERAL, 'No parameter type set for ' + Name );
end;
end;

PrepareAdvantageProcedure;
end;



{*******************************************************************************
* Module: TAdsStoredProc.PrepareAdvantageProcedure
* Input:
* Output:
* Description: Creates the ACE statement and prepares it.
*******************************************************************************}
procedure TAdsStoredProc.PrepareAdvantageProcedure;
var
strSQL : string;
hTemp : cardinal;
begin
{* If we don't have a statement yet then allocate one *}
if ( FStmtHandle = INVALID_ACE_HANDLE ) then
begin
if ( GetAdsConnection = nil ) then
raise EADSDatabaseError.Create( self, AE_TADSDATASET_GENERAL,
'Invalid Connection Handle.' );
ACECHECK( self, ACE.AdsCreateSQLStatement( GetAdsConnection.Handle, hTemp ) );
FStmtHandle := hTemp;
end;

{* Build statement text *}
strSQL := 'EXECUTE PROCEDURE ' + StoredProcName + ' ( ' + BuildACEParamsList + ' )';

{* Have ACE prepare the statement *}
ACECHECK( self, ACE.AdsPrepareSQL( FStmtHandle, strSQL ) );

end; {* TAdsStoredProc.PrepareAdvantageProcedure *}



{*******************************************************************************
* Module: TAdsStoredProc.GetResults
* Input:
* Output:
* Description: Populates any output parameters.
*******************************************************************************}
procedure TAdsStoredProc.GetResults;
const
ADS_MAX_PARAM_LEN = 1024;
var
I : integer;
ulLen : UNSIGNED32;
ulRetVal : UNSIGNED32;
aucBuffer : array[0..ADS_MAX_PARAM_LEN] of char;
pcBigBuffer : array of Char;
usNULL : UNSIGNED16;
bEOF : UNSIGNED16;
begin
pcBigBuffer := nil;

ACECHECK( self, AdsAtEOF( FHandle, bEOF ) );
if ( bEOF = 1 ) then
exit;

try
for I := 0 to FParams.Count - 1 do
with Params[I] do
begin
if ParamType in [ptOutput, ptInputOutput] then
begin
{* If NULL value set param to null and continue *}
ACECHECK( self, ACE.AdsIsEmpty( FHandle, Params[i].Name, usNULL ) );
if ( usNULL = 1 ) then
begin
Params[I].Value := NULL;
continue;
end;

ulLen := ADS_MAX_PARAM_LEN;
ulRetVal := ACE.AdsGetField( FHandle, Params[i].Name, aucBuffer, ulLen, ADS_NONE );
if ( ( ulRetVal <> AE_SUCCESS ) and ( ulRetVal <> AE_INSUFFICIENT_BUFFER ) ) then
ACECHECK( self, ulRetVal );

{* If insufficient buffer then allocate a big enough buffer. *}
if ( ulRetVal = AE_INSUFFICIENT_BUFFER ) then
begin
SetLength( pcBigBuffer, ulLen + 1 );
inc( ulLen );
ACECHECK( self, ACE.AdsGetField( FHandle, Params[i].Name, pcBigBuffer, ulLen, ADS_NONE ) );
end;

{* Actually set the parameter value *}
if ( pcBigBuffer = nil ) then
begin
{*
* Work around Delphi bug in some versions that would not correctly
* do a variant conversion of 'F' or 'T' to boolean. We used to
* just use:
* Params[I].Value := string( aucBuffer )
* for all data types. Borland has fixed this in newer versions,
* but cover those users who have older versions.
*}
case Params[i].DataType of
ftBoolean:
begin
if ( ( aucBuffer[0] = 'F' ) or
( aucBuffer[0] = 'f' ) ) then
Params[I].AsBoolean:=False
else
Params[I].AsBoolean:=true;
end;
else
Params[I].Value := string( aucBuffer );
end;
end
else
Params[I].Value := string( pcBigBuffer );
end;
end;
finally
if ( pcBigBuffer <> nil ) then
pcBigBuffer := nil;
end;

end;



{*******************************************************************************
* Module: TAdsStoredProc.BindParams
* Input:
* Output:
* Description: Takes parameter values and binds then in ACE.
*******************************************************************************}
procedure TAdsStoredProc.BindParams;
var
I: Integer;
lAdsDate : SIGNED32;
lMilliSec : SIGNED32;
stDateType : TAdsTimeStampRec;
ulDataSize : UNSIGNED32;
strFieldName : string;
TempBuffer : IntPtr;
begin

{*
* NOTE : A variation of this loop is used elsewhere in our components. If modifying this loop
* be sure to investigate the other loops as well.
*}

FHasResultParam := FALSE;

{ assign all parameter values within ACE }
for I := 0 to FParams.Count - 1 do
begin
{* Mark flag if we find a result parameter *}
if ( ptResult = FParams[i].ParamType ) then
FHasResultParam := TRUE;

{* only bind input parameters *}
if not ( FParams[i].ParamType in [ptInput, ptInputOutput] ) then
continue;

{* If binding by name use the param name, o/w us the param number. *}
if ( FBindMode = pbByName ) then
strFieldName := FParams[I].Name
else
strFieldName := '';

if FParams[i].IsNull then
begin
if strFieldName <> '' then
ACECheck( self, ACE.AdsSetEmpty( FStmtHandle, strFieldname ) )
else
ACECheck( self, ACE.AdsSetEmpty( FStmtHandle, (I+1) ) )
end
else
begin
case FParams[I].DataType of
ftUnknown:
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL,
'The field named: ''' + FParams[i].Name +
''' has the DataType of ftUnknown, which is invalid.' );

ftString,
{$IFDEF ADSDELPHI4_OR_NEWER}
ftFixedChar,
ftLargeint,
{$ENDIF}
ftWord,
ftSmallint,
ftInteger,
ftBCD,
ftMemo,
ftFmtMemo,
ftAutoInc:
begin
if strFieldName <> '' then
ACECheck( self, ACE.AdsSetString( FStmtHandle, strFieldname, FParams[i].AsString,
Length( FParams[i].AsString ) ))
else
ACECheck( self, ACE.AdsSetString( FStmtHandle, (I+1), FParams[i].AsString,
Length( FParams[i].AsString ) ));
end;

ftTime:
begin
lMilliSec := ROUND( Frac( FParams[i].AsDateTime ) *
MSEC_PER_DAY );
if strFieldName <> '' then
ACECheck( self, ACE.AdsSetMilliseconds( FStmtHandle, strFieldname, lMilliSec ))
else
ACECheck( self, ACE.AdsSetMilliseconds( FStmtHandle, (I+1), lMilliSec ));
end;

ftDate:
begin
lAdsDate := Trunc( FParams[i].AsDateTime ) + DELPHI_DATETIME_TO_JULIAN;
if strFieldName <> '' then
ACECheck( self, ACE.AdsSetJulian( FStmtHandle, strFieldname, lAdsDate ))
else
ACECheck( self, ACE.AdsSetJulian( FStmtHandle, (I+1), lAdsDate ));
end;

ftDateTime:
begin
stDateType.lTime := ROUND( Frac( FParams[i].AsDateTime ) *
MSEC_PER_DAY );
stDateType.lDate := Trunc( FParams[i].AsDateTime ) + DELPHI_DATETIME_TO_JULIAN;

TempBuffer := Marshal.AllocHGlobal( 2 * sizeof( Int32 ) );
try
Marshal.WriteInt32( TempBuffer, stDateType.lDate );
Marshal.WriteInt32( TempBuffer, 4, stDateType.lTime );

if strFieldName <> '' then
ACECheck( nil, ACEUNPUB.AdsSetTimeStampRaw( FStmtHandle, strFieldname,
TempBuffer,
8 ) )
else
ACECheck( nil, ACEUNPUB.AdsSetTimeStampRaw( FStmtHandle, ( I + 1 ),
TempBuffer,
8 ) );
finally
Marshal.FreeHGlobal( TempBuffer );
end;
end;

ftCurrency,
ftFloat:
if strFieldName <> '' then
ACECheck( self, AdsSetDouble( FStmtHandle, strFieldname,
FParams[i].AsFloat ))
else
ACECheck( self, AdsSetDouble( FStmtHandle, (I+1),
FParams[i].AsFloat ));

ftBoolean:
if ( FParams[i].AsBoolean ) then
begin
if strFieldName <> '' then
ACECheck( self, AdsSetLogical( FStmtHandle, strFieldname, ADS_TRUE ))
else
ACECheck( self, AdsSetLogical( FStmtHandle, (I+1), ADS_TRUE ));
end
else
begin
if strFieldName <> '' then
ACECheck( self, AdsSetLogical( FStmtHandle, strFieldname, ADS_FALSE ))
else
ACECheck( self, AdsSetLogical( FStmtHandle, (I+1), ADS_FALSE ));
end;


ftBytes,
ftVarBytes,
ftBlob,
ftGraphic :
begin
ulDataSize := FParams[i].GetDataSize();
TempBuffer := Marshal.AllocHGlobal( ulDataSize );
try
Params[i].GetData( TempBuffer );
if strFieldName <> '' then
ACECheck( nil, ACE.AdsSetBinary( FStmtHandle, strFieldname, ADS_BINARY,
ulDataSize, 0, TempBuffer,
ulDataSize ))
else
ACECheck( nil, ACE.AdsSetBinary( FStmtHandle, ( I + 1 ), ADS_BINARY,
ulDataSize, 0, TempBuffer,
ulDataSize ));
finally
Marshal.FreeHGlobal( TempBuffer );
end;
end;

{$IFDEF ADSDELPHI4_OR_NEWER}
ftWideString,
ftADT,
ftArray,
ftReference,
ftDataSet,
{$ENDIF}
ftParadoxOle,
ftDBaseOle,
ftTypedBinary,
ftCursor:
raise EADSDatabaseError.create( self, AE_TADSDATASET_GENERAL, 'The field named: ''' +
FParams[i].Name + ''' has a DataType that is not supported.' );
end; {case}
end; {if not empty}
end; {for}

end;



{*******************************************************************************
* Module: TAdsStoredProc.SetPrepared
* Input:
* Output:
* Description: Prepares the procedure
*******************************************************************************}
procedure TAdsStoredProc.SetPrepared(Value: Boolean);
begin
if Handle <> INVALID_ACE_HANDLE then
raise EAdsDatabaseError.Create( self, AE_TADSDATASET_GENERAL,
'Cannot perform this operation on an open dataset');
if Prepared <> Value then
begin
if Value then
try
if not FQueryMode then PrepareProc;
FPrepared := True;
except
FreeStatement;
raise;
end
else FreeStatement;
end;
end;



{*******************************************************************************
* Module: TAdsStoredProc.Prepare
* Input:
* Output:
* Description: Prepares the procedure statement
*******************************************************************************}
procedure TAdsStoredProc.Prepare;
begin
SetPrepared(True);
end;



{*******************************************************************************
* Module: TAdsStoredProc.UnPrepare
* Input:
* Output:
* Description: Unprepares the procedure statement
*******************************************************************************}
procedure TAdsStoredProc.UnPrepare;
begin
SetPrepared(False);
end;



{*******************************************************************************
* Module: TAdsStoredProc.FreeStatement
* Input:
* Output:
* Description: Frees the procedure statement
*******************************************************************************}
procedure TAdsStoredProc.FreeStatement;
var
ulRetCode : UNSIGNED32;
bHaveConnection : boolean;
begin
{*
* Our parent's destructor will remove us from our TAdsConnection (if
* we are pointing at one). Save the connected property, so we can use it
* in logic below.
*}
if ( ( AdsConnection <> nil ) and ( AdsConnection.IsConnected ) ) then
bHaveConnection := TRUE
else
bHaveConnection := FALSE;

if StmtHandle <> INVALID_ACE_HANDLE then
begin
{* Only free this statement if we still have a connection. If we don't have
* a connection then that means this statement handle has already been
* cleaned up. If we were to close it here some other thread might already
* be using it. *}
if ( bHaveConnection ) then
begin
ulRetCode := ACE.AdsCloseSQLStatement( FStmtHandle );
if ulRetCode <> AE_INVALID_SQLSTATEMENT_HANDLE then
ACECheck( self, ulRetCode );
end;
end;

FStmtHandle := INVALID_ACE_HANDLE;
FPrepared := False;

end;



{*******************************************************************************
* Module: TAdsStoredProc.SetPrepare
* Input:
* Output:
* Description:
*******************************************************************************}
procedure TAdsStoredProc.SetPrepare(Value: Boolean);
begin
if Value then Prepare
else UnPrepare;
end;



{*******************************************************************************
* Module: TAdsStoredProc.CopyParams
* Input:
* Output:
* Description: Copy procedure params into new object
*******************************************************************************}
procedure TAdsStoredProc.CopyParams(Value: TParams);
begin
if not Prepared and (FParams.Count = 0) then
try
FQueryMode := True;
Prepare;
Value.Assign(FParams);
finally
UnPrepare;
FQueryMode := False;
end else
Value.Assign(FParams);
end;



{*******************************************************************************
* Module: TAdsStoredProc.SetParamsList
* Input:
* Output:
* Description: Assigns params from Value to the FParams member
*******************************************************************************}
procedure TAdsStoredProc.SetParamsList(Value: TParams);
begin
CheckInactive;
if Prepared then
begin
SetPrepared(False);
FParams.Assign(Value);
SetPrepared(True);
end else
FParams.Assign(Value);
end;



{*******************************************************************************
* Module: TAdsStoredProc.ParamByName
* Input: Value - name of the parameter to retrieve
* Output:
* Description: Returns parameter with the given name
*******************************************************************************}
function TAdsStoredProc.ParamByName(const Value: string): TParam;
begin
Result := FParams.ParamByName(Value);
end;



{*******************************************************************************
* Module: TAdsStoredProc.LoadParamsFromDictionary
* Input:
* Output:
* Description: Reads parameter info from the dictionary and populates FParams
* NOTE: Leaves any existing FParams entries in the list
*******************************************************************************}
procedure TAdsStoredProc.LoadParamsFromDictionary;
const
ADS_MAX_PARAMDEF_LEN = 2048;
var
aucBuffer : array [0..ADS_MAX_PARAMDEF_LEN] of char;
usLen : UNSIGNED16;
ulRetVal : UNSIGNED32;
pcBigBuffer : array of char;
usTemp : word;
begin
pcBigBuffer := nil;

try
if ( StoredProcName = '' ) then
exit;

{* Must have an open ADS connection to read from *}
if ( GetAdsConnection = nil ) then
raise EADSDatabaseError.Create( self, AE_TADSDATASET_GENERAL,
'Invalid Connection Handle.' );
if ( ADSHANDLE( GetAdsConnection.Handle ) = ADSHANDLE( INVALID_ACE_HANDLE ) ) or
( GetAdsConnection.Handle = 0 ) then
raise EADSDatabaseError.Create( self, AE_TADSDATASET_GENERAL,
'Connection must be active.' );

{* Quick trick here. We need the dictionary to refresh the record it is
* sitting on, because there's a chance it's still sitting on the procedure
* object and that means ACE will short-circuit and won't re-read the
* procedure properties from disk. A quick call to AdsDDGetDatabaseProperty
* will move the record pointer, which will make the call to LoadParamsFromDictionary
* get the most up-to-date properties. *}
usLen := 0;
ace.AdsDDGetDatabaseProperty( GetAdsConnection.Handle, ADS_DD_TEMP_TABLE_PATH, usTemp, usLen );

{* Get the input parameters, if any exist. *}
usLen := ADS_MAX_PARAMDEF_LEN;
ulRetVal := ACE.AdsDDGetProcedureProperty( GetAdsConnection.Handle,
StoredProcName,
ADS_DD_PROC_INPUT,
aucBuffer,
usLen );
if ( ulRetVal <> AE_SUCCESS ) and
( ulRetVal <> AE_PROPERTY_NOT_SET ) and
( ulRetVal <> AE_INSUFFICIENT_BUFFER ) then
ACECHECK( self, ulRetVal );

{* If insufficient buffer allocate a new buffer. *}
if ( ulRetVal = AE_INSUFFICIENT_BUFFER ) then
begin
SetLength( pcBigBuffer, usLen + 1 );
inc( usLen );
ulRetVal := ACE.AdsDDGetProcedureProperty( GetAdsConnection.Handle,
StoredProcName,
ADS_DD_PROC_INPUT,
pcBigBuffer,
usLen );
if ( ulRetVal <> AE_SUCCESS ) and ( ulRetVal <> AE_PROPERTY_NOT_SET ) then
ACECHECK( self, ulRetVal );
end;

if ( ulRetVal <> AE_PROPERTY_NOT_SET ) then
if ( pcBigBuffer = nil ) then
AddFieldsToParams( aucBuffer, ptInput )
else
AddFieldsToParams( pcBigBuffer, ptInput );

{* If we allocated a new buffer, free it here. *}
if ( pcBigBuffer <> nil ) then
pcBigBuffer := nil;

{* Get the output parameters, if any exist *}
usLen := ADS_MAX_PARAMDEF_LEN;
ulRetVal := ACE.AdsDDGetProcedureProperty( GetAdsConnection.Handle,
StoredProcName,
ADS_DD_PROC_OUTPUT,
aucBuffer,
usLen );
if ( ulRetVal <> AE_SUCCESS ) and
( ulRetVal <> AE_PROPERTY_NOT_SET ) and
( ulRetVal <> AE_INSUFFICIENT_BUFFER ) then
ACECHECK( self, ulRetVal );

{* If insufficient buffer allocate a new buffer. *}
if ( ulRetVal = AE_INSUFFICIENT_BUFFER ) then
begin
SetLength( pcBigBuffer, usLen + 1 );
inc( usLen );
ulRetVal := ACE.AdsDDGetProcedureProperty( GetAdsConnection.Handle,
StoredProcName,
ADS_DD_PROC_OUTPUT,
pcBigBuffer,
usLen );
if ( ulRetVal <> AE_SUCCESS ) and ( ulRetVal <> AE_PROPERTY_NOT_SET ) then
ACECHECK( self, ulRetVal );
end;

if ( ulRetVal <> AE_PROPERTY_NOT_SET ) then
if ( pcBigBuffer = nil ) then
AddFieldsToParams( aucBuffer, ptOutput )
else
AddFieldsToParams( pcBigBuffer, ptOutput );
finally
if ( pcBigBuffer <> nil ) then
pcBigBuffer := nil;
end;

end; {* TAdsStoredProc.LoadParamsFromDictionary *}



{*******************************************************************************
* Module: TAdsStoredProc.BuildACEParamsList
* Input:
* Output:
* Description: Reads parameter info from the dictionary and builds a parameter
* string to be used in the EXECUTE PROCEDURE statement.
*******************************************************************************}
function TAdsStoredProc.BuildACEParamsList : string;
const
ADS_MAX_PARAMDEF_LEN = 2048;
var
aucBuffer : array [0..ADS_MAX_PARAMDEF_LEN] of char;
usLen : UNSIGNED16;
ulRetVal : UNSIGNED32;
pcBigBuffer : array of Char;
pcInputParams : array of char;
strTempString : string;
strTempType : string;
i : integer;
begin
pcBigBuffer := nil;
Result := '';

try
{* Get the input parameters, if any exist. *}
usLen := ADS_MAX_PARAMDEF_LEN;
ulRetVal := ACE.AdsDDGetProcedureProperty( GetAdsConnection.Handle,
StoredProcName,
ADS_DD_PROC_INPUT,
aucBuffer,
usLen );
if ( ulRetVal <> AE_SUCCESS ) and
( ulRetVal <> AE_PROPERTY_NOT_SET ) and
( ulRetVal <> AE_INSUFFICIENT_BUFFER ) then
ACECHECK( self, ulRetVal );

{* If insufficient buffer allocate a new buffer. *}
if ( ulRetVal = AE_INSUFFICIENT_BUFFER ) then
begin
SetLength( pcBigBuffer, usLen + 1 );
inc( usLen );
ulRetVal := ACE.AdsDDGetProcedureProperty( GetAdsConnection.Handle,
StoredProcName,
ADS_DD_PROC_INPUT,
pcBigBuffer,
usLen );
if ( ulRetVal <> AE_SUCCESS ) and ( ulRetVal <> AE_PROPERTY_NOT_SET ) then
ACECHECK( self, ulRetVal );
end;

if ( ulRetVal = AE_PROPERTY_NOT_SET ) then
exit;

if ( pcBigBuffer = nil ) then
pcInputParams := aucBuffer
else
pcInputParams := pcBigBuffer;

{* Loop through and get each parameter's name. *}
i := 0;
while ( pcInputParams[i] <> #0 ) do
begin
strTempString := '';
strTempType := '';
{ get the field name }
while( pcInputParams[i] <> ',' ) do
begin
strTempString := strTempString + pcInputParams[i];
inc( i );
end; { while }

{* Add to the result string *}
Result := Result + ':' + strTempString + ', ';

{ move past the ',' and ' ' }
inc( i );

{ now we are going after the field type }
while( ( pcInputParams[i] <> ',' ) and ( pcInputParams[i] <> ';' ) ) do
begin
strTempType := strTempType + pcInputParams[i];
inc( i );
end;

{ now check the type to see what else we have to read }
strTempString := strTempString + ' ' + strTempType;

if( ( UpperCase( strTempType ) = 'CHAR' ) or
( UpperCase( strTempType ) = 'CICHAR' ) or
( UpperCase( strTempType ) = 'CHARACTER' ) or
( UpperCase( strTempType ) = 'CICHARACTER' ) or
( UpperCase( strTempType ) = 'BINARY' ) or
( UpperCase( strTempType ) = 'VARCHAR' ) or
( UpperCase( strTempType ) = 'RAW' ) or
( UpperCase( strTempType ) = 'DECIMAL' ) or
( UpperCase( strTempType ) = 'DOUBLE' ) or
( UpperCase( strTempType ) = 'CURDOUBLE' ) or
( UpperCase( strTempType ) = 'NUMERIC' ) ) then

begin
strTempString := strTempString + '(';
inc( i );
while ( pcInputParams[i] <> ';' ) and (pcInputParams[i] <> #0 ) do
begin
strTempString := strTempString + pcInputParams[i];
inc( i );
end; { while }
strTempString := strTempString + ')';

end; { if }

if( pcInputParams[i] <> #0 ) then
inc( i );

end; { while }

{* remove final coma if one exists *}
if ( Result[ Length( Result ) - 1 ] = ',' ) then
Borland.Delphi.System.Delete( Result, Length( Result ) - 1, 2 ); {* delete 2 byes, ',' and the ' ' *}

finally
if ( pcBigBuffer <> nil ) then
pcBigBuffer := nil;
end;
end;



{*******************************************************************************
* Module: TAdsStoredProc.AddFieldsToParams
* Input: pcBuffer - list of fields, in the same format AdsCreateTable
* takes them
* eParamType - either input or output parameter
* Output:
* Description: Takes a buffer of field descriptions and adds each field to
* the FParams member
*******************************************************************************}
procedure TAdsStoredProc.AddFieldsToParams( pcBuffer : array of Char; eParamType : TParamType );
var
strTempString : string;
strTempType : string;
FieldType : TFieldType;
strParamName : string;
i : integer;
begin
i := 0;
while ( pcBuffer[i] <> #0 ) do
begin
strTempString := '';
strTempType := '';
{ get the field name }
while( pcBuffer[i] <> ',' ) do
begin
strTempString := strTempString + pcBuffer[i];
inc( i );
end; { while }

strParamName := strTempString;

{ move past the ',' and ' ' }
inc( i );

{ now we are going after the field type }
while( ( pcBuffer[i] <> ',' ) and ( pcBuffer[i] <> ';' ) ) do
begin
strTempType := strTempType + pcBuffer[i];
inc( i );
end;

{ now check the type to see what else we have to read }
strTempString := strTempString + ' ' + strTempType;

if( ( UpperCase( strTempType ) = 'CHAR' ) or
( UpperCase( strTempType ) = 'CICHAR' ) or
( UpperCase( strTempType ) = 'CHARACTER' ) or
( UpperCase( strTempType ) = 'CICHARACTER' ) or
( UpperCase( strTempType ) = 'BINARY' ) or
( UpperCase( strTempType ) = 'VARCHAR' ) or
( UpperCase( strTempType ) = 'RAW' ) or
( UpperCase( strTempType ) = 'DECIMAL' ) or
( UpperCase( strTempType ) = 'DOUBLE' ) or
( UpperCase( strTempType ) = 'CURDOUBLE' ) or
( UpperCase( strTempType ) = 'NUMERIC' ) ) then

begin
strTempString := strTempString + '(';
inc( i );
while( pcBuffer[i] <> ';' ) and ( pcBuffer[i] <> #0 ) do
begin
strTempString := strTempString + pcBuffer[i];
inc( i );
end; { while }
strTempString := strTempString + ')';

end; { if }

{* Get the field type *}
if ( pos( 'LOGICAL', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftBoolean
{* NOTE: CURDOUBLE must be before DOUBLE for this logic to work correctly. *}
else if ( pos( 'CURDOUBLE', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftCurrency
else if ( pos( 'DOUBLE', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftFloat
else if ( pos( 'INTEGER', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftInteger
else if ( pos( 'SHORTINT', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftSmallInt
else if ( pos( 'AUTOINC', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftAutoInc
else if ( pos( 'RAW', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftBytes
else if ( pos( 'TIMESTAMP', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftDateTime
else if ( pos( 'TIME', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftTime
else if ( pos( 'SHORTDATE', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftDate
else if ( pos( 'DATE', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftDate
else if ( pos( 'NUMERIC', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftSmallInt // float??
else if ( pos( 'VARCHAR', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftMemo
{* NOTE: Next one will get CHAR and CICHAR fields. *}
else if ( pos( 'CHAR', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftString
else if ( pos( 'BINARY', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftBlob
else if ( pos( 'IMAGE', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftBlob
else if ( pos( 'MEMO', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftMemo
{$IFDEF ADSDELPHI5_OR_NEWER}
else if ( pos( 'MONEY', UpperCase( strTempType ) ) <> 0 ) then
FieldType := ftBCD
{$ENDIF}
else
raise EADSDatabaseError.Create( nil, AE_TADSDATASET_GENERAL, 'unknown field type encountered' );

{* Add this parameter to our Params member *}
Params.CreateParam( FieldType, strParamName, eParamType );

if( pcBuffer[i] <> #0 ) then
inc( i );

end; { while }

end; {* TAdsStoredProc.AddFieldsToParams *}



{*******************************************************************************
* Module: TStoredProc.InvalidateAceHandles
* Input:
* Output:
* Description: Invalidates ace handles in the component. Called by a
* TAdsConnection component when disconnecting. This way the query or proc
* component won't have invalid statement handles referenced inside it (since
* the connection component destroyed them when it closed).
*******************************************************************************}
procedure TAdsStoredProc.InvalidateAceHandles;
begin
FHandle := INVALID_ACE_HANDLE;
UnPrepare; {* This will invalidate the statement handle *}
{* And just in case it doesn't... *}
FStmtHandle := INVALID_ACE_HANDLE;
end;


{$IFDEF ADSDELPHI5_OR_NEWER}

{ TAdsStoredProc.IProviderSupport }

{*******************************************************************************
* Module: TAdsStoredProc.PSGetParams
* Input:
* Output:
* Description: IProviderSupport interface that allows MIDAS to work
*******************************************************************************}
function TAdsStoredProc.PSGetParams: TParams;
begin
Result := Params;
end;



{*******************************************************************************
* Module: TAdsStoredProc.PSSetParams
* Input:
* Output:
* Description: IProviderSupport interface that allows MIDAS to work
*******************************************************************************}
procedure TAdsStoredProc.PSSetParams(AParams: TParams);
begin
if AParams.Count > 0 then
Params.Assign(AParams);
Close;
end;



{*******************************************************************************
* Module: TAdsStoredProc.PSGetTableName
* Input:
* Output:
* Description: IProviderSupport interface that allows MIDAS to work
*******************************************************************************}
function TAdsStoredProc.PSGetTableName: string;
begin
Result := inherited PSGetTableName;
end;



{*******************************************************************************
* Module: TAdsStoredProc.PSExecute
* Input:
* Output:
* Description: IProviderSupport interface that allows MIDAS to work
*******************************************************************************}
procedure TAdsStoredProc.PSExecute;
begin
ExecProc;
end;



{*******************************************************************************
* Module: TAdsStoredProc.PSSetCommandText
* Input:
* Output:
* Description: IProviderSupport interface that allows MIDAS to work
*******************************************************************************}
procedure TAdsStoredProc.PSSetCommandText(const CommandText: string);
begin
if CommandText <> '' then
StoredProcName := CommandText;
end;


{ TAdsTable.IProviderSupport }

{****************************************************************************************
* Module: TAdsTable.PSGetDefaultOrder
* Input:
* Output:
* Return:
* Description: Returns the definition of an index that imposes the default order on
* the data included in data packets.
****************************************************************************************}
function TAdsTable.PSGetDefaultOrder: TIndexDef;

function GetIdx(IdxType: TIndexOption): TIndexDef;
var
i: Integer;
begin
Result := nil;
for i := 0 to IndexDefs.Count - 1 do
if IdxType in IndexDefs[i].Options then
try
Result := IndexDefs[i];
GetFieldList(nil, Result.Fields);
break;
except
Result := nil;
end;
end;

var
DefIdx: TIndexDef;
begin
DefIdx := nil;
IndexDefs.Update;
try
if IndexName <> '' then
DefIdx := IndexDefs.Find(IndexName)
else if IndexFieldNames <> '' then
DefIdx := IndexDefs.FindIndexForFields(IndexFieldNames);
if Assigned(DefIdx) then
GetFieldList(nil, DefIdx.Fields);
except
DefIdx := nil;
end;
if not Assigned(DefIdx) then
DefIdx := GetIdx(ixPrimary);
if not Assigned(DefIdx) then
DefIdx := GetIdx(ixUnique);
if Assigned(DefIdx) then
begin
Result := TIndexDef.Create(nil);
Result.Assign(DefIdx);
end else
Result := nil;
end;



{****************************************************************************************
* Module: TAdsTable.PSGetIndexDefs
* Input: IndexTypes - index options
* Output:
* Return:
* Description: Returns the definitions of all specified indexes defined for
* the dataset.
****************************************************************************************}
function TAdsTable.PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs;
begin
Result := GetIndexDefs(IndexDefs, IndexTypes);
end;



{****************************************************************************************
* Module: TAdsTable.PSGetTableName
* Input:
* Output:
* Return: table name
* Description: Returns the name of the dataset table that appears in generated
* SQL statements.
****************************************************************************************}
function TAdsTable.PSGetTableName: string;
begin
Result := TableName;
{* if we return tablename.ext the sql statement won't work, strip the extension if it exists *}
if ( Length( Result ) > 4 ) then
if ( Result[ Length( Result ) - 3 ] = '.' ) then
Borland.Delphi.System.Delete( Result, Length( Result ) - 3, 4 );
end;



{****************************************************************************************
* Module: TAdsTable.PSSetParams
* Input: AParams - parameters to set
* Output:
* Return:
* Description: Assigns the specified parameter values to the dataset.
****************************************************************************************}
procedure TAdsTable.PSSetParams(AParams: TParams);

procedure AssignFields;
var
I: Integer;
begin
for I := 0 to AParams.Count - 1 do
if AParams[I].Name <> '' then
FieldByName(AParams[I].Name).Value := AParams[I].Value else
IndexFields[I].Value := AParams[I].Value;
end;

begin
if AParams.Count > 0 then
begin
Open;
SetRangeStart;
AssignFields;
SetRangeEnd;
AssignFields;
ApplyRange;
end else
if Active then CancelRange;
PSReset;
end;



{****************************************************************************************
* Module: TAdsTable.PSSetCommandText
* Input: CommandText - sql statement
* Output:
* Return:
* Description: Assigns a specified SQL command to be executed by PSExecute.
****************************************************************************************}
procedure TAdsTable.PSSetCommandText(const CommandText: string);
begin
if CommandText <> '' then
TableName := CommandText;
end;



{****************************************************************************************
* Module: TAdsTable.PSGetKeyFields
* Input:
* Output:
* Return: key fields
* Description: Returns the names of all fields required to uniquely identify
* records in the data packet.
****************************************************************************************}
function TAdsTable.PSGetKeyFields: string;
var
i, Pos: Integer;
IndexFound: Boolean;
begin
Result := inherited PSGetKeyFields;
if Result = '' then
begin
{* The existence check below doesn't make a lot of sense to me. It was put there
* because that's what TTable and Interbase do, but it has caused problems for
* customers that do not have file sharing turned on. This used to only be hit
* by Midas applications, but as of Delphi 6 it is called on a normal table
* open. I noticed TCustomADODataSet does not make the existence check, however,
* and the rest of its code looks just like ours. Removing for now, if this
* causes problems in the future we can look for a different solution to the
* rights checking problem. *}
// if not Exists then Exit;
IndexFound := False;
IndexDefs.Update;
for i := 0 to IndexDefs.Count - 1 do
if ixUnique in IndexDefs[I].Options then
begin
Result := IndexDefs[I].Fields;
IndexFound := (FieldCount = 0);
if not IndexFound then
begin
Pos := 1;
while Pos <= Length(Result) do
begin
IndexFound := FindField(ExtractFieldName(Result, Pos)) <> nil;
if not IndexFound then Break;
end;
end;
if IndexFound then Break;
end;
if not IndexFound then
Result := '';
end;
end;


{ TQuery.IProviderSupport }

{****************************************************************************************
* Module: TAdsQuery.PSGetDefaultOrder
* Input:
* Output:
* Return:
* Description: Returns the definition of an index that imposes the default order on
* the data included in data packets.
****************************************************************************************}
function TAdsQuery.PSGetDefaultOrder: TIndexDef;
begin
Result := inherited PSGetDefaultOrder;
if not Assigned(Result) then
Result := GetIndexForOrderBy(SQL.Text, Self);
end;



{****************************************************************************************
* Module: TAdsQuery.PSGetParams
* Input:
* Output:
* Return: pointer to this queries internal parameter object
* Description: Returns the current parameter values of the dataset.
****************************************************************************************}
function TAdsQuery.PSGetParams: TParams;
begin
Result := Params;
end;



{****************************************************************************************
* Module: TAdsQuery.PSSetParams
* Input: AParams - parameter values to set
* Output:
* Return:
* Description: Assigns the specified parameter values to the dataset.
****************************************************************************************}
procedure TAdsQuery.PSSetParams(AParams: TParams);
begin
if AParams.Count <> 0 then
Params.Assign(AParams);
Close;
end;



{****************************************************************************************
* Module: TAdsQuery.PSGetTableName
* Input:
* Output:
* Return: table name
* Description: Returns the name of the dataset table that appears in generated
* SQL statements.
****************************************************************************************}
function TAdsQuery.PSGetTableName: string;
begin
Result := GetTableNameFromSQL(SQL.Text);
end;



{****************************************************************************************
* Module: TAdsQuery.PSExecute
* Input:
* Output:
* Return:
* Description: Executes the SQL command associated with the dataset.
****************************************************************************************}
procedure TAdsQuery.PSExecute;
begin
ExecSQL;
end;



{****************************************************************************************
* Module: TAdsQuery.PSSetCommandText
* Input: CommandText - sql statement to execute
* Output:
* Return:
* Description: Assigns a specified SQL command to be executed by PSExecute.
****************************************************************************************}
procedure TAdsQuery.PSSetCommandText(const CommandText: string);
begin
if CommandText <> '' then
SQL.Text := CommandText;
end;

{$ENDIF} {* IFDEF ADSDELPHI5_OR_NEWER *}


{******************************************************************************}
{******************************************************************************}
{******************************************************************************}
{******************************************************************************}



{*
* Functions used to ignore old WaitCursor property. Tried putting in parent
* class so there wouldn't have to be 2 of each, but it screwed up the
* stream reader
*}

{**********************************************************
* Module: TAdsStoredProc.GetWaitCursor
* Description: Stub used to ignore old WaitCursor prop
**********************************************************}
function TAdsStoredProc.GetWaitCursor() : integer;
begin
result := 0;
end;

{**********************************************************
* Module: TAdsQuery.GetWaitCursor
* Description: Stub used to ignore old WaitCursor prop
**********************************************************}
function TAdsQuery.GetWaitCursor() : integer;
begin
result := 0;
end;

{**********************************************************
* Module: TAdsStoredProc.SetWaitCursor
* Description: Stub used to ignore old WaitCursor prop
**********************************************************}
procedure TAdsStoredProc.SetWaitCursor( val : integer );
begin
end;

{**********************************************************
* Module: TAdsQuery.SetWaitCursor
* Description: Stub used to ignore old WaitCursor prop
**********************************************************}
procedure TAdsQuery.SetWaitCursor( val : integer );
begin
end;

{**********************************************************
* Module: TAdsStoredProc.ReadWaitCursor
* Description: Stub used to ignore old WaitCursor prop
**********************************************************}
procedure TAdsStoredProc.ReadWaitCursor(Reader: TReader);
begin
{* Skip over the waitcursor value, as we don't care what it is *}
if ( Reader.NextValue = vaIdent ) then
Reader.ReadIdent
else
{* Cbuilder stored waitcursor as an integer *}
Reader.ReadInteger;
end;

{**********************************************************
* Module: TAdsQuery.GetWaitCursor
* Description: Stub used to ignore old WaitCursor prop
**********************************************************}
procedure TAdsQuery.ReadWaitCursor(Reader: TReader);
begin
{* Skip over the waitcursor value, as we don't care what it is *}
if ( Reader.NextValue = vaIdent ) then
Reader.ReadIdent
else
{* Cbuilder stored waitcursor as an integer *}
Reader.ReadInteger;
end;



initialization
goDynamicConnList := TDynamicConnList.Create;

finalization
goDynamicConnList.Free;

end.