{ *********************************************************************** }
{                                                                         }
{ Delphi Visual Component Library                                         }
{                                                                         }
{ Copyright (c) 1997-2004 Borland Software Corporation                    }
{                                                                         }
{ *********************************************************************** }

unit Borland.Vcl.DSIntf platform;

{$MINENUMSIZE 4}
{$T-,H+,X+}

interface

uses
  System.Runtime.InteropServices, System.Text,
  Windows, ActiveX, Variants, DB, DBCommon;

{ Guids }

const
  CLSID_DSBase: string   = '9E8D2FA1-591C-11D0-BF52-0020AF32BD64';
  CLSID_DSCursor: string = '9E8D2FA3-591C-11D0-BF52-0020AF32BD64';
  CLSID_DSWriter: string = '9E8D2FA5-591C-11D0-BF52-0020AF32BD64';

  GUID_DSBASE            = '9E8D2FA2-591C-11D0-BF52-0020AF32BD64';
  GUID_DSCursor          = '9E8D2FA4-591C-11D0-BF52-0020AF32BD64';
  GUID_DSWriter          = '9E8D2FA6-591C-11D0-BF52-0020AF32BD64';

{ Record attributes }

  dsRecUnmodified    = $0000;       { Unmodified record }
  dsRecOrg           = $0001;       { Original record (was changed) }
  dsRecDeleted       = $0002;       { Record was deleted }
  dsRecNew           = $0004;       { Record was inserted }
  dsRecModified      = $0008;       { Record was changed }
  dsUnused           = $0020;       { Record not used anymore (hole) }
  dsDetUpd           = $0040;       { Detail modification  Ins/Del/Mod. }
                                    { Can be combined with other status. }
  dsIsNotVisible     = dsRecDeleted or dsRecOrg or dsUnused;
  dsIsVisible        = not (dsRecDeleted or dsRecOrg or dsUnused);

{ Field attributes }

  fldAttrHIDDEN      = $0001;       { Field is hidden }
  fldAttrREADONLY    = $0002;       { Field is readonly }
  fldAttrREQUIRED    = $0004;       { Field value required }
  fldAttrLINK        = $0008;       { Linking field }

  BLANK_NULL         = 1;           { 'real' NULL }
  BLANK_NOTCHANGED   = 2;           { Not changed , compared to original value }

  MAXKEYFIELDS       = 16;

{ Master Detail Semantics DSBase.SetProp(dspropMD_SEMANTICS, Value) }

  mdCASCADEDEL       = $0004;
  mdCASCADEMOD       = $0008;  { Allow master link field to be changed (cascade change to details) }
  mdALLOWLINKCHANGE  = $0010;  { Allow detail linkfields to be changed (fly-away) }

  MIDASPATHLEN       = 261;
  MIDASNAMELEN       = 32;

type
  DBResult           = Word;           { Function result }

  DBSearchCond = (                     { Search condition for keys }
    keySEARCHEQ,                          { = }
    keySEARCHGT,                          { > }
    keySEARCHGEQ                          { >= }
  );

  MIDASNAME          = string; // packed array [0..31] of Char; { holds a name }
  MIDASPATH          = string; // packed array [0..260] of Char; { holds a DOS path }

{ Native Types }

  TDataPacket = IntPtr; { PSafeArray }
  //pDSAttr = ^DSAttr;
  DSAttr = type Byte;

  //phDSFilter = ^hDSFilter;
  hDSFilter = IntPtr;

  GROUPSTATE = (
    grSTATEMIDDLE,                  { Record is neither the first or the last in the group }
    grSTATEFIRST,                   { Record is the first in the group }
    grSTATELAST,                    { Record is the last in the group }
    grSTATEFIRSTLAST
  );

//  phDSAggregate = ^hDSAggregate;
  hDSAggregate = type Integer;

  AGGSTATE = (
    aggSTATEUNDEF,                  { State is undefined. Needs recalc. }
    aggSTATEOK,
    aggSTATEBLANK,                  { This is a blank value }
    aggSTATEERROR                   { An error occurred previously }
  );

  AGGVALUE = packed record
    iCnt      : Integer;            { Count of records in each }
    eAggState : AGGSTATE;           { State of value }
    Value     : IntPtr;             { First byte of value }
  end;

//  pDSBOOKMRK = ^DSBOOKMRK;
  DSBOOKMRK = packed record
    iPos   : Integer;               { Position in given order }
    iState : Integer;               { State of cursor }
    iRecNo : Integer;               { Record number }
    iSeqNo : Integer;               { Version number of order }
    iOrderID : Integer;             { Defines Order }
  end;

//  pSAVEPOINT = ^SAVEPOINT;
  SAVEPOINT = type Integer;

  DSKEY     = array[0..MAXKEYFIELDS - 1] of Integer;
  DSKEYBOOL = array[0..MAXKEYFIELDS - 1] of Integer;  { LongBool }

{ Dataset and Cursor Properties }

  DSProp = (
    dspropLOGCHANGES,               { rw LongBool,   Log changes for undo/delta }
    dspropREADONLY,                 { rw LongBool,   Disable dataset updates }
    dspropNOOFCHANGES,              { r  UINT32, Number of changes }
    dspropCONSTRAINTS_DISABLED,     { rw LongBool,   Disable constraints }
    dspropDSISPARTIAL,              { rw LongBool,   Dataset is parital }
    dspropRECORDSINDS,              { r  UINT32, Records in dataset }
    dspropAUTOINC_DISABLED,         { rw LongBool,   Autoinc disabled }
    dspropISDELTA,                  { r  LongBool,   Dataset is a delta }
    dspropDONTINCLMETADATA,         { rw LongBool,   Exclude metadata in StreamDS }
    dspropINCLBLOBSINDELTA,         { rw UINT32, include blobs with lengths <= than }
                                    { this value in delta for 'original' record }
    dspropGETSAVEPOINT,             { r  SAVEPOINT, return savepoint for current update state. }
    dspropCOMPRESSARRAYS,           { rw LongBool(TRUE), if true expands fielddescriptors for arrays }
    dspropMD_SEMANTICS,             { rw UINT32(0), Master/detail semantics }
    dspropFIELD_FULLNAME,           { r  in: UINT32 (FieldID), out: zstring (full name) }
    dspropFIELDID_FORNAME,          { r  in: zstring(full name), out:UINT32 (fieldid) }
    dspropFIELDID_FORPARENT,        { r  in: UINT32 (FieldID), out: UINT32 (FieldID) }
    dspropCHANGEINDEX_VIEW,         { rw DSAttr (UINT32) (update attributes), any combination, 0->show all }
    dspropGETUNIQUEINDEX,           { r  DSIDX, internal use, returns first unique index, if any }
    dspropREMOTE_UPDATEMODE,        { rw UINT32, 0: where key, 1: where all, 3: where ch }
    dspropXML_STREAMMODE,
    dspropDISABLEDELETES,           { unused }
    dspropDISABLEINSERTS,           { unused }
    dspropDISABLEEDITS,             { unused }
    dspropDISABLESTRINGTRIM,        { rw LongBool: disable automatic trimming of strings }
    dspropDATAHASCHANGED
  );

  CURProp = (
    curpropCONSTRAINT_ERROR_MESSAGE,{ r pCHAR,   Constraint Error Message }
    curpropDSBASE,                  { r pDSBASE, Underlying DSBASE) }
    curpropSETCRACK,                { w Sets crack-value to supplied value (DBERR_NOCURRREC) }
    curpropGETORG_RECBUF            { r returns recordbuffer for original record, error if none }
  );

