pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
053b9c89c76cdb2fd23e7a77ad0bf52b51f8da6a
lazarus-ccr/components/flashfiler/sourcelaz/crystal/ffcrmain.pas
wp_xxyyzz 27aea1d1ad flashfiler: Initial commit (ported by A.Soner). Not working yet (server error). 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5438 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-12-07 13:31:59 +00:00

4526 lines
164 KiB
ObjectPascal
Raw Blame History

{*********************************************************}
(* Implementation of all driver functions *)
(* Direct port of the original PHYSDB.CPP source file *)
{*********************************************************}
(* ***** BEGIN LICENSE BLOCK *****
* Version: MPL 1.1
*
* The contents of this file are subject to the Mozilla Public License Version
* 1.1 (the "License"); you may not use this file except in compliance with
* the License. You may obtain a copy of the License at
* http://www.mozilla.org/MPL/
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
* for the specific language governing rights and limitations under the
* License.
*
* The Original Code is TurboPower FlashFiler
*
* The Initial Developer of the Original Code is
* TurboPower Software
*
* Portions created by the Initial Developer are Copyright (C) 1996-2002
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
*
* ***** END LICENSE BLOCK ***** *)
{$I ffcrdefn.inc}
unit ffcrmain;
{ The import unit can be built by copying the interface section of this
unit and globally replacing "stdcall;" with "external 'PDBFF.DLL';" }
{
This file contains the interface definition used by all Brahma physical
database DLL's.
Brahma supports three basic types of DLLs, physical database (PhysDb.hpp),
physical dictionary (PhysDict.hpp), and physical directory (PhysDir.hpp).
These DLLs provide some similar functions, but differ as follows:
PhysDb: - Supports single physical database tables (assumed to be
stored in single files), and provides both retrieving of
database info and reading of database records.
- May be able to retrieve structural and index info of a
single table, but has no support for links between multiple
tables.
- Performs reading of database records (sequentially or using
an index).
PhysDict: - Supports retrieving of database info from multiple database
tables, but has no support for reading of database records.
- May be able to retrieve structural, index and link
information of multiple tables.
- Is knowledgeable of PhysDb database table types, and informs
the Database Manager of these types for reading of database
records.
PhysDir: - Supports a directory of multiple database files, but does not
perform retrieving of database info or reading of database
records itself.
- Is knowledgeable of PhysDb and PhysDict DLLs, and informs
the Database Manager which DLL to use for servicing each
entry in its directory.
Since each physical database, dictionary and directory is implemented as a
DLL, other database types can be defined and linked dynamically to the
Database Manager in the future.
Note: As mentioned above, physical database DLLs are responsible for
individual database tables only, and handling the links between multiple-
table databases is the responsibility of the Database Manager. The
physical database DLL must support multiple open database tables at a
time however.
Friendly advice: No global static data should be used in the
implementation of a physical database DLL. This makes it easier to
support multiple open files per report, and multiple open sets of files
for multiple reports, by letting the Database Manager save state
information instead.
The general rule is that whenever any state information is required
by the DLL it is dynamically allocated and a reference to it passed back
to the Database Manager. The Database Manager is then responsible for
storing this reference, passing it to the DLL whenever it is needed, and
calling the DLL to free the associated information.
Error Messages: When any DLL function cannot complete successfully, it
has a choice of returning an error code (PhysDbError type) or an error
message (code PhysDbErrMsgReturned, and returning a message in ErrMsg
parameter). The recommended behavior of the DLL is:
- Return an error string if no error code matches the situation
well, or if very specific information is available that would help
the user (e.g. "Please execute DOS share program", "Table is
corrupted at record 15", etc.). If an error string is returned it
will be displayed by the Database Manager.
- Return an error code in all other cases. The Database Manager
will display a standard error message of its own in these cases,
which will be consistent for all physical database types
(e.g. "Not enough memory", "File could not be found", etc.).
}
{$DEFINE IDAPI_INTERNAL_LIMITS}
interface
uses
ffllbase,
fflllog, {!!.12}
ffcrptyp,
ffcrtype,
ffclreng,
ffstdate, {!!.02}
SysUtils;
{ --------------------- Database Abilities ------------------------ }
{ Return physical database version number. }
function PhysDbVersionNumber(
var MajorVersionNumber : Word;
var MinorVersionNumber : Word;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ Return whether this physical database can recognize data files of
its own type. For example, a Paradox physical database DLL can recognize
a data file passed to it by its file name extension and internal header
information, whereas an ASCII physical database DLL cannot uniquely
identify a data file as being of its type.
If this returns true, the Database Manager may pass arbitrary file names to
the function OpenDataFileIfRecognizedVer12, and assumes it only opens data
files belonging to it. If this is false the function OpenDataFileIfRecognizedVer12
is only called when the user has confirmed that a file is of this data
type (via a dialog of FetchDatabaseName names) and can assume that the
type is correct. }
function CanRecognizeDataFile(var CanRecognize : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ Return whether this physical database can retrieve info describing
an open data file (whether flat or recurring records, number of
fields in the file, the width & type of each data field, etc.).
This can be done by the physical database either by "inhaling" the
data file information (without user interaction), or by displaying
Windows dialogs to prompt the user for this information.
If this returns true, the Database Manager calls FetchDataFileInfo
to retrieve this info, if false the Database Manager uses default Windows
dialogs of its own to prompt the user to provide this information. }
function CanFetchDataFileInfo(var CanFetchFileInfo : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ Return whether this physical database can fetch index information
for data files of its type. There are four possible cases:
1. indexesNeverExist: e.g. for ASCII files.
2. indexesExistButNotKnown: e.g. if not implemented yet.
3. someIndexesKnown: e.g. for dBase, default indexes known, but
others may exist.
4. allIndexesKnown: e.g. for Paradox, all indexes known by system.
In cases 3 and 4 the function FetchDataFileIndexInfo is called to
retrieve information on all known indexes. In cases 2 and 3 the
Database Manager uses default Windows dialogs to allow the user to
select file names containing indexes. }
function CanFetchDataFileIndexInfo(
var CanFetchIndexInfo : TPhysDbIndexInfoCases;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ Return whether this physical database can build indexes on data files
if required. There are three possible cases:
1. cannotBuildIndex
2. canBuildNonMaintainedIndex
3. canBuildMaintainedIndex }
function CanBuildIndex(var CanBuildIndex : TPhysDbBuildIndexCases;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ Return whether this physical database can (efficiently) retrieve the
number of records in an open data file. This information is required
by the Database Manager to estimate the % completion of reading of a
data file.
If this returns true, the Database Manager calls NRecurringRecordsToRead
to retrieve the record count, if false it does not.
Note: It is not recommended to read the entire data file to determine
the number of records, since performance will be seriously slowed.
Therefore if the physical database system does not easily provide this
info, this function should return false indicating that the ability is
not provided. }
function CanFetchNRecurringRecords(var CanFetchNrecords : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ This function is to tell whether this DLL has SQL functionality,
three parameters are passed back, isSQLTypeDLL, canBuildAndExecSQLQuery,
and canExecSQLQuery. }
function SQLCompatible(
var IsSQLTypeDLL : TcrBoolean;
var CanBuildAndExecSQLQuery : TcrBoolean;
var CanExecSQLQuery : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ Return if physical database supports reading of main file using an index.
This is a speed-up option, since Brahma will not need to sort the report. }
function CanReadSortedOrder(var CanReadSorted : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ Return if physical database supports selecting records using a range.
This is a speed-up option, since Brahma will only be given records
matching the record selection criteria. }
function CanReadRangeOfValues(var CanReadRange : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ Each physical database type may or may not support multi-user access.
If a database does support multi-user access, it may allow a choice of
either file locking or record locking, or it may always use one method.
This function returns whether record locking is available for this
physical database type. }
function CanUseRecordLocking(var RecordLockingPossible : TcrBoolean;
var RecordLockingPreferred : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ This function returns whether file locking is available for this
physical database type. }
function CanUseFileLocking(var FileLockingPossible : TcrBoolean;
var FileLockingPreferred : TcrBoolean;
ErrMsg: PAnsiChar) : TPhysDbError; stdcall;
{ ---------------- Initialization and Termination ----------------- }
{ Any database system initialization is performed at this point.
Note: No global static structures should be allocated, as discussed in
the program header above. }
function InitPhysicalDatabase(ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ Termination of the database system is performed at this point. }
function TermPhysicalDatabase(ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ OpenSession and TermSession are called to initialize and terminate on
a per task basis. The Database Manager determines when a new task
attempts to use a DLL, and calls OpenSession at that time. }
function OpenSession(ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
function TermSession(ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ ------------------------- Database Name -------------------------- }
{ Return the text name of this physical database format. This is used
in Database Manager dialogs to describe the database type of a data
file, and to store with a database dictionary to describe which physical
database DLL to use for a file. }
function FetchDatabaseName(var Name : PAnsiChar;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ Free the text name of this physical database format. }
function FreeDatabaseName(var Name : PAnsiChar;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ ---------------------- Log On and Log Off ----------------------- }
{ These functions allow the CRPE user to pass log on and log off
information to a PhysDB DLL.
Note: These functions are only required if the database supports
password-protected database files (e.g. Paradox). Otherwise
they do not need to be implemented. }
function LogOnServer(ServerInfo : PPhysDbServerInfo;
var ServerHandle : PPhysDbServerHandle;
Password : PAnsiChar;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
function LogOffServer(var ServerHandle : PPhysDbServerHandle;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ ------------------- Parse and Rebuild SQL Info -------------------- }
{ These functions are helpers to parse SQL connect info passed
down from a PhysDir type DLL.
Note: These functions are only useful for MS Access tables. These
functions do not need to be implemented in any other case. In
general, for SQL databases the PhysDs.hpp (PDS*.DLL) interface
should be used.
SST: These routines must be exported even if they are not used or Crystal
will not load the driver DLL. }
function ParseLogOnInfo(ConnectBuf : PAnsiChar;
BufSize : Word;
ServerInfo : PPhysDbServerInfo;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
function RebuildConnectBuf(ServerInfo : PPhysDbServerInfo;
ConnectBuf : PAnsiChar;
BufSize : Word;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ -------------------- Open and Close Files ----------------------- }
{ This function is passed a file name, including its path and extension,
and determines whether it is a data file of its physical database type,
and if so opens the data file and returns a file handle.
This function is called the first time a data file is attempted to be
opened, and before fetching the file info (from FetchDataFileInfo) and
index info (from FetchDataFileIndexInfo) structures that describe the
file. This function may also be called to open a data file for
sequential reading (without an index) using ReadNextRecurringRecord.
The Database Manager may pass arbitrary file names to this function,
and assumes it only opens data files belonging to it. If it is false
this function is only called when the user has confirmed that a file
is of this data type (via a dialog of FetchDatabaseName names) and this
function opens the file as if the database type is correct.
The new parameter logOnInfo can contain a password to use in opening
password-protected files.
Note: The parameter sessionInfo is only of use for MS Access DLLs
that track user session info. The parameter dirInfo is also only
currently useful for MS Access DLLs.
The parameter silentMode is used to tell DLL whether to pop up any
dialog or message itself or just return an error code.
The parameter aliasName allows the DLL to pass back its own alias
name to be used for the file, it can ignore this parameter if it wants
to use the default alias.
The parameter calledFromDirDLL indicates whether the user has
chosen a directory or database type file. If the user chose a
directory type file, the directory file says to call this database
DLL with an internal file name. }
function OpenDataFileIfRecognizedVer113(
FileName : PAnsiChar;
OpenDefaultIndex : TcrBoolean;
var Recognized : TcrBoolean;
var FileHandle : PPhysDbFileHandle;
CalledFromDirDLL : TcrBoolean;
var AliasName : PAnsiChar;
SilentMode : TcrBoolean;
DirInfo : PPhysDbFileDirectoryInfo;
DictInfo : PPhysDbFileDictionaryInfo;
SessionInfo : PPhysDbSessionInfo;
LogOnInfo : PPhysDbLogOnInfo;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ This function is passed both a data file name and index file name,
including paths and extensions, and determines whether they are of
its physical database type. If so it opens the data file using the
specified index, and returns a file handle.
This function is called when the user has selected an index file
to attempt to open, or to open a data file for reading, using either
ReadNextRecurringRecord (in the order of the chosen index file) or
LookupMatchingRecurringRecord to search directly for a record (using the
chosen index file).
This function will only be called if CanFetchDataFileIndexInfo has
returned indexesExistButNotKnown or someIndexesKnown.
The new parameter logOnInfo can contain a password to use in opening
password-protected files.
Note: The parameter sessionInfo is only of use for MS Access DLLs
that track user session info. The parameter dirInfo is also only
currently useful for MS Access DLLs.
The parameter silentMode is used to tell DLL whether to pop up any
dialog or message itself or just return an error code.
The parameter aliasName allows the DLL to pass back its own alias
name to be used for the file, it can ignore this parameter if it wants
to use the default alias. }
function OpenDataAndIndexFileIfRecogV113(
FileName : PAnsiChar;
IndexName : PAnsiChar;
var Recognized : TcrBoolean;
var FileHandle : PPhysDbFileHandle;
var AliasName : PAnsiChar;
SilentMode : TcrBoolean;
DirInfo : PPhysDbFileDirectoryInfo;
DictInfo : PPhysDbFileDictionaryInfo;
SessionInfo : PPhysDbSessionInfo;
LogOnInfo : PPhysDbLogOnInfo;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ This function is passed a file name, including its path and extension,
and the file info (from FetchDataFileInfo) and index info (from
FetchDataFileIndexInfo) structures, with usedInRead field set to
indicate the index file chosen. This function opens the data file
using the chosen index and returns a file handle.
This function is called to open a data file for reading, using either
ReadNextRecurringRecord (in the order of the chosen index file) or
LookupMatchingRecurringRecord to search directly for a record (using the
chosen index file).
This function can assume that the data file is of its physical
database type, since it was opened and recognized previously in order
to fetch the file info and index info passed as parameters.
The new parameter logOnInfo can contain a password to use in opening
password-protected files.
Note: The parameter sessionInfo is only of use for MS Access DLLs
that track user session info. The parameter dirInfo is also only
currently useful for MS Access DLLs.
The parameter silentMode is used to tell DLL whether to pop up any
dialog or message itself or just return an error code. }
function OpenDataFileAndIndexChoiceVer113(
FileName : PAnsiChar;
InfoPtr : PPhysDbFileInfo;
IndexesPtr : PPhysDbIndexesInfo;
var FileHandle : PPhysDbFileHandle;
SilentMode : TcrBoolean;
DirInfo : PPhysDbFileDirectoryInfo;
DictInfo : PPhysDbFileDictionaryInfo;
SessionInfo : PPhysDbSessionInfo;
LogOnInfo : PPhysDbLogOnInfo;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ This function closes a data file opened with OpenDataFileIfRecognized,
OpenDataAndIndexFileIfRecognized or OpenDataFileAndIndexChoice, and
deletes any allocated memory structures. }
function CloseDataFile(var FileHandle : PPhysDbFileHandle;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ ---------------------- Fetch Data File Info --------------------- }
{ This function is passed a file handle of an open data file, and returns
info describing its file structure (whether flat or recurring records,
number of fields in the file, the width & type of each data field,
etc.)
This function may retrieve this information by:
1. "Inhaling" the data file information (without user interaction),
if it has facilities to query the data file definition directly.
2. Displaying Windows dialogs to prompt the user for this information,
and then returning these values as the file structure.
This function is only called if CanFetchDataFileInfo has previously
returned true. If it has not, the Database Manager uses default Windows
dialogs to allow the user to describe the data file structure (with
obvious risks of error).
The parameter infoDefaultsExist is only meaningful in case 2 above.
(In case 1 the function should always retrieve the most current data
file definition from the system.) In case 2 if this parameter is true
the user has executed this function on this table before, and if
false this is the first time. If true, the previous values are passed as
defaults in the info structure, and the function can display them as
defaults in its Windows dialogs.
Note: This function is not responsible for filling in certain information
in PhysDbFileInfo:
- nBytesInReadRecord
- nFieldsInReadRecord
- nBytesInIndexRecord
- nFieldsInIndexRecord
and certain information in PhysDbFieldInfo:
- usedInReadRecord
- offsetInReadRecord
- usedInIndexRecord
- offsetInIndexRecord
This information is only meaningful in the InitDataFile functions
below. It can be set to zero or ignored by FetchDataFileInfo. }
function FetchDataFileInfo(
FileHandle : PPhysDbFileHandle;
InfoDefaultsExist : TcrBoolean;
var InfoPtr : PPhysDbFileInfo;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ This function frees the file info structure allocated by FetchDataFileInfo. }
function FreeDataFileInfo(
var InfoPtr : PPhysDbFileInfo;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ ------------------- Fetch Data File Index Info ------------------ }
{ This function is passed a file handle of an open data file, and returns
an index info structure (such as the number of known indexes, which
fields are used in each index definition, etc.). The fields in an
index definition are identified by their (0-origin) index in the
PhysDbFileInfoPtr->fieldInfo array of fields returned by FetchDataFileInfo.
The file info structure is passed as a parameter to this function to
look up these field numbers.
This function is expected to "inhale" the index information (without user
interaction) by querying the data file definition directly.
This function is only called if CanFetchDataFileIndexInfo has previously
returned someIndexesKnown or allIndexesKnown. If indexesExistButNotKnown
or someIndexesKnown the Database Manager uses default Windows dialogs
to allow the user to select file names containing indexes.
Note: This function is not responsible for filling in certain information
in PhysDbIndexInfo:
- usedInRead
This information is only meaningful in the function OpenDataFileAndIndexChoice
above. It can be set to zero or ignored by FetchDataFileIndexInfo. }
function FetchDataFileIndexInfo(
FileHandle : PPhysDbFileHandle;
InfoPtr : PPhysDbFileInfo;
var IndexesPtr : PPhysDbIndexesInfo;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ This function frees the index info structure created by
FetchDataFileIndexInfo. }
function FreeDataFileIndexInfo(var IndexesPtr : PPhysDbIndexesInfo;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ ---- Initialization and Termination of Reading from Data File ---- }
{ Note: This function is only useful for non-SQL databases that prefer a
SQL-type interface. In general, for SQL databases the PhysDs.hpp
(PDS*.DLL) interface should be used.
SST: This routine must be exported even if it is not used or Crystal
will not load the driver DLL. }
function BuildAndExecSQLQuery(
FileHandleList : PPhysDbFileHandleArray;
FileInfoList : PPhysDbFileInfoArray;
LinkNonSQLFlags : PcrBooleanArray;
IndexesInfoList : PPhysDbIndexesInfoArray;
RangeInfoList : PPhysDbRangeInfoArray;
NFiles : Word;
LinkInfoList : PPhysDbFileLinkInfoArray;
NFileLinks : Word;
SqlDrivingFile : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ This function is passed a file handle of an open data file, and the
file info structure (from FetchDataFileInfo) describing this file,
before starting to read from the file. This function should perform
any file initialization, and determine the sets of fields to be read
for each record.
During the Database Manager print cycle, the physical database functions
are called as follows for each data file to be read:
if (OpenDataFileIfRecognizedVer12 ()) // or OpenDataFileAndIndexChoice ()
if (InitDataFileForReading ()) // or InitDataFileAndIndexForReading ()
... // perform reading
TermDataFileForReading ()
CloseDataFile ()
Important: This function must not interfere with other data files
being read at the same time by this physical database implementation.
Therefore no global (static) data should be used by this function,
and all state information needed during reading should be kept local
to its own file handle. This function should also not perform any
global initialization of the database system that will affect other
open data files, (this can be done during InitPhysicalDatabase instead).
Translated and Non-Translated Fields: The Database Manager specifies
two sets of fields to be read from each data record, using the
additional information in the file info structure:
- nBytesInReadRecord
- nFieldsInReadRecord
- nBytesInIndexRecord
- nFieldsInIndexRecord
and in each field info structure:
- usedInReadRecord
- offsetInReadRecord
- usedInIndexRecord
- offsetInIndexRecord
The two sets of fields are required for different purposes. The
fields indicated by usedInReadRecord are used in the printed report
and must be translated to generic Brahma data types before returning.
The fields flagged by usedInIndexRecord are used in constructing an
index value for looking up records in another file, and should
not be translated from their native format.
The function now allows the main file of the report to be opened using
an index, to speed up sorting and selection of records.
The function now also allows an array of range values.
If indexesPtr is NULL, OpenDataFileIfRecognizedVer12 was called to
open the data file. If indexesPtr is non-NULL, OpenDataFileAndIndexChoice
was called to open the file, and indexPtr contains the index choice.
This function returns in canDoLimitRange whether it is able to perform
the range check on this particular field type. }
function InitDataFileForReadingVer17(
FileHandle : PPhysDbFileHandle;
InfoPtr : PPhysDbFileInfo;
IndexesPtr : PPhysDbIndexesInfo;
RangeInfoList : PPhysDbRangeInfoArray;
NRanges : TcrInt16u;
var CanDoRangeLimit : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ This function serves the same purpose as InitDataFileForReading, but
is called when initializing reading from a file with an index,
whereas InitDataFileForReading is called when reading from a file
without. The index info structure (from FetchDataFileIndexInfo) is
passed to this function to identify the chosen index. }
function InitDataFileAndIndexForReadV115(
FileHandle : PPhysDbFileHandle;
InfoPtr : PPhysDbFileInfo;
IndexesPtr : PPhysDbIndexesInfo;
LookupOptPtr : PPhysDbLookupOptInfo;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ This function frees the read state information allocated by
InitDataFile functions. }
function TermDataFileForReading(
FileHandle : PPhysDbFileHandle;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ --------------- Number of Records in Data File ------------------- }
{ This function is passed a file handle of an open data file, and
returns the number of recurring records in the file. }
function NRecurringRecordsToRead(
FileHandle : PPhysDbFileHandle;
var NRecordsToRead : LongInt;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ ----------------------- Read Functions --------------------------- }
{ The following comments apply to all three of the functions for
data file reading: ReadFlatRecord, ReadNextRecurringRecord, and
LookupMatchingRecurringRecord.
Translated and Non-Translated Fields: The Database Manager requires
two sets of fields to be returned from each data record, as explained in
InitDataFile functions above. The two buffers readRecordBuf and
indexRecordBuf are passed to these functions for the two sets of field
values. As well indexNullFlags is an array of flags indicating whether
a field has special database "null value" and its indexRecordBuf entry
should be ignored.
The two sets of fields are required for different purposes. The fields
returned in readRecordBuf are used in the printed report and must be
translated to generic Brahma data types before returning. The fields
returned in indexRecordBuf are used in constructing an index value for
looking up records in another file, and should not be translated from
their native format. }
{ --------------------- Read Flat File Record ---------------------- }
{ This function is passed a file handle of an open flat data file, and
reads the first data record. }
function ReadFlatRecordVer15(
FileHandle : PPhysDbFileHandle;
ReadRecordBuf : PByteArray;
ReadNullFlags : PcrBooleanArray;
IndexRecordBuf : PByteArray;
IndexNullFlags : PcrBooleanArray;
var RecordRead : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ -------- Read Next Recurring Record (Sequential Access) ---------- }
{ This function is passed a file handle of an open data file, and
reads the next data record (from its current file position) sequentially.
It sets recordRead to true if it is successful, and to false if it is
at end of file. }
function ReadNextRecurringRecordVer15(
FileHandle : PPhysDbFileHandle;
ReadRecordBuf : PByteArray;
ReadNullFlags : PcrBooleanArray;
IndexRecordBuf : PByteArray;
IndexNullFlags : PcrBooleanArray;
var RecordRead : TcrBoolean;
var NRecordsSkipped : LongInt;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ ------- Lookup Matching Recurring Record (Random Access) --------- }
{ This function is passed a file handle of an open data file, a lookup
value and whether to start searching from first record, and looks up
a record matching the lookup value. This function is only called if
OpenDataFileAndIndexChoice has been called to open the data file.
The lookup value passed in the parameters lookupValueRecordBuf and
lookupValueNullFlags agrees in type and ordering with the fields of the
index chosen in the file open call. The lookup value fields are not
translated from the native field format, so no translation needs to occur
back to their native format when doing record lookup.
If the parameter startTopOfFile is true this function should begin its
search from the beginning of the data file, if it is false it should
search from its current file position.
This function sets recordRead to true if it is successful, and to false
if it is at end of file. }
function LookupMatchingRecurringRecVer15(
FileHandle : PPhysDbFileHandle;
LookupValueRecordBuf : PAnsiChar;
LookupValueNullFlags : PcrBooleanArray;
LookupValueType : Word;
StartTopOfFile : TcrBoolean;
ReadRecordBuf : PByteArray;
ReadNullFlags : PcrBooleanArray;
IndexRecordBuf : PByteArray;
IndexNullFlags : PcrBooleanArray;
var RecordRead : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ ------------------------- Memo Fields ---------------------------- }
{ There are two types of memo fields: transientMemoField and
persistentMemoField. A transient memo field is one that must
be read at the same time as the recurring data record, and a
persistent memo field is one that can be read at any later point.
For example, dBase supports persistent memo fields by storing a
memo field number in the data record that uniquely identifies the
field value in the memo file. This field number can be stored
by the physical database in the recurring record, and then read from
the memo file at any later point.
Persistent memo fields are preferred by Brahma, since the (potentially
very large) variable length text values do not need to be saved with
the data record (including buffering in memory, sorting, etc.)
The following functions are used to support memo fields. The
functions FetchMemoField and FreeMemoField are only called for fields
identified as transientMemoField's by this physical database.
The functions FetchPersistentMemoField and FreePersistentMemoField
are only called for fields identified as persistentMemoField's by
this physical database.
Memo field identifiers are stored in data records returned to Brahma
by the above Read functions, and these identifiers are used to
retrieve the memo field value. }
function FetchMemoField(MemoFieldRecordBuf : PAnsiChar;
var MemoField : PAnsiChar;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
function FreeMemoField(var MemoField : PAnsiChar;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
function FetchPersistentMemoField(FileHandle : PPhysDbFileHandle;
MemoFieldRecordBuf : PAnsiChar;
var MemoField : PAnsiChar;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
function FreePersistentMemoField(FileHandle : PPhysDbFileHandle;
var MemoField : PAnsiChar;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ --------------------- Multi-User Access -------------------------- }
{ This function is called to tell the physical database functions to use
record locking when reading from the database file(s). }
function UseRecordLocking(
FileHandle : PPhysDbFileHandle;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{ This function is called to tell the physical database functions to use
file locking when reading from the database file(s). }
function UseFileLocking(
FileHandle : PPhysDbFileHandle;
ErrMsg : PAnsiChar) : TPhysDbError; stdcall;
{===DEBUG LOGGING===}
procedure StartLog;
procedure EndLog;
procedure AddToLog(const S : string);
procedure AddToLogFmt(const S : string; args : array of const); {!!.12}
procedure AddBlockToLog(const S : string; Buf : pointer; BufLen : TffMemSize);
procedure AddResultToLog(aResult : TPhysDbError);
implementation
uses
Dialogs,
Forms,
Classes,
Windows,
ffclbde,
ffsrbde,
ffclconv,
ffcrltyp,
ffcrutil,
ffllunc,
ffdb,
fflleng,
ffdbbase;
type
TTaskListItem = record
TaskHandle : THandle;
AlreadyInitialized : Boolean;
end;
PTaskListItem = ^TTaskListItem;
TTaskList = class(TList)
function AddTask(TaskHandle: THandle) : TPhysDbError;
function DeleteTask(var TaskFound: Boolean;
var AlreadyInitialized: Boolean;
ErrMsg: PAnsiChar) : TPhysDbError;
function FindTask(TaskHandle: THandle) : integer;
function NewTask(var TaskFound: Boolean;
var TaskIndex: integer;
ErrMsg: PAnsiChar) : TPhysDbError;
end;
var
TaskList : TTaskList;
IsTaskSuccess : Boolean;
DebugBuff : array[0..1023] of AnsiChar;
Log : TffEventLog; {!!.12}
{$IFDEF IDAPI_INTERNAL_LIMITS}
const
MAX_DBS_PER_SESSION = 32;
nOpenDatabase: Word = 0;
{$ENDIF}
function ServerEngine : TffBaseServerEngine;
{return the default sessions server engine}
begin
Result := FFSession.ServerEngine;
end;
{ ----------------------- TTaskList methods ------------------------- }
function TTaskList.AddTask(TaskHandle: THandle) : TPhysDbError;
var
Item : PTaskListItem;
begin
try
FFGetMem(Item, sizeof(TTaskListItem));
Item^.TaskHandle := TaskHandle;
Item^.AlreadyInitialized := False;
Add(Item);
Result := errPhysDbNoError;
except
Result := errPhysDbNotEnoughMemory;
end;
end;
function TTaskList.DeleteTask(var TaskFound: Boolean;
var AlreadyInitialized: Boolean;
ErrMsg: PAnsiChar) : TPhysDbError;
var
Item : PTaskListItem;
TaskHandle : THandle;
TaskIndex : integer;
begin
TaskFound := False;
AlreadyInitialized := False;
TaskHandle := HInstance; {!!GetCurrentTask }
TaskIndex := FindTask(TaskHandle);
if TaskIndex <> -1 then begin
TaskFound := True;
Item := PTaskListItem(TaskList.Items[TaskIndex]);
AlreadyInitialized := Item^.AlreadyInitialized;
FFFreeMem(Item, sizeof(TTaskListItem));
Delete(TaskIndex);
end;
Result := errPhysDbNoError;
end;
function TTaskList.FindTask(TaskHandle: THandle) : integer;
var
i : integer;
begin
Result := -1;
for i := 0 to pred(Count) do
if PTaskListItem(Items[i])^.TaskHandle = TaskHandle then begin
Result := i;
Break;
end;
end;
function TTaskList.NewTask(var TaskFound : Boolean;
var TaskIndex : integer;
ErrMsg : PAnsiChar) : TPhysDbError;
var
TaskHandle : THandle;
begin
TaskFound := False;
{ See if current task is already in the list of tasks }
TaskHandle := HInstance; {GetCurrentTask;}
TaskIndex := FindTask(TaskHandle);
if TaskIndex <> -1 then begin
TaskFound := True;
Result := errPhysDbNoError;
Exit;
end;
{ If not, then add it }
TaskIndex := Count;
Result := AddTask(TaskHandle);
end;
{ ----------------------- Helper Routines ------------------------- }
function IDAPIError(ErrCode: TffResult; var ErrMsg: PAnsiChar) : TPhysDbError;
begin
with EffDatabaseError.CreateViaCode(ErrCode, False) do
try
StrPCopy(ErrMsg, ErrorString);
finally
Free;
end;
AddToLogFmt(' IDAPI Error: [%s]', [ErrMsg]);
Result := errPhysDbErrMsgReturned;
end;
function Convert2BrahmaType(FileHandle : PPhysDbFileHandle;
NativeType : TcrInt16u;
var NativeWidth : TcrInt16u;
var BrahmaType : TFieldValueType;
var BrahmaWidth : TcrInt16u;
ErrMsg : PAnsiChar) : TPhysDbError;
var
BookmarkSize : Integer;
FFError : TffResult;
begin
Result := errPhysDbNoError;
case NativeType of
fldZSTRING:
begin
BrahmaType := ftStringField;
if NativeWidth = 1 then begin { Handle Char types }
BrahmaWidth := 2;
end
else begin
BrahmaWidth := NativeWidth;
(* Dec(NativeWidth);*)
end;
end;
fldDATE:
begin
BrahmaType := ftDateField;
BrahmaWidth := SizeOf(TcrDate);
NativeWidth := SizeOf(TcrDate);
end;
fldBLOB, fldstBINARY, fldstGRAPHIC, fldstTYPEDBINARY:
begin
BrahmaType := ftBlobField;
{ Get bookmark size }
FFError := ServerEngine.CursorGetBookmarkSize(FileHandle^.CursorID, BookmarkSize);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
BrahmaWidth := SizeOf(TcrInt16u) + BookmarkSize;
NativeWidth := SizeOf(TcrInt16u) + BookmarkSize;
end;
fldstMEMO, fldstFMTMEMO:
{ Memo field, or variable length char string. save only the FieldNo
in this field. }
begin
BrahmaType := ftPersistentMemoField;
{ Get bookmark size }
FFError := ServerEngine.CursorGetBookmarkSize(FileHandle^.CursorID, BookmarkSize);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
BrahmaWidth := SizeOf(TcrInt16u) + BookmarkSize + 100;
NativeWidth := SizeOf(TcrInt16u) + BookmarkSize + 100;
end;
fldBOOL:
begin
BrahmaType := ftBooleanField;
BrahmaWidth := SizeOf(TcrBoolean);
end;
fldTIME:
begin
BrahmaType := ftTimeField;
BrahmaWidth := SizeOf(TcrTime);
NativeWidth := SizeOf(TDbiTime);
end;
fldTIMESTAMP:
begin
BrahmaType := ftStringField;
BrahmaWidth := SIZEOF_DATETIME_FIELD_STRING;
NativeWidth := SizeOf(TDbiTimeStamp);
end;
fldINT16, fldUINT16:
begin
BrahmaType := ftInt16sField;
BrahmaWidth := SizeOf(TcrInt16s);
end;
fldINT32, fldUINT32:
begin
BrahmaType := ftInt32sField;
BrahmaWidth := SizeOf(TcrInt32s);
end;
fldFLOAT:
begin
BrahmaType := ftNumberField;
BrahmaWidth := SizeOf(TcrNumber);
end;
fldstMONEY:
begin
BrahmaType := ftCurrencyField;
BrahmaWidth := SizeOf(TcrNumber);
end;
else
begin
BrahmaType := ftUnknownField;
BrahmaWidth := 1;
NativeWidth := 1;
end;
end;
end;
function DoubleToNumber(const D: Double) : TcrNumber;
begin
Result := D * NUMBER_SCALING_FACTOR;
end;
function NumberToDouble(const N : TcrNumber) : Double;
begin
Result := (N / NUMBER_SCALING_FACTOR);
end;
procedure ConvertTimestampToDateTimeString(
aDate : TDbiDate;
aTime : TDbiTime;
aBrahmaValue : PAnsiChar);
var
Year : TcrInt16u;
Fraction : TcrInt16s;
Hour : TcrInt16u;
Minute : TcrInt16u;
Second : TcrInt16u;
Millisec : TcrInt16u;
Month : TcrInt16u;
Day : TcrInt16u;
I : TcrInt16u;
ZeroOrd : Integer;
begin
Year := 0;
Fraction := 0;
FFBDEDateDecode(aDate, Day, Month, Year);
FFBDETimeDecode(aTime, Hour, Minute, MilliSec);
Second := Millisec div 1000;
ZeroOrd := Ord('0');
{ Translate year to string }
for I := 3 downto 0 do begin
aBrahmaValue[I] := Chr((Year mod 10) + ZeroOrd);
Year := Year div 10;
end;
aBrahmaValue[4] := '/';
aBrahmaValue[5] := Chr((Month div 10) + ZeroOrd);
aBrahmaValue[6] := Chr((Month mod 10) + ZeroOrd);
aBrahmaValue[7] := '/';
aBrahmaValue[8] := Chr((Day div 10) + ZeroOrd);
aBrahmaValue[9] := Chr((Day mod 10) + ZeroOrd);
aBrahmaValue[10] := ' ';
aBrahmaValue[11] := Chr((Hour div 10) + ZeroOrd);
aBrahmaValue[12] := Chr((Hour mod 10) + ZeroOrd);
aBrahmaValue[13] := ':';
aBrahmaValue[14] := Chr((Minute div 10) + ZeroOrd);
aBrahmaValue[15] := Chr((Minute mod 10) + ZeroOrd);
aBrahmaValue[16] := ':';
aBrahmaValue[17] := Chr((Second div 10) + ZeroOrd);
aBrahmaValue[18] := Chr((Second mod 10) + ZeroOrd);
aBrahmaValue[19] := '.';
aBrahmaValue[20] := Chr((Fraction div 10) + ZeroOrd);
aBrahmaValue[21] := Chr((Fraction mod 10) + ZeroOrd);
aBrahmaValue[22] := #0;
end;
{ --------------------- Database Abilities ------------------------ }
{ This is the version number for the driver DLL, not the physical database.
Crystal Reports uses this number to decide which list of function names
to expect to be exported from the DLL.
Crystal Reports OEM Tech Support advised me that this should be
identical to the version number coded into the PDBXBSE driver. As such,
the exported function names should be identical to PDBXBSE as well. }
function PhysDbVersionNumber(
var MajorVersionNumber : Word;
var MinorVersionNumber : Word;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('PhysDbVersionNumber');
MajorVersionNumber := 1;
MinorVersionNumber := 17;
Result := errPhysDbNoError;
AddToLogFmt(' MajMin: [%d.%d]', [MajorVersionNumber, MinorVersionNumber]);
AddResultToLog(Result);
end;
function CanRecognizeDataFile(
var CanRecognize : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('CanRecognizeDataFile');
CanRecognize := true;
Result := errPhysDbNoError;
AddToLogFmt(' Can?: [%s]', [BoolToStr(CanRecognize)]);
AddResultToLog(Result);
end;
function CanFetchDataFileInfo(
var CanFetchFileInfo : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('CanFetchDataFileInfo');
CanFetchFileInfo := true;
Result := errPhysDbNoError;
AddToLogFmt(' Can?: [%s]', [BoolToStr(CanFetchFileInfo)]);
AddResultToLog(Result);
end;
function CanFetchDataFileIndexInfo(
var CanFetchIndexInfo : TPhysDbIndexInfoCases;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('CanFetchDataFileIndexInfo');
CanFetchIndexInfo := iiAllIndexesKnown;
Result := errPhysDbNoError;
AddToLogFmt(' Can?: [%d]', [Ord(CanFetchIndexInfo)]);
AddResultToLog(Result);
end;
function CanBuildIndex(
var CanBuildIndex : TPhysDbBuildIndexCases;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('CanBuildIndex');
CanBuildIndex := biCannotBuildIndex;
Result := errPhysDbNoError;
AddToLogFmt(' Can?: [%d]', [ord(CanBuildIndex)]);
AddResultToLog(Result);
end;
function CanFetchNRecurringRecords(
var CanFetchNrecords : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('CanFetchNRecurringRecords');
CanFetchNRecords := true;
Result := errPhysDbNoError;
AddToLogFmt(' Can?: [%s]', [BoolToStr(CanFetchNRecords)]);
AddResultToLog(Result);
end;
function SQLCompatible(
var IsSQLTypeDLL : TcrBoolean;
var CanBuildAndExecSQLQuery : TcrBoolean;
var CanExecSQLQuery : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('SQLCompatible');
IsSQLTypeDLL := false;
CanBuildAndExecSQLQuery := false;
CanExecSQLQuery := false; {true - allow passing down rangeinfolist }
Result := errPhysDbNoError;
AddToLogFmt(' IsSQLTypeDLL?: [%s]', [BoolToStr(IsSQLTypeDLL)]);
AddToLogFmt(' CanBuildAndExecSQLQuery?: [%s]', [BoolToStr(CanBuildAndExecSQLQuery)]);
AddToLogFmt(' CanExecSQLQuery?: [%s]', [BoolToStr(CanExecSQLQuery)]);
AddResultToLog(Result);
end;
function CanReadSortedOrder(
var CanReadSorted : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('CanReadSortedOrder');
CanReadSorted := True;
Result := errPhysDbNoError;
AddToLogFmt(' Can?: [%s]', [BoolToStr(CanReadSorted)]);
AddResultToLog(Result);
end;
function CanReadRangeOfValues(
var CanReadRange : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('CanReadRangeOfValues');
CanReadRange := False;
Result := errPhysDbNoError;
AddToLogFmt(' Can?: [%s]', [BoolToStr(CanReadRange)]);
AddResultToLog(Result);
end;
function CanUseRecordLocking(
var RecordLockingPossible : TcrBoolean;
var RecordLockingPreferred : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('CanUseRecordLocking');
RecordLockingPossible := false;
RecordLockingPreferred := false;
Result := errPhysDbNoError;
AddToLogFmt(' Record Locking Possible?: [%s]', [BoolToStr(RecordLockingPossible)]);
AddToLogFmt(' Record Locking Preferred?: [%s]', [BoolToStr(RecordLockingPreferred)]);
AddResultToLog(Result);
end;
function CanUseFileLocking(
var FileLockingPossible : TcrBoolean;
var FileLockingPreferred : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('CanUseFileLocking');
FileLockingPossible := false;
FilelockingPreferred := false;
Result := errPhysDbNoError;
AddToLogFmt(' File Locking Possible?: [%s]', [BoolToStr(FileLockingPossible)]);
AddToLogFmt(' File Locking Preferred?: [%s]', [BoolToStr(FileLockingPreferred)]);
AddResultToLog(Result);
end;
{ ----------- Database Initialization and Termination ------------- }
function InitPhysicalDatabase(ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('InitPhysicalDatabase');
{ No special processing to initilize the database.
But we can't return PhysDbNotImplemented or Crystal will choke. }
IsTaskSuccess := True;
Result := errPhysDbNoError;
AddResultToLog(Result);
end;
function TermPhysicalDatabase(ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('TermPhysicalDatabase');
{ No special processing to deinitialize the database.
But we can't return PhysDbNotImplemented or Crystal will choke. }
Result := errPhysDbNoError;
AddResultToLog(Result);
end;
function OpenSession(ErrMsg : PAnsiChar) : TPhysDbError;
var
TaskFound : Boolean;
TaskIndex : integer;
begin
AddToLog('OpenSession');
Result := errPhysDbNoError;
TaskIndex := -1;
{handling in the except block? }
try
Result := TaskList.NewTask(TaskFound, TaskIndex, ErrMsg);
if (Result = errPhysDbNoError) then
if not TaskFound then
FFSession.Open;
except
on EOutOfMemory do begin
Result := errPhysDbNotEnoughMemory;
StrPCopy(ErrMsg, '');
end;
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
if not Assigned(ErrMsg) then
StrPCopy(ErrMsg, E.Message);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function TermSession(ErrMsg : PAnsiChar) : TPhysDbError;
var
TaskFound : Boolean;
AlreadyInitialized : Boolean;
begin
AddToLog('TermSession');
Result := TaskList.DeleteTask(TaskFound, AlreadyInitialized, ErrMsg);
if (Result = errPhysDbNoError) then
if TaskFound then
if not AlreadyInitialized then
FFSession.Close;
AddResultToLog(Result);
end;
{ ------------------------- Database Name -------------------------- }
function FetchDatabaseName(var Name : PAnsiChar;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('FetchDatabaseName');
try
Name := FFStrNew('FlashFiler 2');
Result := errPhysDbNoError;
except
Result := errPhysDbNotEnoughMemory;
end;
AddToLogFmt(' Name: [%s]', [Name]);
AddResultToLog(Result);
end;
function FreeDatabaseName(var Name : PAnsiChar;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('FreeDatabaseName');
AddToLogFmt(' Name: [%s]', [Name]);
Result := errPhysDbNoError;
try
FFStrDispose(Name);
Name := nil;
except
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
{ ---------------------- Log On and Log Off ----------------------- }
function LogOnServer(ServerInfo : PPhysDbServerInfo;
var ServerHandle : PPhysDbServerHandle;
Password : PAnsiChar;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('LogOnServer');
{ Can't return PhysDbNotImplemented or Crystal will choke. }
Result := errPhysDbNoError;
AddToLogFmt(' Server Handle: [%d]', [ServerHandle]);
AddResultToLog(Result);
end;
function LogOffServer(
var ServerHandle : PPhysDbServerHandle;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('LogOffServer');
{ Can't return PhysDbNotImplemented or Crystal will choke. }
Result := errPhysDbNoError;
AddToLogFmt(' Server Handle: [%d]', [ServerHandle]);
AddResultToLog(Result);
end;
{ ------------------- Parse and Rebuild SQL Info -------------------- }
function ParseLogOnInfo(
connectBuf : PAnsiChar;
bufSize : Word;
serverInfo : PPhysDbServerInfo;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('ParseLogOnInfo');
Result := errPhysDbNotImplemented;
AddResultToLog(Result);
end;
function RebuildConnectBuf(
serverInfo : PPhysDbServerInfo;
connectBuf : PAnsiChar;
bufSize : Word;
ErrMsg : PAnsiChar) : TphysDbError;
begin
AddToLog('RebuildConnectBuf');
Result := errPhysDbNotImplemented;
AddResultToLog(Result);
end;
{ -------------------- Open and Close Files ----------------------- }
function InitDataFileHandle(FileName : PAnsiChar;
var FileHandle : PPhysDbFileHandle;
DatabaseHandle : TffDatabaseID;
hCursor : TffcursorID;
ErrMsg : PAnsiChar) : TPhysDbError;
var
vNotXlateDOSString : Boolean;
vNotXlateDOSMemo : Boolean;
begin
Result := errPhysDbNoError;
try
{By default these two flags are FALSE : always convert OEM to ANSI,
check it now}
vNotXlateDOSString :=
(LongInt(FileHandle) and TRANSLATE_DOS_STRINGS) = 0;
vNotXlateDOSMemo :=
(LongInt(FileHandle) and TRANSLATE_DOS_MEMOS) = 0;
FFGetZeroMem(FileHandle, sizeof(TPhysDbFileHandle));
FileHandle^.DatabaseID := DatabaseHandle;
FileHandle^.CursorID := hCursor;
FileHandle^.NotXlateDOSString := vNotXlateDOSString;
FileHandle^.NotXlateDOSMemo := vNotXlateDOSMemo;
FileHandle^.PathAndFileName := FFStrAllocCopy(FileName);
except
on EOutOfMemory do begin
Result := errPhysDbNotEnoughMemory;
ServerEngine.CursorClose(hCursor);
ServerEngine.DatabaseClose(DatabaseHandle);
if Assigned(FileHandle) then
FFFreeMem(FileHandle, sizeof(TPhysDbFileHandle));
StrPCopy(ErrMsg, '');
end;
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
ServerEngine.CursorClose(hCursor);
ServerEngine.DatabaseClose(DatabaseHandle);
if Assigned(FileHandle) then
FFFreeMem(FileHandle, sizeof(TPhysDbFileHandle));
if not Assigned(ErrMsg) then {not assigned? }
StrPCopy(ErrMsg, E.Message);
end;
end;
end;
function OpenDatabase(DBName : PAnsiChar;
var DatabaseHandle : TffDatabaseID;
ErrMsg : PAnsiChar) : TPhysDbError;
var
FFError : TffResult;
DBNameUNC : TffShStr;
begin
if not Assigned(DBName) then begin
Result := errPhysDbProgrammingError;
Exit;
end;
DBNameUNC := FFExpandUNCFilename(FFStrPas(DBName));
if (length(DBNameUNC) > 3) and
(DBNameUNC[length(DBNameUNC)] = '\') then
dec(DBNameUNC[0]);
FFSession.Open;
FFError := ServerEngine.DatabaseOpenNoAlias(FFSession.Client.ClientID,
DBNameUNC,
omReadOnly,
smShared,
DefaultTimeOut, {2000}{-1} {!!.05}
DatabaseHandle);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
Result := errPhysDbNoError;
end;
function OpenDataFile(DatabaseHandle : TffDatabaseID;
FileName : PAnsiChar;
var FileHandle : PPhysDbFileHandle;
IndexFileName : PAnsiChar;
TagName : PAnsiChar;
IndexId : Word;
ErrMsg : PAnsiChar) : TPhysDbError;
var
FFError : TffResult;
hCursor : TffCursorID;
TableName : TffShStr;
IndexName : TffShStr;
Stream : TMemoryStream;
begin
TableName := FFExtractTableName(FFStrPas(FileName));
if (IndexFileName = nil) then
IndexName := ''
else
IndexName := FFStrPas(IndexFilename);
AddToLogFmt(' TableName: [%s]', [TableName]);
AddToLogFmt(' IndexName: [%s]', [IndexName]);
Stream := TMemoryStream.Create;
try
FFError := ServerEngine.TableOpen(DatabaseHandle,
TableName,
False,
IndexName,
IndexId,
omReadOnly,
smShared,
DefaultTimeOut, {2000}{-1} {!!.05}
hCursor,
Stream);
finally
Stream.Free;
end;
if FFError <> DBIERR_NONE then begin
ServerEngine.DatabaseClose(DatabaseHandle);
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
Result := InitDataFileHandle(FileName, FileHandle, DatabaseHandle,
hCursor, ErrMsg);
end;
function OpenDataFileIfRecognizedVer113(
FileName : PAnsiChar;
OpenDefaultIndex : TcrBoolean;
var Recognized : TcrBoolean;
var FileHandle : PPhysDbFileHandle;
CalledFromDirDLL : TcrBoolean;
var AliasName : PAnsiChar;
SilentMode : TcrBoolean;
DirInfo : PPhysDbFileDirectoryInfo;
DictInfo : PPhysDbFileDictionaryInfo;
SessionInfo : PPhysDbSessionInfo;
LogOnInfo : PPhysDbLogOnInfo;
ErrMsg : PAnsiChar) : TPhysDbError;
var
FileNameStr : TffShStr;
DatabaseHandle : TffDatabaseID;
DBNameOem : array[0..255] of AnsiChar;
begin
AddToLog('OpenDataFileIfRecognizedVer113');
AddToLogFmt(' File Name: [%s]', [FileName]);
AddToLogFmt(' OpenDefIndex: [%s]', [BoolToStr(OpenDefaultIndex)]);
Result := errPhysDbNoError;
Recognized := false;
if not IsTaskSuccess then begin
AddToLog(' IsTaskSuccess is false');
AddToLogFmt(' Recognized? [%s]', [BoolToStr(Recognized)]);
AddResultToLog(Result);
Exit;
end;
FileHandle := nil;
DBNameOem[0] := #0;
if (AliasName <> nil) then
AliasName[0] := #0;
try
{ Return error if file does not exist. }
FileNameStr := FFStrPas(FileName);
if not FileExists(FileNameStr) then begin
Result := errPhysDbFileDoesNotExist;
AddToLogFmt(' Recognized? [%s]', [BoolToStr(Recognized)]);
AddResultToLog(Result);
Exit;
end;
{ Check to see if the file name has an FF2 extension. If not, then
we assume that it's not a FF table (this avoids the time-
consuming protocol and FF client initialization stuff).}
if (FFCmpShStrUC(FFExtractExtension(FileNameStr),
ffc_ExtForData, ffcl_Extension) <> 0) then begin
{ No error, but file is not recognized }
Result := errPhysDbNoError;
AddToLogFmt(' Recognized? [%s]', [BoolToStr(Recognized)]);
AddResultToLog(Result);
Exit;
end;
{$IFDEF IDAPI_INTERNAL_LIMITS}
if NOpenDatabase >= MAX_DBS_PER_SESSION then begin
Recognized := false;
AddToLogFmt(' Recognized? [%s]', [BoolToStr(Recognized)]);
AddResultToLog(Result);
Exit;
end;
{$ENDIF}
FFStrPCopy(DBNameOem, FFExtractPath(FFStrPas(FileName)));
Result := OpenDatabase(DBNameOem, DatabaseHandle, ErrMsg);
if Result <> errPhysDbNoError then begin
AddToLogFmt(' Recognized? [%s]', [BoolToStr(Recognized)]);
AddResultToLog(Result);
Exit;
end;
{$IFDEF IDAPI_INTERNAL_LIMITS}
Inc(NOpenDatabase);
{$ENDIF}
{convert filename to oem? }
Recognized := OpenDataFile(DatabaseHandle, FileName, FileHandle, nil, nil, 0, ErrMsg) = errPhysDbNoError;
AddToLogFmt(' CursorID: [%d]', [FileHandle^.CursorID]);
Result := errPhysDbNoError;
except
on EOutOfMemory do begin
Result := errPhysDbNotEnoughMemory;
CloseDataFile(FileHandle, ErrMsg);
StrPCopy(ErrMsg, '');
end;
on E: Exception do begin
CloseDataFile(FileHandle, ErrMsg);
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
AddToLogFmt(' Recognized? [%s]', [BoolToStr(Recognized)]);
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function OpenDataAndIndexFileIfRecogV113(
FileName : PAnsiChar;
IndexName : PAnsiChar;
var Recognized : TcrBoolean;
var FileHandle : PPhysDbFileHandle;
var AliasName : PAnsiChar;
SilentMode : TcrBoolean;
DirInfo : PPhysDbFileDirectoryInfo;
DictInfo : PPhysDbFileDictionaryInfo;
SessionInfo: PPhysDbSessionInfo;
LogOnInfo : PPhysDbLogOnInfo;
ErrMsg : PAnsiChar) : TPhysDbError;
var
FFError : TffResult;
begin
AddToLog('OpenDataAndIndexFileIfRecogV113');
AddToLogFmt(' FName: [%s]', [FileName]);
AddToLogFmt(' InxName: [%s]', [IndexName]);
Result := errPhysDbNoError;
try
Recognized := false;
AliasName := nil;
{ Open the data file first }
Result := OpenDataFileIfRecognizedVer113(FileName, False, Recognized,
FileHandle, False, FileName, SilentMode, DirInfo,
DictInfo, SessionInfo, LogOnInfo, ErrMsg);
if Result <> errPhysDbNoError then Exit;
AddToLogFmt(' FName: [%s]', [FileHandle^.PathAndFileName]);
AddToLogFmt(' Cursor ID: [%d]', [FileHandle^.CursorID]);
FFError := ServerEngine.CursorSwitchToIndex(FileHandle^.CursorID,
IndexName,
0,
True);
if (FFError = DBIERR_NOCURRREC) then
FFError := ServerEngine.CursorSwitchToIndex(FileHandle^.CursorID,
IndexName,
0,
False);
if FFError <> DBIERR_NONE then
Result := IDAPIError(FFError, ErrMsg);
except
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function OpenDataFileAndIndexChoiceVer113(
FileName : PAnsiChar;
InfoPtr : PPhysDbFileInfo;
IndexesPtr : PPhysDbIndexesInfo;
var FileHandle : PPhysDbFileHandle;
SilentMode : TcrBoolean;
DirInfo : PPhysDbFileDirectoryInfo;
DictInfo : PPhysDbFileDictionaryInfo;
SessionInfo: PPhysDbSessionInfo;
LogOnInfo : PPhysDbLogOnInfo;
ErrMsg : PAnsiChar) : TPhysDbError;
var
DatabaseHandle: TffDatabaseID;
FileNameOem: array[0..MAX_PATH] of AnsiChar;
DBNameOem: array[0..MAX_PATH] of AnsiChar;
begin
AddToLog('OpenDataFileandIndexChoiceVer113');
Result := errPhysDbNoError;
try
{$IFDEF IDAPI_INTERNAL_LIMITS}
if NOpenDatabase >= MAX_DBS_PER_SESSION then begin
Result := errPhysDbErrorHandledByDBDLL;
Exit;
end;
{$ENDIF}
StrPCopy(DBNameOem, ExtractFilePath(StrPas(FileName)));
Result := OpenDatabase(DBNameOem, DatabaseHandle, ErrMsg);
AddToLogFmt(' DatabaseID: [%d]', [DatabaseHandle]);
if Result = errPhysDbNoError then begin
{$IFDEF IDAPI_INTERNAL_LIMITS}
Inc(NOpenDatabase);
{$ENDIF}
StrCopy(FileNameOem, FileName);
with IndexesPtr^.IndexInfo^[IndexesPtr^.IndexInUse] do
Result := OpenDataFile(DatabaseHandle, FilenameOem, FileHandle,
IndexFilename, TagName, IndexesPtr^.IndexInUse, ErrMsg);
AddToLogFmt(' FName: [%s]', [FileHandle^.PathAndFileName]);
AddToLogFmt(' CursorID: [%d]', [FileHandle^.CursorID]);
end;
except
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function CloseDataFile(var FileHandle : PPhysDbFileHandle;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('CloseDataFile');
Result := errPhysDbNoError;
try
if Assigned(FileHandle) then begin
AddToLogFmt(' FName: [%s]', [FileHandle^.PathAndFileName]);
AddToLogFmt(' CursorID: [%d]', [FileHandle^.CursorID]);
with FileHandle^ do begin
ServerEngine.CursorClose(CursorID);
if DatabaseID > 0 then { not sure why DbiCloseCursor is clearing this }
ServerEngine.DatabaseClose(DatabaseID);
{$IFDEF IDAPI_INTERNAL_LIMITS}
if NOpenDatabase > 0 then
Dec(NOpenDatabase);
{$ENDIF}
FFStrDispose(PathAndFileName);
FFStrDispose(IndexFileName);
FFStrDispose(TagName);
end;
FFFreeMem(FileHandle, sizeof(TPhysDbFileHandle));
end;
FileHandle := nil;
except
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
{ ---------------------- Fetch Data File Info --------------------- }
function FetchDataFileInfo(
FileHandle : PPhysDbFileHandle;
InfoDefaultsExist : TcrBoolean;
var InfoPtr : PPhysDbFileInfo;
ErrMsg : PAnsiChar) : TPhysDbError;
var
I : Integer;
FieldOffset : LongInt;
Buffer : TffShStr;
FFFieldType : TffFieldType;
BDEType : Word;
BDESubType : Word;
LogSize : Word;
begin
AddToLog('FetchDataFileInfo');
AddToLogFmt(' File Name: [%s]', [FileHandle^.PathAndFileName]);
AddToLogFmt(' CursorID: [%d]', [FileHandle^.CursorID]);
Result := errPhysDbNoError;
try
try
{ Allocate the file info structure }
FFGetZeroMem(InfoPtr, sizeof(TPhysDbFileInfo));
with InfoPtr^ do begin
NFields := 0;
FieldInfo := nil;
{ Always set the file to the recurring type, even if file contains only
0 or 1 records, since the file may grow in size. }
FileType := ftRecurringFile;
{ Set tablename to nil so the file name will be used by default }
TableName := nil;
{ Get number of fields in table }
NFields := TFFProxyCursor(FileHandle^.CursorID).Dictionary.FieldCount;
NBytesInPhysRecord := TFFProxyCursor(FileHandle^.CursorID).PhysicalRecordSize;
if NFields > 0 then begin
{ Retrieve field info }
{ Allocate the field info array structure }
FFGetZeroMem(FieldInfo, SizeOf(TPhysDbFieldInfo) * NFields);
{ Build the field info array }
FieldOffset := 0;
for I := 0 to pred(NFields) do begin
with FieldInfo^[I], TFFProxyCursor(FileHandle^.CursorID) do begin
{ Allocate space for the field name }
Name := FFStrNew(Dictionary.FieldName[I]);
{ Determine Brahma data type and width }
NBytesInNativeField := Dictionary.FieldLength[I];
FFFieldType := Dictionary.FieldType[I];
MapFFTypeToBDE(FFFieldType, NBytesInNativeField, BDEType, BDESubType, LogSize);
NativeFieldType := BDEType;
if NativeFieldType = fldBLOB then
NativeFieldType := BDESubType;
if (NativeFieldType = fldFLOAT) and (BDESubType = fldstMONEY) then
NativeFieldType := BDESubType;
Result := Convert2BrahmaType(FileHandle,
NativeFieldType,
NBytesInNativeField,
FieldType,
NBytesInField,
ErrMsg);
if Result <> errPhysDbNoError then Exit;
if FieldType = ftUnknownField then begin
AddToLog('Convert2BrahmaType: Unknown field');
AddToLogFmt(' Field: [%s]', [Dictionary.FieldName[I]]);
AddToLogFmt(' Type : [%d]', [NativeFieldType]);
end;
case FFFieldType of
fftShortString,
fftShortAnsiStr : NativeFieldOffset := Succ(FieldOffset);
else
NativeFieldOffset := FieldOffset;
end;
NDecPlacesInNativeField := Dictionary.FieldUnits[I];
Picture := nil;
Alignment := alLeftAlignedChars;
Sortable := true;
end;
{ Calculate the offset for the next field }
Inc(FieldOffset, FieldInfo^[I].NBytesInNativeField);
end;
end;
{ these are not set by this routine }
NBytesInReadRecord := 0;
NFieldsInReadRecord := 0;
NBytesInIndexRecord := 0;
NFieldsInIndexRecord := 0;
end;
except { InfoPtr error handler }
on EOutOfMemory do begin
Result := errPhysDbNotEnoughMemory;
FreeDataFileInfo(InfoPtr, ErrMsg);
StrPCopy(ErrMsg, '');
end;
on E: Exception do begin
FreeDataFileInfo(InfoPtr, ErrMsg);
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
finally
Buffer := PhysDbErrors[Result]; { this seems necessary for 32-bit, debug mode only }
end;
if (InfoPtr <> nil) then begin
with InfoPtr^ do begin
AddToLogFmt(' InfoPtr.NFields: [%d]', [NFields]);
AddToLogFmt(' InfoPtr.NBytesInPhysRecord: [%d]', [NBytesInPhysRecord]);
for i := 0 to pred(NFields) do begin
AddToLogFmt(' FieldName[%d]: [%s]', [i, FieldInfo^[i].Name]);
end;
AddBlockToLog(' InfoPtr.FieldInfo', FieldInfo, sizeOf(TPhysDbFieldInfo) * NFields);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function FreeDataFileInfo(
var InfoPtr : PPhysDbFileInfo;
ErrMsg : PAnsiChar) : TPhysDbError;
var
i : Integer;
begin
AddToLog('FreeDataFileInfo');
Result := errPhysDbNoError;
try
if Assigned(InfoPtr) then begin
with InfoPtr^ do begin
FFStrDispose(TableName);
if Assigned(FieldInfo) then begin
for I := 0 to pred(NFields) do begin
FFStrDispose(FieldInfo^[I].Name);
FFStrDispose(FieldInfo^[I].Picture);
end;
FFFreeMem(FieldInfo, Sizeof(TPhysDbFieldInfo) * NFields);
end;
end;
FFFreeMem(InfoPtr, sizeof(TPhysDbFileInfo));
end;
InfoPtr := nil;
except
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function FetchDataFileIndexInfo(
FileHandle: PPhysDbFileHandle;
InfoPtr: PPhysDbFileInfo;
var IndexesPtr: PPhysDbIndexesInfo;
ErrMsg: PAnsiChar) : TPhysDbError;
var
I : Integer;
function FetchIndexInfo: TPhysDbError;
var
Index : integer;
IndexDesc : IDXDesc;
FFIndexDesc : TffIndexDescriptor;
FieldN : Integer;
begin
with IndexesPtr^ do begin
for Index := 1 to NIndexes do begin {!!.02}
FFIndexDesc := TFFProxyCursor(FileHandle^.CursorID).Dictionary.IndexDescriptor[Index]^;
GetBDEIndexDescriptor(FFIndexDesc, IndexDesc);
with IndexInfo^[Pred(Index)] do begin {!!.02}
ValuesUnique := IndexDesc.bUnique;
Ascending := not IndexDesc.bDescending;
{ Allocate space for the filename }
if StrLen(IndexDesc.szName) <> 0 then begin
IndexFileName := FFStrAlloc(StrLen(IndexDesc.szName) + 1);
OemToAnsi(IndexDesc.szName, IndexFilename);
end;
{ Allocate space for the tagname }
if StrLen(IndexDesc.szTagName) <> 0 then begin
TagName := FFStrAlloc(StrLen(IndexDesc.szTagName) + 1);
OemToAnsi(IndexDesc.szTagName, TagName);
end;
IndexType := IndexDesc.iKeyExpType;
CaseSensitive := not IndexDesc.bCaseInsensitive;
if IndexDesc.bExpIdx then begin
{ omitted a bunch}
end
else begin
DefaultIndexFileName := not Assigned(IndexFileName);
DefaultTagName := not Assigned(TagName);
IndexExpr := nil;
EstimatedNBytesInexpr := 0;
NFields := IndexDesc.iFldsInKey;
{ Allocate the output list structure }
FFGetZeroMem(FieldNumInFile, SizeOf(TcrInt16u) * NFields);
for FieldN := 0 to pred(NFields) do
FieldNuminFile^[FieldN] := IndexDesc.aiKeyFld[FieldN] - 1; {!!.02}
end;
end;
end;
end;
Result := errPhysDbNoError;
end;
begin
AddToLog('FetchDataFileIndexInfo');
Result := errPhysDbNoError;
{ Allocate the index info structure }
try
FFGetZeroMem(IndexesPtr, SizeOf(TPhysDbIndexesInfo));
with IndexesPtr^ do begin
{ Get number of indexes in the table minus the SEQ Idx} {!!.02}
NIndexes := TFFProxyCursor(FileHandle^.CursorID).Dictionary.IndexCount - 1; {!!.02}
AddToLogFmt(' File Name: [%s]', [FileHandle^.PathAndFileName]);
AddToLogFmt(' CursorID: [%d]', [FileHandle^.CursorID]);
if NIndexes > 0 then begin
{ Allocate the index info structures }
FFGetZeroMem(IndexInfo, SizeOf(TPhysDbIndexInfo) * NIndexes);
Result := FetchIndexInfo;
if Result <> errPhysDbNoError then SysUtils.Abort;
end;
end;
except { InfoPtr error handler }
on EOutOfMemory do begin
Result := errPhysDbNotEnoughMemory;
FreeDataFileIndexInfo(IndexesPtr, ErrMsg);
StrPCopy(ErrMsg, '');
end;
on E: Exception do begin
FreeDataFileIndexInfo(IndexesPtr, ErrMsg);
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
if (IndexesPtr <> nil) then begin
with IndexesPtr^ do begin
AddToLogFmt(' IndexesPtr.NIndexes: [%d]', [NIndexes]);
for i := 0 to pred(NIndexes) do begin
AddToLogFmt(' IndexName[%d]: [%s]', [i, IndexInfo^[i].IndexFileName]);
end;
AddBlockToLog(' IndexesPtr.IndexInfo', IndexInfo, sizeOf(TPhysDbIndexInfo) * NIndexes);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function FreeDataFileIndexInfo(
var IndexesPtr: PPhysDbIndexesInfo;
ErrMsg: PAnsiChar) : TPhysDbError;
var
I: Integer;
begin
AddToLog('FreeDataFileIndexInfo');
Result := errPhysDbNoError;
try
if Assigned(IndexesPtr) then begin
if Assigned(IndexesPtr^.IndexInfo) then begin
for I := 0 to pred(IndexesPtr^.NIndexes) do
with IndexesPtr^.IndexInfo^[I] do begin
FFFreeMem(FieldNumInFile, SizeOf(Word) * NFields);
FFStrDispose(IndexExpr);
FFStrDispose(IndexFileName);
FFStrDispose(TagName);
end;
FFFreeMem(IndexesPtr^.IndexInfo, SizeOf(TPhysDbIndexInfo) * IndexesPtr^.NIndexes);
end;
FFFreeMem(IndexesPtr, SizeOf(TPhysDbIndexesInfo));
IndexesPtr := nil;
end;
except
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function BuildAndExecSQLQuery(
FileHandleList: PPhysDbFileHandleArray;
FileInfoList: PPhysDbFileInfoArray;
LinkNonSQLFlags: PcrBooleanArray;
IndexesInfoList: PPhysDbIndexesInfoArray;
RangeInfoList: PPhysDbRangeInfoArray;
NFiles: Word;
LinkInfoList: PPhysDbFileLinkInfoArray;
NFileLinks: Word;
SqlDrivingFile: TcrBoolean;
ErrMsg: PAnsiChar) : TPhysDbError;
begin
AddToLog('BuildAndExecSQLQuery');
{ This is what PDBBDE returns }
Result := errPhysDbNotImplemented;
AddResultToLog(Result);
end;
function InitDataFileForReadingVer17(
FileHandle : PPhysDbFileHandle;
InfoPtr : PPhysDbFileInfo;
IndexesPtr : PPhysDbIndexesInfo;
RangeInfoList : PPhysDbRangeInfoArray;
NRanges : TcrInt16u;
var CanDoRangeLimit : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError;
var
FFError : TffResult;
function CanDoRangeLimitOnField(
FileHandle : PPhysDbFileHandle;
InfoPtr : PPhysDbFileInfo;
IndexesPtr : PPhysDbIndexesInfo;
RangeInfoList : PPhysDbRangeInfoArray;
NRanges : Word;
var CanDoRangeLimit : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError;
var
IndexInfo : TPhysDbIndexInfo;
ContinueBuildStopKey : Boolean;
ContinueBuildStartKey : Boolean;
StopKeyOffset : integer;
StartKeyLen : integer;
NFieldsInStartKey : integer;
MinInclusive : Boolean;
RangeN : integer;
FieldN : integer;
TempPtr : Pointer;
TempBool : TcrBoolean;
IndexFieldN : integer;
RangeFieldN : integer;
SearchCond : TffSearchKeyAction;
function InitLimitRangeInfo(
FileHandle : PPhysDbFileHandle;
RangeInfoList : PPhysDbRangeInfoArray;
RangeIndex : integer;
RangeFieldN : integer;
FieldInfo : PPhysDbFieldInfo;
var ContinueBuildStartKey : Boolean;
var StartKeyLen : integer;
var ContinueBuildStopKey : Boolean;
var StopKeyOffset : integer;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
Result := errPhysDbNoError;
with FileHandle^.ReadInfo^.RangeFieldInfo^[RangeIndex] do begin
FieldNo := RangeFieldN;
OffsetInRecord := FieldInfo^.OffsetInIndexRecord;
FieldLength := FieldInfo^.NBytesInNativeField;
FieldType := FieldInfo^.FieldType;
NativeFieldOffset := FieldInfo^.NativeFieldOffset;
NativeFieldType := FieldInfo^.NativeFieldType;
NBytesInNativeField := FieldINfo^.NBytesInNativeField;
end;
with RangeInfoList^[RangeIndex].FieldRanges^[0] do begin
if ContinueBuildStartKey and Assigned(MinFieldValue) then
Inc(StartKeyLen, FieldInfo^.NBytesInNativeField)
else
ContinueBuildStartKey := False;
if ContinueBuildStopKey and Assigned(MaxFieldValue) then begin
with FileHandle^.ReadInfo^.RangeFieldInfo^[RangeIndex] do begin
{ Makes no sense to me; we already did this }
FieldNo := RangeFieldN;
OffsetInRecord := FieldInfo^.OffsetInIndexRecord;
FieldLength := FieldInfo^.NBytesInNativeField;
FieldType := FieldInfo^.FieldType;
NativeFieldOffset := FieldInfo^.NativeFieldOffset;
NativeFieldType := FieldInfo^.NativeFieldType;
NBytesInNativeField := FieldInfo^.NBytesInNativeField;
NDecPlacesInNativeField := FieldInfo^.NDecPlacesInNativeField;
OffsetInStopKeyBuf := StopKeyOffset;
StopInclusive := RangeInfoList^[RangeIndex].FieldRanges^[0].MaxInclusive;
end;
Inc(StopKeyOffset, FieldInfo^.NBytesInNativeField);
FileHandle^.ReadInfo^.StopKeyLen := StopKeyOffset;
Inc(FileHandle^.ReadInfo^.NStopKeyRanges);
end
else
ContinueBuildStopKey := False;
end;
end;
function BuildStringRanges(
FileHandle: PPhysDbFileHandle;
RangeInfoList: PPhysDbRangeInfoArray;
RangeIndex: TcrInt16u;
RangeFieldN: TcrInt16u;
FieldInfo: PPhysDbFieldInfo;
ErrMsg: PAnsiChar) : TPhysDbError;
var
SavedOffset: TcrINt16u;
KeyBuf,
KeyBufOem,
StartKeyBuf,
StopKeyBuf: PAnsiChar;
begin
SavedOffset := StopKeyOffset;
Result := InitLimitRangeInfo(FileHandle, RangeInfoList, RangeIndex,
RangeFieldN, FieldInfo, ContinueBuildStartKey,
StartKeyLen, ContinueBuildStopKey, StopKeyOffset,
ErrMsg);
if Result <> errPhysDbNoError then Exit;
if ContinueBuildStartKey then begin
KeyBuf := RangeInfoList^[RangeIndex].FieldRanges^[0].MinFieldValue;
try
KeyBufOem := FFStrAllocCopy(KeyBuf);
except
Result := errPhysDbNotEnoughMemory;
Exit;
end;
try
AnsiToOem(keyBufOem, keyBufOem);
TFFProxyCursor(FileHandle^.CursorID).Dictionary.SetRecordField(RangeFieldN,
FileHandle^.ReadInfo^.PhysRecordBuf,
KeyBufOem);
finally
FFStrDispose(KeyBufOem);
end;
end;
if ContinueBuildStopKey then begin
KeyBuf := @FileHandle^.ReadInfo^.StopKeyBuf[SavedOffset];
StrCopy(KeyBuf, @RangeInfoList^[RangeIndex].FieldRanges^[0].MaxFieldValue);
AnsiToOem(keyBuf, keyBuf);
end;
{ If current field of min and max range in index are not equal, do not
try to build stop key. }
with RangeInfoList^[RangeIndex].FieldRanges^[0] do begin
StartKeyBuf := @MinFieldValue;
StopKeyBuf := @MaxFieldValue;
end;
if not Assigned(StartKeyBuf) or
not Assigned(StopKeyBuf) or
(StrComp(StartKeyBuf, StopKeyBuf) <> 0) then
ContinueBuildStopKey := False;
end;
function BuildDateRanges(
FileHandle: PPhysDbFileHandle;
RangeInfoList: PPhysDbRangeInfoArray;
RangeIndex: TcrInt16u;
RangeFieldN: TcrInt16u;
FieldInfo: PPhysDbFieldInfo;
ErrMsg: PAnsiChar) : TPhysDbError;
var
SavedOffset : TcrInt16u;
Year : TcrInt16s;
Month : TcrInt16u;
Day : TcrInt16u;
DateValue : TDbiDate;
FieldLen : TcrInt16u;
KeyBuf : PDBIDate;
StartKeyBuf : PDBIDate;
StopKeyBuf : PDbiDate;
begin
SavedOffset := StopKeyOffset;
Result := InitLimitRangeInfo(FileHandle, RangeInfoList, RangeIndex,
RangeFieldN, FieldInfo, ContinueBuildStartKey,
StartKeyLen, ContinueBuildStopKey, StopKeyOffset,
ErrMsg);
if Result <> errPhysDbNoError then Exit;
if ContinueBuildStartKey then begin
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
CrDateToYearMonthDay(TcrDate(MinFieldValue^), Year, Month, Day);
DateValue := FFBDEDateEncode(Day, Month, Year);
TFFProxyCursor(FileHandle^.CursorID).Dictionary.SetRecordField(RangeFieldN,
FileHandle^.ReadInfo^.PhysRecordBuf,
@DateValue);
end;
if ContinueBuildStopKey then begin
FieldLen := StopKeyOffset - SavedOffset;
KeyBuf := PDbiDate(@FileHandle^.ReadInfo^.StopKeyBuf[SavedOffset]);
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
CrDateToYearMonthDay(TcrDate(MaxFieldValue^), Year, Month, Day);
DateValue := FFBDEDateEncode(Day, Month, Year);
Move(DateValue, KeyBuf^, FieldLen);
end;
{ If current field of min and max range in index are not equal, do not
try to build stop key. }
with RangeInfoList^[RangeIndex].FieldRanges^[0] do begin
StartKeyBuf := PDbiDate(@MinFieldValue);
StopKeyBuf := PDbiDate(@MaxFieldValue);
end;
if not Assigned(StartKeyBuf) or
not Assigned(StopKeyBuf) or
(StartKeyBuf^ <> StopKeyBuf^) then
ContinueBuildStopKey := False;
end;
function BuildIntegerRanges(
FileHandle: PPhysDbFileHandle;
RangeInfoList: PPhysDbRangeInfoArray;
RangeIndex: TcrInt16u;
RangeFieldN: TcrInt16u;
FieldInfo: PPhysDbFieldInfo;
ErrMsg: PAnsiChar) : TPhysDbError;
var
SavedLen,
SavedOffset: TcrInt16u;
FieldLen: TcrInt16u;
KeyBuf: PAnsiChar;
StartKeyValue,
StopKeyValue: TcrInt32s;
ShortValue: TcrInt16s;
LongValue: TcrInt32s;
begin
SavedLen := StartKeyLen;
SavedOffset := StopKeyOffset;
Result := InitLimitRangeInfo(FileHandle, RangeInfoList, RangeIndex,
RangeFieldN, FieldInfo, ContinueBuildStartKey,
StartKeyLen, ContinueBuildStopKey, StopKeyOffset,
ErrMsg);
if Result <> errPhysDbNoError then Exit;
StartKeyValue := 0;
StopKeyValue := 0;
if ContinueBuildStartKey then begin
FieldLen := StartKeyLen - SavedLen;
if FieldLen = 2 then begin
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
ShortValue := TcrInt16s(MinFieldValue^);
StartKeyValue := ShortValue;
TFFProxyCursor(FileHandle^.CursorID).Dictionary.SetRecordField(RangeFieldN,
FileHandle^.ReadInfo^.PhysRecordBuf,
@ShortValue);
end
else begin
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
LongValue := TcrInt32s(MinFieldValue^);
StartKeyValue := LongValue;
TFFProxyCursor(FileHandle^.CursorID).Dictionary.SetRecordField(RangeFieldN,
FileHandle^.ReadInfo^.PhysRecordBuf,
@LongValue);
end;
end;
if ContinueBuildStopKey then begin
FieldLen := stopKeyOffset - SavedOffset;
KeyBuf := @FileHandle^.ReadInfo^.StopKeyBuf[SavedOffset];
if FieldLen = 2 then begin
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
ShortValue := TcrInt16s(MaxFieldValue^);
StopKeyValue := ShortValue;
Move(ShortValue, KeyBuf^, FieldLen);
end
else begin
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
LongValue := TcrInt32s(MaxFieldValue^);
StopKeyValue := LongValue;
Move(LongValue, KeyBuf^, FieldLen);
end;
end;
{ If current field of min and max range in index are not equal, do not
try to build stop key. }
if ContinueBuildStopKey and ContinueBuildStartKey then
if StartKeyValue <> StopKeyValue then
ContinueBuildStopKey := False;
end;
function BuildDoubleRanges(
FileHandle: PPhysDbFileHandle;
RangeInfoList: PPhysDbRangeInfoArray;
RangeIndex: TcrInt16u;
RangeFieldN: TcrInt16u;
FieldInfo: PPhysDbFieldInfo;
ErrMsg: PAnsiChar) : TPhysDbError;
var
SavedOffset: TcrInt16u;
DoubleValue: Double;
FieldLen: TcrInt16u;
KeyBuf: PAnsiChar;
StartKeyBuf,
StopKeyBuf: PcrNumber;
begin
SavedOffset := StopKeyOffset;
Result := InitLimitRangeInfo(FileHandle, RangeInfoList, RangeIndex,
RangeFieldN, FieldInfo, ContinueBuildStartKey,
StartKeyLen, ContinueBuildStopKey, StopKeyOffset,
ErrMsg);
if Result <> errPhysDbNoError then Exit;
if ContinueBuildStartKey then begin
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
DoubleValue := NumberToDouble(TcrNumber(MinFieldValue^));
TFFProxyCursor(FileHandle^.CursorID).Dictionary.SetRecordField(RangeFieldN,
FileHandle^.ReadInfo^.PhysRecordBuf,
@DoubleValue);
end;
if ContinueBuildStopKey then begin
FieldLen := StopKeyOffset - SavedOffset;
KeyBuf := @FileHandle^.ReadInfo^.StopKeyBuf[SavedOffset];
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
DoubleValue := NumberToDouble(TcrNumber(MaxFieldValue^));
Move(DoubleValue, KeyBuf^, FieldLen);
end;
{ If current field of min and max range in index are not equal, do not
try to build stop key. }
with RangeInfoList^[RangeIndex].FieldRanges^[0] do begin
StartKeyBuf := PcrNumber(@MinFieldValue);
StopKeyBuf := PcrNumber(@MaxFieldValue);
end;
if not Assigned(StartKeyBuf) or
not Assigned(StopKeyBuf) or
(StartKeyBuf^ <> StopKeyBuf^) then
ContinueBuildStopKey := False;
end;
function BuildDecimalRanges(
FileHandle: PPhysDbFileHandle;
RangeInfoList: PPhysDbRangeInfoArray;
RangeIndex: TcrInt16u;
RangeFieldN: TcrInt16u;
FieldInfo: PPhysDbFieldInfo;
ErrMsg: PAnsiChar) : TPhysDbError;
(*
var
SavedLen,
SavedOffset: TcrInt16u;
FieldLen: TcrInt16u;
KeyBuf: PAnsiChar;
DoubleValue: Double;
StartKeyBuf,
StopKeyBuf: PcrNumber;
*)
begin
Result := errPhysDbNoError;
(* SavedLen := StartKeyLen;
SavedOffset := StopKeyOffset;
Result := InitLimitRangeInfo(FileHandle, RangeInfoList, RangeIndex,
RangeFieldN, FieldInfo, ContinueBuildStartKey,
StartKeyLen, ContinueBuildStopKey, StopKeyOffset,
ErrMsg);
if Result <> errPhysDbNoError then Exit;
if ContinueBuildStartKey then begin
FieldLen := StartKeyLen - SavedLen;
KeyBuf := @FileHandle^.ReadInfo^.KeyBuf[SavedLen];
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
DoubleValue := NumberToDouble(TcrNumber(MinFieldValue^));
if Doublevalue < 0 then begin
ContinueBuildStartKey := False;
StartKeyLen := SavedLen;
end
else
{
DoubleToDecimal(FileHandle, DoubleValue, KeyBuf, FieldLen,
FieldInfo^.NDecPlacesInNativeField)};
end;
if ContinueBuildStopKey then begin
FieldLen := StopKeyOffset - SavedOffset;
KeyBuf := @FileHandle^.ReadInfo^.StopKeyBuf[SavedOffset];
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
DoubleValue := NumberToDouble(TcrNumber(MaxFieldValue^));
Move(DoubleValue, KeyBuf^, FieldLen);
end;
{ If current field of min and max range in index are not equal, do not
try to build stop key. }
with RangeInfoList^[RangeIndex].FieldRanges^[0] do begin
StartKeyBuf := PcrNumber(@MinFieldValue);
StopKeyBuf := PcrNumber(@MaxFieldValue);
end;
if not Assigned(StartKeyBuf) or
not Assigned(StopKeyBuf) or
(StartKeyBuf^ <> StopKeyBuf^) then
ContinueBuildStopKey := False;*)
end;
function BuildTimeRanges(
FileHandle: PPhysDbFileHandle;
RangeInfoList: PPhysDbRangeInfoArray;
RangeIndex: TcrInt16u;
RangeFieldN: TcrInt16u;
FieldInfo: PPhysDbFieldInfo;
ErrMsg: PAnsiChar) : TPhysDbError;
(*
var
SavedLen,
SavedOffset: TcrInt16u;
KeyBuf: PAnsiChar;
TimeValue: TcrInt32s;
TimeValueN: TcrNumber;
StartKeyBuf,
StopKeyBuf: PcrNumber;
*)
begin
Result := errPhysDbNoError;
(* SavedLen := StartKeyLen;
SavedOffset := StopKeyOffset;
Result := InitLimitRangeInfo(FileHandle, RangeInfoList, RangeIndex,
RangeFieldN, FieldInfo, ContinueBuildStartKey,
StartKeyLen, ContinueBuildStopKey, StopKeyOffset,
ErrMsg);
if Result <> errPhysDbNoError then Exit;
if ContinueBuildStartKey then begin
KeyBuf := @FileHandle^.ReadInfo^.KeyBuf[SavedLen];
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
TimeValue := TBrahmaNumber(MinFieldValue^);
if TimeValue < 0 then begin
ContinueBuildStartKey := False;
StartKeyLen := SavedLen;
end
else
Convert2BTTime(TimeValue, KeyBuf);
end;
if ContinueBuildStopKey then begin
KeyBuf := @FileHandle^.ReadInfo^.StopKeyBuf[SavedOffset];
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
TimeValueN := TBrahmaNumber(MaxFieldValue^);
if TimeValue < 0 then begin
ContinueBuildStopKey := False;
StartKeyLen := SavedLen;
end
else
Move(TimeValueN, KeyBuf, SizeOf(TBrahmaNumber));
end;
{ If current field of min and max range in index are not equal, do not
try to extend the stop key. }
with RangeInfoList^[RangeIndex].FieldRanges^[0] do begin
StartKeyBuf := PBrahmaNumber(@MinFieldValue);
StopKeyBuf := PBrahmaNumber(@MaxFieldValue);
end;
if not Assigned(StartKeyBuf) or
not Assigned(StopKeyBuf) or
(StartKeyBuf^ <> StopKeyBuf^) then
ContinueBuildStopKey := False;*)
end;
function BuildLogicalRanges(
FileHandle: PPhysDbFileHandle;
RangeInfoList: PPhysDbRangeInfoArray;
RangeIndex: TcrInt16u;
RangeFieldN: TcrInt16u;
FieldInfo: PPhysDbFieldInfo;
ErrMsg: PAnsiChar) : TPhysDbError;
var
SavedLen,
SavedOffset,
FieldLen: TcrInt16u;
KeyBuf: PAnsiChar;
LogicalValue: TcrBoolean;
StartKeyValue,
StopKeyValue: TcrBoolean;
begin
SavedLen := StartKeyLen;
SavedOffset := StopKeyOffset;
Result := InitLimitRangeInfo(FileHandle, RangeInfoList, RangeIndex,
RangeFieldN, FieldInfo, ContinueBuildStartKey,
StartKeyLen, ContinueBuildStopKey, StopKeyOffset,
ErrMsg);
if Result <> errPhysDbNoError then Exit;
if ContinueBuildStartKey then begin
FieldLen := StartKeylen - SavedLen;
KeyBuf := @FileHandle^.ReadInfo^.KeyBuf[SavedLen];
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
LogicalValue := TcrBoolean(MinFieldValue^);
if FieldLen = 1 then
TcrInt8u(KeyBuf^) := Ord(LogicalValue)
else
PcrInt16u(KeyBuf)^ := Ord(LogicalValue);
end;
if ContinueBuildStopKey then begin
FieldLen := StopKeyOffset - SavedOffset;
KeyBuf := @FileHandle^.ReadInfo^.StopKeyBuf[SavedOffset];
with RangeInfoList^[RangeIndex].FieldRanges^[0] do
LogicalValue := TcrBoolean(MaxFieldValue^);
if FieldLen = 1 then
TcrInt8u(KeyBuf^) := Ord(LogicalValue)
else
PcrInt16u(KeyBuf)^ := Ord(LogicalValue);
end;
{ If current field of min and max range in index are not equal, do not
try to extend the stop key. }
with RangeInfoList^[RangeIndex].FieldRanges^[0] do begin
StartKeyValue := TcrBoolean(@MinFieldValue);
StopKeyValue := TcrBoolean(@MaxFieldValue);
end;
if StartKeyValue = StopKeyValue then
ContinueBuildStopKey := False;
end;
begin
CanDoRangeLimit := false;
Result := errPhysDbNoError;
if NRanges = 0 then Exit;
with FileHandle^.ReadInfo^ do
FillChar(KeyBuf, SizeOf(KeyBuf), #0);
StopKeyOffset := 0;
StartKeyLen := 0;
NFieldsInStartKey := 0;
ContinueBuildStopKey := True;
ContinueBuildStartKey := True;
MinInclusive := True;
FileHandle^.ReadInfo^.AscendingIndex :=
IndexesPtr^.IndexInfo^[IndexesPtr^.IndexInUse].Ascending;
{ Swap the begin and end range key, when descending index }
if not FileHandle^.ReadInfo^.AscendingIndex then begin
AddToLog(' swapping begin and end range key');
for RangeN := 0 to pred(NRanges) do begin
with RangeInfoList^[RangeN] do begin
for FieldN := 0 to pred(RangeInfoList^[RangeN].NFieldRanges) do begin
with RangeInfoList^[RangeN].FieldRanges^[FieldN] do begin
TempPtr := MinFieldValue;
MinFieldValue := MaxFieldValue;
MaxFieldValue := TempPtr;
TempBool := MinInclusive;
MinInclusive := MaxInclusive;
MaxInclusive := TempBool;
end;
end;
end;
end;
end;
{ Start to do the range search }
IndexInfo := IndexesPtr^.IndexInfo^[IndexesPtr^.IndexInUse];
for RangeN := 0 to pred(NRanges) do begin
RangeFieldN := IndexInfo.FieldNumInFile^[RangeN];
if not RangeInfoList^[RangeN].SelectIfWithinRange or
(RangeInfoList^[RangeN].NFieldRanges <> 1) then
Break;
case InfoPtr^.FieldInfo^[RangeFieldN].NativeFieldType of
fldZSTRING:
begin
CanDoRangeLimit := true;
Result := BuildStringRanges(FileHandle, RangeInfoList, RangeN,
RangeFieldN, @InfoPtr^.FieldInfo^[RangeFieldN], ErrMsg);
end;
fldDATE:
begin
CanDoRangeLimit := true;
Result := BuildDateRanges(FileHandle, RangeInfoList, RangeN,
RangeFieldN, @InfoPtr^.FieldInfo^[RangeFieldN], ErrMsg);
end;
fldINT16, fldINT32:
begin
CanDoRangeLimit := true;
Result := BuildIntegerRanges(FileHandle, RangeInfoList, RangeN,
RangeFieldN, @InfoPtr^.FieldInfo^[RangeFieldN], ErrMsg);
end;
fldFLOAT, fldstMONEY:
begin
CanDoRangeLimit := true;
Result := BuildDoubleRanges(FileHandle, RangeInfoList, RangeN,
RangeFieldN, @InfoPtr^.FieldInfo^[RangeFieldN], ErrMsg);
end;
fldBCD:
begin
CanDoRangeLimit := true;
ShowMessage('BCD datatypes not supported for ranges');
{Result := BuildDecimalRanges(FileHandle, RangeInfoList, RangeN,
RangeFieldN, @InfoPtr^.FieldInfo^[RangeFieldN], ErrMsg);}
end;
fldTIME:
begin
CanDoRangeLimit := true;
ShowMessage('Time datatypes are not supported for ranges');
{Result := BuildTimeRanges(FileHandle, RangeInfoList, RangeN,
RangeFieldN, @InfoPtr^.FieldInfo^[RangeFieldN], ErrMsg);}
end;
fldBOOL:
begin
CanDoRangeLimit := true;
Result := BuildLogicalRanges(FileHandle, RangeInfoList, RangeN,
RangeFieldN, @InfoPtr^.FieldInfo^[RangeFieldN], ErrMsg);
end;
else CanDoRangeLimit := false;
end;
if ContinueBuildStartKey and
not RangeInfoList^[RangeN].FieldRanges^[0].MinInclusive then
MinInclusive := False;
if (Result <> errPhysDbNoError) or not CanDoRangeLimit then
Break;
if ContinueBuildStartKey then
Inc(NFieldsInStartKey)
else
TFFProxyCursor(FileHandle^.CursorID).Dictionary.SetRecordField(RangeFieldN,
FileHandle^.ReadInfo^.PhysRecordBuf,
nil);
end;
{ Clear the remaining fields in index }
for FieldN := NFieldsInStartKey to pred(IndexInfo.NFields) do begin
IndexFieldN := IndexInfo.FieldNumInFile^[FieldN];
TFFProxyCursor(FileHandle^.CursorID).Dictionary.SetRecordField(IndexFieldN,
FileHandle^.ReadInfo^.PhysRecordBuf,
nil);
end;
if (Result = errPhysDbNoError) and CanDoRangeLimit then begin
if StartKeyLen > 0 then begin
with TFFProxyCursor(FileHandle^.CursorID) do begin
Dictionary.ExtractKey(IndexID,
@FileHandle^.ReadInfo^.PhysRecordBuf,
@FileHandle^.ReadInfo^.KeyBuf);
end;
if MinInclusive then
SearchCond := skaEqual
else
SearchCond := skaGreater;
FFError := ServerEngine.CursorSetToKey(FileHandle^.CursorID,
SearchCond,
True,
NFieldsInStartKey,
0,
@FileHandle^.ReadInfo^.KeyBuf);
AddToLogFmt(' CursorSetToKey: [%d]', [FFError]);
if FFError = DBIERR_NONE then begin
FFError := ServerEngine.CursorSetRange(FileHandle^.CursorID,
True,
NFieldsInStartKey,
0,
@FileHandle^.ReadInfo^.KeyBuf,
MinInclusive,
0,
0,
nil,
True);
AddToLogFmt(' CursorSetRange: [%d]', [FFError]);
end;
end else begin
FFError := ServerEngine.CursorSetToBegin(FileHandle^.CursorID);
AddToLogFmt(' CursorSetRange: [%d]', [FFError]);
end;
if FFError <> DBIERR_NONE then SysUtils.Abort;
FileHandle^.RangeLimit := True;
end;
end;
function InitReadInfoForRange(
FileHandle : PPhysDbFileHandle;
InfoPtr : PPhysDbFileInfo;
IndexesPtr : PPhysDbIndexesInfo;
RangeInfoList : PPhysDbRangeInfoArray;
NRanges : Word;
var CanDoRangeLimit : TcrBoolean;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
Result := errPhysDbNoError;
with fileHandle^ do begin
RangeLimit := False;
with ReadInfo^ do begin
RangeFieldInfo := nil;
NStopKeyRanges := 0;
StopKeyLen := 0;
if NRanges > 0 then begin
IndexCaseSensitive := IndexesPtr^.IndexInfo^[IndexesPtr^.IndexInUse].CaseSensitive;
{ Allocate structure for range field info }
FFGetZeroMem(RangeFieldInfo, SizeOf(TPhysDbReadFieldInfo) * NRanges);
Result := CanDoRangeLimitOnField(FileHandle, InfoPtr, IndexesPtr,
RangeInfoList, NRanges,
CanDoRangeLimit, ErrMsg);
end;
end;
end;
end;
var
ReadFieldNo : integer;
IndexFieldNo : integer;
FieldN : integer;
begin { InitDataFileForReadingVer17 }
AddToLog('InitDataFileForReadingVer17');
AddToLogFmt(' PathAndFilename: [%s]', [FileHandle^.PathAndFileName]);
AddToLogFmt(' CursorID: [%d]', [FileHandle^.CursorID]);
if Assigned(IndexesPtr) then
AddToLogFmt(' IndexesPtr^.IndexInUse: [%d]', [IndexesPtr^.IndexInUse]);
AddToLogFmt(' NRanges: [%d]', [NRanges]);
if Assigned(RangeInfoList) then begin
AddBlockToLog(' RangeInfoList^[0]: ', @RangeInfoList^[0], SizeOf(TPhysDbRangeInfo));
with RangeInfoList^[0] do begin
AddToLogFmt(' RangeInfoList^[0].FieldName: [%s]', [FieldName]);
AddToLogFmt(' RangeInfoList^[0].BrahmaType: [%s]', [FieldValueTypes[BrahmaType]]);
AddToLogFmt(' RangeInfoList^[0].BrahmaFieldLen: [%d]', [BrahmaFieldLen]);
AddToLogFmt(' RangeInfoList^[0].SelectIfWithinRange: [%s]', [BoolToStr(SelectIfWithinRange)]);
AddToLogFmt(' RangeInfoList^[0].NFieldRanges: [%d]', [NFieldRanges]);
end;
end;
Result := errPhysDbNoError;
try
try
CanDoRangeLimit := false;
with FileHandle^ do begin
ReadInfo := nil;
{ Allocate structure for read state info }
FFGetZeroMem(ReadInfo, SizeOf(TPhysDbReadInfo));
MainFile := True;
ReadInfo^.NumRanges := NRanges;
with ReadInfo^ do begin
ValuesUnique := true;
NBytesInReadRecord := InfoPtr^.NBytesInReadRecord;
NFieldsInReadRecord := InfoPtr^.NFieldsInReadRecord;
NBytesInIndexRecord := InfoPtr^.NBytesInIndexRecord;
NFieldsInIndexRecord := InfoPtr^.NFieldsInIndexRecord;
NBytesInPhysRecord := InfoPtr^.NBytesInPhysRecord + 1;
{ Allocate the physical record buffer }
FFGetZeroMem(PhysRecordBuf, NBytesInPhysRecord);
{ Position at first record of file for subsequent reading }
CurrentRecord := 0;
{ Allocate structure for read state information per translated field }
FFGetZeroMem(FieldInfo, SizeOf(TPhysDbReadFieldInfo) * InfoPtr^.NFieldsInReadRecord);
{ Allocate structure for read state information per untranslated field }
FFGetZeroMem(IndexFieldInfo, SizeOf(TPhysDbReadFieldInfo) * InfoPtr^.NFieldsInIndexRecord);
NFieldsInIndexDefn := 0;
IndexDefnInfo := nil;
{ Pass through complete file info structure to find all (translated)
read record fields and (untranslated) index record fields. }
ReadFieldNo := 0;
IndexFieldNo := 0;
for FieldN := 0 to pred(InfoPtr^.NFields) do begin
with InfoPtr^.FieldInfo^[FieldN] do begin
if UsedInReadRecord then begin
{ At a field to be translated in read record }
FieldInfo^[ReadFieldNo].FieldNo := FieldN;
FieldInfo^[ReadFieldNo].ReadFieldNo := ReadFieldNo;
FieldInfo^[ReadFieldNo].OffsetInRecord := OffsetInReadRecord;
FieldInfo^[ReadFieldNo].FieldType := FieldType;
FieldInfo^[ReadFieldNo].FieldLength := NBytesInField;
FieldInfo^[ReadFieldNo].NativeFieldOffset := NativeFieldOffset;
FieldInfo^[ReadFieldNo].NativeFieldType := NativeFieldType;
FieldInfo^[ReadFieldNo].NBytesInNativeField := NBytesInNativeField;
FieldInfo^[ReadFieldNo].NDecPlacesInNativeField := NDecPlacesInNativeField;
Inc(ReadFieldNo);
end;
if UsedInIndexRecord then begin
{ At a field to be untranslated in index record }
IndexFieldInfo^[IndexFieldNo].FieldNo := FieldN;
IndexFieldInfo^[IndexFieldNo].ReadFieldNo := IndexFieldNo;
IndexFieldInfo^[IndexFieldNo].OffsetInRecord := OffsetInIndexRecord;
IndexFieldInfo^[IndexFieldNo].FieldType := FieldType;
IndexFieldInfo^[IndexFieldNo].FieldLength := NBytesInNativeField;
IndexFieldInfo^[IndexFieldNo].NativeFieldOffset := NativeFieldOffset;
IndexFieldInfo^[IndexFieldNo].NativeFieldType := NativeFieldType;
IndexFieldInfo^[IndexFieldNo].NBytesInNativeField := NBytesInNativeField;
IndexFieldInfo^[IndexFieldNo].NDecPlacesInNativeField := NDecPlacesInNativeField;
Inc(IndexFieldNo);
end;
end;
end;
end;
end;
Result := InitReadInfoForRange(FileHandle, InfoPtr, IndexesPtr,
RangeInfoList, NRanges, CanDoRangeLimit, ErrMsg);
if Result <> errPhysDbNoError then
raise Exception.Create(StrPas(ErrMsg));
AddToLogFmt(' CanDoRangeLimit: [%s]', [BoolToStr(CanDoRangeLimit)]);
except
on EOutOfMemory do begin
Result := errPhysDbNotEnoughMemory;
TermDataFileForReading(FileHandle, ErrMsg);
StrPCopy(ErrMsg, '');
end;
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
TermDataFileForReading(FileHandle, ErrMsg);
StrPCopy(ErrMsg, E.Message);
if FFError <> DBIERR_NONE then
Result := IDAPIError(FFError, ErrMsg);
end;
end;
finally
StrPCopy(DebugBuff, PhysDbErrors[Result]); { this seems necessary for 32-bit }
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function InitDataFileAndIndexForReadV115(
FileHandle: PPhysDbFileHandle;
InfoPtr: PPhysDbFileInfo;
IndexesPtr: PPhysDbIndexesInfo;
LookupOptPtr: PPhysDbLookupOptInfo;
ErrMsg: PAnsiChar) : TPhysDbError;
var
CanDoRangeLimit: TcrBoolean;
{ This function serves the same purpose as InitDataFileForReading, but
is called when initializing reading from a file with an index,
whereas InitDataFileForReading is called when reading from a file
without. The index info structure (from FetchDataFileIndexInfo) is
passed to this function to identify the chosen index. }
function InitReadInfoForIndex: TPhysDbError;
var
IndexInfo: TPhysDbIndexInfo;
IndexOffset,
FieldIndex,
FieldN: integer;
begin
Result := errPhysDbNoError;
if IndexesPtr^.NIndexes = 0 then begin
Result := errPhysDbFileIntegrityError;
Exit;
end;
{ Allocate structure to save information on index fields }
IndexInfo := IndexesPtr^.IndexInfo^[IndexesPtr^.IndexInUse];
with FileHandle^.ReadInfo^ do begin
ValuesUnique := IndexInfo.ValuesUnique;
IndexCaseSensitive := IndexInfo.CaseSensitive;
NFieldsInIndexDefn := IndexInfo.NFields;
FFGetZeroMem(IndexDefnInfo, SizeOf(TPhysDbReadFieldInfo) * IndexInfo.NFields);
{ Default number of lookup fields to same as index }
NFieldsInLookupValue := NFieldsInIndexDefn;
LookupValueLen := LookupOptPtr^.LookupValueLen;
LastLookupFieldLen := 0;
LastLookupFieldIsSubstr := false;
IndexOffset := 0;
for FieldN := 0 to pred(IndexInfo.NFields) do begin
FieldIndex := IndexInfo.FieldNumInFile^[FieldN];
IndexDefnInfo^[FieldN].FieldNo := FieldIndex;
IndexDefnInfo^[FieldN].OffsetInRecord := IndexOffset;
IndexDefnInfo^[FieldN].FieldLength := InfoPtr^.FieldInfo^[FieldIndex].NBytesInNativeField;
IndexDefnInfo^[FieldN].FieldType := InfoPtr^.FieldInfo^[FieldIndex].FieldType;
{ Detect if we have link on partial number of fields }
if IndexDefnInfo^[FieldN].OffsetInRecord >= LookupOptPtr^.LookupValueLen then
if NFieldsInLookupValue = NFieldsInIndexDefn then
if FieldN > 0 then
NFieldsInLookupValue := FieldN;
IndexOffset := IndexOffset + InfoPtr^.FieldInfo^[FieldIndex].NBytesInNativeField;
end;
{ Detect if we have link to a partial string field at the end
of lookup value. }
if (IndexDefnInfo^[IndexInfo.NFields - 1].FieldType = ftStringField) and
LookupOptPtr^.PartialMatch then
LastLookupFieldIsSubstr := True;
end;
end;
begin
AddToLog('InitDataFileAndIndexForReadV115');
AddToLogFmt(' PathAndFilename: [%s]', [FileHandle^.PathAndFileName]);
AddToLogFmt(' CursorID: [%d]', [FileHandle^.CursorID]);
AddBlockToLog(' LookupOptPtr^:', LookupOptPtr, SizeOf(LookupOptPtr^));
Result := errPhysDbNoError;
try
{ Perform same initialization as for no index file }
Result := InitDataFileForReadingVer17(FileHandle, InfoPtr, IndexesPtr,
nil, 0, CanDoRangeLimit, ErrMsg);
if Result = errPhysDbNoError then begin
{ Perform index specific initialization }
Result := InitReadInfoForIndex;
if Result <> errPhysDbNoError then
TermDataFileForReading(FileHandle, ErrMsg);
end;
FileHandle^.MainFile := False;
except
on EOutOfMemory do begin
Result := errPhysDbNotEnoughMemory;
StrPCopy(ErrMsg, '');
end;
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function TermDataFileForReading(
FileHandle: PPhysDbFileHandle;
ErrMsg: PAnsiChar) : TPhysDbError;
begin
AddToLog('TermDataFileForReading');
Result := errPhysDbNoError;
try
if Assigned(FileHandle) then begin
AddToLogFmt(' FileName: [%s]', [FileHandle^.PathAndFileName]);
AddToLogFmt(' CursorID: [%d]', [FileHandle^.CursorID]);
with FileHandle^ do begin
if Assigned(ReadInfo) then begin
with ReadInfo^ do begin
FFFreeMem(PhysRecordBuf, NBytesInPhysRecord);
PhysRecordBuf := nil;
FFFreeMem(FieldInfo, SizeOf(TPhysDbReadFieldInfo) * NFieldsInReadRecord);
FieldInfo := nil;
FFFreeMem(IndexFieldInfo, SizeOf(TPhysDbReadFieldInfo) * NFieldsInIndexRecord);
IndexFieldInfo := nil;
FFFreeMem(RangeFieldInfo, SizeOf(TPhysDbReadFieldInfo) * NumRanges);
RangeFieldInfo := nil;
end;
FFFreeMem(ReadInfo, sizeof(TPhysDbReadInfo));
ReadInfo := nil;
end;
end;
end;
except
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function NRecurringRecordsToRead(
FileHandle: PPhysDbFileHandle;
var NRecordsToRead: LongInt;
ErrMsg: PAnsiChar) : TPhysDbError;
var
NRecords : TcrInt32u;
FFError : TffResult;
begin
AddToLog('NRecurringRecordsToRead');
AddToLogFmt(' FName: [%s]', [FileHandle^.PathAndFileName]);
AddToLogFmt(' CursorID: [%d]', [FileHandle^.CursorID]);
Result := errPhysDbNoError;
try
FFError := ServerEngine.TableGetRecCount(FileHandle^.CursorID, NRecords);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
NRecordsToRead := NRecords;
except
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
AddToLogFmt(' Records count: [%d]', [NRecordsToRead]);
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
{ Translate and copy fields requested by Database Manager to read
record buffer. }
function FetchReadRecFields(
ReadInfo : PPhysDbReadInfo;
HCursor : TffCursorID;
NotXlateDOSString : Boolean;
ReadRecordBuf : PByteArray;
ReadNullFlags : PcrBooleanArray;
ErrMsg : PAnsiChar) : TPhysDbError;
var
FFError : TffResult;
I : integer;
ReadRecOffset : integer;
BoolValue : Bool;
DoubleValue : Double;
SingleValue : Single; {!!.02}
CompValue : Comp; {!!.02}
ExtendedValue : Extended; {!!.02}
CurrencyValue : Currency; {!!.02}
Int16Value : TcrInt16s;
Int32Value : TcrInt32s;
UInt16Value : TcrInt16u;
UInt32Value : TcrInt32u;
DateValue : TDbiDate;
Year : TcrInt16u;
Month, Day : TcrInt16u;
SYear : Integer; {!!.02}
SMonth, SDay : Integer; {!!.02}
TimeValue : TDbiTime;
Millisec : TcrInt16u;
SHours, {!!.02}
SMinutes, {!!.02}
SSeconds : Byte; {!!.02}
HourL,
MinuteL : TcrInt32u;
DateTime : TDateTime; {!!.02}
CrTime : TcrTime;
CrTimeArray : array[1..4] of Byte absolute CrTime;
IsNull : boolean;
FType : TffFieldType; {!!.02}
aByte : Byte; {!!.02}
begin
// AddToLog('FetchReadRecFields');
// AddToLogFmt(' CursorID: [%d]', [HCursor]);
if hCursor = 0 then begin
Result := IDAPIError(DBIERR_NOTINITIALIZED, ErrMsg);
Exit;
end;
Result := errPhysDbNoError;
{ Translate and copy fields requested by Database Manager to read
record buffer. }
for I := 0 to pred(ReadInfo^.NFieldsInReadRecord) do begin
with ReadInfo^.FieldInfo^[I] do begin
ReadRecOffset := OffsetInRecord;
case NativeFieldType of
fldZSTRING:
begin
FType := TFFProxyCursor(HCursor).Dictionary.FieldType[FieldNo];
if (FType = fftNullString) or
(FType = fftNullAnsiStr) or {!!.02}
(FType = fftChar) then begin {!!.02}
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@ReadRecordBuf^[ReadRecOffset]);
// AddToLogFmt(' read Null String field: [%s]',
// [PChar(@ReadRecordBuf^[ReadRecOffset])]);
end
else if (FType = fftWideChar) or {!!.02}
(FType = fftWideString) then {!!.02}
ShowMessage('Widestring types not supported') {!!.02}
else begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@ReadRecordBuf^[Pred(ReadRecOffset)]);
// AddToLogFmt(' read String field: [%s]',
// [PChar(@ReadRecordBuf^[Pred(ReadRecOffset)])]);
end;
ReadNullFlags^[I] := IsNull;
if not NotXlateDOSString then
OemToAnsi(@ReadRecordBuf^[ReadRecOffset],
@ReadRecordBuf^[ReadRecOffset]);
TrimStrR(@ReadRecordBuf^[ReadRecOffset]);
end;
fldBOOL:
begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@BoolValue);
if IsNull then
ReadNullFlags^[I] := true
else begin
ReadNullFlags^[I] := false;
PcrBoolean(@ReadRecordBuf^[ReadRecOffset])^ := BoolValue;
end;
// AddToLogFmt(' read Bool field: [%s]',
// [BoolToStr(BoolValue)]);
end;
fldFLOAT,
fldstMONEY:
begin
FType := TFFProxyCursor(HCursor).Dictionary.FieldType[FieldNo];{begin !!.02}
case FType of
fftSingle :
begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@SingleValue);
DoubleValue := SingleValue;
end;
fftComp :
begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@CompValue);
DoubleValue := CompValue;
end;
fftExtended :
begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@ExtendedValue);
DoubleValue := ExtendedValue;
end;
fftCurrency :
begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@CurrencyValue);
DoubleValue := CurrencyValue;
end;
else
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@DoubleValue);
end; {end !!.02}
if IsNull then
ReadNullFlags^[I] := true
else begin
ReadNullFlags^[I] := false;
PcrNumber(@ReadRecordBuf^[ReadRecOffset])^ :=
DoubleToNumber(DoubleValue);
end;
end;
fldINT16:
begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@Int16Value);
if IsNull then
ReadNullFlags^[I] := true
else begin
ReadNullFlags^[I] := false;
PcrInt16s(@ReadRecordBuf^[ReadRecOffset])^ := Int16Value;
end;
end;
fldINT32:
begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@Int32Value);
if IsNull then
ReadNullFlags^[I] := true
else begin
ReadNullFlags^[I] := false;
PcrInt32s(@ReadRecordBuf^[ReadRecOffset])^ := Int32Value;
end;
end;
fldUINT16:
begin
FType := TFFProxyCursor(HCursor).Dictionary.FieldType[FieldNo]; {begin !!.02}
if FType <> fftByte then
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@UInt16Value)
else begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@aByte);
UInt16Value := aByte;
end; {end !!.02}
if IsNull then
ReadNullFlags^[I] := true
else begin
ReadNullFlags^[I] := false;
PcrInt16u(@ReadRecordBuf^[ReadRecOffset])^ := UInt16Value;
end;
end;
fldUINT32:
begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@UInt32Value);
if IsNull then
ReadNullFlags^[I] := true
else begin
ReadNullFlags^[I] := false;
PcrInt32s(@ReadRecordBuf^[ReadRecOffset])^ := UInt32Value;
end;
end;
fldDATE:
begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@DateValue);
if IsNull then
ReadNullFlags^[I] := true
else begin
ReadNullFlags^[I] := false;
FType := TFFProxyCursor(HCursor).Dictionary.FieldType[FieldNo]; {begin !!.02}
if FType = fftStDate then begin
StDateToDMY(TStDate(DateValue), SDay, SMonth, SYear);
Day := SDay;
Month := SMonth;
Year := SYear;
end else
FFBDEDateDecode(DateValue, Day, Month, Year); {end !!.02}
PcrDate(@ReadRecordBuf^[ReadRecOffset])^ :=
YearMonthDayToCrDate(Year, Month, Day);
end;
end;
fldTIME:
begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@TimeValue);
if IsNull then
ReadNullFlags^[I] := true
else begin
ReadNullFlags^[I] := false;
StTimeToHMS(TimeValue, SHours, SMinutes, SSeconds); {begin !!.02}
HourL := SHours;
MinuteL := SMinutes;
Millisec := SSeconds * 1000;
{ Compute Brahma time (number of hundredths of seconds) }
CrTime := (HourL * 360000 + MinuteL * 6000 + (Millisec div 10)) div 100; {end !!.02}
PcrTime(@ReadRecordBuf^[ReadRecOffset])^ := CrTime;
end;
end;
fldTIMESTAMP:
begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo, {begin !!.02}
ReadInfo^.PhysRecordBuf,
IsNull,
@DateTime);
StrPCopy(PChar(@ReadRecordBuf^[ReadRecOffset]),
FormatDateTime('yyyy/mm/dd hh:nn:zz', DateTime - 693594.0)); {end !!.02}
end;
fldBCD:
begin
ShowMessage('BCD datatypes not supported');
end;
fldBLOB,
fldstMEMO,
fldstFMTMEMO,
fldstBINARY,
fldstOLEOBJ,
fldstGRAPHIC,
fldstTYPEDBINARY:
begin
(*
{ Check the unstable bookmark }
FFError := DbiGetCursorProps(HCursor, CursorProps);
if not CursorProps.bBookMarkStable then begin
Result := IDAPIError(90, ErrMsg); { 90? }
Exit;
end;
{ Check any primary index, sometimes bBookMarkStable doesn't work }
HasPrimaryIndex := False;
for IndexN := 0 to CursorProps.iIndexes do begin
DbiGetIndexDesc(HCursor, IndexN + 1, IndexDesc);
if IndexDesc.bPrimary = True then begin
HasPrimaryIndex := True;
Break;
end;
end;
(*
if not HasPrimaryIndex then begin
Result := IDAPIError(90, ErrMsg);
Exit;
end;
*)
{ Save the field info and RecNo for memo read. }
PcrInt16u(@ReadRecordBuf^[ReadRecOffset])^:= FieldNo;
FFError := ServerEngine.CursorGetBookmark(HCursor,
@ReadRecordBuf^[ReadRecOffset + SizeOf(TcrInt16u)]);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
end;
else
Break;
end;
end;
end;
end;
{ Copy fields (without translating) requested by Database Manager to
index record buffer. }
function FetchIndexRecFields(
ReadInfo : PPhysDbReadInfo;
HCursor : TffCursorID;
IndexRecordBuf : PByteArray;
IndexNullFlags : PcrBooleanArray;
ErrMsg : PAnsiChar) : TPhysDbError;
var
I : integer;
IsNull : Boolean;
begin
// AddToLog('FetchIndexRecFields');
// AddToLogFmt(' CursorID: [%d]', [HCursor]);
// AddToLogFmt(' Field count: [%d]', [ReadInfo^.NFieldsInIndexRecord]);
Result := errPhysDbNoError;
for I := 0 to pred(ReadInfo^.NFieldsInIndexRecord) do begin
IndexNullFlags^[I] := false;
// AddToLogFmt(' Field: [%d]', [ReadInfo^.IndexFieldInfo^[I].FieldNo]);
with ReadInfo^.IndexFieldInfo^[I] do begin
TFFProxyCursor(HCursor).Dictionary.GetRecordField(FieldNo,
ReadInfo^.PhysRecordBuf,
IsNull,
@IndexRecordBuf^[OffsetInRecord]);
IndexNullFlags^[I] := IsNull;
end;
end;
end;
function ReadFlatRecordVer15(
FileHandle: PPhysDbFileHandle;
ReadRecordBuf: PByteArray;
ReadNullFlags: PcrBooleanArray;
IndexRecordBuf: PByteArray;
IndexNullFlags: PcrBooleanArray;
var RecordRead: TcrBoolean;
ErrMsg: PAnsiChar) : TPhysDbError;
var
NRecordsSkipped : TcrInt32u;
FFError : TffResult;
begin
AddToLog('ReadFlatRecordVer15');
AddToLogFmt(' FName: [%s]', [FileHandle^.PathAndFileName]);
AddToLogFmt(' CursorID: [%d]', [FileHandle^.CursorID]);
Result := errPhysDbNoError;
try
if FileHandle^.ReadInfo^.CurrentRecord > 0 then begin
FileHandle^.ReadInfo^.CurrentRecord := 0;
{ Position at the first record of file for subsequent reading }
FFError := ServerEngine.CursorSetToBegin(FileHandle^.CursorID);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
end;
Result := ReadNextRecurringRecordVer15(
FileHandle,
ReadRecordBuf,
ReadNullFlags,
IndexRecordBuf,
IndexNullFlags,
RecordRead,
NRecordsSkipped,
ErrMsg);
except
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function ReadNextRecurringRecordVer15(
FileHandle: PPhysDbFileHandle;
ReadRecordBuf: PByteArray;
ReadNullFlags: PcrBooleanArray;
IndexRecordBuf: PByteArray;
IndexNullFlags: PcrBooleanArray;
var RecordRead: TcrBoolean;
var NRecordsSkipped: LongInt;
ErrMsg: PAnsiChar) : TPhysDbError;
function RecordWithinRange(
FileHandle: PPhysDbFileHandle;
StopHere: Boolean;
ErrMsg: PAnsiChar) : TPhysDbError;
var
RangeFieldInfo : TPhysDbReadFieldInfo;
RangeN : integer;
StopKeyOffset : integer;
KeyBuf : Pointer;
StopKeyBuf : PAnsiChar;
NullField : Boolean;
function TestRangeLimitForOneField(
KeyBuf : PAnsiChar;
IndexCaseSensitive,
AscendingIndex : TcrBoolean;
var StopHere : Boolean) : TPhysDbError;
var
SaveKeyCh : AnsiChar;
SaveStopKeyCh : AnsiChar;
CompResult : Integer;
MinLen : Integer;
DateKey,
StopDate : TDbiDate;
ShortKey,
StopShort : TcrInt16s;
LongKey,
StopLong : TcrInt32s;
DoubleKey,
StopDouble : Double;
StopKeyLen : TcrInt16u;
Evaluate : Boolean;
begin
Result := errPhysDbNoError;
StopHere := False;
Evaluate := True;
CompResult := 0;
case RangeFieldInfo.NativeFieldType of
fldZSTRING:
begin
StopKeyLen := StrLen(StopKeyBuf);
if RangeFieldInfo.NBytesInNativeField > StopKeyLen then
MinLen := StopKeyLen
else
MinLen := RangeFieldInfo.NBytesInNativeField;
SaveKeyCh := KeyBuf[MinLen];
KeyBuf[MinLen] := #0;
SaveStopKeyCh := StopKeyBuf[RangeFieldInfo.NBytesInNativeField];
StopKeyBuf[RangeFieldInfo.NBytesInNativeField] := #0;
if IndexCaseSensitive then
CompResult := StrComp(KeyBuf, StopKeyBuf)
else
CompResult := StrIComp(KeyBuf, StopKeyBuf);
KeyBuf[MinLen] := SaveKeyCh;
StopKeyBuf[RangeFieldInfo.NBytesInNativeField] := SaveStopKeyCh;
end;
fldDATE:
begin
DateKey := PDbiDate(KeyBuf)^;
StopDate := PDbiDate(StopKeyBuf)^;
CompResult := -1;
if DateKey = StopDate then CompResult := 0
else if DateKey > StopDate then CompResult := 1;
end;
fldINT16:
begin
ShortKey := PcrInt16s(KeyBuf)^;
StopShort := PcrInt16s(StopKeyBuf)^;
CompResult := -1;
if ShortKey = StopShort then CompResult := 0
else if ShortKey > StopShort then CompResult := 1;
end;
fldINT32:
begin
LongKey := PcrInt32s(KeyBuf)^;
StopLong := PcrInt32s(StopKeyBuf)^;
CompResult := -1;
if LongKey = StopLong then CompResult := 0
else if LongKey > StopLong then CompResult := 1;
end;
fldFLOAT,
fldstMONEY:
begin
DoubleKey := PDouble(KeyBuf)^;
StopDouble := PDouble(StopKeyBuf)^;
CompResult := -1;
if DoubleKey = StopDouble then CompResult := 0
else if DoubleKey > StopDouble then CompResult := 1;
end;
fldTIME:
begin
{}
end;
fldBOOL:
begin
Evaluate := False;
if TcrBoolean(StopKeyBuf^) then
if TcrBoolean(KeyBuf^) then
StopHere := False
else
StopHere := True
else
if TcrBoolean(KeyBuf^) then
StopHere := True
else
StopHere := False;
end;
else
begin
Result := errPhysDbProgrammingError;
Exit;
end;
end;
if Evaluate then begin
if RangeFieldInfo.StopInclusive then
if AscendingIndex then
StopHere := (CompResult > 0)
else
StopHere := (CompResult < 0)
else
if AscendingIndex then
StopHere := (CompResult >= 0)
else
StopHere := (CompResult <= 0);
end;
end;
begin
Result := errPhysDbNoError;
if FileHandle^.ReadInfo^.StopKeyLen = 0 then Exit;
{ Loop through all the range fields for the current index }
for RangeN := 0 to pred(FileHandle^.ReadInfo^.NStopKeyRanges) do begin
RangeFieldInfo := FileHandle^.ReadInfo^.RangeFieldInfo^[RangeN];
StopHere := False;
{ KeyBuf points to the values from the current current.
stopKeyBuf points to the values that define the end of the range. }
StopKeyOffset := RangeFieldInfo.OffsetInStopKeyBuf;
KeyBuf := Addr(FileHandle^.ReadInfo^.KeyBuf[StopKeyOffset]);
StopKeyBuf := Addr(FileHandle^.ReadInfo^.StopKeyBuf[StopKeyOffset]);
{ Get the range value values out of the current record and into
the comparison buffer in their native format. }
TFFProxyCursor(FileHandle^.CursorID).Dictionary.GetRecordField(RangeFieldInfo.FieldNo,
FileHandle^.ReadInfo^.PhysRecordBuf,
NullField,
KeyBuf);
if NullField then
Continue;
{ Test this record for out of range on the current range field }
Result := TestRangeLimitForOneField(
KeyBuf,
FileHandle^.ReadInfo^.IndexCaseSensitive,
FileHandle^.ReadInfo^.AscendingIndex,
StopHere);
if Result <> errPhysDbNoError then Exit;
{ Once we've found a field with an out of range value, we needn't look
at the remaining range fields }
if StopHere then
Break;
end;
end;
var
FFError : TffResult;
StopHere : Boolean;
Buffer : TffShStr;
begin
// AddToLog('ReadNextRecurringRecordVer15');
// AddToLogFmt(' FName: [%s]', [FileHandle^.PathAndFileName]);
// AddToLogFmt(' CursorID: [%d]', [FileHandle^.CursorID]);
Result := errPhysDbNoError;
try
try
RecordRead := false;
NRecordsSkipped := 0;
while not RecordRead do begin
{ Advance to the next recurring record, skipping if it is locked
or deleted by another user }
FFError := ServerEngine.RecordGetNext(FileHandle^.CursorID,
ffltNoLock,
nil);
if (FFError = DBIERR_RECDELETED) or (FFError = DBIERR_RECNOTFOUND) then begin
Inc(FileHandle^.ReadInfo^.CurrentRecord);
Inc(NRecordsSkipped);
Continue; { Try the next record }
end;
if FFError = DBIERR_EOF then
Exit;
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
FFError := ServerEngine.RecordGet(FileHandle^.CursorID,
ffltNoLock,
FileHandle^.ReadInfo^.PhysRecordBuf);
if FFError = DBIERR_NONE then begin
{ Test if index fields still in range. If in range, break, else return }
if FileHandle^.RangeLimit then begin
StopHere := False;
if RecordWithinRange(FileHandle, StopHere, ErrMsg) <> errPhysDbNoError then
Break;
if StopHere then
Exit;
end;
RecordRead := true;
Inc(FileHandle^.ReadInfo^.CurrentRecord);
end
else begin
if (FileHandle^.ReadInfo^.CurrentRecord > 0) and
((FFError = DBIERR_RECDELETED) or (FFError = DBIERR_RECNOTFOUND)) then
Inc(NRecordsSkipped)
else begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
end;
end;
Result := FetchReadRecFields(FileHandle^.ReadInfo, FileHandle^.CursorID,
FileHandle^.NotXlateDOSString, ReadRecordBuf, ReadNullFlags, ErrMsg);
if Result <> errPhysDbNoError then Exit;
RecordRead := true;
Result := FetchIndexRecFields(FileHandle^.ReadInfo, FileHandle^.CursorID,
IndexRecordBuf, IndexNullFlags, ErrMsg);
except
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
finally
Buffer := PhysDbErrors[Result]; { this seems necessary for 32-bit }
end;
end;
function LookupMatchingRecurringRecVer15(
FileHandle: PPhysDbFileHandle;
LookupValueRecordBuf: PAnsiChar;
LookupValueNullFlags: PcrBooleanArray;
LookupValueType: TcrInt16u;
StartTopOfFile: TcrBoolean;
ReadRecordBuf: PByteArray;
ReadNullFlags: PcrBooleanArray;
IndexRecordBuf: PByteArray;
IndexNullFlags: PcrBooleanArray;
var RecordRead: TcrBoolean;
ErrMsg: PAnsiChar) : TPhysDbError;
function CompareLookupResult(
FileHandle : PPhysDbFileHandle;
LookupValueRecordBuf : PAnsiChar;
LookupValueNullFlags : PcrBooleanArray;
var Match : Boolean;
ErrMsg : PAnsiChar) : TPhysDbError;
var
FFError : TffResult;
I : integer;
FieldNo : integer;
LookupOffset : integer;
LookupValueLen : DWORD;
FieldLen : integer;
CompareLen : DWORD;
NFields : integer;
LookupNullFlag : Boolean;
NullField : Boolean;
begin
Result := errPhysDbNoError;
Match := False;
{ Ensure that fields are in system buffer }
FFError := ServerEngine.RecordGet(FileHandle^.CursorID,
ffltNoLock,
FileHandle^.ReadInfo^.PhysRecordBuf);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
{ Fetch fields from system record buffer }
NFields := FileHandle^.ReadInfo^.NFieldsInLookupValue;
LookupNullFlag := False;
if NFields > 0 then
LookupNullFlag := LookupValueNullFlags^[0];
for I := 0 to pred(NFields) do begin
FieldNo := FileHandle^.ReadInfo^.IndexDefnInfo^[I].FieldNo;
LookupOffset := FileHandle^.ReadInfo^.IndexDefnInfo^[I].OffsetInRecord;
FieldLen := FileHandle^.ReadInfo^.IndexDefnInfo^[I].FieldLength;
NullField := False;
TFFProxyCursor(FileHandle^.CursorID).Dictionary.GetRecordField(FieldNo,
FileHandle^.ReadInfo^.PhysRecordBuf,
NullField,
@FileHandle^.ReadInfo^.KeyBuf[LookupOffset]);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
if LookupNullFlag or NullField then Exit;
{ Compare each individual field to see if matches lookup value.
Only compare as much data as present if substring field }
CompareLen := FieldLen;
if FileHandle^.ReadInfo^.LookupValueLen < (LookupOffset + FieldLen) then
CompareLen := FileHandle^.ReadInfo^.LookupValueLen - LookupOffset;
if FileHandle^.ReadInfo^.IndexDefnInfo^[I].FieldType = ftStringField then begin
LookupValueLen := StrLen(@LookupValueRecordBuf[LookupOffset]);
if LookupValueLen < CompareLen then begin
if I = NFields - 1 then begin
if FileHandle^.ReadInfo^.LastLookupFieldIsSubstr then
CompareLen := LookupValueLen
else if LookupValueLen <> StrLen(@FileHandle^.ReadInfo^.KeyBuf[LookupOffset]) then
Exit
else
CompareLen := LookupValueLen;
end;
end;
end;
(* if FileHandle^.ReadInfo^.IndexCaseSensitive then begin*)
if (CompareLen = 0) or (FFCmpBytes(PffByteArray(@FileHandle^.ReadInfo^.KeyBuf[LookupOffset]),
PffByteArray(@LookupValueRecordBuf[LookupOffset]),
CompareLen) <> 0) then begin
Exit;
end;
end;
Match := True;
end;
var
FFError : TffResult;
Match : Boolean;
I : integer;
FieldN : integer;
NFields : integer;
LookupNullFlag : Boolean;
begin
AddToLog('LookupMatchingRecurringRecVer15');
AddToLogFmt(' FileName: [%s]', [FileHandle^.PathAndFileName]);
AddToLogFmt(' CursorID: [%d]', [FileHandle^.CursorID]);
Result := errPhysDbNoError;
try
{ Set up for search }
RecordRead := false;
with FileHandle^.ReadInfo^ do begin
if not StartTopOfFile then begin
AddToLog(' StartTopOfFile [False]');
if ValuesUnique and
not LastLookupFieldIsSubstr and
(NFieldsInLookupValue > NFieldsInIndexDefn) then
Exit;
{ See if next record also matches }
FFError := ServerEngine.RecordGetNext(FileHandle^.CursorID,
ffltNoLock,
nil);
AddToLogFmt(' RecordGetNext Result [%d]', [FFError]);
if FFError <> DBIERR_NONE then
Exit;
Result := CompareLookupResult(FileHandle,
LookupValueRecordBuf,
LookupValueNullFlags,
Match,
ErrMsg);
AddToLogFmt(' Match Result [%s]', [BoolToStr(Match)]); {!!.12}
if (Result <> errPhysDbNoError) or not Match then Exit;
end else begin
AddToLog(' StartTopOfFile [True]');
{ Clear all the fields in index }
for FieldN := 0 to pred(NFieldsInIndexDefn) do begin
TFFProxyCursor(FileHandle^.CursorID).Dictionary.SetRecordField(
IndexDefnInfo^[FieldN].FieldNo,
PhysRecordBuf,
nil);
end;
{ Copy fields (without translating) from lookup value buffer to
system record buffer }
NFields := NFieldsInLookupValue;
LookupNullFlag := False;
if NFields > 0 then
LookupNullFlag := LookupValueNullFlags^[0];
FillChar(PhysRecordBuf^, NBytesInPhysRecord, #0);
for I := 0 to pred(NFields) do begin
if not LookupNullFlag then begin
{ Copy index record field into system record buffer }
with IndexDefnInfo^[I] do
TFFProxyCursor(FileHandle^.CursorID).Dictionary.SetRecordField(
FieldNo,
PhysRecordBuf,
@LookupValueRecordBuf[OffsetInRecord]);
end;
end;
with TFFProxyCursor(FileHandle^.CursorID) do
Dictionary.ExtractKey(IndexID, PhysRecordBuf, @KeyBuf);
FFError := ServerEngine.CursorSetToKey(FileHandle^.CursorID,
skaEqual,
True,
NFieldsInLookupValue,
LastLookupFieldLen,
@KeyBuf);
AddToLogFmt(' CursorSetToKey Result [%d]', [FFError]);
{ Test if exact lookup succeeeded }
if (FFError = DBIERR_EOF) or
(FFError = DBIERR_OUTOFRANGE) or
(FFError = DBIERR_RECNOTFOUND) or
(FFError = DBIERR_RECDELETED) then begin
Result := errPhysDbNoError;
Exit;
end
else if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
{ read in the current record }
FFError := ServerEngine.RecordGetNext(FileHandle^.CursorID,
ffltNoLock,
FileHandle^.ReadInfo^.PhysRecordBuf);
AddToLogFmt(' RecordGetNext Result here [%d]', [FFError]);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
end;
Result := FetchReadRecFields(FileHandle^.ReadInfo,
FileHandle^.CursorID,
FileHandle^.NotXlateDOSString,
ReadRecordBuf,
ReadNullFlags,
ErrMsg);
if Result <> errPhysDbNoError then Exit;
RecordRead := true;
Result := FetchIndexRecFields(FileHandle^.ReadInfo,
FileHandle^.CursorID,
IndexRecordBuf,
IndexNullFlags,
ErrMsg);
end;
except
on EOutOfMemory do begin
Result := errPhysDbNotEnoughMemory;
StrPCopy(ErrMsg, '');
end;
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
{ ------------------------- Memo Fields ---------------------------- }
function FetchMemoField(
MemoFieldRecordBuf: PAnsiChar;
var MemoField: PAnsiChar;
ErrMsg: PAnsiChar) : TPhysDbError;
begin
AddToLog('FetchMemoField');
MemoField := nil;
Result := errPhysDbNoError;
AddResultToLog(Result);
end;
function FreeMemoField(
var MemoField: PAnsiChar;
ErrMsg: PAnsiChar) : TPhysDbError;
begin
AddToLog('FreeMemoField');
FFStrDispose(MemoField);
MemoField := nil;
Result := errPhysDbNoError;
AddResultToLog(Result);
end;
function FetchPersistentMemoField(FileHandle : PPhysDbFileHandle;
MemoFieldRecordBuf : PAnsiChar;
var MemoField : PAnsiChar;
ErrMsg : PAnsiChar) : TPhysDbError;
var
FFError : TffResult;
NativeType : TcrInt16u;
FieldN : integer;
FieldNo : integer;
ValueType : TFieldValueType;
CmpResult : Integer;
BlobSize : TcrInt32u;
NBytesReturned : TffWord32;
BlobHandle : THandle;
Handle : THandle;
BlobFieldPtr : PByteArray;
FinalBlobFieldPtr : PByteArray;
Size : TcrInt32u;
SavedBlobSize : TcrInt32u;
FirstTime : Boolean;
Offset : TcrInt32u;
NBytesCopied : TcrInt32u;
StartPos : TcrInt32u;
BookmarkSize : Integer;
IsNull : Boolean;
aBlobNr : TffInt64;
TempI64 : TffInt64;
BookmarkBuf : Pointer;
begin
AddToLog('FetchPersistentMemoField');
AddBlockToLog(' Memo Data', MemoFieldRecordBuf, 12);
Result := errPhysDbNoError;
MemoField := nil;
try
try
{ Restore the field info from brahma buffer }
FieldNo := TcrInt16s(MemoFieldRecordBuf^);
ValueType := ftPersistentMemoField;
NativeType := 0;
with FileHandle^.ReadInfo^ do
for FieldN := 0 to pred(NFieldsInReadRecord) do begin
if FieldInfo^[FieldN].FieldNo = FieldNo then begin
NativeType := FieldInfo^[FieldN].NativeFieldType;
if FieldInfo^[FieldN].FieldType = ftBlobField then
ValueType := ftBlobField;
end;
end;
{ Get the current bookmark }
FFError := ServerEngine.CursorGetBookmarkSize(FileHandle^.CursorID, BookmarkSize);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
FFGetMem(BookmarkBuf, BookmarkSize + 1);
try
FFError := ServerEngine.CursorGetBookmark(FileHandle^.CursorID,
BookmarkBuf);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
ServerEngine.CursorCompareBookmarks(FileHandle^.CursorID,
BookmarkBuf,
@MemoFieldRecordBuf[SizeOf(TcrInt16u)],
CmpResult);
finally
FFFreeMem(BookmarkBuf, BookmarkSize+1);
end;
{ If it is not the current position, reposition to the old position }
if CmpResult <> 0 then begin
FFError := ServerEngine.CursorSetToBookmark(FileHandle^.CursorID,
@MemoFieldRecordBuf[SizeOf(TcrInt16u)]);
if FFError = DBIERR_NONE then
FFError := ServerEngine.RecordGet(FileHandle^.CursorID,
ffltNoLock,
FileHandle^.ReadInfo^.PhysRecordBuf);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
end;
TempI64.iLow := 0;
TempI64.iHigh := 0;
TFFProxyCursor(FileHandle^.CursorID).Dictionary.GetRecordField(
FieldNo, FileHandle^.ReadInfo^.PhysRecordBuf, IsNull, @aBLOBNr);
if (not IsNull) and (ffCmpI64(aBLOBNr, TempI64) = 0) then
FFError := DBIERR_INVALIDBLOBHANDLE
else
FFError := DBIERR_NONE;
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
if not IsNull then begin {!!.02}
try
FFError := ServerEngine.BLOBGetLength(FileHandle^.CursorID,
aBlobNr,
BlobSize);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
if BlobSize = 0 then
Exit;
if ValueType = ftPersistentMemoField then begin
{Handle only 64K memos for now }
BlobSize := BlobSize;
Handle := GlobalAlloc(GHND or GMEM_SHARE, BlobSize);
if Handle = 0 then
raise EOutOfMemory.Create('');
try
BlobHandle := GlobalAlloc(GHND or GMEM_SHARE, BlobSize + 1);
BlobFieldPtr := GlobalLock(Handle);
try
if Assigned(BlobFieldPtr) then begin
FinalBlobFieldPtr := GlobalLock(BlobHandle);
try
FFError := ServerEngine.BLOBRead(FileHandle^.CursorID,
aBlobNr,
0,
BlobSize,
BlobFieldPtr^,
NBytesReturned);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
if NativeType = fldstFMTMEMO then begin
if BlobSize > 44 then begin
if StrLComp(PAnsiChar(BlobFieldPtr), #1#0#0#0#$C7#0#0#0, 8) = 0 then begin
Move(BlobFieldPtr^[8], FinalBlobFieldPtr^, BlobSize - 8);
FinalBlobFieldPtr[NBytesReturned - 8] := $0;
end else begin
Move(BlobFieldPtr^[44], FinalBlobFieldPtr^, BlobSize - 44);
FinalBlobFieldPtr[NBytesReturned - 44] := $0;
end;
end else begin
Move(BlobFieldPtr^, FinalBlobFieldPtr^, BlobSize);
FinalBlobFieldPtr[NBytesReturned] := $0;
end;
end else begin
Move(BlobFieldPtr^, FinalBlobFieldPtr^, BlobSize);
FinalBlobFieldPtr[NBytesReturned] := $0;
end;
if not FileHandle^.NotXlateDOSMemo then
OemToAnsi(PAnsiChar(FinalBlobFieldPtr), PAnsiChar(FinalBlobFieldPtr));
MemoField := PAnsiChar(FinalBlobFieldPtr);
finally
GlobalUnlock(BlobHandle);
end;
end;
finally
GlobalUnlock(Handle)
end;
finally
GlobalFree(Handle);
end;
end else begin
{ Nonmemo BLOB, may be a bitmap }
Handle := GlobalAlloc(GHND or GMEM_SHARE, BlobSize);
if Handle = 0 then
raise EOutOfMemory.Create('');
try
if NativeType = fldstBINARY then
{ No BLOB_INFO }
BlobHandle := GlobalAlloc(GHND or GMEM_SHARE, BlobSize - SizeOf(TBitmapFileHeader))
else
BlobHandle := GlobalAlloc(GHND or GMEM_SHARE, BlobSize - BLOB_INFO_SIZE - SizeOf(TBitmapFileHeader));
BlobFieldPtr := GlobalLock(Handle);
try
if Assigned(BlobFieldPtr) then begin
FinalBlobFieldPtr := GlobalLock(BlobHandle);
try
NBytesReturned := 0;
SavedBlobSize := BlobSize;
Size := FFMinDW(SavedBlobSize, $FFE0);
FirstTime := True;
Offset := 0;
NBytesCopied := 0;
while Size <> 0 do begin
FFError := ServerEngine.BLOBRead(FileHandle^.CursorID,
aBlobNr,
Offset,
Size,
BlobFieldPtr^,
NBytesReturned);
if FFError <> DBIERR_NONE then begin
Result := IDAPIError(FFError, ErrMsg);
Exit;
end;
Inc(Offset, NBytesReturned);
Dec(SavedBlobSize, NBytesReturned);
StartPos := 0;
if FirstTime then begin
if NativeType <> fldstBINARY then
Inc(StartPos, BLOB_INFO_SIZE);
{ If it is not a bitmap, return nil }
if Copy(StrPas(PAnsiChar(@BlobFieldPtr^[StartPos])), 1 ,2) <> 'BM' then
Exit;
Inc(StartPos, SizeOf(TBitmapFileHeader));
end;
{ Copy the bitmap data of size FFE0 or less depending on the size
of whole bitmap }
Move(BlobFieldPtr^[StartPos], FinalBlobFieldPtr^[NBytesCopied], Size - StartPos);
Inc(NBytesCopied, Size - StartPos);
{ The size of data to be got }
Size := FFMinDW(SavedBlobSize, $FFE0);
FirstTime := False
end;
finally
GlobalUnlock(BlobHandle);
end;
end;
finally
GlobalUnlock(Handle);
end;
finally
GlobalFree(Handle);
end;
{ Pass back the handle to the bitmap to Crystal. Allegedly, Crystal
will handle freeing it }
MemoField := PAnsiChar(BlobHandle);
end;
finally
ServerEngine.BLOBFree(FileHandle^.CursorID,
aBlobNr,
True);
end;
end; {!!.02}
except
on EOutOfMemory do begin
Result := errPhysDbNotEnoughMemory;
StrPCopy(ErrMsg, '');
end;
on E: Exception do begin
if Result = errPhysDbNoError then
Result := errPhysDbErrMsgReturned;
StrPCopy(ErrMsg, E.Message);
end;
end;
finally
StrPCopy(DebugBuff, PhysDbErrors[Result]); { this seems necessary for 32-bit }
end;
if (Result = errPhysDbErrMsgReturned) then
AddToLogFmt(' ErrMsg: [%s]', [ErrMsg]);
AddResultToLog(Result);
end;
function FreePersistentMemoField(
FileHandle: PPhysDbFileHandle;
var MemoField: PAnsiChar;
ErrMsg: PAnsiChar) : TPhysDbError;
begin
AddToLog('FreePersistentMemoField');
GlobalFree(THandle(MemoField));
MemoField := nil;
Result := errPhysDbNoError;
AddResultToLog(Result);
end;
{ --------------------- Multi-User Access -------------------------- }
function UseRecordLocking(FileHandle : PPhysDbFileHandle;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('UseRecordLocking');
Result := errPhysDbNotImplemented;
AddResultToLog(Result);
end;
function UseFileLocking(FileHandle : PPhysDbFileHandle;
ErrMsg : PAnsiChar) : TPhysDbError;
begin
AddToLog('UseFileLocking');
Result := errPhysDbNotImplemented;
AddResultToLog(Result);
end;
{===Debug logging====================================================}
{Begin !!.12}
procedure StartLog;
begin
{$IFDEF Debug}
Log := TffEventLog.Create(nil);
Log.FileName := FFMakeFullFileName(FFExtractPath(FFGetExeName), 'FFDRIVER.LOG');
Log.Enabled := True;
Log.WriteString('FF server log started');
{$ELSE}
Log := nil;
{$ENDIF}
end;
{--------}
procedure EndLog;
begin
if Log <> nil then
Log.Free;
end;
{--------}
procedure AddToLog(const S : string);
begin
if Log <> nil then
Log.WriteString(S);
end;
{--------}
procedure AddToLogFmt(const S : string; args : array of const);
begin
if Log <> nil then
Log.WriteStringFmt(S, args);
end;
{--------}
procedure AddBlockToLog(const S : string; Buf : pointer; BufLen : TffMemSize);
begin
if Log <> nil then
Log.WriteBlock(S, Buf, BufLen);
end;
{--------}
procedure AddResultToLog(aResult : TPhysDbError);
{$IFDEF Debug}
var
S : string;
{$ENDIF}
begin
{$IFDEF Debug}
case aResult of
errPhysDbNoError : S := 'errPhysDbNoError';
errPhysDbErrMsgReturned : S := 'errPhysDbErrMsgReturned';
errPhysDbNotEnoughMemory : S := 'errPhysDbNotEnoughMemory';
errPhysDbFileDoesNotExist : S := 'errPhysDbFileDoesNotExist';
errPhysDbFilePermissionError : S := 'errPhysDbFilePermissionError';
errPhysDbFileIntegrityError : S := 'errPhysDbFileIntegrityError';
errPhysDbUserCancelOperation : S := 'errPhysDbUserCancelOperation';
errPhysDbProgrammingError : S := 'errPhysDbProgrammingError';
errPhysDbNotImplemented : S := 'errPhysDbNotImplemented';
errPhysDbSQLServerError : S := 'errPhysDbSQLServerError';
errPhysDbIncorrectPassword : S := 'errPhysDbIncorrectPassword';
errPhysDbOpenSessionError : S := 'errPhysDbOpenSessionError';
errPhysDbLogOnServerError : S := 'errPhysDbLogOnServerError';
errPhysDbErrorHandledByDBDLL : S := 'errPhysDbErrorHandledByDBDLL';
errPhysDbStopProceeding : S := 'errPhysDbStopProceeding';
else
S := '***Unknown***';
end;{case}
Log.WriteStringFmt(' Result: %s [%d]', [S, ord(aResult)]);
{$ENDIF}
end;
{End !!.12}
{====================================================================}
procedure UnitEnterProc;
begin
TaskList := TTaskList.Create;
StartLog;
end;
procedure UnitExitProc;
begin
EndLog;
TaskList.Free;
end;
initialization
UnitEnterProc;
finalization
UnitExitProc;
end.
Reference in New Issue View Git Blame Copy Permalink