//  pDSProps = ^DSProps;
  DSProps = packed  record
    [MarshalAs(UnmanagedType.ByValTStr, SizeConst = MIDASPATHLEN)]
    szName           : MIDASPATH;    { Name, if any }
    iFields          : Integer;      { Number of columns }
    iRecBufSize      : Integer;      { Size of record buffer }
    iBookMarkSize    : Integer;      { Size of bookmark }
    bReadOnly        : LongBool;     { Dataset is not updateable }
    iIndexes         : Integer;      { Number of indexes on dataset }
    iOptParams       : Integer;      { Number of optional parameters }
    bDelta           : LongBool;     { This is a delta dataset }
    iLCID            : Integer;      { Language used }
    [MarshalAs(UnmanagedType.ByValArray, SizeConst = 8)]
    iUnused          : packed array[0..7] of Integer; { Reserved }
  end;

{ Field Descriptor }

//  pDSFLDDesc = ^DSFLDDesc;
  DSFLDDesc = packed record
    [MarshalAs(UnmanagedType.ByValTStr, SizeConst = MIDASNAMELEN)]
    szName          : MIDASNAME;    { Field name }
    iFldType        : Integer;      { Field type }
    iFldSubType     : Integer;      { Field subtype (if applicable) }
    iUnits1         : Integer;      { Number of Chars, precision etc }
    iUnits2         : Integer;      { Decimal places etc. }
    iFldLen         : Integer;      { Length in bytes (computed) }
    iFldOffsInRec   : Integer;      { Offset to field  in record buffer }
    iNullOffsInRec  : Integer;      { Offset to null flag (1byte) in record buffer }
    iFieldID        : Word;         { FieldID of this field }
    iFieldIDParent  : Word;         { FieldID of parent, if any (part of ADT or ARRAY) }
    bCalculated     : LongBool;     { Field is Calculated }
    iFldAttr        : Integer;      { Field attributes }
    iOptParameters  : Integer;      { Number of optional parameters for field }
  end;

{  Index descriptor }

//  pDSIDXDesc = ^DSIDXDesc;
  DSIDXDesc = packed record
    [MarshalAs(UnmanagedType.ByValTStr, SizeConst = MIDASNAMELEN)]
    szName    : MIDASNAME;          { IndexName }
    iFields   : Integer;            { Number of fields in order (0 -> base order) }
    [MarshalAs(UnmanagedType.ByValArray, SizeConst = MAXKEYFIELDS)]
    iKeyFields: DSKEY;              { FieldNumbers }
    iKeyLen   : Integer;            { Total length of key (computed) }
    bUnique   : LongBool;
    [MarshalAs(UnmanagedType.ByValArray, SizeConst = MAXKEYFIELDS)]
    bDescending : DSKEYBOOL;        { TRUE ->Descending }
    [MarshalAs(UnmanagedType.ByValArray, SizeConst = MAXKEYFIELDS)]
    bCaseInsensitive : DSKEYBOOL;
  end;

{ Callbacks }

  pfCHANGECallBack = procedure(     { Change Notification callback }
    iClientData  : Integer          { Client data }
  );

  pfDSFilter = function(            { Filter callback }
    iClientData  : Integer;         { Client data }
    pRecBuf      : TRecordBuffer    { Record buffer }
  ): LongBool;

  pfDSCalcField = function(         { Calculated field callback }
    iClientData  : Integer;         { Client data }
    pRecBuf      : TRecordBuffer    { Current record-buffer }
  ): DBResult;

  dsCBRType = Integer;              { Return value for reconcile callback }
//  pdsCBRType = ^dsCBRType;

  pfDSReconcile = function(         { Reconcile callback }
    iClientData   : Integer;        { Client data }
    iRslt         : Integer;        { Result of previous callback }
    iAction       : DSAttr;         { Update request Insert/Modify/Delete }
    iResponse     : dsCBRType;      { Resolver response }
    iErrCode      : Integer;        { Native error-code }
    pErrMessage   : string;         { Native errormessage if any }
    pErrContext   : string;         { 1-level error context, if any }
    pRecUpd       : TRecordBuffer;  { Record that failed update }
    pRecOrg       : TRecordBuffer;  { Original record, if any }
    pRecConflict  : TRecordBuffer   { Conflicting record, if any }
  ): dsCBRType;

  pfDSReconcile_MD = function(
    iClientData   : Integer;
    iRslt         : Integer;        { Result of previous callback. If set, the previuos parameters are repeated. }
    iAction       : DSAttr;         { Update request Insert/Modify/Delete }
    iErrResponse  : dsCBRType;      { Resolver response }
    iErrCode      : Integer;        { Native error-code, (BDE or ..) }
    pErrMessage   : string;         { Native errormessage, if any (otherwise NULL) }
    pErrContext   : string;         { 1-level error context, if any (otherwise NULL) }
    pRecUpd       : TRecordBuffer;  { Record that failed update }
    pRecOrg       : TRecordBuffer;  { Original record, if any }
    pRecConflict  : TRecordBuffer;  { Conflicting error, if any }
    iLevels       : Integer;        { Number of levels to error0level }
    piFieldIDs    : IntPtr          { PInteger - Array of fieldIDS to navigate to error-dataset }
): dsCBRType;

  pfFLDComp = function(             { Field compare callback }
    iClientData  : Integer;         { Client callback data }
    pVal1        : IntPtr;          { Fieldvalue 1 (NULL if blank) }
    pVal2        : IntPtr           { Fieldvalue 2 (NULL if blank) }
  ): Integer;                       { returns -1 if pVal1 < pVal2, }
                                    { 0 if equal, +1 if pVal1 > pVal2 }

{ Resolver & Reconcile callback return values }

const
  dscbrSKIP          = 1;   { Skip this operation (resolver : report error) }
  dscbrABORT         = 2;   { Abort the callback session (reconcile or resolve) }
                            { (resolver : undo all changes). }
  dscbrMERGE         = 3;   { Merge the changes  (resolver : 'simple' merge) }
                            { (reconcile : update original. Keep change). }
  { Resolving only }
  dscbrAPPLY         = 4;   { Overwrite the current record with new values. }
  dscbrIGNORE        = 5;   { Ignore the update request. Don't report error. }

  { Reconcile only }
  dscbrCORRECT       = 4;   { Overwrite change with new values. }
  dscbrCANCEL        = 5;   { Cancel change (remove from delta). }
  dscbrREFRESH       = 6;   { Update original record. Cancel change. }

{ Defines for SetXmlMode/GetXmlMode }

  xmlUNTYPED         =  1;  { Forces XML Data }
  xmlXMLDATATYPED    =  2;  { Not used }
  xmlXMLSCHEMA       =  4;  { Get XML Meta Data }
  xmlXMLUTF8         =  8;  { Encode data using UTF8 }

  xmlON              = xmlXMLSCHEMA or xmlUNTYPED;
  xmlUTF8            = xmlON or xmlXMLUTF8;
  xmlOFF             =  0;


{ Packet Creation }

type
  TPcktAttrArea = (fldAttrArea, pcktAttrArea);
  TPcktFldStatus = (fldIsChanged, fldIsNull, fldIsUnChanged);

//  PDSDataPacketFldDesc = ^TDSDataPacketFldDesc;
  TDSDataPacketFldDesc = packed record
    [MarshalAs(UnmanagedType.ByValTStr, SizeConst = MIDASNAMELEN)]
    szFieldName: MIDASNAME;         { Column Name }
    iFieldType: Integer;            { Column Type }
    iAttributes: Word;              { Column attributes }
  end;

const
{Do not localize }
  szUNIQUE_KEY       = 'UNIQUE_KEY';  { Series of unique keys to enforce on the client }
  szPRIMARY_KEY      = 'PRIMARY_KEY'; { Primary key used in RowRequest and for key information }
  szDEFAULT_ORDER    = 'DEFAULT_ORDER'; { Index used for the default ordering of the dataset }
  szCHANGEINDEX      = 'CHANGEINDEX';
  szCHANGE_LOG       = 'CHANGE_LOG';
  szSERVER_COL       = 'SERVER_COL';
  szCONSTRAINTS      = 'CONSTRAINTS';
  szDATASET_CONTEXT  = 'DATASET_CONTEXT';
  szDATASET_DELTA    = 'DATASET_DELTA';
  szREADONLY         = 'READONLY'; { Specifies the packet is read only }
  szSUBTYPE          = 'SUBTYPE'; { Field Subtype }
  szDECIMALS         = 'DECIMALS'; { Field decimal precision }
  szWIDTH            = 'WIDTH'; { Field width }
  szLCID             = 'LCID'; { Locale ID that the packet comes from }
  szBDEDOMX          = 'BDEDOMAIN_X'; { Server side field constraints }
  szBDERECX          = 'BDERECORD_X'; { Server side record constraints }
  szBDEDEFX          = 'BDEDEFAULT_X'; { Server side default values }
  szAUTOINCVALUE     = 'AUTOINCVALUE';
  szELEMENTS         = 'ELEMENTS';
  szTABLE_NAME       = 'TABLE_NAME'; { Table name used for resolving the packet - deprecated}
  szMD_FIELDLINKS    = 'MD_FIELDLINKS'; { Master detail field relationships }
  szTYPENAME         = 'TYPENAME'; { Field type name.  Used for object fields }
  szUPDATEMODE       = 'UPDATEMODE'; { Update mode }
  szFIELDPROPS       = 'FIELDPROPS'; { Delphi transferable field properties }
  szPROVFLAGS        = 'PROVFLAGS'; { Provider flags }
  szORIGIN           = 'ORIGIN'; { Field origin }
  szMD_SEMANTICS     = 'MD_SEMANTICS'; { Master detail semantic properties }
  szSERVERCALC       = 'SERVER_CALC'; { A server side calculated field }
  szBDEDOMCL         = 'BDEDOMAIN_CL'; { Client side field constraints }
  szBDERECCL         = 'BDERECORD_CL'; { Client side record constraints }
  szBDEDEFCL         = 'BDEDEFAULT_CL'; { Client side default values }
  szDISABLE_INSERTS  = 'DISABLE_INSERTS'; { Disable inserting records }
  szDISABLE_DELETES  = 'DISABLE_DELETES'; { Disable deleting records }
  szDISABLE_EDITS    = 'DISABLE_EDITS'; { Disable editing records }
  szNO_RESET_CALL    = 'NO_RESET_CALL'; { Specifies not to call reset when the client closes the data }
  szMINVALUE         = 'MINVALUE'; { Minimum value for the field }
  szMAXVALUE         = 'MAXVALUE'; { Maximum value for the field }

  szstMEMO           = 'Text';
  szstBINARY         = 'Binary';
  szstFMTMEMO        = 'Formatted';
  szstOLEOBJ         = 'Ole';
  szstGRAPHIC        = 'Graphics';
  szstDBSOLEOBJ      = 'dBASEOle';
  szstTYPEDBINARY    = 'TypedBinary';
  szstMONEY          = 'Money';
  szstAUTOINC        = 'Autoinc';
  szstADTNESTEDTABLE = 'ADTNestedTable';
  szstFIXEDCHAR      = 'FixedChar';
  szstREFNESTEDTABLE = 'Reference';
  szstGUID           = 'Guid';
  szstACCOLEOBJ      = 'AccessOle';
  szstHMEMO          = 'HMemo';
  szstHBINARY        = 'HBinary';

  fldstReference     = 70;

  dsfldUNKNOWN       = 0;           { Unknown }
  dsfldINT           = 1;           { signed integer }
  dsfldUINT          = 2;           { Unsigned integer }
  dsfldBOOL          = 3;           { Boolean }
  dsfldFLOATIEEE     = 4;           { IEEE float }
  dsfldBCD           = 5;           { BCD }
  dsfldDATE          = 6;           { Date     (32 bit) }
  dsfldTIME          = 7;           { Time     (32 bit) }
  dsfldTIMESTAMP     = 8;           { Time-stamp  (64 bit) }
  dsfldZSTRING       = 9;           { Multi-byte string }
  dsfldUNICODE       = 10;          { unicode string }
  dsfldBYTES         = 11;          { bytes }
  dsfldADT           = 12;          { ADT (Abstract Data Type) }
  dsfldARRAY         = 13;          { Array type (not attribute) }
  dsfldEMBEDDEDTBL   = 14;          { Embedded (nested table type) }
  dsfldREF           = 15;          { Reference }
  dsfldDATETIME      = 17;          { Datetime struct for DB Express }
  dsfldFMTBCD        = 18;          { BCD Variant type }

  dsSizeBitsLen      = 16;          { no. bits indicating fld size }
  dsSizeBitsMask     = $0000FFFF;   { mask to retrieve fld size }
  dsTypeBitsMask     = $003F0000;   { mask to retrieve Type info }
  dsVaryingFldType   = $00400000;   { Varying attribute type. }
  dsArrayFldType     = $00800000;   { Array attribute type. }

  dsPseudoFldType    = $01000000;   {Composite. Bits 1..15 gives number of elements }
  dsCompArrayFldType = $02000000;   { Compressed array }
  dsEmbeddedFldType  = $04000000;   { Embedded table }
  dsIncInDelta       = $80000000;   { For optional parameters only:include parameter in delta }

  dskeyCASEINSENSITIVE  = $4000;
  dskeyDESCENDING       = $8000;

  dsDELAYEDBIT       = $80000000;   { Length/number is not present }

  PACKETVERSION_1     = 1;
  PACKETVERSION_2     = 2;
  PACKETVERSION_3     = 3;

  dsCASCADEDELETES   = 1;
  dsCASCADEUPDATES   = 2;

{ Field Types (Logical) - Originally from BDE.PAS }

  fldUNKNOWN         = 0;
  fldZSTRING         = 1;               { Null terminated string }
  fldDATE            = 2;               { Date     (32 bit) }
  fldBLOB            = 3;               { Blob }
  fldBOOL            = 4;               { Boolean  (16 bit) }
  fldINT16           = 5;               { 16 bit signed number }
  fldINT32           = 6;               { 32 bit signed number }
  fldFLOAT           = 7;               { 64 bit floating point }
  fldBCD             = 8;               { BCD }
  fldBYTES           = 9;               { Fixed number of bytes }
  fldTIME            = 10;              { Time        (32 bit) }
  fldTIMESTAMP       = 11;              { Time-stamp  (64 bit) }
  fldUINT16          = 12;              { Unsigned 16 bit integer }
  fldUINT32          = 13;              { Unsigned 32 bit integer }
  fldFLOATIEEE       = 14;              { 80-bit IEEE float }
  fldVARBYTES        = 15;              { Length prefixed var bytes }
  fldLOCKINFO        = 16;              { Look for LOCKINFO typedef }
  fldCURSOR          = 17;              { For Oracle Cursor type }
  fldINT64           = 18;              { 64 bit signed number }
  fldUINT64          = 19;              { Unsigned 64 bit integer }
  fldADT             = 20;              { Abstract datatype (structure) }
  fldARRAY           = 21;              { Array field type }
  fldREF             = 22;              { Reference to ADT }
  fldTABLE           = 23;              { Nested table (reference) }
  fldDATETIME        = 24;              { Datetime structure for DBExpress }
  fldFMTBCD          = 25;              { BCD Variant type: required by Midas, same as BCD for DBExpress}

  MAXLOGFLDTYPES     = 26;              { Number of logical fieldtypes }

{ Additional (non-BDE fieldtypes }
  fldUNICODE          = $1007;          { Unicode }

{ Sub Types (Logical) }

{ fldFLOAT subtype }

  fldstMONEY         = 21;              { Money }

{ fldBLOB subtypes }

  fldstMEMO          = 22;              { Text Memo }
  fldstBINARY        = 23;              { Binary data }
  fldstFMTMEMO       = 24;              { Formatted Text }
  fldstOLEOBJ        = 25;              { OLE object (Paradox) }
  fldstGRAPHIC       = 26;              { Graphics object }
  fldstDBSOLEOBJ     = 27;              { dBASE OLE object }
  fldstTYPEDBINARY   = 28;              { Typed Binary data }
  fldstACCOLEOBJ     = 30;              { Access OLE object }
  fldstHMEMO         = 33;              { CLOB }
  fldstHBINARY       = 34;              { BLOB }
  fldstBFILE         = 36;              { BFILE }

{ fldZSTRING subtype }

  fldstPASSWORD      = 1;               { Password }
  fldstFIXED         = 31;              { CHAR type }
  fldstUNICODE       = 32;              { Unicode }
  fldstGUID          = 38;              { GUID }

{ fldINT32 subtype }

  fldstAUTOINC       = 29;

const
  FieldTypeMap: TFieldMap = (
    fldUNKNOWN, fldZSTRING, fldINT16, fldINT32, fldUINT16, fldBOOL,
    fldFLOAT, fldFLOAT, fldBCD, fldDATE, fldTIME, fldTIMESTAMP, fldBYTES,
    fldVARBYTES, fldINT32, fldBLOB, fldBLOB, fldBLOB, fldBLOB, fldBLOB,
    fldBLOB, fldBLOB, fldCURSOR, fldZSTRING, fldZSTRING, fldINT64, fldADT,
    fldArray, fldREF, fldTABLE, fldBLOB, fldBLOB, fldUNKNOWN, fldUNKNOWN,
    fldUNKNOWN, fldZSTRING, fldDATETIME, fldFMTBCD);

  FldSubTypeMap: array[TFieldType] of Word = (
    0, 0, 0, 0, 0, 0, 0, fldstMONEY, 0, 0, 0, 0, 0, 0, fldstAUTOINC,
    fldstBINARY, fldstMEMO, fldstGRAPHIC, fldstFMTMEMO, fldstOLEOBJ,
    fldstDBSOLEOBJ, fldstTYPEDBINARY, 0, fldstFIXED, fldstUNICODE,
    0, 0, 0, 0, 0, fldstHBINARY, fldstHMEMO, 0, 0, 0, fldstGUID,
    fldDATETIME, 0);

  DataTypeMap: array[0..MAXLOGFLDTYPES - 1] of TFieldType = (
    ftUnknown, ftString, ftDate, ftBlob, ftBoolean, ftSmallint,
    ftInteger, ftFloat, ftBCD, ftBytes, ftTime, ftDateTime,
    ftWord, ftInteger, ftUnknown, ftVarBytes, ftUnknown, ftUnknown,
    ftLargeInt, ftLargeInt, ftADT, ftArray, ftReference, ftDataSet,
    ftTimeStamp, ftFMTBcd);

  BlobTypeMap: array[fldstMEMO..fldstBFILE] of TFieldType = (
    ftMemo, ftBlob, ftFmtMemo, ftParadoxOle, ftGraphic, ftDBaseOle,
    ftTypedBinary, ftBlob, ftBlob, ftBlob, ftBlob, ftOraClob,
    ftOraBlob, ftBlob, ftBlob);

{ Error Codes }

const

  DBERR_NONE                   = 0;
  DBERR_BOF                    = $2201;
  DBERR_EOF                    = $2202;
  DBERR_NOSUCHINDEX            = $270D;

  ERRCAT_ALC  = $40;
  ERRBASE_ALC = $4000;

  ERRCODE_DELTAISEMPTY       = 1;   { Delta is empty }
  ERRCODE_NOTHINGTOUNDO      = 2;   { Nothing to undo }
  ERRCODE_NOMETADATA         = 3;   { Datapacket contains no meta data }
  ERRCODE_CANNOTAPPEND       = 4;   { Trying to append data to a non-partial }
  ERRCODE_DATAPACKETMISMATCH = 5;   { Mismatch in datapacket }
  ERRCODE_ABORTED            = 6;   { Operation was aborted }
  ERRCODE_CANCELLED          = 7;   { Operation was cancelled }
  ERRCODE_NEWERVERSIONREQ    = 8;   { Newer version required }
  ERRCODE_BLOBNOTFETCHED     = 9;   { Blob has not been fetched }
  ERRCODE_DETAILSNOTFETCHED  = 10;  { Details has not been fetched }
  ERRCODE_NOMASTERRECORD     = 11;  { no corresponding master record found }
  ERRCODE_LINKFIELDSNOTUNIQUE= 12;  { Linkfields must be unique }
  ERRCODE_FLYAWAY_WRONGORDER = 13;  { Special case: wrong order of updates for fly-away }
  ERRCODE_NOCASCADEDUPDATES  = 14;  { Cascaded updates is not enabled }

  DBERR_DELTAISEMPTY        = ERRBASE_ALC + ERRCODE_DELTAISEMPTY;
  DBERR_NOTHINGTOUNDO       = ERRBASE_ALC + ERRCODE_NOTHINGTOUNDO;
  DBERR_NOMETADATA          = ERRBASE_ALC + ERRCODE_NOMETADATA;
  DBERR_CANNOTAPPEND        = ERRBASE_ALC + ERRCODE_CANNOTAPPEND;
  DBERR_DATAPACKETMISMATCH  = ERRBASE_ALC + ERRCODE_DATAPACKETMISMATCH;
  DBERR_ABORTED             = ERRBASE_ALC + ERRCODE_ABORTED;
  DBERR_CANCELLED           = ERRBASE_ALC + ERRCODE_CANCELLED;
  DBERR_NEWERVERSIONREQ     = ERRBASE_ALC + ERRCODE_NEWERVERSIONREQ;
  DBERR_BLOBNOTFETCHED      = ERRBASE_ALC + ERRCODE_BLOBNOTFETCHED;
  DBERR_DETAILSNOTFETCHED   = ERRBASE_ALC + ERRCODE_DETAILSNOTFETCHED;
  DBERR_NOMASTERRECORD      = ERRBASE_ALC + ERRCODE_NOMASTERRECORD;
  DBERR_LINKFIELDSNOTUNIQUE = ERRBASE_ALC + ERRCODE_LINKFIELDSNOTUNIQUE;
  DBERR_FLYAWAY_WRONGORDER  = ERRBASE_ALC + ERRCODE_FLYAWAY_WRONGORDER;
  DBERR_NOCASCADEDUPDATES   = ERRBASE_ALC + ERRCODE_NOCASCADEDUPDATES;

{ IDSBase }

type

  [ComImport,
  GuidAttribute(GUID_DSBASE),
  InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  IDSBase = interface

    [PreserveSig]
    function Create(              { Create empty dataset }
      iFields  : LongWord;        { Number of fields }
      pFldDes  : IntPtr;          { pDSFLDDesc - Array of field descriptors }
      pszName  : string           { Name (optional) }
    ): DBResult;

    [PreserveSig]
    function AddField(            { Add a field to the dataset }
      pFldDes  : IntPtr           { pDSFLDDesc - Field descriptor }
    ): DBResult;

    [PreserveSig]
    function AppendData(          { Appends data packet to dataset. }
      Packet   : IntPtr;          { PSafeArray - Data packet }
      bEof     : LongBool         { If True, this is last packet }
    ): DBResult;

    [PreserveSig]
    function GetOptParameter(     { Returns optional parameter (unknown to dataset) }
      iNo         : LongWord;     { Number 1..iOptAttr }
      iFldNo      : LongWord;     { 0 if not field attribute }
      var ppName  : IntPtr;       { returns ptr to name }
      var piType  : LongWord;     { returns type }
      var piLen   : LongWord;     { returns length }
      var ppValue : IntPtr        { returns ptr to value }
    ): DBResult;

    [PreserveSig]
    function AddOptParameter(     { Adds optional parameter to dataset }
      iFldNo   : LongWord;        { 0 if not field attribute }
      pszAttr  : IntPtr;          { ptr to name }
      iType    : LongWord;        { type }
      iLen     : LongWord;        { length }
      pValue   : IntPtr           { ptr to value }
    ): DBResult;

    [PreserveSig]
    function GetProps(              { Get dataset properties }
      var Prop : DSProps
    ): DBResult;

    [PreserveSig]
    function GetFieldDescs(       { Get field descriptors }
      Fields  : IntPtr            { pDSFLDDesc - Array of fields descriptors (output) }
    ): DBResult;

    [PreserveSig]
    function GetIndexDescs(       { Get index descriptors }
      p1: IntPtr                  { PDSIDXDesc - Array of index descriptors (output) }
    ): DBResult;

    [PreserveSig]
    function GetDelta(            { Extract delta from dataset }
      out DsDelta: IDSBase        { Delta in a dataset }
    ): DBResult;

    [PreserveSig]
    function StreamDS(            { Create data packet from the dataset }
      out Packet : IntPtr         { PSafeArray - Return data packet }
    ): DBResult;

    [PreserveSig]
    function AcceptChanges: DBResult;  { Accept all current changes }

    [PreserveSig]
    function PutBlank(            { Put blank value }
      pRecBuf     : TRecordBuffer;{ RecBuf OR }
      iRecNo      : LongWord;     { iRecNo }
      iFldNo      : LongWord;
      iBlankValue : LongWord
    ): DBResult;

    [PreserveSig]
    function CreateIndex(         { Create, and add an index }
                                                                                                              
      var IdxDesc  : DSIDXDesc
    ): DBResult;

    [PreserveSig]
    function RemoveIndex(         { Remove index of given name }
      pszName  : IntPtr
    ): DBResult;

    [PreserveSig]
    function GetErrorString(      { Retrieve error string }
      iErrCode  : DBResult;
      pString   : IntPtr
    ): DBResult;

    [PreserveSig]
    function FldCmp(              { Compare field values returns 0 if equal }
      iFldType  : LongWord;       { Fieldtype }
      pFld1     : IntPtr;         { NULL if blank }
      pFld2     : IntPtr;         { NULL if blank }
      iUnits1   : LongWord;
      iUnits2   : LongWord
    ): Integer;

    [PreserveSig]
    function GetProp(             { Get property }
      eProp       : DSProp;
      piPropValue : IntPtr
    ): DBResult;

    [PreserveSig]
    function SetProp(             { Set property }
      eProp      : DSProp;
      iPropValue : LongWord
    ): DBResult;

    [PreserveSig]
    function SetFieldCalculation(  { Register fieldcalculation on this field }
      iClientData  : LongWord;     { Client data }
      [MarshalAs(UnmanagedType.FunctionPtr)]
      pfCalc       : pfDSCalcField { Callback function, NULL to remove }
    ): DBResult;

    [PreserveSig]
    function Reconcile(           { Reconcile update errors }
      DeltaPacket : IntPtr;       { PSafeArray - Delta data packet }
      ErrorPacket : IntPtr;       { PSafeArray - NULL if all changes accepted }
      iClientData : LongWord;
      [MarshalAs(UnmanagedType.FunctionPtr)]
      pfReconcile : pfDSReconcile { Callback-fn (called for each error) }
    ): DBResult;

    { Place Holders for aggregate functions that were moved into DSCursor }
    [PreserveSig]
    function Reserved1(Input: IntPtr): DBResult;
    [PreserveSig]
    function Reserved2(Input: IntPtr): DBResult;
    [PreserveSig]
    function Reserved3(Input: IntPtr): DBResult;

    [PreserveSig]
    function Refresh(             { Refresh dataset }
      NewPacket   : IntPtr;       { PSafeArray - New updated packet }
      iClientData : LongWord;     { Client data }
      [MarshalAs(UnmanagedType.FunctionPtr)]
      pfReconcile : pfDSReconcile { Callback for resolving conflicts }
    ): DBResult;

    [PreserveSig]
    function Reset: DBResult;     { Remove all data from dataset }

    [PreserveSig]
    function RollBack(            { Rollback changes to this savepoint }
      iSavePoint  : SAVEPOINT
    ): DBResult;

    [PreserveSig]
    function GetEmbeddedDS(
      iFieldID  : LongWord;       { FieldID of embedded table (0 : get the first one) }
      out DsDet : IDSBase         { Returns the ds of the embedded table }
    ): DBResult;

    [PreserveSig]
    function MakeEmbedded(
      DsDet            : IDSBase; { Embed this dataset }
      iFieldsLink      : LongWord;
      piFieldsM        : IntPtr;  { PLongWord - Fields in Master }
      piFieldsD        : IntPtr;  { PLongWord - Fields in Detail }
      pMasterFieldName : string;  { Name of new link field in master, NULL if using default name }
      pDetailFieldName : string   { Name of new link field in detail, NULL if using defaultname }
    ): DBResult;

    [PreserveSig]
    function RefreshRecords(      { Refresh specific records }
      NewDataPacket   : IntPtr;   { PSafeArray - Datapacket containing refreshed records }
      iRecNo          : LongWord; { Refresh this specific record (0 if more than one.Unique key req.) }
      iClientData     : LongWord;
      [MarshalAs(UnmanagedType.FunctionPtr)]
      pfReconcile     : pfDSReconcile { (NULL) Callback for resolving conflicts }
    ): DBResult;

    [PreserveSig]
    function ReleaseBlobs(        { Release all uncommitted blobs }
      iBlobId  : LongWord         { 0: all uncommitted blobs, otherwise : specific blob }
    ): DBResult;

    [PreserveSig]
    function Clone(               { Clones the structure of the dsbase, including details if any }
       iPType : LongWord;         { 0:normal-ds, 1:delta-ds, 2:error-ds }
       bRecurse : LongBool;       { TRUE:create complete tree-structure }
       bCloneOptParams: LongBool; { TRUE:clone all optional parameters (normal only) }
       var DataSet: IDSBase       { Returned dsbase }
    ): DBResult;

    [PreserveSig]
    function Reconcile_MD(
      pDsRec          : IDSBase;  { Ds for info }
      pDeltaPacket    : IntPtr;   { PSafeArray - Delta pickle }
      pErrorPacket    : IntPtr;   { PSafeArray - NULL if all changes accepted }
      iClientData     : LongWord;
      [MarshalAs(UnmanagedType.FunctionPtr)]
      pfReconcile_MD  : pfDSReconcile_MD { Callback-fn (called for each error) }
    ): DBResult;

    [PreserveSig]
    function DropOptParameter(
      iFldNo: LongWord;          { 0 if not field attribute }
      pName: IntPtr              { Name of attribute to delete }
    ): DBResult;
  end;

{ IDSCursor }

  [ComImport,
  GuidAttribute(GUID_DSCursor),
  InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  IDSCursor = interface

    [PreserveSig]
    function InitCursor(            { Associate Cursor with a DataSet }
      DataSet: IDSBase
    ): DBResult;

    [PreserveSig]
    function CloneCursor(           { Clone cursor from cursor }
      Cursor: IDSCursor
    ): DBResult;

    [PreserveSig]
    function GetCursorProps(        { Get cursor properties }
      var p1: DSProps
    ): DBResult;

    [PreserveSig]
    function GetIndexDescs(         { Get index descriptors }
      bCurrentOnly : LongBool;      { Only return 'current' indexdesc, otherwise all }
      var IdxDesc  : DSIDXDesc
    ): DBResult;

    [PreserveSig]
    function GetFieldDescs(         { Get field descriptors }
      p1  : IntPtr
    ): DBResult;

    [PreserveSig]
    function GetCurrentRecord(      { Return record at current cursorposition }
      pRecBuf  : TRecordBuffer
    ): DBResult;

    [PreserveSig]
    function GetRecordBlock(        { Return block of records }
      var piRecs : LongWord;
      pRecBuf    : TRecordBuffer
    ): DBResult;

    [PreserveSig]
    function GetCurrentBookMark(    { Get bookmark for current position }
      pBookMark  : TBookmark
    ): DBResult;

    [PreserveSig]
    function GetSequenceNumber(     { Get Sequence number of current position }
      var iSeq  : LongWord
    ): DBResult;

    [PreserveSig]
    function GetRecordAttribute(    { Get record attribute of current position }
      var Attr  : DSAttr
    ): DBResult;

    [PreserveSig]
    function GetRecordCount(        { Number of records in active view }
      var iRecs  : Integer
    ): DBResult;

    [PreserveSig]
    function MoveToBOF: DBResult;   { Set to beginning of table (BOF) }

    [PreserveSig]
    function MoveToEOF: DBResult;   { Set to end of table (EOF) }

    [PreserveSig]
    function MoveRelative(i: Integer): DBResult;

    [PreserveSig]
    function MoveToSeqNo(i: LongWord): DBResult;

    [PreserveSig]
    function MoveToBookMark(        { Goto bookmark }
      pBookMark: TBookmark
    ): DBResult;

    [PreserveSig]
    function MoveToKey(             { Goto key }
      SearchCond  : DBSearchCond;
      iFields     : LongWord;
      iPartLen    : LongWord;
      pRecBuf     : TRecordBuffer
    ): DBResult;

    [PreserveSig]
    function CompareBookMarks(      { Compare two bookmark (positions) -1, 0, 1 }
      pBookMark1  : TBookmark;
      pBookMark2  : TBookmark;
      var iCmp    : Integer
    ): DBResult;

    [PreserveSig]
    function ExtractKey(            { Extract key from record }
      pRecBuf  : TRecordBuffer;
      pKeyBuf  : TRecordBuffer
    ): DBResult;

    [PreserveSig]
    function GetRecordForKey(       { Return (first) record with given key }
      iFields   : LongWord;
      iPartLen  : LongWord;
      pKey      : TRecordBuffer;
      pRecBuf   : TRecordBuffer
    ): DBResult;

    [PreserveSig]
    function GetField(              { Extract field value from record buffer }
      pRecBuf    : TRecordBuffer;
      iFieldNo   : LongWord;
      pFldBuf    : IntPtr;
      var bBlank : Integer          { Returns TRUE/FALSE if blank }
    ): DBResult;

    [PreserveSig]
    function PutField(              { Put field value into record buffer }
      pRecBuf   : TRecordBuffer;
      iFieldNo  : LongWord;
      pFldBuf   : IntPtr            { If NULL, adds a blank value }
    ): DBResult;

    { Blob functions }

    [PreserveSig]
    function GetBlobLen(            { Return length of blob }
      pRecBuf     : TRecordBuffer;
      iFieldNo    : LongWord;
      var iLength : LongWord
    ): DBResult;

    [PreserveSig]
    function GetBlob(               { Return blob }
      pRecBuf     : TRecordBuffer;
      iFieldNo    : LongWord;
      iOffSet     : LongWord;       { Starting position }
      pBuf        : TRecordBuffer;
      var iLength : LongWord        { No of bytes to be read/ returns number read }
    ): DBResult;

    [PreserveSig]
    function PutBlob(               { Write blob data }
      pRecBuf   : TRecordBuffer;
      iFieldNo  : LongWord;
      iOffSet   : LongWord;         { Starting position }
      pBuf      : TRecordBuffer;
      iLength   : LongWord
    ): DBResult;

    [PreserveSig]
    function InitRecord(            { Initialize record buffer (for insertion) }
      pRecBuf  : TRecordBuffer
    ): DBResult;

    [PreserveSig]
    function DeleteRecord: DBResult; { Delete current record }

    [PreserveSig]
    function ModifyRecord(          { Modify current record }
      pRecBuf  : TRecordBuffer
    ): DBResult;

    [PreserveSig]
    function InsertRecord(          { Insert new record }
      pRecBuf  : TRecordBuffer
    ): DBResult;

    [PreserveSig]
    function UndoLastChange(        { Undo last update }
      bFollowChange  : LongBool
    ): DBResult;

    [PreserveSig]
    function AddFilter(             { Add a canexpr-filter to this cursor }
      pcanExpr    : IntPtr;         { Can expr }
      iLen        : LongWord;       { Length of canexpr }
      var hFilter : hDSFilter
    ): DBResult;

    [PreserveSig]
    function DropFilter(            { Drop a filter }
      hFilter  : hDSFilter
    ): DBResult;

    [PreserveSig]
    function SetRange(              { Set a range on a cursor }
      iFields    : LongWord;
      pKey1      : TRecordBuffer;
      bKey1Incl  : LongBool;
      pKey2      : TRecordBuffer;
      bKey2Incl  : LongBool
    ): DBResult;

    [PreserveSig]
    function DropRange: DBResult;   { Remove current range }

    [PreserveSig]
    function SortOnFields(          { Sort on fields }
      iFields     : LongWord;
      piFields    : IntPtr;         { NULL -> all fields }
      pDescending : IntPtr;         { NULL -> all ascending }
      pCaseInsensitive: IntPtr      { NULL -> all case-sensitive }
    ): DBResult;

    [PreserveSig]
    function UseIndexOrder(         { Switch to index order }
      pszName  : IntPtr
    ): DBResult;

    [PreserveSig]
    function SetNotifyCallBack(     { Called when posting changes to dataset }
      iClientData  : LongWord;
      [MarshalAs(UnmanagedType.FunctionPtr)]
      pfCallBack   : pfCHANGECallBack { Call back fn being registered }
    ): DBResult;

    [PreserveSig]
    function AddFilterCallBack(     { Add a canexpr-filter to this cursor }
      iClientData : LongWord;       { Client supplied data }
      [MarshalAs(UnmanagedType.FunctionPtr)]
      pfFilter    : pfDSFilter;     { ptr to filter function }
      var hFilter : hDSFilter
    ): DBResult;

    [PreserveSig]
    function VerifyField(           { Verify if field value is valid }
      iFieldNo  : LongWord;
      pFldBuf   : TRecordBuffer
    ): DBResult;

    [PreserveSig]
    function GetProp(               { Get property }
      eProp        : CURProp;
      piPropValue  : IntPtr
    ): DBResult;

    [PreserveSig]
    function RevertRecord: DBResult; { Restore current record }

    [PreserveSig]
    function LocateWithFilter(
      pCanExpr  : IntPtr;           { NULL -> use previous }
      iLen      : LongWord          { Length of canexpr }
    ): DBResult;

    [PreserveSig]
    function AddAggregate(
      iFlds     : LongWord;         { Defines grouping  (0 if global) }
      iCanLen   : LongWord;         { Length of canexpr (0 if grouping only) }
      pCanExpr  : IntPtr;           { Canexpression for aggregate }
      var hAgg  : hDSAggregate      { returns aggregate handle }
    ): DBResult;

    [PreserveSig]
    function DropAggregate(
      hAgg  : hDSAggregate
    ): DBResult;

    [PreserveSig]
    function GetAggregateValue(
      hAgg       : hDSAggregate;
      pValue     : IntPtr;
      var bBlank : LongBool
    ): DBResult;

    [PreserveSig]
    function GetAggregateDesc(
      hAgg     : hDSAggregate;
      var Desc : DSFLDDesc
    ): DBResult;

    [PreserveSig]
    function MoveToNextSubGroup(
      iFields  : LongWord
    ): DBResult;

    [PreserveSig]
    function GetSubGroupState(
      iFields            : LongWord;
      var iSubGroupState : GROUPSTATE
    ): DBResult;

    [PreserveSig]
    function LinkCursors(
      iFieldsM   : LongWord;
      piFieldsM  : IntPtr;          { Fields in Master }
      piFieldsD  : IntPtr;          { Fields in Detail }
      hCurDet    : IDSCursor        { Detail cursor to link }
    ): DBResult;

    [PreserveSig]
    function ResyncWithMaster: DBResult;  { If this is a detail, reset range }

    [PreserveSig]
    function SetProp(               { Set property }
      eProp       : CURProp;        { Property to set }
      iPropValue  : LongWord        { Property value (or pointer to value) }
    ): DBResult;

    [PreserveSig]
    function GetRecordNumber(        { Return record number of current record, if any }
      var iRecNo: LongWord
    ): DBResult;


    [PreserveSig]
    function GetRowRequestPacket(   { Get packet describing the curent 'path',
                                      for delayed fetching/refreshing }
      bKeysOnly       : LongBool;   { Only include unique keys in packet }
      bFetchAllBlobs  : LongBool;   { fetch all blobs for 'current'record }
      bFetchAllDetails: LongBool;   { fetch all details for 'current' record }
      bInclMetaData   : LongBool;   { Include metadata in packet }
      out Packet      : IntPtr      { PSafeArray - returns datapacket with row description }
    ): DBResult;

    [PreserveSig]
    function RefreshRecord(          { Refresh details/blobs for this record, and all
                                       'current' records above, if any }
      Packet  : IntPtr               { PSafeArray - New updated pickle }
    ): DBResult;
  end;

{ IDSWriter }

  [ComImport,
  GuidAttribute(GUID_DSWriter),
  InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  IDSWriter = interface

    [PreserveSig]
    function Init_Sequential(   { Initialze by sequentially adding columns }
      Version: LongWord;
      Columns: Word
    ): DBResult;

    [PreserveSig]
    function Init(
      Version: LongWord;
      Columns: Word;
      var FieldDesc: TDSDataPacketFldDesc
    ): DBResult;

    [PreserveSig]
    function AddAttribute(      { Add an optional parameter }
      AttrArea: TPcktAttrArea;
      Attr: IntPtr;
      AttrType: LongWord;
      Len: LongWord;
      Value: IntPtr
    ): DBResult;

    [PreserveSig]
    function GetDataPacket(     { Return pointer to the finished 'safearray' }
      var SA: IntPtr            { PSafeArray }
    ): DBResult;

    [PreserveSig]
    function GetSize(           { Get the size of the safearray. }
      var DataPacketSize: LongWord
    ): DBResult;

    [PreserveSig]
    function PutField(          { Add this field to the data stream. }
      FldStatus: TPcktFldStatus;
      Len: LongWord;
      Src: IntPtr
    ): DBResult;

                                                                                                            
    [PreserveSig]
    function AddColumnDesc(     { Add a column descriptor. }
      var FldDes: TDSDataPacketFldDesc
    ): DBResult;

    { Reset all data (in order to create partial data).  Datapackets will not
      contain meta-info. Last created datapacket must be released by caller. }
    [PreserveSig]
    function Reset: DBResult;

    { Return number of fielddescriptors, including embedded tables etc. }

    [PreserveSig]
    function GetColumnCount(var Count: LongWord): DBResult;

    [PreserveSig]
    function GetColumnDescs(    { Return all fielddescriptors }
      FieldDes: IntPtr          { PDSDataPacketFldDesc }
    ): DBResult;

    [PreserveSig]
    function GetErrorString(    { Retrieve error string }
      iErrCode  : DBResult;
      pString   : IntPtr
    ): DBResult;

    { Signals last row for a nested table, in case rowcount was not known
      in advance }
    [PreserveSig]
    function EndOfNestedRows: DBResult;

    [PreserveSig]
    function SetXMLMode(iMode: Integer): DBResult;

    [PreserveSig]
    function GetXMLMode: LongWord;
  end;

type
  TVarArrayData = packed record
    VType: Word;
    Reserved1: Word;
    Reserved2: Word;
    Reserved3: Word;
    VArray: IntPtr;  { PSafeArray }
  end;

{ Utility Routines }
procedure FreeDataPacket(var DataPacket: TDataPacket);
function VarToDataPacket(const V: OleVariant): TDataPacket;
function VarToVarArrayData(const V: OleVariant): TVarArrayData;
function VarArrayDataToDataPacket(const V: TVarArrayData): TDataPacket;
function DataPacketSize(const DataPacket: TDataPacket): Integer;
procedure DataPacketToVariant(const DataPacket: TDataPacket; var V: OleVariant);
procedure CreateDbClientObject(const CLSID, IID: TGUID; out Obj);
function VariantArrayToString(const V: OleVariant): string;
function StringToVariantArray(const S: string): OleVariant;

type
  TDllGetClassObject = function([MarshalAs(UnmanagedType.LPStruct)] CLSID: TGUID;
    [MarshalAs(UnmanagedType.LPStruct)] IID: TGUID): IClassFactory;

procedure RegisterMidasLib(GetClassProc: TDllGetClassObject);

implementation

uses
  System.Collections, System.Threading,
  WinUtils, {ComObj,} SysUtils, Types, MidConst;

{ Utility Routines }

                                                      
[DllImport('midas.dll', PreserveSig = False, EntryPoint = 'DllGetClassObject')]
function _DllGetClassObject([MarshalAs(UnmanagedType.LPStruct)] CLSID: TGUID;
  [MarshalAs(UnmanagedType.LPStruct)] IID: TGUID): IClassFactory; external;

[DllImport('midas.dll', EntryPoint = 'DllRegisterServer')]
function Midas_DllRegisterServer: HResult; external;

var
  ThreadLock: TObject;
  DbClientChecked: Boolean = False;
  DllGetClassObject: TDllGetClassObject;

                          
procedure RegisterComServer(const DLLName: string);
type
  TRegProc = function: HResult;
//const
//  RegProcName = 'DllRegisterServer'; { Do not localize }
var
  Handle: THandle;
  RegProc: TRegProc;
begin
  Handle := SafeLoadLibrary(DLLName);
  if Handle <= HINSTANCE_ERROR then
    raise Exception.CreateFmt('%s: %s', [SysErrorMessage(GetLastError), DLLName]);
  try
    RegProc := Midas_DllRegisterServer;
    //Midas_DllRegisterServer;
                                                
    //RegProc := GetProcAddress(Handle, RegProcName);
    if Assigned(RegProc) then RegProc else RaiseLastOSError;
  finally
    FreeLibrary(Handle);
  end;
end;

procedure CheckDbClient(const CLSID: TGUID);
var
  Size: Integer;
  FileName: string;
  Buffer: StringBuilder;
  DbClientHandle: THandle;
begin
  if not DbClientChecked then
  begin
    System.Threading.Monitor.Enter(ThreadLock);
    try
      if not DbClientChecked then
      begin
        DbClientChecked := True;
        DbClientHandle := 0;
        Size := 256;
        Buffer := StringBuilder.Create(Size);
        if RegQueryValue(HKEY_CLASSES_ROOT, Format('CLSID\%s\InProcServer32',
          [CLSID.ToString]), Buffer, Size) = ERROR_SUCCESS then
          FileName := Buffer.ToString
        else
        begin
          FileName := MIDAS_DLL;
          try
            RegisterComServer(FileName);
          except
          end;
        end;
        try
          DbClientHandle := LoadLibrary(FileName);
          if DbClientHandle = 0 then
            raise Exception.Create(SErrorLoadingMidas);
        finally
          FreeLibrary(DbClientHandle);
        end;

                                                    
        //DllGetClassObject := GetProcAddress(DbClientHandle, 'DllGetClassObject');  { Do not localize }
        DllGetClassObject := _DllGetClassObject;
      end;
    finally
      System.Threading.Monitor.Exit(ThreadLock);
    end;
  end;
end;

const
  CLSID_IClassFactory: string = '00000001-0000-0000-C000-000000000046';

procedure CreateDbClientObject(const CLSID, IID: TGUID; out Obj);
var
  Factory: IClassFactory;
begin
  CheckThreadingModel(System.Threading.ApartmentState.STA);
  CheckDbClient(CLSID);
  Factory := DllGetClassObject(CLSID, Guid.Create(CLSID_IClassFactory)); 
  Factory.CreateInstance(nil, IID, Obj);
end;

procedure FreeDataPacket(var DataPacket: TDataPacket);
begin
  if Assigned(DataPacket) then
  begin
    SafeArrayCheck(SafeArrayDestroy(DataPacket));
    DataPacket := nil;
  end;
end;

function VarToDataPacket(const V: OleVariant): TDataPacket;
var
  Buffer: IntPtr;
  Bounds: array of Integer;
  LBytes: TBytes;
begin
  Result := nil;
  if VarIsNull(V) then Exit
  else
    begin
      if not (VarArrayElementsIsType(V, varByte) and (VarArrayHighBound(V, 1) > 20)) then
        DatabaseError(SInvalidDataPacket);

      LBytes := TBytes(TObject(V));
      SetLength(Bounds, 1);
      Bounds[0] := Length(LBytes);
      Result := SafeArrayCreate(VT_UI1, 1, Bounds);
      SafeArrayCheck(SafeArrayAccessData(Result, Buffer));
      try
        Marshal.Copy(LBytes, 0, Buffer, Length(LBytes));
      finally
        SafeArrayCheck(SafeArrayUnaccessData(Result));
      end;
  end;
end;

function VarToVarArrayData(const V: OleVariant): TVarArrayData;
begin
  if VarIsEmpty(V) then Exit;
  Result.VType := VarType(V);
  Result.VArray := VarToDataPacket(V);
end;

function VarArrayDataToDataPacket(const V: TVarArrayData): TDataPacket;
begin
  Result := nil;
  if (V.VType = VT_NULL) or (V.VType = VT_EMPTY) then
    Exit
  else
  begin
    if not ((V.VType and VT_ARRAY = VT_ARRAY) and (DataPacketSize(V.VArray) > 20)) then
      DatabaseError(SInvalidDataPacket);

    Result := V.VArray;
  end;
end;

function DataPacketSize(const DataPacket: TDataPacket): Integer;
begin
  SafeArrayCheck(SafeArrayGetUBound(DataPacket, 1, Result));
  Inc(Result);
end;

procedure DataPacketToVariant(const DataPacket: TDataPacket; var V: OleVariant);
var
  Size: Integer;
  Bytes: TBytes;
  Buffer: IntPtr;
begin
  if Assigned(DataPacket) then
  begin
    Size := DataPacketSize(DataPacket);
    SafeArrayCheck(SafeArrayAccessData(DataPacket, Buffer));
    try
      SetLength(Bytes, Size);
      Marshal.Copy(Buffer, Bytes, 0, Size);
    finally
      SafeArrayCheck(SafeArrayUnaccessData(DataPacket));
    end;
                                                        
    V := OleVariant(TObject(Bytes));
  end
  else
    V := NULL;
end;

function VariantArrayToString(const V: OleVariant): string;
begin
  Result := '';
  if VarArrayElementsIsType(V, varByte) then
    Result := StringOf(TBytes(TObject(V)));
end;

function StringToVariantArray(const S: string): OleVariant;
begin
  Result := NULL;
  if Length(S) > 0 then
    Result := BytesOf(S);
end;

procedure RegisterMidasLib(GetClassProc: TDllGetClassObject);
begin
  DllGetClassObject := GetClassProc;
  //DbClientHandle := THandle(1);
  DbClientChecked := True;
end;


initialization
  ThreadLock := TObject.Create;
// Finalization section may not execute on all platforms
finalization
  FreeAndNil(ThreadLock);
  
end.
