home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / SPCC / DBLAYER.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-21  |  122KB  |  3,332 lines
  1.  
  2. {╔══════════════════════════════════════════════════════════════════════════╗
  3.  ║                                                                          ║
  4.  ║     Sibyl Portable Component Classes                                     ║
  5.  ║                                                                          ║
  6.  ║     Copyright (C) 1995,97 SpeedSoft Germany,   All rights reserved.      ║
  7.  ║                                                                          ║
  8.  ╚══════════════════════════════════════════════════════════════════════════╝}
  9.                     
  10. Unit DbLayer;
  11.  
  12. Interface
  13.  
  14. Uses Dos,SysUtils,IniFiles;
  15.  
  16. {$IFDEF OS2}
  17. Uses Os2Def,BseDos,PmWin;
  18. {$ENDIF}
  19. {$IFDEF Win95}
  20. Uses WinNt,WinDef,WinBase;
  21. {$ENDIF}
  22.  
  23. Uses Classes;
  24.  
  25. Type
  26.     HENV=LongWord;
  27.     HDBC=LongWord;
  28.     HSTMT=LongWord;
  29.     RETCODE=Integer;
  30.  
  31.     SQLHENV=HENV;
  32.     SQLHDBC=HDBC;
  33.     SQLHSTMT=HSTMT;
  34.     SQLHWND=HWND;
  35.  
  36.     SWORD=Integer;
  37.     UWORD=Word;
  38.     SQLSMALLINT=SWORD;
  39.     SQLUSMALLINT=UWORD;
  40.     SQLUINTEGER=LongWord;
  41.     SQLINTEGER=LongInt;
  42.     SQLRETURN=SQLSMALLINT;
  43.     SQLCHAR=cstring;
  44.     SQLPOINTER=Pointer;
  45.  
  46. Const
  47.      SQL_SUCCESS             =0;
  48.      SQL_SUCCESS_WITH_INFO   =1;
  49.      SQL_NO_DATA_FOUND       =100;
  50.      SQL_NEED_DATA           =99;
  51.      SQL_NO_DATA             =SQL_NO_DATA_FOUND;
  52.      SQL_STILL_EXECUTING     =2;
  53.      SQL_ERROR               =-1;
  54.      SQL_INVALID_HANDLE      =-2;
  55.  
  56.      SQL_COMMIT              =0;
  57.      SQL_ROLLBACK            =1;
  58.  
  59.     /* Options For SQLSetConnectOption/SQLGetConnectOption */
  60. Const
  61.     SQL_ACCESS_MODE              =101;
  62.     SQL_AUTOCOMMIT               =102;
  63.     SQL_LOGIN_TIMEOUT            =103;
  64.     SQL_OPT_TRACE                =104;
  65.     SQL_OPT_TRACEFILE            =105;
  66.     SQL_TRANSLATE_DLL            =106;
  67.     SQL_TRANSLATE_OPTION         =107;
  68.     SQL_TXN_ISOLATION            =108;
  69.     SQL_CURRENT_QUALIFIER        =109;
  70.     SQL_ODBC_CURSORS             =110;
  71.     SQL_QUIET_MODE               =111;
  72.     SQL_PACKET_SIZE              =112;
  73.     SQL_CONNECT_OPT_DRVR_START   =1000;
  74.  
  75.     SQL_PARAM_TYPE_UNKNOWN       =0;
  76.     SQL_PARAM_INPUT              =1;
  77.     SQL_PARAM_INPUT_OUTPUT       =2;
  78.     SQL_RESULT_COL               =3;
  79.     SQL_PARAM_OUTPUT             =4;
  80.     SQL_RETURN_VALUE             =5;
  81.     SQL_PARAM_RESULT             =6; //Oracle7
  82.  
  83.     /* Options For SQLGetConnectOption/SQLSetConnectOption extensions */
  84.     SQL_WCHARTYPE                =1252;
  85.     SQL_LONGDATA_COMPAT          =1253;
  86.     SQL_CURRENT_SCHEMA           =1254;
  87.     SQL_DB2EXPLAIN               =1258;
  88.     SQL_DB2ESTIMATE              =1259;
  89.     SQL_PARAMOPT_ATOMIC          =1260;
  90.     SQL_STMTTXN_ISOLATION        =1261;
  91.     SQL_MAXCONN                  =1262;
  92.  
  93.     /* Options For SQLSetConnectOption, SQLSetEnvAttr */
  94.     SQL_CONNECTTYPE              =1255;
  95.     SQL_SYNC_POINT               =1256;
  96.  
  97.     /* Options For SQL_LONGDATA_COMPAT */
  98.     SQL_LD_COMPAT_YES            =1;
  99.     SQL_LD_COMPAT_NO             =0;
  100.     SQL_LD_COMPAT_DEFAULT        =SQL_LD_COMPAT_NO;
  101.  
  102.     /*  Options For SQL_PARAMOPT_ATOMIC*/
  103.     SQL_ATOMIC_YES               =1;
  104.     SQL_ATOMIC_NO                =0;
  105.     SQL_ATOMIC_DEFAULT           =SQL_ATOMIC_YES;
  106.  
  107.     /* Options For SQL_CONNECT_TYPE */
  108.     SQL_CONCURRENT_TRANS         =1;
  109.     SQL_COORDINATED_TRANS        =2;
  110.     SQL_CONNECTTYPE_DEFAULT      =SQL_CONCURRENT_TRANS;
  111.  
  112.     /* Options For SQL_SYNCPOINT */
  113.     SQL_ONEPHASE                 =1;
  114.     SQL_TWOPHASE                 =2;
  115.     SQL_SYNCPOINT_DEFAULT        =SQL_ONEPHASE;
  116.  
  117.     /* Options For SQL_DB2ESTIMATE */
  118.     SQL_DB2ESTIMATE_ON           =1;
  119.     SQL_DB2ESTIMATE_OFF          =0;
  120.     SQL_DB2ESTIMATE_DEFAULT      =SQL_DB2ESTIMATE_OFF;
  121.  
  122.     /* Options For SQL_DB2EXPLAIN */
  123.     SQL_DB2EXPLAIN_ON            =1;
  124.     SQL_DB2EXPLAIN_OFF           =0;
  125.     SQL_DB2EXPLAIN_DEFAULT       =SQL_DB2EXPLAIN_OFF;
  126.  
  127.     /* Options For SQL_WCHARTYPE */
  128.     SQL_WCHARTYPE_CONVERT        =1;
  129.     SQL_WCHARTYPE_NOCONVERT      =0;
  130.     SQL_WCHARTYPE_DEFAULT        =SQL_WCHARTYPE_NOCONVERT;
  131.  
  132.     /* SQL_ACCESS_MODE Options */
  133.     SQL_MODE_READ_WRITE          =0;
  134.     SQL_MODE_READ_ONLY           =1;
  135.     SQL_MODE_DEFAULT             =SQL_MODE_READ_WRITE;
  136.  
  137.     /* SQL_AUTOCOMMIT Options */
  138.     SQL_AUTOCOMMIT_OFF           =0;
  139.     SQL_AUTOCOMMIT_ON            =1;
  140.     SQL_AUTOCOMMIT_DEFAULT       =SQL_AUTOCOMMIT_ON;
  141.  
  142.     /* SQL_LOGIN_TIMEOUT Options */
  143.     SQL_LOGIN_TIMEOUT_DEFAULT    =0;
  144.  
  145.     /* Column types And scopes In SQLSpecialColumns */
  146.     SQL_BEST_ROWID               =1;
  147.     SQL_ROWVER                   =2;
  148.  
  149.     SQL_SCOPE_CURROW             =0;
  150.     SQL_SCOPE_TRANSACTION        =1;
  151.     SQL_SCOPE_SESSION            =2;
  152.  
  153.     /* Defines For SQLStatistics */
  154.     SQL_INDEX_UNIQUE             =0;
  155.     SQL_INDEX_ALL                =1;
  156.  
  157.     SQL_QUICK                    =0;
  158.     SQL_ENSURE                   =1;
  159.  
  160.     /* Defines For SQLStatistics (returned In the Result Set) */
  161.     SQL_TABLE_STAT               =0;
  162.     SQL_INDEX_CLUSTERED          =1;
  163.     SQL_INDEX_HASHED             =2;
  164.     SQL_INDEX_OTHER              =3;
  165.  
  166.     /* Defines For SQLSpecialColumns (returned In the Result Set) */
  167.     SQL_PC_UNKNOWN               =0;
  168.     SQL_PC_NOT_PSEUDO            =1;
  169.     SQL_PC_PSEUDO                =2;
  170.  
  171.     /* SQLDataSources "fDirection" values, also used ON SQLExtendedFetch() */
  172.     /* See sqlext.H For additional SQLExtendedFetch fetch Direction Defines */
  173.     SQL_FETCH_NEXT             =1;
  174.     SQL_FETCH_FIRST            =2;
  175.     SQL_FETCH_LAST             =3;
  176.     SQL_FETCH_PRIOR            =4;
  177.     SQL_FETCH_ABSOLUTE         =5;
  178.     SQL_FETCH_RELATIVE         =6;
  179.  
  180.     /* Special Length values  */
  181.     SQL_NULL_DATA        =-1;
  182.     SQL_DATA_AT_EXEC     =-2;
  183.     SQL_NTS              =-3;      /* NTS = Null Terminated String    */
  184.  
  185.     /* SQLFreeStmt option values  */
  186.     SQL_CLOSE               =0;
  187.     SQL_DROP                =1;
  188.     SQL_UNBIND              =2;
  189.     SQL_RESET_PARAMS        =3;
  190.  
  191.     /* SQLColAttributes Defines */
  192.     SQL_COLUMN_COUNT             =0;
  193.     SQL_COLUMN_NAME              =1;
  194.     SQL_COLUMN_TYPE              =2;
  195.     SQL_COLUMN_LENGTH            =3;
  196.     SQL_COLUMN_PRECISION         =4;
  197.     SQL_COLUMN_SCALE             =5;
  198.     SQL_COLUMN_DISPLAY_SIZE      =6;
  199.     SQL_COLUMN_NULLABLE          =7;
  200.     SQL_COLUMN_UNSIGNED          =8;
  201.     SQL_COLUMN_MONEY             =9;
  202.     SQL_COLUMN_UPDATABLE        =10;
  203.     SQL_COLUMN_AUTO_INCREMENT   =11;
  204.     SQL_COLUMN_CASE_SENSITIVE   =12;
  205.     SQL_COLUMN_SEARCHABLE       =13;
  206.     SQL_COLUMN_TYPE_NAME        =14;
  207.     SQL_COLUMN_TABLE_NAME       =15;
  208.     SQL_COLUMN_OWNER_NAME       =16;
  209.     SQL_COLUMN_QUALIFIER_NAME   =17;
  210.     SQL_COLUMN_LABEL            =18;
  211.     SQL_COLUMN_SCHEMA_NAME      =SQL_COLUMN_OWNER_NAME;
  212.     SQL_COLUMN_CATALOG_NAME     =SQL_COLUMN_QUALIFIER_NAME;
  213.     SQL_COLUMN_DISTINCT_TYPE    =1250;
  214.  
  215.     /* SQLColAttributes Defines For SQL_COLUMN_UPDATABLE condition */
  216.     SQL_ATTR_READONLY           = 0;
  217.     SQL_ATTR_WRITE              = 1;
  218.     SQL_ATTR_READWRITE_UNKNOWN  = 2;
  219.  
  220.     /* Standard SQL Data types */
  221.     SQL_CHAR                =1;
  222.     SQL_NUMERIC             =2;
  223.     SQL_DECIMAL             =3;
  224.     SQL_INTEGER             =4;
  225.     SQL_SMALLINT            =5;
  226.     SQL_FLOAT               =6;
  227.     SQL_REAL                =7;
  228.     SQL_DOUBLE              =8;
  229.     SQL_DATE                =9;
  230.     SQL_TIME               =10;
  231.     SQL_TIMESTAMP          =11;
  232.     SQL_VARCHAR            =12;
  233.  
  234.     /* SQL Extended Data types */
  235.     SQL_LONGVARCHAR        =-1;
  236.     SQL_BINARY             =-2;
  237.     SQL_VARBINARY          =-3;
  238.     SQL_LONGVARBINARY      =-4;
  239.     SQL_BIGINT             =-5;  /* Not supported */
  240.     SQL_TINYINT            =-6;  /* Not supported */
  241.     SQL_BIT                =-7;  /* Not supported */
  242.     SQL_GRAPHIC            =-95;
  243.     SQL_VARGRAPHIC         =-96;
  244.     SQL_LONGVARGRAPHIC     =-97;
  245.     SQL_BLOB               =-98;
  246.     SQL_CLOB               =-99;
  247.     SQL_DBCLOB             =-350;
  248.  
  249.     SQL_SIGNED_OFFSET      =-20;
  250.     SQL_UNSIGNED_OFFSET    =-22;
  251.  
  252.     /* C Data Type To SQL Data Type mapping */
  253.     SQL_C_CHAR       =SQL_CHAR;      /* Char, VARCHAR, DECIMAL, NUMERIC */
  254.     SQL_C_LONG       =SQL_INTEGER;   /* Integer                         */
  255.     SQL_C_SHORT      =SQL_SMALLINT;  /* SMALLINT                        */
  256.     SQL_C_FLOAT      =SQL_REAL;      /* Real                            */
  257.     SQL_C_DOUBLE     =SQL_DOUBLE;    /* FLOAT, Double                   */
  258.     SQL_C_DATE       =SQL_DATE;      /* date                            */
  259.     SQL_C_TIME       =SQL_TIME;      /* Time                            */
  260.     SQL_C_TIMESTAMP  =SQL_TIMESTAMP; /* TIMESTAMP                       */
  261.     SQL_C_BINARY     =SQL_BINARY;    /* binary, VARGINARY               */
  262.     SQL_C_BIT        =SQL_BIT;
  263.     SQL_C_TINYINT    =SQL_TINYINT;
  264.     SQL_C_DBCHAR     =SQL_DBCLOB;
  265.     SQL_C_DEFAULT    =99;
  266.  
  267.     /* For ODBC compatibility only */
  268.     SQL_C_SLONG      =SQL_C_LONG+SQL_SIGNED_OFFSET;
  269.     SQL_C_SSHORT     =SQL_C_SHORT+SQL_SIGNED_OFFSET;
  270.     SQL_C_STINYINT   =SQL_C_TINYINT+SQL_SIGNED_OFFSET;
  271.     SQL_C_ULONG      =SQL_C_LONG+SQL_UNSIGNED_OFFSET;
  272.     SQL_C_USHORT     =SQL_C_SHORT+SQL_UNSIGNED_OFFSET;
  273.     SQL_C_UTINYINT   =SQL_C_TINYINT+SQL_UNSIGNED_OFFSET;
  274.  
  275.     /* generally useful constants */
  276.     SQL_SQLSTATE_SIZE        = 5;   /* Size Of SQLSTATE, Not including
  277.                                           Null terminating Byte           */
  278.     SQL_MAX_MESSAGE_LENGTH   =1024; /* Message Buffer Size             */
  279.     SQL_MAX_DSN_LENGTH       =32;   /* maximum Data Source Name Size   */
  280.     SQL_MAX_ID_LENGTH        =18;   /* maximum identifier Name Size, */
  281.  
  282.     //SQLSetStmtOption values
  283.     SQL_QUERY_TIMEOUT =0;
  284.     SQL_MAX_ROWS      =1;
  285.     SQL_NOSCAN        =2;
  286.     SQL_MAX_LENGTH    =3;
  287.     SQL_ASYNC_ENABLE  =4;
  288.     SQL_BIND_TYPE     =5;
  289.     SQL_CURSOR_TYPE   =6;
  290.     SQL_CONCURRENCY   =7;
  291.     SQL_KEYSET_SIZE   =8;
  292.     SQL_ROWSET_SIZE   =9;
  293.     SQL_SIMULATE_CURSOR =10;
  294.     SQL_RETRIEVE_DATA =11;
  295.     SQL_USE_BOOKMARKS =12;
  296.     SQL_GET_BOOKMARK  =13;
  297.     SQL_ROW_NUMBER    =14;
  298.  
  299.     //SQLScrollOptions
  300.     SQL_SO_FORWARD_ONLY         = 1;
  301.     SQL_SO_KEYSET_DRIVEN        = 2;
  302.     SQL_SO_DYNAMIC              = 4;
  303.     SQL_SO_MIXED                = 8;
  304.     SQL_SO_STATIC               = 16;
  305.  
  306.     //CursorType
  307.     SQL_CURSOR_FORWARD_ONLY     =0;
  308.     SQL_CURSOR_KEYSET_DRIVEN    =1;
  309.     SQL_CURSOR_DYNAMIC          =2;
  310.     SQL_CURSOR_STATIC           =3;
  311.  
  312.     SQL_NO_NULLS                =0;
  313.     SQL_NULLABLE                =1;
  314.     SQL_NULLABLE_UNKNOWN        =2;
  315.  
  316.  
  317. Type
  318.     TDBTypes=(Unkown_DB,Native,Native_DBase,Native_mSQL,Sybase,DB2,
  319.               Native_Paradox,Native_Oracle7,ODBC);
  320.  
  321.     TODBCDate=Record
  322.        Year,Month,Day:Word;
  323.     End;
  324.  
  325.  
  326.     TODBCTime=Record
  327.         Hour,Minute,Second:Word;
  328.     End;
  329.  
  330.  
  331.     TODBCDateTime=Record
  332.         Date:TODBCDate;
  333.         Time:TODBCTime;
  334.     End;
  335.  
  336.     PDBProcs=^TDBProcs;
  337.     TDBProcs=Record
  338.                    ModHandle:LongWord;  //Module Handle
  339.                    ahenv:SQLHENV;       //Environment Handle
  340.                    ahdbc:SQLHDBC;       //DataBase Handle
  341.                    ahstmt:SQLHSTMT;     //statement Handle
  342.                    DataBase:cstring;    //DataBase Name
  343.                    AliasName:String;    //Server alias Name
  344.                    Host:string;         //database host
  345.                    uid:cstring;         //user Id
  346.                    pwd:cstring;         //pasword
  347.                    Assigned:Boolean;    //True if functions and heap-structures are valid
  348.                    FuncTable:Pointer;   //function table for some native db's (like mSQL)
  349.                    IsStoredProc:Boolean;//True for stored procs
  350.  
  351.                    Case DBType:TDBTypes Of
  352.                      Native_DBase,Native_Paradox,Unkown_DB,Native,Native_mSQL,Sybase,DB2,ODBC:
  353.                      (
  354.                         SQLAllocEnv:Function(Var phenv:SQLHENV):SQLRETURN;APIENTRY;
  355.                         SQLAllocConnect:Function(ahenv:SQLHENV;Var phdbc:SQLHDBC):SQLRETURN;APIENTRY;
  356.                         SqlConnect:Function(ahdbc:SQLHDBC;Const szDSN:SQLCHAR;
  357.                                             cbDSN:LongInt;Const szUID:SQLCHAR;
  358.                                             cbUID:LongInt;Const szAuthString:SQLCHAR;
  359.                                             cbAuthString:LongInt):SQLRETURN;APIENTRY;
  360.                         {
  361.                         SQLDriverConnect:Function(ahdbc:SQLHDBC;HWindow:SQLHWND;
  362.                                                   Const szConnStrIn:SQLCHAR;cbConnStrIn:LongInt;
  363.                                                   Var szConnStrOut:SQLCHAR;cbConnStrOutMax:LongInt;
  364.                                                   Var pcbConnStrOut:SQLSMALLINT;
  365.                                                   fDriverCompletion:LongWord):SQLRETURN;APIENTRY;
  366.                         }
  367.                         SQLDataSources:Function(ahenv:SQLHENV;fDirection:LongWord;
  368.                                                 Var szDSN:SQLCHAR;cbDSNMax:LongInt;
  369.                                                 Var pcbDSN:SQLSMALLINT;
  370.                                                 Var szDescription:SQLCHAR;cbDescriptionMax:LongInt;
  371.                                                 Var pcbDescription:SQLSMALLINT):SQLRETURN;APIENTRY;
  372.                         {SQLGetInfo:Function(ahdbc:SQLHDBC;fInfoType:LongWord;Var rgbInfoValue;cbInfoValueMax:LongInt;
  373.                                             Var pcbInfoValue:SQLSMALLINT):SQLRETURN;APIENTRY;
  374.                         SQLGetFunctions:Function(ahdbc:SQLHDBC;fFunction:LongWord;Var pfExists:SQLUSMALLINT):SQLRETURN;APIENTRY;
  375.                         }
  376.                         SQLGetTypeInfo:Function(ahstmt:SQLHSTMT;fSQLType:LongInt):SQLRETURN;APIENTRY;
  377.                         SQLSetConnectOption:Function(ahdbc:SQLHDBC;fOption:LongWord;vParam:SQLUINTEGER):SQLRETURN;APIENTRY;
  378.                         //SQLGetConnectOption:Function(ahdbc:SQLHDBC;fOption:LongWord;Var pvParam):SQLRETURN;APIENTRY;
  379.                         SQLSetStmtOption:Function(ahstmt:SQLHSTMT;fOption:LongWord;vParam:SQLUINTEGER):SQLRETURN;APIENTRY;
  380.                         {SQLGetStmtOption:Function(ahstmt:SQLHSTMT;fOption:LongWord;Var pvParam):SQLRETURN;APIENTRY;}
  381.                         SQLAllocStmt:Function(ahdbc:SQLHDBC;Var phstmt:SQLHSTMT):SQLRETURN;APIENTRY;
  382.                         {SQLPrepare:Function(ahstmt:SQLHSTMT;Const szSqlStr:SQLCHAR;cbSqlStr:SQLINTEGER):SQLRETURN;APIENTRY;}
  383.                         SQLBindParameter:Function(ahstmt:SQLHSTMT;ipar:LongWord;fParamType:LongInt;
  384.                                                   fCType:LongInt;fSQLType:LongInt;cbParamDef:SQLUINTEGER;
  385.                                                   ibScale:LongInt;Var rgbValue;cbValueMax:SQLINTEGER;
  386.                                                   Var pcbValue:SQLINTEGER):SQLRETURN;APIENTRY;
  387.                         {SQLSetParam:Function(ahstmt:SQLHSTMT;ipar:LongWord;fCType:LongInt;fSQLType:LongInt;
  388.                                              cbParamDef:SQLUINTEGER;ibScale:LongInt;Var rgbValue;
  389.                                              Var pcbValue:SQLINTEGER):SQLRETURN;APIENTRY;
  390.                         SQLParamOptions:Function(ahstmt:SQLHSTMT;crow:SQLUINTEGER;Var pirow:SQLUINTEGER):SQLRETURN;APIENTRY;}
  391.                         SQLGetCursorName:Function(ahstmt:SQLHSTMT;Var szCursor:SQLCHAR;cbCursorMax:LongInt;
  392.                                                   Var pcbCursor:SQLSMALLINT):SQLRETURN;APIENTRY;
  393.                         {SQLSetCursorName:Function(ahstmt:SQLHSTMT;Const szCursor:SQLCHAR;cbCursor:LongInt):SQLRETURN;APIENTRY;
  394.                         SQLExecute:Function(ahstmt:SQLHSTMT):SQLRETURN;APIENTRY;}
  395.                         SQLExecDirect:Function(ahstmt:SQLHSTMT;Const szSqlStr:SQLCHAR;cbSqlStr:SQLINTEGER):SQLRETURN;APIENTRY;
  396.                         {SQLNativeSql:Function(ahdbc:SQLHDBC;Const szSqlStrIn:SQLCHAR;cbSqlStrIn:SQLINTEGER;
  397.                                               Var szSqlStr:SQLCHAR;cbSqlStrMax:SQLINTEGER;Var pcbSqlStr:SQLINTEGER):SQLRETURN;APIENTRY;}
  398.                         SQLNumParams:Function(ahstmt:SQLHSTMT;Var pcpar:SQLSMALLINT):SQLRETURN;APIENTRY;
  399.                         {SQLParamData:Function(ahstmt:SQLHSTMT;Var prgbValue):SQLRETURN;APIENTRY;
  400.                         SQLPutData:Function(ahstmt:SQLHSTMT;Var rgbValue;Var cbValue:SQLINTEGER):SQLRETURN;APIENTRY;
  401.                         SQLRowCount:Function(ahstmt:SQLHSTMT;Var pcrow:SQLINTEGER):SQLRETURN;APIENTRY;}
  402.                         SQLNumResultCols:Function(ahstmt:SQLHSTMT;Var pccol:SQLSMALLINT):SQLRETURN;APIENTRY;
  403.                         SQLDescribeCol:Function(ahstmt:SQLHSTMT;icol:LongWord;Var szColName:SQLCHAR;
  404.                                                 cbColNameMax:LongInt;Var pcbColName:SQLSMALLINT;
  405.                                                 Var pfSqlType:SQLSMALLINT;Var pcbColDef:SQLUINTEGER;
  406.                                                 Var pibScale:SQLSMALLINT;Var pfNullable:SQLSMALLINT):SQLRETURN;APIENTRY;
  407.                         {SQLColAttributes:Function(ahstmt:SQLHSTMT;icol:LongWord;fDescType:LongWord;
  408.                                                   Var rgbDesc:SQLCHAR;cbDescMax:LongInt;
  409.                                                   Var pcbDesc:SQLSMALLINT;Var pfDesc:SQLINTEGER):SQLRETURN;APIENTRY;}
  410.                         SQLBindCol:Function(ahstmt:SQLHSTMT;icol:LongWord;fCType:LongInt;Var rgbValue;
  411.                                             cbValueMax:SQLINTEGER;Var pcbValue:SQLINTEGER):SQLRETURN;APIENTRY;
  412.                         SQLFetch:Function(ahstmt:SQLHSTMT):SQLRETURN;APIENTRY;
  413.                         SQLExtendedFetch:Function(ahstmt:SQLHSTMT;fFetchType:LongWord;irow:SQLINTEGER;
  414.                                                   Var pcrow:SQLUINTEGER;Var rgfRowStatus):SQLRETURN;APIENTRY;
  415.                         SQLGetData:Function(ahstmt:SQLHSTMT;icol:LongWord;fCType:LongInt;
  416.                                             Var rgbValue;cbValueMax:SQLINTEGER;Var pcbValue:SQLINTEGER):SQLRETURN;APIENTRY;
  417.                         {SQLMoreResults:Function(ahstmt:SQLHSTMT):SQLRETURN;APIENTRY;}
  418.                         SQLError:Function(ahenv:SQLHENV;ahdbc:SQLHDBC;ahstmt:SQLHSTMT;Var szSqlState:SQLCHAR;
  419.                                           Var pfNativeError:SQLINTEGER;Var szErrorMsg;
  420.                                           cbErrorMsgMax:LongInt;Var pcbErrorMsg:SQLSMALLINT):SQLRETURN;APIENTRY;
  421.                         {SQLColumns:Function(ahstmt:SQLHSTMT;Const szCatalogName:SQLCHAR;cbCatalogName:LongInt;
  422.                                            Const szSchemaName:SQLCHAR;cbSchemaName:LongInt;
  423.                                            Const szTableName:SQLCHAR;cbTableName:LongInt;
  424.                                            Const szColumnName:SQLCHAR;cbColumnName:LongInt):SQLRETURN;APIENTRY;}
  425.                         SQLForeignKeys:Function(ahstmt:SQLHSTMT;Const szPkCatalogName:SQLCHAR;cbPkCatalogName:LongInt;
  426.                                                 Const szPkSchemaName:SQLCHAR;cbPkSchemaName:LongInt;
  427.                                                 Const szPkTableName:SQLCHAR;cbPkTableName:LongInt;
  428.                                                 Const szFkCatalogName:SQLCHAR;cbFkCatalogName:LongInt;
  429.                                                 Const szFkSchemaName:SQLCHAR;cbFkSchemaName:LongInt;
  430.                                                 Const szFkTableName:SQLCHAR;cbFkTableName:LongInt):SQLRETURN;APIENTRY;
  431.                         SQLPrimaryKeys:Function(ahstmt:SQLHSTMT;Const szCatalogName:SQLCHAR;cbCatalogName:LongInt;
  432.                                                 Const szSchemaName:SQLCHAR;cbSchemaName:LongInt;
  433.                                                 Const szTableName:SQLCHAR;cbTableName:LongInt):SQLRETURN;APIENTRY;
  434.                         SQLProcedureColumns:Function(ahstmt:SQLHSTMT;Const szProcCatalog:SQLCHAR;cbProcCatalog:LongInt;
  435.                                                      Const szProcSchema:SQLCHAR;cbProcSchema:LongInt;
  436.                                                      Const szProcName:SQLCHAR;cbProcName:LongInt;
  437.                                                      Const szColumnName:SQLCHAR;cbColumnName:LongInt):SQLRETURN;APIENTRY;
  438.                         SQLProcedures:Function(ahstmt:SQLHSTMT;Const szProcCatalog:SQLCHAR;cbProcCatalog:LongInt;
  439.                                                Const szProcSchema:SQLCHAR;cbProcSchema:LongInt;
  440.                                                Const szProcName:SQLCHAR;cbProcName:LongInt):SQLRETURN;APIENTRY;
  441.                         {SQLSpecialColumns:Function(ahstmt:SQLHSTMT;fColType:LongWord;
  442.                                                    Const szCatalogName:SQLCHAR;cbCatalogName:LongInt;
  443.                                                    Const szSchemaName:SQLCHAR;cbSchemaName:LongInt;
  444.                                                    Const szTableName:SQLCHAR;cbTableName:LongInt;
  445.                                                    fScope:LongWord;fNullable:LongWord):SQLRETURN;APIENTRY;}
  446.                         SQLStatistics:Function(ahstmt:SQLHSTMT;Const szCatalogName:SQLCHAR;cbCatalogName:LongInt;
  447.                                                Const szSchemaName:SQLCHAR;cbSchemaName:LongInt;
  448.                                                Const szTableName:SQLCHAR;cbTableName:LongInt;
  449.                                                fUnique:LongWord;fAccuracy:LongWord):SQLRETURN;APIENTRY;
  450.                         {
  451.                         SQLTablePrivileges:Function(ahstmt:SQLHSTMT;Const szTableQualifier:SQLCHAR;cbTableQualifier:LongInt;
  452.                                                     Const szSchemaName:SQLCHAR;cbSchemaName:LongInt;
  453.                                                     Const szTableName:SQLCHAR;cbTableName:LongInt):SQLRETURN;APIENTRY;}
  454.                         SQLTables:Function(ahstmt:SQLHSTMT;Const szCatalogName:SQLCHAR;cbCatalogName:LongInt;
  455.                                            Const szSchemaName:SQLCHAR;cbSchemaName:LongInt;
  456.                                            Const szTableName:SQLCHAR;cbTableName:LongInt;
  457.                                            Const szTableType:SQLCHAR;cbTableType:LongInt):SQLRETURN;APIENTRY;
  458.                         SQLFreeStmt:Function(ahstmt:SQLHSTMT;fOption:LongWord):SQLRETURN;APIENTRY;
  459.                         SQLCancel:Function(ahstmt:SQLHSTMT):SQLRETURN;APIENTRY;
  460.                         SQLTransact:Function(ahenv:SQLHENV;ahdbc:SQLHDBC;fType:LongWord):SQLRETURN;APIENTRY;
  461.                         SQLDisconnect:Function(ahdbc:SQLHDBC):SQLRETURN;APIENTRY;
  462.                         SQLFreeConnect:Function(ahdbc:SQLHDBC):SQLRETURN;APIENTRY;
  463.                         SQLFreeEnv:Function(ahenv:SQLHENV):SQLRETURN;APIENTRY;
  464.                         Oracle7GetProcParams:Function(Const Name:String;DBProcs:PDBProcs;ParamName:TStrings;ParamType,ParamMode:TList):Boolean;
  465.                      );
  466.     End;
  467.  
  468. Type
  469.     EProcAddrError=Class(Exception);
  470.  
  471. Function FillDBProcs(Var DbProcs:TDBProcs):Boolean;
  472. Procedure FreeDBProcs(Var DbProcs:TDBProcs);
  473. Function SQLErrorText(Var DbProcs:TDBProcs;ahenv:SQLHENV;ahdbc:SQLHDBC;ahstmt:SQLHSTMT):String;
  474.  
  475. Function GetDBServersCount:LongInt;
  476. Procedure GetDBServer(Index:LongInt;Var AliasName,DllName:String;Var DBType:TDBTypes);
  477. Procedure GetDBServerFromAlias(Const alias:String;Var DllName:String;Var DBType:TDBTypes);
  478. Procedure AddServerAlias(Const AliasName,DllName:String;DBType:TDBTypes);
  479. Procedure ModifyServerAlias(Const AliasName,NewAliasName,DllName:String;DBType:TDBTypes);
  480. Procedure RemoveServerAlias(Const AliasName:String);
  481. Function IsDefaultServer(Const AliasName:String):Boolean;
  482.  
  483. Function GetDBAliasNamesCount:LongInt;
  484. Procedure GetDBAlias(Index:LongInt;Var AliasName,DriverName,Advanced,UID:String);
  485. Procedure GetDBServerFromDBAlias(Const AliasName:String;Var DriverName,Advanced,UID:String);
  486. Procedure AddDatabaseAlias(Const AliasName,DriverName,Advanced,UID:String);
  487. Procedure ModifyDatabaseAlias(Const AliasName,NewAliasName,DriverName,Advanced,UID:String);
  488. Procedure RemoveDatabaseAlias(Const AliasName:String);
  489.  
  490.  
  491. Function AllocateDBEnvironment(Var Procs:TDBProcs):SQLRETURN;
  492. Procedure RegisterDBDrivers(IniName:String);
  493. Procedure RegisterDBAliasNames(IniName:String);
  494.  
  495.  
  496. Implementation
  497.  
  498.  
  499. {*******************************************************************************************
  500.  *                                                                                         *
  501.  * Oracle7 section (native support)                                                        *
  502.  *                                                                                         *
  503.  *                                                                                         *
  504.  *******************************************************************************************}
  505.  
  506. //Oracle 7 definitions
  507.  
  508. /*  internal/external datatype codes */
  509. Const
  510.      O7_VARCHAR2_TYPE          =  1;
  511.      O7_NUMBER_TYPE            =  2;
  512.      O7_INT_TYPE               =  3;
  513.      O7_FLOAT_TYPE             =  4;
  514.      O7_STRING_TYPE            =  5;
  515.      O7_ROWID_TYPE             = 11;
  516.      O7_DATE_TYPE              = 12;
  517.  
  518.      PARSE_NO_DEFER         = 0;
  519.      PARSE_V7_LNG           = 2;
  520.  
  521. /*  ORACLE error codes used in demonstration programs */
  522. Const
  523.      VAR_NOT_IN_LIST       =1007;
  524.      NO_DATA_FOUND         =1403;
  525.      NULL_VALUE_RETURNED   =1405;
  526.  
  527. /*  some SQL and OCI function codes */
  528. Const
  529.      FT_INSERT             =   3;
  530.      FT_SELECT             =   4;
  531.      FT_UPDATE             =   5;
  532.      FT_DELETE             =   9;
  533.  
  534.      FC_OOPEN              =  14;
  535.  
  536. /*
  537. ** Size of HDA area:
  538. ** 512 for 64 bit arquitectures
  539. ** 256 for 32 bit arquitectures
  540. */
  541.  
  542. Const HDA_SIZE =512;
  543.  
  544. Type
  545.     eb1=Byte;        /* use where sign not important */
  546.     ub1=Byte;       /* use where unsigned important */
  547.     sb1=ShortInt;   /* use where   signed important */
  548.  
  549. Type
  550.     eb2=Integer;   /* use where sign not important */
  551.     ub2=Word;      /* use where unsigned important */
  552.     sb2=Integer;   /* use where   signed important */
  553.  
  554. Type
  555.     eb4=LongInt;   /* use where sign not important */
  556.     ub4=LongWord;  /* use where unsigned important */
  557.     sb4=LongInt;   /* use where   signed important */
  558.  
  559. Type
  560.     dvoid=Pointer;
  561.  
  562. /* The cda_head struct is strictly PRIVATE.  It is used
  563.    internally only. Do not use this struct in OCI programs. */
  564.  
  565. Type cda_head=record
  566.                     v2_rc:sb2;
  567.                     ft:ub2;
  568.                     rpc:ub4;
  569.                     peo:ub2;
  570.                     fc:ub1;
  571.                     rcs1:ub1;
  572.                     rc:ub2;
  573.                     wrn:ub1;
  574.                     rcs2:ub1;
  575.                     rcs3:LongInt;
  576.                     rid:record
  577.                         rd:record
  578.                                  rcs4:ub4;
  579.                                  rcs5:ub2;
  580.                                  rcs6:ub1;
  581.                         End;
  582.                         rcs7:ub4;
  583.                         rcs8:ub2;
  584.                     End;
  585.                     ose:LongInt;
  586.                     rcsp:Pointer;
  587.      End;
  588.  
  589. /* the real CDA, padded to 64 bytes in size */
  590. Type
  591.    cda_def=Record
  592.                  v2_rc:sb2;                       /* V2 return code */
  593.                  ft:ub2;                          /* SQL function type */
  594.                  rpc:ub4;                         /* rows processed count */
  595.                  peo:ub2;                         /* parse error offset */
  596.                  fc:ub1;                          /* OCI function code */
  597.                  rcs1:ub1;                        /* filler area */
  598.                  rc:ub2;                          /* V7 return code */
  599.                  wrn:ub1;                         /* warning flags */
  600.                  rcs2:ub1;                        /* reserved */
  601.                  rcs3:LongInt;                      /* reserved */
  602.                  rid:record                       /* rowid structure */
  603.                     rd:record
  604.                              rcs4:ub4;
  605.                              rcs5:ub2;
  606.                              rcs6:ub1;
  607.                     End;
  608.                     rcs7:ub4;
  609.                     rcs8:ub2;
  610.                  End;
  611.                  ose:LongInt;                       /* OSD dependent error */
  612.                  rcsp:Pointer;                    /* pointer to reserved area */
  613.                  rcs9:Array[0..((64 - sizeof (cda_head))-1)] Of ub1; /* filler to 64 */
  614.    End;
  615.  
  616.  
  617. /* the logon data area (LDA) is the same shape as the CDA */
  618. Type Lda_Def=cda_def;
  619.  
  620. Const /* input data types */
  621.      SQLT_CHR  =1;              /* (ORANET TYPE) character string */
  622.      SQLT_NUM  =2;                /* (ORANET TYPE) oracle numeric */
  623.      SQLT_INT  =3;                       /* (ORANET TYPE) integer */
  624.      SQLT_FLT  =4;         /* (ORANET TYPE) Floating point number */
  625.      SQLT_STR  =5;                      /* zero terminated string */
  626.      SQLT_VNU  =6;              /* NUM with preceding length byte */
  627.      SQLT_PDN  =7;        /* (ORANET TYPE) Packed Decimal Numeric */
  628.      SQLT_LNG  =8;                                        /* long */
  629.      SQLT_VCS  =9;                   /* Variable character string */
  630.      SQLT_NON  =10;            /* Null/empty PCC Descriptor entry */
  631.      SQLT_RID  =11;                                      /* rowid */
  632.      SQLT_DAT  =12;                      /* date in oracle format */
  633.      SQLT_VBI  =15;                       /* binary in VCS format */
  634.      SQLT_BIN  =23;                        /* binary data(DTYBIN) */
  635.      SQLT_LBI  =24;                                /* long binary */
  636.      SQLT_UIN  =68;                           /* unsigned integer */
  637.      SQLT_SLS  =91;              /* Display sign leading separate */
  638.      SQLT_LVC  =94;                        /* Longer longs (char) */
  639.      SQLT_LVB  =95;                         /* Longer long binary */
  640.      SQLT_AFC  =96;                            /* Ansi fixed char */
  641.      SQLT_AVC  =97;                              /* Ansi Var char */
  642.      SQLT_LAB  =105;                                /* label type */
  643.      SQLT_OSL  =106;                              /* oslabel type */
  644.  
  645. Type
  646.     POracle7Func=^TOracle7Func;
  647.     TOracle7Func=Record
  648.                        obndra:Function(Var Cursor:cda_def;Var sqlvar:CString;sqlvl:LongInt;
  649.                                        Var progv;progvl:LongInt;ftype:LongInt;scale:LongInt;
  650.                                        Var indp:sb2;Var alen:ub2;Var arcode:ub2;maxsiz:ub4;
  651.                                        Var cursiz:ub4;Var fmt:CString;fmtl:LongInt;fmtt:LongInt):LongInt;APIENTRY;
  652.                        obndrv:Function(Var cursor:cda_def;Const sqlvar:CString;
  653.                                        sqlvl:LongInt;Var progv;progvl:LongInt;
  654.                                        ftype,scale:LongInt;
  655.                                        Var indp:sb2;Const fmt:CString;
  656.                                        fmtl,fmtt:LongInt):LongInt;APIENTRY;
  657.                        ocan:Function(Var cursor:cda_def):LongInt;APIENTRY;
  658.                        oclose:Function(Var cursor:cda_def):LongInt;APIENTRY;
  659.                        ocof:Function(Var lda:cda_def):LongInt;APIENTRY;
  660.                        ocom:Function(Var lda:cda_def):LongInt;APIENTRY;
  661.                        ocon:Function(Var lda:cda_def):LongInt;APIENTRY;
  662.                        odefin:Function(Var cursor:cda_def;pos:LongInt;Var buf;bufl:LongInt;ftype:LongInt;
  663.                                        scale:LongInt;Var indp:sb2;Const fmt:CString;
  664.                                        fmtl:LongInt;fmtt:LongInt;Var rlen:ub2;Var rcode:ub2):LongInt;APIENTRY;
  665.                        odescr:Function(Var cursor:cda_def;pos:LongInt;Var dbsize:sb4;
  666.                                        Var dbtype:sb2;Var cbuf:CString;Var cbufl:sb4;Var dsize:sb4;
  667.                                        Var prec:sb2;Var scale:sb2;Var nullok:sb2):LongInt;APIENTRY;
  668.                        oerhms:Function(Var lda:cda_def;rcode:sb2;Var buf:CString;bufsiz:LongInt):LongInt;APIENTRY;
  669.                        oexec:Function(Var cursor:cda_def):LongInt;APIENTRY;
  670.                        ofetch:Function(Var cursor:cda_def):LongInt;APIENTRY;
  671.                        ologof:Function(Var lda:cda_def):LongInt;APIENTRY;
  672.                        olon:Function(Var lda:cda_def;uid:CString;uidl:LongInt;
  673.                                      pswd:CString;pswdl:LongInt;audit:LongInt):LongInt;APIENTRY;
  674.                        oopen:Function(Var cursor:cda_def;Var lda:cda_def;
  675.                                       Const dbn:CString;dbnl:LongInt;arsize:LongInt;
  676.                                       Const uid:CString;uidl:LongInt):LongInt;APIENTRY;
  677.                        oparse:Function(Var cursor:cda_def;Const sqlstm:CString;sqllen:sb4;
  678.                                        defflg:LongInt;lngflg:ub4):LongInt;APIENTRY;
  679.  
  680.                        orlon:Function(Var lda:cda_def;Var hda:ub1;uid:CString;
  681.                                       uidl:LongInt;Const pswd:CString;pswdl:LongInt;audit:LongInt):LongInt;APIENTRY;
  682.                        orol:Function(Var lda:cda_def):LongInt;APIENTRY;
  683.                        odessp:Function(Var lda:lda_def;Const ProcName:CString;ProcNameLen:LongInt;
  684.                                        Var rsv1;rsv1ln:LongInt;Var rsv2;rsv2ln:LongInt;Var ovrld,pos,
  685.                                        level,argnm,arnlen,dtype,defsup,mode,
  686.                                        dtsiz,prec,scale,radix,sparem,arrsiz):LongInt;APIENTRY;
  687.  
  688.                        lda:cda_def;
  689.                        hda:Array[0..HDA_SIZE] Of ub1;
  690.                        aDBProcs:PDBProcs;
  691.                        Connected:Boolean;
  692.     End;
  693.  
  694.     P_henv=POracle7Func;
  695.  
  696.     P_hdbc=P_henv;
  697.  
  698.     P_hstmt=^T_hstmt;
  699.     T_hstmt=Record
  700.                  ahdbc:P_hdbc;
  701.                  cda:cda_def;
  702.                  CursorValid:Boolean;
  703.                  Executed:Boolean;
  704.                  ColList:TList;
  705.     End;
  706.  
  707.     P_stmtcol=^T_stmtcol;
  708.     T_stmtcol=Record
  709.                    dbsize:sb4;
  710.                    dbtype:sb2;
  711.                    ColName:CString;
  712.                    dsize:sb4;
  713.                    precision:sb2;
  714.                    scale:sb2;
  715.                    Nullok:sb2;
  716.                    Data:Pointer;
  717.                    DataLen:LongInt;
  718.                    OutLen:ub2;
  719.                    BindVar:Pointer;
  720.                    BindVarMax:LongInt;
  721.                    BindType:LongInt;
  722.                    pcbValue:^SQLINTEGER;
  723.     End;
  724.  
  725. Function MapODBCTypes(oratyp:sb2):SQLSMALLINT;
  726. Begin
  727.      Case oratyp Of
  728.          SQLT_CHR:Result:=SQL_VARCHAR;
  729.          SQLT_NUM:Result:=SQL_INTEGER;
  730.          SQLT_INT:Result:=SQL_INTEGER;
  731.          SQLT_FLT:Result:=SQL_FLOAT;
  732.          SQLT_STR:Result:=SQL_CHAR;
  733.          SQLT_LNG:Result:=SQL_LONGVARBINARY;
  734.          SQLT_VCS:Result:=SQL_VARCHAR;
  735.          SQLT_VBI:Result:=SQL_VARBINARY;
  736.          SQLT_BIN:Result:=SQL_BINARY;
  737.          SQLT_LBI:Result:=SQL_LONGVARBINARY;
  738.          SQLT_UIN:Result:=SQL_INTEGER;
  739.          SQLT_LVC:Result:=SQL_LONGVARCHAR;
  740.          SQLT_DAT:Result:=SQL_TIMESTAMP;
  741.          Else Result:=SQL_VARCHAR;
  742.      End; //case
  743. End;
  744.  
  745. Function MapOracleTypes(oratyp:SQLSMALLINT):sb2;
  746. Begin
  747.      Case oratyp Of
  748.          SQL_C_CHAR:Result:=SQLT_STR;
  749.          SQL_C_LONG,SQL_C_SHORT:Result:=SQLT_INT;
  750.          SQL_C_FLOAT:Result:=SQLT_FLT;
  751.          SQL_C_BINARY:Result:=SQLT_BIN;
  752.          SQL_C_TIMESTAMP:Result:=SQLT_DAT;
  753.          Else Result:=SQLT_STR;
  754.      End; //case
  755. End;
  756.  
  757. {$HINTS OFF}
  758. Function Oracle7_SQLAllocConnect(ahenv:SQLHENV;Var phdbc:SQLHDBC):SQLRETURN;APIENTRY;
  759. Begin
  760.      phdbc:=SQLHDBC(ahenv);
  761.      Result:=SQL_SUCCESS;
  762. End;
  763.  
  764. Function Oracle7_SqlConnect(ahdbc:SQLHDBC;Const szDSN:SQLCHAR;
  765.                             cbDSN:LongInt;Const szUID:SQLCHAR;
  766.                             cbUID:LongInt;Const szAuthString:SQLCHAR;
  767.                             cbAuthString:LongInt):SQLRETURN;APIENTRY;
  768. Var hdbc:P_hdbc;
  769.     s,s1:String;
  770.     UID_DSN:CString;
  771.     UID,DSN:^Pointer;
  772. Begin
  773.      {$IFDEF OS2}
  774.      ASM
  775.         xor eax,eax
  776.         db $64,$ff,$30  //pushd fs:[eax]
  777.      END;
  778.      {$ENDIF}
  779.  
  780.      hdbc:=PDBProcs(ahdbc)^.FuncTable;
  781.      UID:=@szUID;
  782.      DSN:=@szDSN;
  783.      If UID=Nil Then s:=''
  784.      Else s:=szUID;
  785.      If DSN=Nil Then s1:=''
  786.      Else s1:=szDSN;
  787.      UID_DSN:=s+'@'+s1;
  788.      if hdbc^.orlon(hdbc^.lda,hdbc^.hda[0],UID_DSN,-1,szAuthString,-1,0)<>0 Then Result:=SQL_ERROR
  789.      Else
  790.      Begin
  791.           hdbc^.Connected:=True;
  792.           Result:=SQL_SUCCESS;
  793.      End;
  794.  
  795.      {$IFDEF OS2}
  796.      ASM
  797.         xor eax,eax
  798.         db $64,$8f,$00  //popd fs:[eax]
  799.      END;
  800.      {$ENDIF}
  801. End;
  802.  
  803. Function Oracle7_SQLDataSources(ahenv:SQLHENV;fDirection:LongWord;
  804.                                 Var szDSN:SQLCHAR;cbDSNMax:LongInt;
  805.                                 Var pcbDSN:SQLSMALLINT;
  806.                                 Var szDescription:SQLCHAR;cbDescriptionMax:LongInt;
  807.                                 Var pcbDescription:SQLSMALLINT):SQLRETURN;APIENTRY;
  808. Begin
  809.      Result:=SQL_ERROR;
  810. End;
  811.  
  812. Function Oracle7_SQLSetConnectOption(ahdbc:SQLHDBC;fOption:LongWord;vParam:SQLUINTEGER):SQLRETURN;APIENTRY;
  813. Var hdbc:P_hdbc;
  814. Begin
  815.    If ahdbc=0 Then
  816.    Begin
  817.         Result:=SQL_ERROR;
  818.         exit;
  819.    End;
  820.  
  821.    hdbc:=PDBProcs(ahdbc)^.FuncTable;
  822.  
  823.    Result:=SQL_SUCCESS;
  824.    Case fOption Of
  825.       SQL_AUTOCOMMIT:
  826.       Begin
  827.            Case vParam Of
  828.               SQL_AUTOCOMMIT_OFF:hdbc^.ocon(hdbc^.lda);
  829.               SQL_AUTOCOMMIT_ON:hdbc^.ocof(hdbc^.lda);
  830.               Else Result:=SQL_ERROR; //driver not capable
  831.            End; //case
  832.       End;
  833.       Else Result:=SQL_ERROR; //driver not capable
  834.     End; //case
  835. End;
  836.  
  837. Function Oracle7_SQLSetStmtOption(ahstmt:SQLHSTMT;fOption:LongWord;vParam:SQLUINTEGER):SQLRETURN;APIENTRY;
  838. Begin
  839.      Result:=SQL_ERROR;
  840. End;
  841.  
  842. Function Oracle7_SQLAllocStmt(ahdbc:SQLHDBC;Var phstmt:SQLHSTMT):SQLRETURN;APIENTRY;
  843. Var stmt:P_hstmt;
  844. Begin
  845.      new(stmt);
  846.      stmt^.ahdbc:=PDBProcs(ahdbc)^.FuncTable;
  847.      If stmt^.ahdbc^.oopen(stmt^.cda,stmt^.ahdbc^.lda,Nil,-1,-1,Nil,-1)<>0 Then
  848.      Begin
  849.           Dispose(stmt);
  850.           phstmt:=0;
  851.           Result:=SQL_ERROR;
  852.      End
  853.      Else
  854.      Begin
  855.           stmt^.CursorValid:=True;
  856.           stmt^.ColList.Create;
  857.           phstmt:=SQLHSTMT(stmt);
  858.           Result:=SQL_SUCCESS;
  859.      End;
  860. End;
  861.  
  862. Function Oracle7_SQLBindParameter(ahstmt:SQLHSTMT;ipar:LongWord;fParamType:LongInt;
  863.                                   fCType:LongInt;fSQLType:LongInt;cbParamDef:SQLUINTEGER;
  864.                                   ibScale:LongInt;Var rgbValue;cbValueMax:SQLINTEGER;
  865.                                   Var pcbValue:SQLINTEGER):SQLRETURN;APIENTRY;
  866. Var s:String;
  867.     stmt:P_hstmt;
  868.     c:CString;
  869. Begin
  870.      stmt:=P_hstmt(ahstmt);
  871.      If fParamType=SQL_PARAM_RESULT Then s:=':p0'
  872.      Else s:=':p'+tostr(ipar);
  873.      c:=s;
  874.      If pcbValue=SQL_NTS Then pcbValue:=255; //String
  875.  
  876.      If stmt^.ahdbc^.obndrv(stmt^.cda,c,-1,rgbValue,pcbValue,
  877.                             MapOracleTypes(fcType),-1,
  878.                             Nil,Nil,0,0)<>0 Then
  879.        Result:=SQL_ERROR
  880.      Else
  881.        Result:=SQL_SUCCESS;
  882. End;
  883.  
  884. Function Oracle7_SQLGetCursorName(ahstmt:SQLHSTMT;Var szCursor:SQLCHAR;cbCursorMax:LongInt;
  885.                                   Var pcbCursor:SQLSMALLINT):SQLRETURN;APIENTRY;
  886. Begin
  887.      szCursor:='';
  888.      pcbCursor:=0;
  889.      Result:=SQL_SUCCESS;
  890. End;
  891.  
  892. Function Oracle7_SQLExecDirect(ahstmt:SQLHSTMT;Var szSqlStr:SQLCHAR;cbSqlStr:SQLINTEGER):SQLRETURN;APIENTRY;
  893. Var stmt:P_hstmt;
  894.     t:LongInt;
  895.     col:P_stmtcol;
  896.     ColNameLen:LongInt;
  897.     typ:LongInt;
  898. Label float;
  899. Begin
  900.      stmt:=P_hstmt(ahstmt);
  901.      stmt^.Executed:=False;
  902.      If stmt=Nil Then
  903.      Begin
  904.          Result:=SQL_ERROR;
  905.          exit;
  906.      End;
  907.  
  908.      if stmt^.ahdbc^.oparse(stmt^.cda,szSqlStr,-1,1{PARSE_NO_DEFER},PARSE_V7_LNG)<>0 Then Result:=SQL_ERROR
  909.      Else
  910.      Begin
  911.           Result:=SQL_SUCCESS;
  912.  
  913.           //describe result cols and store it into stmt
  914.           For t:=1 To stmt^.ColList.Count-1 Do
  915.           Begin
  916.               col:=stmt^.ColList[t];
  917.               If col^.DataLen>0 Then FreeMem(col^.Data,col^.DataLen);
  918.               Dispose(col);
  919.           End;
  920.           stmt^.ColList.Clear;
  921.  
  922.           Result:=SQL_SUCCESS;
  923.           If stmt^.cda.ft=FT_SELECT Then
  924.           Begin
  925.                //describe cols
  926.                t:=1;
  927.                Repeat
  928.                     //describe one row
  929.                     New(Col);
  930.  
  931.                     ColNameLen:=255;
  932.                     If stmt^.ahdbc^.odescr(stmt^.cda,t,col^.dbsize,col^.dbtype,col^.ColName,
  933.                                            ColNameLen,Col^.dsize,col^.precision,
  934.                                            Col^.scale,Col^.nullok)<>0 Then
  935.                     Begin
  936.                          If stmt^.cda.rc=VAR_NOT_IN_LIST Then
  937.                          Begin
  938.                               Dispose(Col);
  939.                               break;
  940.                          End
  941.                          Else
  942.                          Begin
  943.                               Dispose(Col);
  944.                               Result:=SQL_ERROR;
  945.                               break;
  946.                          End;
  947.                     End
  948.                     Else
  949.                     Begin
  950.                          col^.ColName[ColNameLen]:=#0;
  951.                          stmt^.ColList.Add(Col);
  952.                     End;
  953.  
  954.                     inc(t);
  955.                Until False;
  956.  
  957.                //bind params
  958.                If Result<>SQL_ERROR Then For t:=1 To stmt^.ColList.Count Do
  959.                Begin
  960.                     col:=stmt^.ColList[t-1];
  961.  
  962.                     Case col^.dbType Of
  963.                         SQLT_NUM,SQLT_INT,SQLT_UIN:
  964.                         Begin
  965.                             If Col^.Scale<>0 Then goto float;
  966.                             If ((Col^.Precision=0)And(Col^.Scale=0)) Then goto float;
  967.  
  968.                             Col^.DataLen:=4;
  969.                             typ:=SQLT_INT;
  970.                         End;
  971.                         SQLT_CHR,SQLT_STR,SQLT_VCS,SQLT_LVC:
  972.                         Begin
  973.                             Col^.DataLen:=col^.dbSize+1;
  974.                             typ:=SQLT_STR;
  975.                         End;
  976.                         SQLT_FLT:
  977.                         Begin
  978. float:
  979.                              Col^.DataLen:=8;
  980.                              typ:=SQLT_FLT;
  981.                         End;
  982.                         SQLT_VBI,SQLT_BIN,SQLT_LBI,SQLT_LNG:
  983.                         Begin
  984.                              Col^.DataLen:=col^.dbSize;
  985.                              typ:=SQLT_BIN;
  986.                         End;
  987.                         SQLT_DAT:
  988.                         Begin
  989.                              Col^.DataLen:=col^.dbSize;
  990.                              typ:=SQLT_DAT;
  991.                         End;
  992.                         SQLT_RID:
  993.                         Begin
  994.                              Col^.DataLen:=255;
  995.                              typ:=SQLT_STR;
  996.                         End;
  997.                     End; //case
  998.  
  999.                     GetMem(col^.Data,col^.DataLen);
  1000.  
  1001.                     Col^.OutLen:=0;
  1002.                     if stmt^.ahdbc^.odefin(stmt^.cda,t,col^.data^,col^.datalen,Typ,-1,Nil,Nil,-1,-1,col^.OutLen,Nil)<>0 Then
  1003.                       Result:=SQL_ERROR
  1004.                     Else
  1005.                       Result:=SQL_SUCCESS;
  1006.                End;
  1007.           End
  1008.           Else
  1009.           Begin
  1010.                If stmt^.ahdbc^.aDBProcs^.IsStoredProc Then exit;
  1011.  
  1012.                If stmt^.ahdbc^.oexec(stmt^.cda)<>0 Then
  1013.                Begin
  1014.                     Result:=SQL_ERROR;
  1015.                     exit;
  1016.                End;
  1017.                stmt^.Executed:=True;
  1018.           End;
  1019.      End;
  1020. End;
  1021.  
  1022. Function Oracle7_SQLNumParams(ahstmt:SQLHSTMT;Var pcpar:SQLSMALLINT):SQLRETURN;APIENTRY;
  1023. Begin
  1024.      Result:=SQL_ERROR;
  1025. End;
  1026.  
  1027. Function Oracle7_SQLNumResultCols(ahstmt:SQLHSTMT;Var pccol:SQLSMALLINT):SQLRETURN;APIENTRY;
  1028. Begin
  1029.      pccol:=P_hstmt(ahstmt)^.ColList.Count;
  1030.      Result:=SQL_SUCCESS;
  1031. End;
  1032.  
  1033. Function Oracle7_SQLDescribeCol(ahstmt:SQLHSTMT;icol:LongWord;Var szColName:SQLCHAR;
  1034.                                 cbColNameMax:LongInt;Var pcbColName:SQLSMALLINT;
  1035.                                 Var pfSqlType:SQLSMALLINT;Var pcbColDef:SQLUINTEGER;
  1036.                                 Var pibScale:SQLSMALLINT;Var pfNullable:SQLSMALLINT):SQLRETURN;APIENTRY;
  1037. Var stmt:P_hstmt;
  1038.     Col:P_stmtcol;
  1039.     p:^Pointer;
  1040. Begin
  1041.      stmt:=P_hstmt(ahstmt);
  1042.      If stmt=Nil Then
  1043.      Begin
  1044.          Result:=SQL_ERROR;
  1045.          exit;
  1046.      End;
  1047.      dec(icol);
  1048.      If icol>stmt^.ColList.Count-1 Then Result:=SQL_ERROR
  1049.      Else
  1050.      Begin
  1051.           Result:=SQL_SUCCESS;
  1052.  
  1053.           Col:=stmt^.ColList[icol];
  1054.           szColName:=Col^.ColName;
  1055.           pcbColName:=length(szColName)+1;
  1056.           pfSqlType:=MapODBCTypes(Col^.dbType);
  1057.           If pfSqlType In [SQL_INTEGER,SQL_FLOAT] Then
  1058.           Begin
  1059.               pcbColDef:=Col^.Precision;
  1060.               pibScale:=Col^.Scale;
  1061.           End
  1062.           Else
  1063.           Begin
  1064.               If Col^.dbType=O7_DATE_TYPE Then pcbColDef:=12
  1065.               Else pcbColDef:=Col^.dbSize;
  1066.               pibScale:=0;
  1067.           End;
  1068.           If Col^.dbType=O7_NUMBER_TYPE Then
  1069.           Begin
  1070.                If pibScale=0 Then
  1071.                Begin
  1072.                     If pcbColDef=0 Then pfSQLType:=SQL_FLOAT
  1073.                     Else pfSQLType:=SQL_INTEGER
  1074.                End
  1075.                Else pfSQLType:=SQL_FLOAT;
  1076.           End;
  1077.           p:=@pfNullable;
  1078.           If p<>Nil Then
  1079.           Begin
  1080.                If Col^.NullOk<>0 Then pfNullable:=SQL_NULLABLE
  1081.                Else pfNullable:=SQL_NO_NULLS;
  1082.           End;
  1083.      End;
  1084. End;
  1085.  
  1086. Function Oracle7_SQLBindCol(ahstmt:SQLHSTMT;icol:LongWord;fCType:LongInt;Var rgbValue;
  1087.                             cbValueMax:SQLINTEGER;Var pcbValue:SQLINTEGER):SQLRETURN;APIENTRY;
  1088. Var
  1089.     stmt:P_hstmt;
  1090.     Col:P_stmtcol;
  1091. Begin
  1092.      stmt:=P_hstmt(ahstmt);
  1093.      dec(icol);
  1094.      If icol>stmt^.ColList.Count-1 Then Result:=SQL_Error
  1095.      Else
  1096.      Begin
  1097.           Col:=stmt^.ColList[icol];
  1098.           Col^.BindVar:=@rgbValue;
  1099.           Col^.BindVarMax:=cbValueMax;
  1100.           Col^.BindType:=fCType;
  1101.           Col^.pcbValue:=@pcbValue;
  1102.           Result:=SQL_SUCCESS;
  1103.      End;
  1104. End;
  1105.  
  1106. Function Oracle7_SQLGetData(ahstmt:SQLHSTMT;icol:LongWord;fCType:LongInt;
  1107.                             Var rgbValue;cbValueMax:SQLINTEGER;Var pcbValue:SQLINTEGER):SQLRETURN;APIENTRY;
  1108. Var Col:P_stmtcol;
  1109.     stmt:P_hstmt;
  1110.     pc:PChar;
  1111.     pl:^LongInt;
  1112.     pd:^Double;
  1113.     s:String;
  1114.     c:CString;
  1115.     ss:single;
  1116.     d:double;
  1117.     e:extended;
  1118.     p:Pointer;
  1119. Label float;
  1120. Type OracleDateRec=Record
  1121.         Cent,Year,Month,Day,Hour,Minute,Second:Byte;
  1122.      End;
  1123.  
  1124. Var ODate:^OracleDateRec;
  1125.     date:TODBCDate;
  1126.     time:TODBCTime;
  1127.     dateTime:TODBCDateTime;
  1128.     year,month,day,hour,minute,second:word;
  1129. Begin
  1130.      Result:=SQL_ERROR;
  1131.  
  1132.      stmt:=P_hstmt(ahstmt);
  1133.      dec(icol);
  1134.      If icol>stmt^.ColList.Count-1 Then exit;
  1135.  
  1136.      Col:=stmt^.ColList[icol];
  1137.      pcbValue:=Col^.OutLen;
  1138.  
  1139.      If pcbValue>0 Then //No Null datas
  1140.      Case Col^.dbType Of
  1141.         SQLT_CHR,SQLT_STR,SQLT_VCS,SQLT_LVC,SQLT_RID:
  1142.         Begin
  1143.              inc(pcbValue);
  1144.              pc:=Col^.Data;
  1145.  
  1146.              Case fcType Of
  1147.                 SQL_C_CHAR,SQL_C_DEFAULT:
  1148.                 Begin
  1149.                      If pcbValue<cbValueMax Then Move(pc^,rgbValue,pcbValue)
  1150.                      Else
  1151.                      Begin
  1152.                           Move(pc^,rgbValue,cbValueMax);
  1153.                           pcbValue:=cbValueMax;
  1154.                      End;
  1155.                 End;
  1156.              End; //case
  1157.         End;
  1158.         SQLT_NUM,SQLT_INT,SQLT_UIN:
  1159.         Begin
  1160.              If Col^.Scale<>0 Then goto float;
  1161.              If ((Col^.Precision=0)And(Col^.Scale=0)) Then goto float;
  1162.  
  1163.              pl:=Col^.Data;
  1164.              Case fcType Of
  1165.                 SQL_C_DEFAULT:
  1166.                 Begin
  1167.                      Move(pl^,rgbValue,cbValueMax);
  1168.                      pcbValue:=cbValueMax;
  1169.                 End;
  1170.                 SQL_C_LONG,SQL_C_SLONG,SQL_C_ULONG:
  1171.                 Begin
  1172.                      Move(pl^,rgbValue,4);
  1173.                      pcbValue:=4;
  1174.                 End;
  1175.                 SQL_C_SHORT,SQL_C_SSHORT,SQL_C_USHORT:
  1176.                 Begin
  1177.                      Move(pl^,rgbValue,cbValueMax);
  1178.                      pcbValue:=cbValueMax;
  1179.                 End;
  1180.                 SQL_C_CHAR:
  1181.                 Begin
  1182.                     s:=tostr(pl^);
  1183.                     c:=s;
  1184.                     Move(c,rgbValue,length(c)+1);
  1185.                     pcbValue:=length(c)+1;
  1186.                 End;
  1187.                 SQL_C_FLOAT:
  1188.                 Begin
  1189.                      d:=pl^;
  1190.                      p:=@d;
  1191.                      Move(p^,rgbValue,8);
  1192.                      pcbValue:=8;
  1193.                 End;
  1194.                 SQL_C_DOUBLE:
  1195.                 Begin
  1196.                      e:=pl^;
  1197.                      p:=@e;
  1198.                      Move(p^,rgbValue,10);
  1199.                      pcbValue:=10;
  1200.                 End;
  1201.              End; //case
  1202.         End;
  1203.         SQLT_FLT:
  1204.         Begin
  1205. float:
  1206.              pd:=Col^.Data;
  1207.              Case fcType Of
  1208.                 SQL_C_DEFAULT:
  1209.                 Begin
  1210.                      Case cbValueMax Of
  1211.                          4:
  1212.                          Begin
  1213.                               ss:=pd^;
  1214.                               p:=@ss;
  1215.                               Move(p^,rgbValue,4);
  1216.                               pcbValue:=4;
  1217.                          End;
  1218.                          8:
  1219.                          Begin
  1220.                               d:=pd^;
  1221.                               p:=@d;
  1222.                               Move(p^,rgbValue,8);
  1223.                               pcbValue:=8;
  1224.                          End;
  1225.                          Else
  1226.                          Begin
  1227.                               e:=pd^;
  1228.                               p:=@e;
  1229.                               Move(p^,rgbValue,10);
  1230.                               pcbValue:=10;
  1231.                          End;
  1232.                      End; //case
  1233.                 End;
  1234.                 SQL_C_FLOAT:
  1235.                 Begin
  1236.                      ss:=pd^;
  1237.                      p:=@ss;
  1238.                      Move(p^,rgbValue,4);
  1239.                      pcbValue:=4;
  1240.                 End;
  1241.                 SQL_C_DOUBLE:
  1242.                 Begin
  1243.                      d:=pd^;
  1244.                      p:=@d;
  1245.                      Move(p^,rgbValue,8);
  1246.                      pcbValue:=8;
  1247.                 End;
  1248.                 SQL_C_CHAR:
  1249.                 Begin
  1250.                      Str(pd^,s);
  1251.                      c:=s;
  1252.                      Move(c,rgbValue,length(c)+1);
  1253.                      pcbValue:=length(c)+1;
  1254.                 End;
  1255.              End; //case
  1256.         End;
  1257.         SQLT_VBI,SQLT_BIN,SQLT_LBI,SQLT_LNG:
  1258.         Begin
  1259.              If pcbValue<cbValueMax Then Move(Col^.Data^,rgbValue,pcbValue)
  1260.              Else
  1261.              Begin
  1262.                   Move(Col^.Data^,rgbValue,cbValueMax);
  1263.                   pcbValue:=cbValueMax;
  1264.              End;
  1265.         End;
  1266.         SQLT_DAT:
  1267.         Begin
  1268.             ODate:=Col^.Data;
  1269.  
  1270.             If pcbValue<>7 Then //no internal Oracle format
  1271.             Begin
  1272.                  Result:=SQL_ERROR;
  1273.                  exit;
  1274.             End;
  1275.  
  1276.             year:=((ODate^.Cent-100)*100)+ODate^.Year-100;
  1277.             month:=ODate^.month;
  1278.             day:=ODate^.Day;
  1279.             Hour:=ODate^.Hour-1;
  1280.             Minute:=ODate^.Minute-1;
  1281.             Second:=ODate^.Second-1;
  1282.  
  1283.             Case fcType Of
  1284.                SQL_C_DATE:
  1285.                Begin
  1286.                     date.year:=year;
  1287.                     date.month:=month;
  1288.                     date.day:=day;
  1289.                     pcbValue:=sizeof(TODBCDate);
  1290.                     Move(Date,rgbValue,pcbValue);
  1291.                End;
  1292.                SQL_C_TIME:
  1293.                Begin
  1294.                     time.Hour:=hour;
  1295.                     time.minute:=minute;
  1296.                     time.second:=second;
  1297.                     pcbValue:=sizeof(TODBCTime);
  1298.                     Move(Time,rgbValue,pcbValue);
  1299.                End;
  1300.                SQL_C_TIMESTAMP,SQL_C_DEFAULT:
  1301.                Begin
  1302.                     datetime.Date.year:=year;
  1303.                     datetime.Date.month:=month;
  1304.                     datetime.Date.day:=day;
  1305.                     datetime.Time.Hour:=hour;
  1306.                     datetime.Time.minute:=minute;
  1307.                     datetime.Time.second:=second;
  1308.                     pcbValue:=sizeof(TODBCDateTime);
  1309.                     Move(DateTime,rgbValue,pcbValue);
  1310.                End;
  1311.                Else //invalid conversion
  1312.                Begin
  1313.                     Result:=SQL_ERROR;
  1314.                     exit;
  1315.                End;
  1316.             End; //case
  1317.         End;
  1318.      End; //case
  1319.  
  1320.      If pcbValue=0 Then pcbValue:=SQL_NULL_DATA;
  1321.      Result:=SQL_SUCCESS;
  1322. End;
  1323.  
  1324. Function Oracle7_SQLFetch(ahstmt:SQLHSTMT):SQLRETURN;APIENTRY;
  1325. var stmt:P_hstmt;
  1326.     t:LongInt;
  1327.     Col:P_stmtcol;
  1328. Begin
  1329.      stmt:=P_hstmt(ahstmt);
  1330.      If not (stmt^.Executed) Then
  1331.      Begin
  1332.           If stmt^.ahdbc^.oexec(stmt^.cda)<>0 Then
  1333.           Begin
  1334.                Result:=SQL_ERROR;
  1335.                exit;
  1336.           End;
  1337.           stmt^.Executed:=True;
  1338.      End;
  1339.  
  1340.      If stmt^.ahdbc^.aDBProcs^.IsStoredProc Then
  1341.      Begin
  1342.           Result:=SQL_SUCCESS;
  1343.           exit;
  1344.      End;
  1345.  
  1346.      If stmt^.ahdbc^.ofetch(stmt^.cda)<>0 Then
  1347.      Begin
  1348.           If stmt^.cda.rc=NO_DATA_FOUND Then Result:=SQL_NO_DATA_FOUND
  1349.           Else If stmt^.cda.rc<>NULL_VALUE_RETURNED Then Result:=SQL_ERROR
  1350.           Else Result:=SQL_SUCCESS;
  1351.      End
  1352.      Else Result:=SQL_SUCCESS;
  1353.  
  1354.      If Result=SQL_SUCCESS Then
  1355.      Begin
  1356.           //store result into bound variables
  1357.           For t:=0 To stmt^.ColList.Count-1 Do
  1358.           Begin
  1359.                Col:=stmt^.ColList[t];
  1360.  
  1361.                If Col^.BindVar<>Nil Then
  1362.                Begin
  1363.                     Result:=Oracle7_SQLGetData(ahstmt,t+1,Col^.BindType,Col^.BindVar^,Col^.BindVarMax,
  1364.                                                Col^.pcbValue^);
  1365.                End;
  1366.           End;
  1367.      End;
  1368. End;
  1369.  
  1370. Function Oracle7_SQLExtendedFetch(ahstmt:SQLHSTMT;fFetchType:LongWord;irow:SQLINTEGER;
  1371.                                   Var pcrow:SQLUINTEGER;Var rgfRowStatus):SQLRETURN;APIENTRY;
  1372. Begin
  1373.      Result:=SQL_ERROR;
  1374. End;
  1375.  
  1376. Function Oracle7_SQLError(ahenv:SQLHENV;ahdbc:SQLHDBC;ahstmt:SQLHSTMT;Var szSqlState:SQLCHAR;
  1377.                           Var pfNativeError:SQLINTEGER;Var szErrorMsg;
  1378.                           cbErrorMsgMax:LongInt;Var pcbErrorMsg:SQLSMALLINT):SQLRETURN;APIENTRY;
  1379. Var Msg:CString;
  1380.     henv:P_henv;
  1381.     stmt:P_hstmt;
  1382. Begin
  1383.      henv:=PDBProcs(ahenv)^.FuncTable;
  1384.      stmt:=P_hstmt(ahstmt);
  1385.  
  1386.      pfNativeError:=henv^.lda.rc;
  1387.      If henv^.lda.rc=0 Then
  1388.      Begin
  1389.           If ((stmt=Nil)Or(stmt^.cda.rc=0)) Then Msg:='Driver not capable'
  1390.           Else
  1391.           Begin
  1392.                henv^.oerhms(henv^.lda,stmt^.cda.rc,Msg,sizeof(msg));
  1393.                pfNativeError:=stmt^.cda.rc;
  1394.           End;
  1395.      End
  1396.      Else henv^.oerhms(henv^.lda,henv^.lda.rc,Msg,sizeof(msg));
  1397.      pcbErrorMsg:=length(Msg)+1;
  1398.      Move(Msg,szErrorMsg,length(Msg)+1);
  1399.      szSQLState:='[Sibyl Oracle7 driver] SQLSTATE:'+tostr(pfNativeError);
  1400.      Result:=SQL_SUCCESS;
  1401. End;
  1402.  
  1403. Function Oracle7_SQLPrimaryKeys(ahstmt:SQLHSTMT;Const szCatalogName:SQLCHAR;cbCatalogName:LongInt;
  1404.                                 Const szSchemaName:SQLCHAR;cbSchemaName:LongInt;
  1405.                                 Const szTableName:SQLCHAR;cbTableName:LongInt):SQLRETURN;APIENTRY;
  1406. Var Ansi:AnsiString;
  1407.     stmt:P_hstmt;
  1408.     s:String;
  1409.     p:Pointer;
  1410. Begin
  1411.      stmt:=P_hstmt(ahstmt);
  1412.      If stmt=Nil Then
  1413.      Begin
  1414.          Result:=SQL_ERROR;
  1415.          exit;
  1416.      End;
  1417.      p:=@szTableName;
  1418.      If p=Nil Then s:=''
  1419.      Else s:=szTableName;
  1420.      If Pos('.',s)<>0 Then Delete(s,1,pos('.',s));
  1421.      Ansi:='SELECT I.TABLE_OWNER,I.TABLE_OWNER,I.TABLE_NAME,I.COLUMN_NAME FROM CONSTRAINT_DEFS D,'+
  1422.            'ALL_IND_COLUMNS I WHERE D.OWNER<>'#39'SYS'#39' AND D.CONSTRAINT_NAME=I.INDEX_NAME';
  1423.      If s<>'' Then Ansi:=Ansi+' AND I.TABLE_NAME='#39+s+#39;
  1424.      Result:=Oracle7_SqlExecDirect(ahstmt,PChar(Ansi)^,length(PChar(Ansi)^)+1);
  1425. End;
  1426.  
  1427. Function Oracle7_SQLForeignKeys(ahstmt:SQLHSTMT;Const szPkCatalogName:SQLCHAR;cbPkCatalogName:LongInt;
  1428.                                 Const szPkSchemaName:SQLCHAR;cbPkSchemaName:LongInt;
  1429.                                 Const szPkTableName:SQLCHAR;cbPkTableName:LongInt;
  1430.                                 Const szFkCatalogName:SQLCHAR;cbFkCatalogName:LongInt;
  1431.                                 Const szFkSchemaName:SQLCHAR;cbFkSchemaName:LongInt;
  1432.                                 Const szFkTableName:SQLCHAR;cbFkTableName:LongInt):SQLRETURN;APIENTRY;
  1433. Var Ansi:AnsiString;
  1434.     stmt:P_hstmt;
  1435.     s:String;
  1436.     p:Pointer;
  1437. Begin
  1438.      stmt:=P_hstmt(ahstmt);
  1439.      If stmt=Nil Then
  1440.      Begin
  1441.          Result:=SQL_ERROR;
  1442.          exit;
  1443.      End;
  1444.      p:=@szFkTableName;
  1445.      If p=Nil Then s:=''
  1446.      Else s:=szFkTableName;
  1447.      If Pos('.',s)<>0 Then Delete(s,1,pos('.',s));
  1448.      Ansi:='SELECT I.TABLE_OWNER,I.TABLE_OWNER,I.TABLE_NAME,I.COLUMN_NAME,D.OWNER,D.OWNER,D.TABLE_NAME,C.COLUMN_NAME ';
  1449.      Ansi:=Ansi+'FROM CONSTRAINT_DEFS D,ALL_CONS_COLUMNS C,ALL_IND_COLUMNS I ';
  1450.      Ansi:=Ansi+' WHERE D.OWNER<>'#39'SYS'#39' AND D.OWNER<>'#39'SYSTEM'#39' ';
  1451.      Ansi:=Ansi+' AND D.R_CONSTRAINT_NAME=I.INDEX_NAME AND D.CONSTRAINT_NAME=C.CONSTRAINT_NAME';
  1452.      If s<>'' Then Ansi:=Ansi+' AND D.TABLE_Name='#39+s+#39;
  1453.      Result:=Oracle7_SqlExecDirect(ahstmt,PChar(Ansi)^,length(PChar(Ansi)^)+1);
  1454. End;
  1455.  
  1456. Function Oracle7_SQLProcedureColumns(ahstmt:SQLHSTMT;Const szProcCatalog:SQLCHAR;cbProcCatalog:LongInt;
  1457.                                      Const szProcSchema:SQLCHAR;cbProcSchema:LongInt;
  1458.                                      Const szProcName:SQLCHAR;cbProcName:LongInt;
  1459.                              Const szColumnName:SQLCHAR;cbColumnName:LongInt):SQLRETURN;APIENTRY;
  1460. Begin
  1461.      Result:=SQL_ERROR;
  1462. End;
  1463.  
  1464. Function Oracle7_SQLProcedures(ahstmt:SQLHSTMT;Const szProcCatalog:SQLCHAR;cbProcCatalog:LongInt;
  1465.                                Const szProcSchema:SQLCHAR;cbProcSchema:LongInt;
  1466.                                Const szProcName:SQLCHAR;cbProcName:LongInt):SQLRETURN;APIENTRY;
  1467. VAR C:CString;
  1468.     stmt:P_hstmt;
  1469. Begin
  1470.      stmt:=P_hstmt(ahstmt);
  1471.      If stmt=Nil Then
  1472.      Begin
  1473.          Result:=SQL_ERROR;
  1474.          exit;
  1475.      End;
  1476.      C:='SELECT OWNER,OWNER,OBJECT_NAME FROM ALL_OBJECTS WHERE OBJECT_TYPE='#39'PROCEDURE'#39+
  1477.         ' OR OBJECT_TYPE='#39'FUNCTION'#39;
  1478.      Result:=Oracle7_SqlExecDirect(ahstmt,c,length(c)+1);
  1479. End;
  1480.  
  1481. Function Oracle7_SQLStatistics(ahstmt:SQLHSTMT;Const szCatalogName:SQLCHAR;cbCatalogName:LongInt;
  1482.                                Const szSchemaName:SQLCHAR;cbSchemaName:LongInt;
  1483.                                Const szTableName:SQLCHAR;cbTableName:LongInt;
  1484.                                fUnique:LongWord;fAccuracy:LongWord):SQLRETURN;APIENTRY;
  1485. Var Name,Qual:String;
  1486.     s:AnsiString;
  1487.     stmt:P_hstmt;
  1488. Begin
  1489.      stmt:=P_hstmt(ahstmt);
  1490.      If stmt=Nil Then
  1491.      Begin
  1492.          Result:=SQL_ERROR;
  1493.          exit;
  1494.      End;
  1495.  
  1496.      Name:=szTableName;
  1497.      UpcaseStr(Name);
  1498.      If Pos('.',Name)<>0 Then
  1499.      Begin
  1500.           Qual:=Copy(Name,1,pos('.',Name)-1);
  1501.           Delete(Name,1,pos('.',Name));
  1502.      End
  1503.      Else Qual:='';
  1504.  
  1505.      s:='SELECT TABLE_OWNER,TABLE_OWNER,TABLE_NAME,TABLE_NAME,INDEX_OWNER,INDEX_NAME';
  1506.      s:=s+' INDEX_NAME,COLUMN_POSITION,COLUMN_NAME,COLUMN_NAME FROM ALL_IND_COLUMNS';
  1507.      If Qual<>'' Then
  1508.        s:=s+' WHERE TABLE_OWNER='#39+Qual+#39+' AND TABLE_NAME='#39+Name+#39
  1509.      Else If Name<>'' Then
  1510.        s:=s+' WHERE TABLE_NAME='#39+Name+#39;
  1511.      Result:=Oracle7_SqlExecDirect(ahstmt,PChar(s)^,SQL_NTS);
  1512. End;
  1513.  
  1514. Function Oracle7_SQLTables(ahstmt:SQLHSTMT;Const szCatalogName:SQLCHAR;cbCatalogName:LongInt;
  1515.                            Const szSchemaName:SQLCHAR;cbSchemaName:LongInt;
  1516.                            Const szTableName:SQLCHAR;cbTableName:LongInt;
  1517.                            Const szTableType:SQLCHAR;cbTableType:LongInt):SQLRETURN;APIENTRY;
  1518. Var s:String;
  1519.     c:CString;
  1520.     p:Pointer;
  1521.     stmt:P_hstmt;
  1522. Begin
  1523.      stmt:=P_hstmt(ahstmt);
  1524.      If stmt=Nil Then
  1525.      Begin
  1526.          Result:=SQL_ERROR;
  1527.          exit;
  1528.      End;
  1529.      s:='SELECT OWNER,OWNER,TABLE_NAME,TABLE_TYPE FROM ALL_CATALOG';
  1530.      If szTableType='SYSTEM TABLE' Then
  1531.      Begin
  1532.           s:=s+' WHERE TABLE_TYPE='#39'TABLE'#39;
  1533.           s:=s+' AND OWNER='#39'SYS'#39'OR OWNER='#39'SYSTEM'#39;
  1534.      End
  1535.      Else
  1536.      Begin
  1537.           s:=s+' WHERE TABLE_TYPE='+#39+szTableType+#39;
  1538.           s:=s+' AND OWNER<>'#39'SYSTEM'#39' AND OWNER<>'#39'SYS'#39;
  1539.      End;
  1540.      p:=@szSchemaName;
  1541.      If p<>Nil Then s:=s+' AND OWNER='+#39+szSchemaName+#39;
  1542.      p:=@szTableName;
  1543.      If p<>Nil Then s:=s+' AND TABLE_NAME='+#39+szTableName+#39;
  1544.  
  1545.      c:=s;
  1546.      Result:=Oracle7_SqlExecDirect(ahstmt,c,length(c)+1);
  1547. End;
  1548.  
  1549. Function Oracle7_SQLFreeStmt(ahstmt:SQLHSTMT;fOption:LongWord):SQLRETURN;APIENTRY;
  1550. Var stmt:P_hstmt;
  1551.     t:LongInt;
  1552.     col:P_stmtcol;
  1553. Begin
  1554.      stmt:=P_hstmt(ahstmt);
  1555.      stmt^.Executed:=False;
  1556.      For t:=1 To stmt^.ColList.Count-1 Do
  1557.      Begin
  1558.          col:=stmt^.ColList[t];
  1559.          If col^.DataLen>0 Then FreeMem(Col^.Data,Col^.datalen);
  1560.          Dispose(col);
  1561.      End;
  1562.      stmt^.ColList.Clear;
  1563.  
  1564.      If stmt^.CursorValid Then
  1565.      Begin
  1566.           If stmt^.ahdbc^.oclose(stmt^.cda)<>0 Then
  1567.           Begin
  1568.                Result:=SQL_ERROR;
  1569.                exit;
  1570.           End;
  1571.           stmt^.CursorValid:=False;
  1572.      End;
  1573.  
  1574.      Case fOption Of
  1575.         SQL_CLOSE:;
  1576.         Else
  1577.         Begin
  1578.             stmt^.ColList.Destroy;
  1579.             Dispose(stmt);
  1580.         End;
  1581.      End;
  1582.  
  1583.      Result:=SQL_SUCCESS;
  1584. End;
  1585.  
  1586. Function Oracle7_SQLCancel(ahstmt:SQLHSTMT):SQLRETURN;APIENTRY;
  1587. Var stmt:P_hstmt;
  1588. Begin
  1589.      stmt:=P_hstmt(ahstmt);
  1590.      If stmt^.ahdbc^.ocan(stmt^.cda)<>0 Then Result:=SQL_ERROR
  1591.      Else Result:=Oracle7_SQLFreeStmt(ahstmt,SQL_CLOSE);
  1592. End;
  1593.  
  1594. Function Oracle7_SQLTransact(ahenv:SQLHENV;ahdbc:SQLHDBC;fType:LongWord):SQLRETURN;APIENTRY;
  1595. Var henv:P_henv;
  1596. Begin
  1597.     Result:=SQL_SUCCESS;
  1598.     henv:=PDBProcs(ahenv)^.FuncTable;
  1599.     Case fType Of
  1600.       SQL_COMMIT:If henv^.ocom(henv^.lda)<>0 Then Result:=SQL_ERROR;
  1601.       SQL_ROLLBACK:If henv^.orol(henv^.lda)<>0 Then Result:=SQL_ERROR;
  1602.       Else Result:=SQL_ERROR;
  1603.     End;
  1604. End;
  1605.  
  1606. Function Oracle7_SQLDisconnect(ahdbc:SQLHDBC):SQLRETURN;APIENTRY;
  1607. Var hdbc:P_hdbc;
  1608. Begin
  1609.      hdbc:=PDBProcs(ahdbc)^.FuncTable;
  1610.      If hdbc^.ologof(hdbc^.lda)<>0 Then Result:=SQL_ERROR
  1611.      Else
  1612.      Begin
  1613.           hdbc^.Connected:=False;
  1614.           Result:=SQL_SUCCESS;
  1615.      End;
  1616. End;
  1617.  
  1618. Function Oracle7_SQLFreeConnect(ahdbc:SQLHDBC):SQLRETURN;APIENTRY;
  1619. Begin
  1620.      Result:=SQL_SUCCESS;
  1621. End;
  1622.  
  1623. Function Oracle7_SQLFreeEnv(ahenv:SQLHENV):SQLRETURN;APIENTRY;
  1624. Var env:P_henv;
  1625. Begin
  1626.      If ahenv=0 Then
  1627.      Begin
  1628.           Result:=SQL_ERROR;
  1629.           exit;
  1630.      End;
  1631.  
  1632.      env:=PDBProcs(ahenv)^.FuncTable;
  1633.      If env=Nil Then Result:=SQL_ERROR
  1634.      Else
  1635.      Begin
  1636.           If ((env^.Connected)And(env^.ologof(env^.lda)<>0)) Then Result:=SQL_ERROR
  1637.           Else Result:=SQL_SUCCESS;
  1638.      End;
  1639. End;
  1640.  
  1641. Function Oracle7_GetProcParams(Const Name:String;DBProcs:PDBProcs;ParamName:TStrings;ParamType,ParamMode:TList):Boolean;
  1642. Var env:P_henv;
  1643. Const ASIZE=50;
  1644. Var ovrld:Array[0..ASIZE] Of ub2;
  1645.     pos:Array[0..ASIZE] Of ub2;
  1646.     level:Array[0..ASIZE] Of ub2;
  1647.     argnm:Array[0..ASIZE] Of CString[29];
  1648.     arnlen:Array[0..ASIZE] Of ub2;
  1649.     dtype:Array[0..ASIZE] Of ub2;
  1650.     defsup:Array[0..ASIZE] Of ub1;
  1651.     mode:Array[0..ASIZE] Of ub1;
  1652.     dtsize:Array[0..ASIZE] Of ub4;
  1653.     prec:Array[0..ASIZE] Of sb2;
  1654.     scale:Array[0..ASIZE] Of sb2;
  1655.     radix:Array[0..ASIZE] Of ub1;
  1656.     spare:Array[0..ASIZE] Of ub4;
  1657.     arrsiz:ub4;
  1658.     rc:sword;
  1659.     t,c:LongInt;
  1660.     s:string;
  1661. Begin
  1662.      If DBProcs^.ahenv=0 Then
  1663.      Begin
  1664.           Result:=False;
  1665.           exit;
  1666.      End;
  1667.  
  1668.      env:=PDBProcs(DBProcs^.ahenv)^.FuncTable;
  1669.      arrsiz:=ASIZE;
  1670.      env^.odessp(env^.lda,Name,-1,Nil,0,Nil,0,ovrld,
  1671.                  pos,level,argnm,arnlen,dtype,
  1672.                  defsup,mode,dtsize,prec,scale,radix,
  1673.                  spare,arrsiz);
  1674.      if ((env^.lda.rc=0)and(arrsiz<50)) then
  1675.      Begin
  1676.           Result:=True;
  1677.           For t:=0 To arrsiz-1 Do
  1678.           Begin
  1679.                move(argnm[t],s[1],arnlen[t]);
  1680.                s[0]:=chr(arnlen[t]);
  1681.                If s[length(s)]=#0 Then
  1682.                 If length(s)>0 Then dec(s[0]);
  1683.                ParamName.Add(s);
  1684.                c:=MapOdbcTypes(dtype[t]);
  1685.                ParamType.Add(Pointer(c));
  1686.                c:=mode[t];
  1687.                if pos[t]=0 Then //result
  1688.                  c:=c+16;
  1689.                ParamMode.Add(Pointer(c));
  1690.           End;
  1691.      End
  1692.      Else Result:=False;
  1693. End;
  1694. {$HINTS OFF}
  1695.  
  1696.  
  1697. {*******************************************************************************************
  1698.  *                                                                                         *
  1699.  * mSQL section (native support)                                                           *
  1700.  *                                                                                         *
  1701.  *                                                                                         *
  1702.  *******************************************************************************************}
  1703.  
  1704. Type m_row=Pointer;
  1705.  
  1706.      Pm_field=^m_field;
  1707.      m_field=Record
  1708.                    Name:PChar;
  1709.                    Table:PChar;
  1710.                    Typ:LongInt;
  1711.                    len:LongInt;
  1712.                    Flags:LongInt;
  1713.              End;
  1714.  
  1715.      Pm_data=^m_data;
  1716.      m_data=Record
  1717.                   width:LongInt;
  1718.                   data:m_row;
  1719.                   next:Pm_data;
  1720.             End;
  1721.  
  1722.      Pm_fdata=^m_fdata;
  1723.      m_fdata=Record
  1724.                    field:m_field;
  1725.                    next:Pm_fdata;
  1726.              End;
  1727.  
  1728.      Pm_result=^m_result;
  1729.      m_result=Record
  1730.                     queryData:Pm_Data;
  1731.                     Cursor:Pm_Data;
  1732.                     FieldData:Pm_fdata;
  1733.                     FieldCursor:Pm_fdata;
  1734.                     numRows:LongInt;
  1735.                     NumFields:LongInt;
  1736.               End;
  1737.  
  1738.  
  1739. Const
  1740.     INT_TYPE        =1;
  1741.     CHAR_TYPE       =2;
  1742.     REAL_TYPE       =3;
  1743.     IDENT_TYPE      =4;
  1744.     NULL_TYPE       =5;
  1745.     TEXT_TYPE       =6;
  1746.     DATE_TYPE       =7;
  1747.     UINT_TYPE       =8;
  1748.     MONEY_TYPE      =9;
  1749.     TIME_TYPE       =10;
  1750.     LAST_REAL_TYPE  =10;
  1751.     IDX_TYPE        =253;
  1752.     SYSVAR_TYPE     =254;
  1753.     ANY_TYPE        =255;
  1754.  
  1755. //Field flags
  1756. Const
  1757.     NOT_NULL_FLAG   =1;
  1758.     UNIQUE_FLAG     =2;
  1759.  
  1760. Type PmSQLFunc=^TmSQLFunc;
  1761.      TmSQLFunc=Record
  1762.                    msqlGetErrMsg:Function(Var Buffer):PChar;APIENTRY;
  1763.                    msqlUserConnect:Function(Host,User:PChar):LongInt;APIENTRY;
  1764.                    msqlSelectDB:Function(Sock:LongInt;Const DBName:CString):LongInt;APIENTRY;
  1765.                    msqlQuery:Function(Sock:LongInt;Const Query:CString):LongInt;APIENTRY;
  1766.                    msqlClose:Procedure(Sock:LongInt);APIENTRY;
  1767.                    msqlDataSeek:Procedure(result:Pm_result;Position:LongInt);APIENTRY;
  1768.                    msqlFieldSeek:Procedure(result:Pm_result;Position:LongInt);APIENTRY;
  1769.                    msqlFreeResult:Procedure(result:Pm_result);APIENTRY;
  1770.                    msqlFetchRow:Function(result:Pm_result):m_row;APIENTRY;
  1771.                    msqlFetchField:Function(result:Pm_result):Pm_field;APIENTRY;
  1772.                    msqlListDBs:Function(Sock:LongInt):Pm_result;APIENTRY;
  1773.                    msqlListTables:Function(Sock:LongInt):Pm_result;APIENTRY;
  1774.                    msqlListFields:Function(Sock:LongInt;Const TableName:CString):Pm_result;APIENTRY;
  1775.                    msqlStoreResult:Function:Pm_result;APIENTRY;
  1776.                    msqlListIndex:Function(Sock:LongInt;Const TableName,IndexType:CString):Pm_result;APIENTRY;
  1777.  
  1778.                    DataSourceCount:LongInt;
  1779.                End;
  1780.  
  1781.      Pmsqlhdbc=^Tmsqlhdbc;
  1782.      Tmsqlhdbc=Record
  1783.                     Procs:PDBProcs;
  1784.                     Socket:LongInt;
  1785.                     Connected:Boolean;
  1786.      End;
  1787.  
  1788.      PBindCol=^TBindCol;
  1789.      TBindCol=Record
  1790.                     fcType:LongInt;
  1791.                     Value:Pointer;
  1792.                     cbValueMax:LongInt;
  1793.                     pcbValue:^SQLInteger;
  1794.      End;
  1795.  
  1796.      PBindCols=^TBindCols;
  1797.      TBindCols=Array[1..65535] Of PBindCol;
  1798.  
  1799.      PmsqlStmt=^TmsqlStmt;
  1800.      TmsqlStmt=Record
  1801.                      hdbc:Pmsqlhdbc;
  1802.                      Procs:PDBProcs;
  1803.                      result:Pm_result;
  1804.                      BindColsCount:LongInt;
  1805.                      BindCols:PBindCols;
  1806.                      m_row:Pointer;
  1807.      End;
  1808.  
  1809.  
  1810. {$HINTS OFF}
  1811. Function msql_SQLError(ahenv:SQLHENV;ahdbc:SQLHDBC;ahstmt:SQLHSTMT;Var szSqlState:SQLCHAR;
  1812.                        Var pfNativeError:SQLINTEGER;Var szErrorMsg;
  1813.                        cbErrorMsgMax:LongInt;Var pcbErrorMsg:SQLSMALLINT):SQLRETURN;APIENTRY;
  1814. Var Procs:PDBProcs;
  1815. Begin
  1816.      Procs:=PDBProcs(ahenv);
  1817.      PmSQLFunc(Procs^.FuncTable)^.msqlGetErrMsg(szErrorMsg);
  1818.      szSQLState:='';
  1819.      pfNativeError:=1;
  1820.      pcbErrorMsg:=length(CString(szErrorMsg))+1;
  1821.      Result:=SQL_SUCCESS;
  1822. End;
  1823.  
  1824. Function msql_SQLGetCursorName(ahstmt:SQLHSTMT;Var szCursor:SQLCHAR;cbCursorMax:LongInt;
  1825.                                Var pcbCursor:SQLSMALLINT):SQLRETURN;APIENTRY;
  1826. Var stmt:PmsqlStmt;
  1827. Begin
  1828.      stmt:=PmsqlStmt(ahstmt);
  1829.      If stmt^.result=Nil Then Result:=SQL_ERROR
  1830.      Else
  1831.      Begin
  1832.           szCursor:=tostr(LongInt(stmt^.Result^.Cursor));
  1833.           pcbCursor:=length(szCursor)+1;
  1834.           Result:=SQL_SUCCESS;
  1835.      End;
  1836. End;
  1837.  
  1838. Function msql_SQLFreeEnv(ahenv:SQLHENV):SQLRETURN;APIENTRY;
  1839. Begin
  1840.      Result:=SQL_SUCCESS;
  1841. End;
  1842.  
  1843. Function msql_SQLNumParams(ahstmt:SQLHSTMT;Var pcpar:SQLSMALLINT):SQLRETURN;APIENTRY;
  1844. Begin
  1845.      pcpar:=0;
  1846.      Result:=SQL_SUCCESS;
  1847. End;
  1848.  
  1849. Function msql_SQLAllocConnect(ahenv:SQLHENV;Var phdbc:SQLHDBC):SQLRETURN;APIENTRY;
  1850. Var hdbc:Pmsqlhdbc;
  1851. Begin
  1852.      new(hdbc);
  1853.      hdbc^.Procs:=PDBProcs(ahenv);
  1854.      phdbc:=SQLHDBC(hdbc);
  1855.      result:=SQL_SUCCESS;
  1856. End;
  1857.  
  1858. Function msql_SQLSetConnectOption(ahdbc:SQLHDBC;fOption:LongWord;vParam:SQLUINTEGER):SQLRETURN;APIENTRY;
  1859. Begin
  1860.      Result:=SQL_SUCCESS;
  1861. End;
  1862.  
  1863. Function msql_SQLSetStmtOption(ahstmt:SQLHSTMT;fOption:LongWord;vParam:SQLUINTEGER):SQLRETURN;APIENTRY;
  1864. Begin
  1865.      Result:=SQL_SUCCESS;
  1866. End;
  1867.  
  1868. Function msql_SQLCancel(ahstmt:SQLHSTMT):SQLRETURN;APIENTRY;
  1869. Begin
  1870.      Result:=SQL_SUCCESS;
  1871. End;
  1872.  
  1873. Function msql_SQLTransact(ahenv:SQLHENV;ahdbc:SQLHDBC;fType:LongWord):SQLRETURN;APIENTRY;
  1874. Begin
  1875.      Result:=SQL_SUCCESS;
  1876. End;
  1877.  
  1878. Function msql_SQLProcedureColumns(ahstmt:SQLHSTMT;Const szProcCatalog:SQLCHAR;cbProcCatalog:LongInt;
  1879.                                   Const szProcSchema:SQLCHAR;cbProcSchema:LongInt;
  1880.                                   Const szProcName:SQLCHAR;cbProcName:LongInt;
  1881.                                   Const szColumnName:SQLCHAR;cbColumnName:LongInt):SQLRETURN;APIENTRY;
  1882. Begin
  1883.      Result:=SQL_ERROR;
  1884. End;
  1885.  
  1886. Function msql_SQLFreeConnect(ahdbc:SQLHDBC):SQLRETURN;APIENTRY;
  1887. Var hdbc:Pmsqlhdbc;
  1888. Begin
  1889.      hdbc:=Pmsqlhdbc(ahdbc);
  1890.      if hdbc^.Socket<>0 Then PmSQLFunc(hdbc^.Procs^.FuncTable)^.msqlClose(hdbc^.Socket);
  1891.      dispose(hdbc);
  1892.      result:=SQL_SUCCESS;
  1893. End;
  1894.  
  1895. Function msql_SQLDisconnect(ahdbc:SQLHDBC):SQLRETURN;APIENTRY;
  1896. Var hdbc:Pmsqlhdbc;
  1897. Begin
  1898.      hdbc:=Pmsqlhdbc(ahdbc);
  1899.      if hdbc^.Socket<>0 Then PmSQLFunc(hdbc^.Procs^.FuncTable)^.msqlClose(hdbc^.Socket);
  1900.      hdbc^.Socket:=0;
  1901.      Result:=SQL_SUCCESS;
  1902. End;
  1903.  
  1904. //returns connect socket
  1905. Function msqlConnect(Procs:PDBProcs;UID:CString):LongInt;
  1906. Var Host,UI:PChar;
  1907. Begin
  1908.      If Procs^.Host='' Then Host:=Nil
  1909.      Else Host:=@Procs^.Host;
  1910.      If UID='' Then UI:=Nil
  1911.      Else UI:=@UID;
  1912.      Result:=PmSQLFunc(Procs^.FuncTable)^.msqlUserConnect(Host,UI);
  1913. End;
  1914.  
  1915. Function msql_SQLAllocStmt(ahdbc:SQLHDBC;Var phstmt:SQLHSTMT):SQLRETURN;APIENTRY;
  1916. var Stmt:PmsqlStmt;
  1917. Begin
  1918.      New(Stmt);
  1919.      Stmt^.Procs:=Pmsqlhdbc(ahdbc)^.Procs;
  1920.      Stmt^.hdbc:=Pmsqlhdbc(ahdbc);
  1921.      phstmt:=SQLHSTMT(Stmt);
  1922.      result:=SQL_SUCCESS;
  1923. End;
  1924.  
  1925. Function msql_SQLFreeStmt(ahstmt:SQLHSTMT;fOption:LongWord):SQLRETURN;APIENTRY;
  1926. Var Stmt:PmsqlStmt;
  1927.     t:LongInt;
  1928.     BindCol:PBindCol;
  1929. Begin
  1930.      Stmt:=PmsqlStmt(ahstmt);
  1931.      If Stmt^.result<>Nil Then PmSQLFunc(Stmt^.Procs^.FuncTable)^.msqlFreeResult(Stmt^.result);
  1932.      Stmt^.Result:=Nil;
  1933.      If Stmt^.BindColsCount>0 Then
  1934.      Begin
  1935.           For t:=1 To Stmt^.BindColsCount Do
  1936.           Begin
  1937.                BindCol:=Stmt^.BindCols[t];
  1938.                If BindCol<>Nil Then Dispose(BindCol);
  1939.           End;
  1940.           FreeMem(Stmt^.BindCols,Stmt^.BindColsCount*4);
  1941.           Stmt^.BindCols:=Nil;
  1942.           Stmt^.BindColsCount:=0;
  1943.      End;
  1944.      Dispose(Stmt);
  1945.      result:=SQL_SUCCESS;
  1946. End;
  1947.  
  1948. Function msql_SQLPrimaryKeys(ahstmt:SQLHSTMT;Const szCatalogName:SQLCHAR;cbCatalogName:LongInt;
  1949.                              Const szSchemaName:SQLCHAR;cbSchemaName:LongInt;
  1950.                              Const szTableName:SQLCHAR;cbTableName:LongInt):SQLRETURN;APIENTRY;
  1951. Var stmt:PmsqlStmt;
  1952.     p:Pointer;
  1953.     s:String;
  1954. Begin
  1955.      Result:=SQL_SUCCESS_WITH_INFO;
  1956.      stmt:=PmsqlStmt(ahstmt);
  1957.      If stmt=Nil Then
  1958.      Begin
  1959.          Result:=SQL_ERROR;
  1960.          exit;
  1961.      End;
  1962.      If stmt^.Result<>Nil Then PmSQLFunc(stmt^.Procs^.FuncTable)^.msqlFreeResult(Stmt^.result);
  1963.      p:=@szTableName;
  1964.      If p=Nil Then s:=''
  1965.      Else s:=szTableName;
  1966.      If Pos('.',s)<>0 Then Delete(s,1,pos('.',s));
  1967.      stmt^.result:=PmSQLFunc(Stmt^.Procs^.FuncTable)^.msqlListIndex(stmt^.hdbc^.Socket,s,'avl');
  1968.      If stmt^.result<>Nil Then Result:=SQL_SUCCESS;
  1969. End;
  1970.  
  1971. Function msql_SQLProcedures(ahstmt:SQLHSTMT;Const szProcCatalog:SQLCHAR;cbProcCatalog:LongInt;
  1972.                             Const szProcSchema:SQLCHAR;cbProcSchema:LongInt;
  1973.                             Const szProcName:SQLCHAR;cbProcName:LongInt):SQLRETURN;APIENTRY;
  1974. Begin
  1975.      Result:=SQL_ERROR;
  1976. End;
  1977.  
  1978. Function msql_SQLBindParameter(ahstmt:SQLHSTMT;ipar:LongWord;fParamType:LongInt;
  1979.                                fCType:LongInt;fSQLType:LongInt;cbParamDef:SQLUINTEGER;
  1980.                                ibScale:LongInt;Var rgbValue;cbValueMax:SQLINTEGER;
  1981.                                Var pcbValue:SQLINTEGER):SQLRETURN;APIENTRY;
  1982. Begin
  1983.      Result:=SQL_ERROR; //not supported
  1984. End;
  1985.  
  1986. Function msql_SQLDataSources(ahenv:SQLHENV;fDirection:LongWord;
  1987.                              Var szDSN:SQLCHAR;cbDSNMax:LongInt;
  1988.                              Var pcbDSN:SQLSMALLINT;
  1989.                              Var szDescription:SQLCHAR;cbDescriptionMax:LongInt;
  1990.                              Var pcbDescription:SQLSMALLINT):SQLRETURN;APIENTRY;
  1991. var res:Pm_result;
  1992.     Procs:PDBProcs;
  1993.     t:LongInt;
  1994.     row:m_row;
  1995.     pc:PChar;
  1996.     Sock:LongInt;
  1997. Begin
  1998.      szDescription:='';
  1999.      pcbDescription:=0;
  2000.  
  2001.      Procs:=PDBProcs(ahenv);
  2002.      If fDirection=SQL_FETCH_FIRST Then PmSQLFunc(Procs^.FuncTable)^.DataSourceCount:=0
  2003.      Else inc(PmSQLFunc(Procs^.FuncTable)^.DataSourceCount);
  2004.  
  2005.      Result:=msqlConnect(Procs,'');
  2006.      If Result=SQL_ERROR Then exit;
  2007.      Sock:=Result;
  2008.  
  2009.      res:=PmSQLFunc(Procs^.FuncTable)^.msqlListDbs(Sock);
  2010.      Result:=SQL_NO_DATA_FOUND;
  2011.      If res<>Nil Then
  2012.      Begin
  2013.          For t:=1 To PmSQLFunc(Procs^.FuncTable)^.DataSourceCount Do
  2014.            row:=PmSQLFunc(Procs^.FuncTable)^.msqlFetchRow(res);
  2015.  
  2016.          row:=PmSQLFunc(Procs^.FuncTable)^.msqlFetchRow(res);
  2017.  
  2018.          If row<>Nil Then
  2019.          Begin
  2020.              Move(row^,pc,4);
  2021.              szDSN:=pc^;
  2022.              pcbDSN:=length(szDSN)+1;
  2023.  
  2024.              Result:=SQL_SUCCESS;
  2025.          End;
  2026.  
  2027.          PmSQLFunc(Procs^.FuncTable)^.msqlFreeResult(res);
  2028.      End;
  2029.  
  2030.      PmSQLFunc(Procs^.FuncTable)^.msqlClose(Sock);
  2031. End;
  2032.  
  2033. Function msql_SqlConnect(ahdbc:SQLHDBC;Const szDSN:SQLCHAR;
  2034.                          cbDSN:LongInt;Const szUID:SQLCHAR;
  2035.                          cbUID:LongInt;Const szAuthString:SQLCHAR;
  2036.                          cbAuthString:LongInt):SQLRETURN;APIENTRY;
  2037. var hdbc:Pmsqlhdbc;
  2038. Begin
  2039.      hdbc:=Pmsqlhdbc(ahdbc);
  2040.      If hdbc^.Socket<>0 Then Result:=SQL_ERROR
  2041.      Else
  2042.      Begin
  2043.           Try
  2044.              hdbc^.Socket:=msqlConnect(hdbc^.Procs,szUID);
  2045.              If hdbc^.Socket<=0 Then Result:=SQL_ERROR
  2046.              Else Result:=PmSQLFunc(hdbc^.Procs^.FuncTable)^.msqlSelectDB(hdbc^.Socket,szDSN);
  2047.           Except
  2048.              Result:=SQL_ERROR;
  2049.           End;
  2050.      End;
  2051. End;
  2052.  
  2053. Function msql_SQLTables(ahstmt:SQLHSTMT;Const szCatalogName:SQLCHAR;cbCatalogName:LongInt;
  2054.                         Const szSchemaName:SQLCHAR;cbSchemaName:LongInt;
  2055.                         Const szTableName:SQLCHAR;cbTableName:LongInt;
  2056.                         Const szTableType:SQLCHAR;cbTableType:LongInt):SQLRETURN;APIENTRY;
  2057. Var stmt:PmsqlStmt;
  2058.     Procs:PDBProcs;
  2059. Begin
  2060.      If szTableType<>'TABLE' Then
  2061.      Begin
  2062.           Result:=SQL_ERROR;
  2063.           exit;
  2064.      End;
  2065.  
  2066.      //query available tables
  2067.      stmt:=PmsqlStmt(ahstmt);
  2068.      Procs:=stmt^.Procs;
  2069.      If stmt^.Result<>Nil Then PmSQLFunc(Procs^.FuncTable)^.msqlFreeResult(Stmt^.result);
  2070.  
  2071.      stmt^.result:=PmSQLFunc(Procs^.FuncTable)^.msqlListTables(stmt^.hdbc^.Socket);
  2072.      If stmt^.result=Nil Then Result:=SQL_ERROR
  2073.      Else Result:=SQL_SUCCESS;
  2074. End;
  2075.  
  2076. Function msql_SQLNumResultCols(ahstmt:SQLHSTMT;Var pccol:SQLSMALLINT):SQLRETURN;APIENTRY;
  2077. Var stmt:PmsqlStmt;
  2078. Begin
  2079.      stmt:=PmsqlStmt(ahstmt);
  2080.      If stmt^.result=Nil Then pccol:=0
  2081.      Else pccol:=stmt^.Result^.NumFields;
  2082.      Result:=SQL_SUCCESS;
  2083. End;
  2084.  
  2085. Function msql_SQLDescribeCol(ahstmt:SQLHSTMT;icol:LongWord;Var szColName:SQLCHAR;
  2086.                              cbColNameMax:LongInt;Var pcbColName:SQLSMALLINT;
  2087.                              Var pfSqlType:SQLSMALLINT;Var pcbColDef:SQLUINTEGER;
  2088.                              Var pibScale:SQLSMALLINT;Var pfNullable:SQLSMALLINT):SQLRETURN;APIENTRY;
  2089. Var stmt:PmsqlStmt;
  2090.     Procs:PDBProcs;
  2091.     Field:Pm_Field;
  2092.     pi:^Pointer;
  2093. Begin
  2094.      stmt:=PmsqlStmt(ahstmt);
  2095.      If stmt^.result=Nil Then Result:=SQL_ERROR
  2096.      Else
  2097.      Begin
  2098.           Procs:=stmt^.Procs;
  2099.           PmSQLFunc(Procs^.FuncTable)^.msqlFieldSeek(stmt^.result,icol-1);
  2100.           Field:=PmSQLFunc(Procs^.FuncTable)^.msqlFetchField(stmt^.result);
  2101.           PmSQLFunc(Procs^.FuncTable)^.msqlFieldSeek(stmt^.result,0);
  2102.  
  2103.           If Field=Nil Then Result:=SQL_ERROR
  2104.           Else
  2105.           Begin
  2106.                Result:=SQL_SUCCESS;
  2107.  
  2108.                szColName:=Field^.Name^;
  2109.                pcbColName:=length(Field^.Name^)+1;
  2110.                Case Field^.Typ Of
  2111.                    INT_TYPE:pfSqlType:=SQL_INTEGER;
  2112.                    CHAR_TYPE:pfSqlType:=SQL_CHAR;
  2113.                    REAL_TYPE:pfSqlType:=SQL_REAL;
  2114.                    TEXT_TYPE:pfSqlType:=SQL_LONGVARCHAR;
  2115.                    DATE_TYPE:pfSqlType:=SQL_DATE;
  2116.                    UINT_TYPE:pfSqlType:=SQL_INTEGER;
  2117.                    MONEY_TYPE:pfSqlType:=SQL_REAL;
  2118.                    TIME_TYPE:pfSqlType:=SQL_TIME;
  2119.                    Else pfSqlType:=SQL_VARCHAR;
  2120.                End; //case
  2121.                pcbColDef:=Field^.len;
  2122.                pibScale:=0;
  2123.                pi:=@pfNullable;
  2124.                If pi<>Nil Then
  2125.                Begin
  2126.                   If (Field^.Flags And NOT_NULL_FLAG)<>0 Then pfNullable:=0
  2127.                   else pfNullable:=1;
  2128.                End;
  2129.           End;
  2130.      End;
  2131. End;
  2132.  
  2133. Function msql_SQLBindCol(ahstmt:SQLHSTMT;icol:LongWord;fCType:LongInt;Var rgbValue;
  2134.                                        cbValueMax:SQLINTEGER;Var pcbValue:SQLINTEGER):SQLRETURN;APIENTRY;
  2135. Var stmt:PmsqlStmt;
  2136. Begin
  2137.      stmt:=PmsqlStmt(ahstmt);
  2138.      If stmt^.result=Nil Then Result:=SQL_ERROR
  2139.      Else
  2140.      Begin
  2141.         If stmt^.BindCols=Nil Then
  2142.         Begin
  2143.             stmt^.BindColsCount:=stmt^.Result^.NumFields;
  2144.             GetMem(stmt^.BindCols,stmt^.BindColsCount*4);
  2145.         End;
  2146.  
  2147.         If stmt^.BindCols^[icol]<>Nil Then Dispose(stmt^.BindCols^[icol]);
  2148.         New(stmt^.BindCols^[icol]);
  2149.         stmt^.BindCols^[icol]^.fcType:=fcType;
  2150.         stmt^.BindCols^[icol]^.Value:=@rgbValue;
  2151.         stmt^.BindCols^[icol]^.cbValueMax:=cbValueMax;
  2152.         stmt^.BindCols^[icol]^.pcbValue:=@pcbValue;
  2153.  
  2154.         Result:=SQL_SUCCESS;
  2155.      End;
  2156. End;
  2157.  
  2158. Const Months:Array[1..12] Of String[4]=('JAN','FEB','MAR','APR','MAY','JUN','JUL',
  2159.                                         'AUG','SEP','OCT','NOV','DEC');
  2160.  
  2161. Function GetDataFromField(stmt:PmsqlStmt;icol:LongInt;Var rgbValue;cbValueMax:LongInt;
  2162.                           Var pcbValue:LongInt):SQLRETURN;
  2163. Var
  2164.     p:^Pointer;
  2165.     Field:Pm_Field;
  2166.     FieldData:Pm_fdata;
  2167.     t:LongInt;
  2168.     c:PChar;
  2169.     cc:Integer;
  2170.     i:LongInt;
  2171.     ui:LongWord;
  2172.     s,s1:String;
  2173.     e:extended;
  2174. Type TTempDate=Record
  2175.                      Year,Month,Day:Word;
  2176.                End;
  2177. Var date:TTempDate;
  2178. Type TTempTime=Record
  2179.                      Hour,Minute,Second:Word;
  2180.                End;
  2181. Var Time:TTempTime;
  2182. Begin
  2183.      FieldData:=stmt^.result^.FieldData;
  2184.      For t:=1 To icol-1 Do FieldData:=FieldData^.Next;
  2185.      Field:=@FieldData^.Field;
  2186.  
  2187.      p:=stmt^.m_row;
  2188.      inc(p,(icol-1)*4);
  2189.      p:=p^;
  2190.  
  2191.      if p=Nil Then //NULL
  2192.      Begin
  2193.           pcbValue:=SQL_NULL_DATA;
  2194.           Result:=SQL_SUCCESS;
  2195.           exit;
  2196.      End;
  2197.  
  2198.      Case Field^.Typ Of
  2199.          INT_TYPE: //convert from signed int
  2200.          Begin
  2201.              c:=Pointer(p);
  2202.              s:=c^;
  2203.              Val(s,i,cc);
  2204.              If cc<>0 Then
  2205.              Begin
  2206.                   Result:=SQL_ERROR;
  2207.                   exit;
  2208.              End;
  2209.  
  2210.              Case Field^.Len Of
  2211.                1:ShortInt(rgbValue):=i;
  2212.                2:Integer(rgbValue):=i;
  2213.                Else LongInt(rgbValue):=i;
  2214.              End;
  2215.  
  2216.              pcbValue:=Field^.Len;
  2217.          End;
  2218.          UINT_TYPE: //convert from int
  2219.          Begin
  2220.              c:=Pointer(p);
  2221.              s:=c^;
  2222.              Val(s,ui,cc);
  2223.              If cc<>0 Then
  2224.              Begin
  2225.                   Result:=SQL_ERROR;
  2226.                   exit;
  2227.              End;
  2228.  
  2229.              Move(ui,rgbValue,Field^.Len);
  2230.              pcbValue:=Field^.Len;
  2231.          End;
  2232.          REAL_TYPE,MONEY_TYPE: //convert from real
  2233.          Begin
  2234.               c:=Pointer(p);
  2235.               s:=c^;
  2236.               Val(s,e,cc);
  2237.               If cc<>0 Then
  2238.               Begin
  2239.                    Result:=SQL_ERROR;
  2240.                    exit;
  2241.               End;
  2242.  
  2243.               Case Field^.Len Of
  2244.                4:Single(rgbValue):=e;
  2245.                8:Double(rgbValue):=e;
  2246.                Else Extended(rgbValue):=e;
  2247.               End;
  2248.  
  2249.               pcbValue:=Field^.Len;
  2250.          End;
  2251.          DATE_TYPE: //convert from Date
  2252.          Begin
  2253.               Result:=SQL_ERROR;
  2254.  
  2255.               c:=Pointer(p);
  2256.               s:=c^;
  2257.               s1:=copy(s,1,pos('-',s)-1);
  2258.               Delete(s,1,pos('-',s));
  2259.               Val(s1,date.day,cc);
  2260.               if cc<>0 Then exit;
  2261.               s1:=copy(s,1,pos('-',s)-1);
  2262.               Delete(s,1,pos('-',s));
  2263.               UpcaseStr(s1);
  2264.               date.Month:=0;
  2265.               For t:=1 To 12 Do If s1=Months[t] Then date.Month:=t;
  2266.               If date.Month=0 Then exit;
  2267.               Val(s,date.year,cc);
  2268.               If cc<>0 Then exit;
  2269.               move(date,rgbValue,sizeof(date));
  2270.               pcbValue:=sizeof(date);
  2271.          End;
  2272.          TIME_TYPE: //convert from time
  2273.          Begin
  2274.               Result:=SQL_ERROR;
  2275.  
  2276.               c:=Pointer(p);
  2277.               s:=c^;
  2278.               s1:=copy(s,1,pos(':',s)-1);
  2279.               Delete(s,1,pos(':',s));
  2280.               Val(s1,time.hour,cc);
  2281.               if cc<>0 Then exit;
  2282.               s1:=copy(s,1,pos(':',s)-1);
  2283.               Delete(s,1,pos(':',s));
  2284.               Val(s1,time.minute,cc);
  2285.               if cc<>0 Then exit;
  2286.               s1:=copy(s,1,pos(':',s)-1);
  2287.               Delete(s,1,pos(':',s));
  2288.               Val(s1,time.second,cc);
  2289.               if cc<>0 Then exit;
  2290.  
  2291.               move(time,rgbValue,sizeof(time));
  2292.               pcbValue:=sizeof(time);
  2293.          End;
  2294.          Else
  2295.          Begin //use string
  2296.               If cbValueMax>Field^.len Then
  2297.               Begin
  2298.                   Move(p^,rgbValue,Field^.Len);
  2299.                   pcbValue:=length(PChar(p)^);
  2300.               End
  2301.               Else
  2302.               Begin
  2303.                   Move(p^,rgbValue,cbValueMax);
  2304.                   pcbValue:=cbValueMax;
  2305.               End;
  2306.          End;
  2307.      End; //case
  2308.  
  2309.      Result:=SQL_SUCCESS;
  2310. End;
  2311.  
  2312. Function msql_SQLFetch(ahstmt:SQLHSTMT):SQLRETURN;APIENTRY;
  2313. Var stmt:PmsqlStmt;
  2314.     t:LongInt;
  2315.     BindCol:PBindCol;
  2316. Begin
  2317.      stmt:=PmsqlStmt(ahstmt);
  2318.      If stmt^.result=Nil Then Result:=SQL_ERROR
  2319.      Else
  2320.      Begin
  2321.           stmt^.m_row:=PmSqlFunc(stmt^.Procs^.FuncTable)^.msqlFetchRow(stmt^.result);
  2322.           If stmt^.m_row=Nil Then Result:=SQL_ERROR
  2323.           Else
  2324.           Begin
  2325.                If Stmt^.BindCols<>Nil Then
  2326.                Begin
  2327.                     For t:=1 To Stmt^.BindColsCount Do
  2328.                     Begin
  2329.                          BindCol:=Stmt^.BindCols^[t];
  2330.                          If BindCol<>Nil Then
  2331.                          Begin
  2332.                               Result:=GetDataFromField(stmt,t,BindCol^.Value^,BindCol^.cbValueMax,
  2333.                                                        BindCol^.pcbValue^);
  2334.                               If Result<>SQL_SUCCESS Then exit;
  2335.                          End;
  2336.                     End;
  2337.                End;
  2338.  
  2339.                Result:=SQL_SUCCESS;
  2340.           End;
  2341.      End;
  2342. End;
  2343.  
  2344. Function msql_SQLExtendedFetch(ahstmt:SQLHSTMT;fFetchType:LongWord;irow:SQLINTEGER;
  2345.                                Var pcrow:SQLUINTEGER;Var rgfRowStatus):SQLRETURN;APIENTRY;
  2346. Var stmt:PmsqlStmt;
  2347. Begin
  2348.      stmt:=PmsqlStmt(ahstmt);
  2349.      If stmt^.result=Nil Then Result:=SQL_ERROR
  2350.      Else
  2351.      Begin
  2352.           pcRow:=0;
  2353.  
  2354.           If fFetchType=SQL_FETCH_FIRST Then irow:=0
  2355.           Else If fFetchType=SQL_FETCH_NEXT Then
  2356.           Begin
  2357.                Result:=msql_SQLFetch(ahstmt);
  2358.                exit;
  2359.           End
  2360.           Else If fFetchType=SQL_FETCH_ABSOLUTE Then
  2361.           Begin
  2362.                If irow>Stmt^.result^.NumRows Then
  2363.                Begin
  2364.                     Result:=SQL_NO_DATA_FOUND;
  2365.                     exit;
  2366.                End;
  2367.           End
  2368.           Else
  2369.           Begin
  2370.                Result:=SQL_ERROR;
  2371.                exit;
  2372.           End;
  2373.  
  2374.           PmSqlFunc(stmt^.Procs^.FuncTable)^.msqlDataSeek(stmt^.Result,irow-1);
  2375.           Result:=msql_SQLFetch(ahstmt);
  2376.      End;
  2377. End;
  2378.  
  2379. Function msql_SQLExecDirect(ahstmt:SQLHSTMT;Const szSqlStr:SQLCHAR;cbSqlStr:SQLINTEGER):SQLRETURN;APIENTRY;
  2380. Var stmt:PmsqlStmt;
  2381. Begin
  2382.      stmt:=PmsqlStmt(ahstmt);
  2383.      If Stmt^.result<>Nil Then PmSQLFunc(Stmt^.Procs^.FuncTable)^.msqlFreeResult(Stmt^.result);
  2384.      Stmt^.result:=Nil;
  2385.      Result:=PmSqlFunc(stmt^.Procs^.FuncTable)^.msqlQuery(stmt^.hdbc^.Socket,szSqlStr);
  2386.      If Result=SQL_ERROR Then exit;
  2387.      stmt^.result:=PmSqlFunc(stmt^.Procs^.FuncTable)^.msqlStoreResult;
  2388.      Result:=SQL_SUCCESS;
  2389. End;
  2390.  
  2391. Function msql_SQLGetData(ahstmt:SQLHSTMT;icol:LongWord;fCType:LongInt;
  2392.                           Var rgbValue;cbValueMax:SQLINTEGER;Var pcbValue:SQLINTEGER):SQLRETURN;APIENTRY;
  2393. Var stmt:PmsqlStmt;
  2394. Begin
  2395.      stmt:=PmsqlStmt(ahstmt);
  2396.      If ((stmt^.result=Nil)Or(stmt^.m_row=Nil)Or
  2397.          (icol>stmt^.result^.NumFields)) Then Result:=SQL_ERROR
  2398.      Else Result:=GetDataFromField(stmt,icol,rgbValue,cbValueMax,pcbValue);
  2399. End;
  2400. {$HINTS ON}
  2401.  
  2402. {*******************************************************************************************
  2403.  *                                                                                         *
  2404.  * general functions                                                                       *
  2405.  *                                                                                         *
  2406.  *                                                                                         *
  2407.  *******************************************************************************************}
  2408.  
  2409. Function AllocateDBEnvironment(Var Procs:TDBProcs):SQLRETURN;
  2410. Begin
  2411.     Case Procs.DBType Of
  2412.        Native_DBase,Native_Paradox,Native_mSQL,Native_Oracle7:
  2413.        Begin
  2414.             Procs.ahenv:=HENV(@Procs);
  2415.             Result:=SQL_SUCCESS;
  2416.        End
  2417.        Else Result:=Procs.SQLAllocEnv(Procs.ahenv);
  2418.     End; //case
  2419. End;
  2420.  
  2421. Function SQLErrorText(Var DbProcs:TDBProcs;ahenv:SQLHENV;ahdbc:SQLHDBC;ahstmt:SQLHSTMT):String;
  2422. Var SQLSTATE:SQLCHAR;
  2423.     Buffer:cstring;
  2424.     sqlCode:SQLINTEGER;
  2425.     len:SQLSMALLINT;
  2426. Begin
  2427.      Result:=#13#10;
  2428.      While DbProcs.SQLError(ahenv,ahdbc,ahstmt,SQLSTATE,sqlCode,Buffer,
  2429.                             255,len)=SQL_SUCCESS Do
  2430.      Begin
  2431.           Result:=Result+'SQLSTATE: '+SQLSTATE+#13#10+
  2432.                          'Native error code: '+tostr(sqlCode)+#13#10+
  2433.                          Buffer;
  2434.           If DbProcs.DBType In [Native_Oracle7,Native_mSQL] Then break;
  2435.      End;
  2436.      If Result=#13#10 Then Result:='';
  2437. End;
  2438.  
  2439.  
  2440. {DLL stuff}
  2441.  
  2442. Function LoadDLL(Name:String):LONGWORD;
  2443. {$IFDEF OS2}
  2444. Var  c:CString;
  2445. {$ENDIF}
  2446. Begin
  2447.      {$IFDEF OS2}
  2448.      If DosLoadModule(c,255,Name,Result) <> 0 Then Result := 0;
  2449.      {$ENDIF}
  2450.      {$IFDEF Win32}
  2451.      Result := LoadLibrary(Name);
  2452.      {$ENDIF}
  2453. End;
  2454.  
  2455. Function FreeDLL(Var Handle:LONGWORD):BOOLEAN;
  2456. Begin
  2457.      Result := FALSE;
  2458.      {$IFDEF OS2}
  2459.      If Handle <> 0 Then Result := DosFreeModule(Handle) = 0;
  2460.      {$ENDIF}
  2461.      {$IFDEF Win32}
  2462.      If Handle <> 0 Then Result := FreeLibrary(Handle);
  2463.      {$ENDIF}
  2464.      If Result Then Handle := 0;
  2465. End;
  2466.  
  2467. Function GetDLLProcAddress(Handle:LONGWORD;Const ProcName:String):POINTER;
  2468. Var  c:CString;
  2469. Begin
  2470.      c := ProcName;
  2471.      {$IFDEF OS2}
  2472.      If DosQueryProcAddr(Handle,0,c,Result) <> 0 Then Result := Nil;
  2473.      {$ENDIF}
  2474.      {$IFDEF Win32}
  2475.      Result := GetProcAddress(Handle,c);
  2476.      {$ENDIF}
  2477. End;
  2478.  
  2479.  
  2480. Var CurrentProcName:String;
  2481.  
  2482. Function GetProcAddr(DllHandle:LongWord;Const ProcName:String):Pointer;
  2483. Begin
  2484.      CurrentProcName:=ProcName;
  2485.      Result:=GetDLLProcAddress(DllHandle,ProcName);
  2486.      If Result=Nil Then
  2487.        Raise EProcAddrError.Create(ProcName);
  2488. End;
  2489.  
  2490.  
  2491. Procedure FreeDBProcs(Var DbProcs:TDBProcs);
  2492. Begin
  2493.      If Not DbProcs.Assigned Then Exit;
  2494.  
  2495.      // free library
  2496.      FreeDLL(DbProcs.ModHandle);
  2497.  
  2498.  
  2499.      // free structures
  2500.      Case DbProcs.DbType Of
  2501.        Native_mSQL:
  2502.        Begin
  2503.             FreeMem(DbProcs.FuncTable,SizeOf(TmSqlFunc));
  2504.             DbProcs.FuncTable := Nil;
  2505.        End;
  2506.        Native_Oracle7:
  2507.        Begin
  2508.             FreeMem(DBProcs.FuncTable,sizeof(TOracle7Func));
  2509.        End;
  2510.      End;
  2511.  
  2512.      DbProcs.Assigned := False;
  2513. End;
  2514.  
  2515.  
  2516. Function FillDBProcs(Var DbProcs:TDBProcs):Boolean;
  2517. Var  DllName:String;
  2518.      DBType:TDBTypes;
  2519. Begin
  2520.      Result:=True;
  2521.  
  2522.      If DbProcs.Assigned Then Exit;
  2523.  
  2524.      GetDBServerFromAlias(DbProcs.AliasName,DllName,DBType);
  2525.  
  2526.      If DllName='' Then
  2527.      Begin
  2528.           Result:=False;
  2529.           Exit; //alias Not found
  2530.      End;
  2531.  
  2532.      UpcaseStr(DllName);
  2533.  
  2534.      DbProcs.ModHandle:=LoadDLL(DllName);
  2535.      If DbProcs.ModHandle=0 Then
  2536.      Begin
  2537.           ErrorBox2('Database DLL not found: '+DllName);
  2538.           Result:=False;
  2539.           Exit;
  2540.      End;
  2541.  
  2542.      DbProcs.DbType:=DBType;
  2543.  
  2544.      Case DBType Of
  2545.         Native_DBase,Native_Paradox,
  2546.         ODBC,DB2,Sybase:
  2547.         Begin
  2548.             Try
  2549.                With DbProcs Do
  2550.                Begin
  2551.                     SQLAllocEnv:=Pointer(GetProcAddr(ModHandle,'SQLAllocEnv'));
  2552.                     SQLAllocConnect:=Pointer(GetProcAddr(ModHandle,'SQLAllocConnect'));
  2553.                     SQLConnect:=Pointer(GetProcAddr(ModHandle,'SQLConnect'));
  2554.                     //SQLDriverConnect:=Pointer(GetProcAddr(ModHandle,'SQLDriverConnect'));
  2555.                     SQLDataSources:=Pointer(GetProcAddr(ModHandle,'SQLDataSources'));
  2556.                     //SQLGetInfo:=Pointer(GetProcAddr(ModHandle,'SQLGetInfo'));
  2557.                     //SQLGetFunctions:=Pointer(GetProcAddr(ModHandle,'SQLGetFunctions'));
  2558.                     SQLGetTypeInfo:=Pointer(GetDLLProcAddress(ModHandle,'SQLGetTypeInfo'));
  2559.                     SQLSetConnectOption:=Pointer(GetProcAddr(ModHandle,'SQLSetConnectOption'));
  2560.                     //SQLGetConnectOption:=Pointer(GetProcAddr(ModHandle,'SQLGetConnectOption'));
  2561.                     SQLSetStmtOption:=Pointer(GetProcAddr(ModHandle,'SQLSetStmtOption'));
  2562.                     //SQLGetStmtOption:=Pointer(GetProcAddr(ModHandle,'SQLGetStmtOption'));
  2563.                     SQLAllocStmt:=Pointer(GetProcAddr(ModHandle,'SQLAllocStmt'));
  2564.                     //SQLPrepare:=Pointer(GetProcAddr(ModHandle,'SQLPrepare'));
  2565.                     SQLBindParameter:=Pointer(GetProcAddr(ModHandle,'SQLBindParameter'));
  2566.                     //SQLSetParam:=Pointer(GetProcAddr(ModHandle,'SQLSetParam'));
  2567.                     //SQLParamOptions:=Pointer(GetProcAddr(ModHandle,'SQLParamOptions'));
  2568.                     SQLGetCursorName:=Pointer(GetProcAddr(ModHandle,'SQLGetCursorName'));
  2569.                     //SQLSetCursorName:=Pointer(GetProcAddr(ModHandle,'SQLSetCursorName'));
  2570.                     //SQLExecute:=Pointer(GetProcAddr(ModHandle,'SQLExecute'));
  2571.                     SQLExecDirect:=Pointer(GetProcAddr(ModHandle,'SQLExecDirect'));
  2572.                     //SQLNativeSql:=Pointer(GetProcAddr(ModHandle,'SQLNativeSql'));
  2573.                     SQLNumParams:=Pointer(GetProcAddr(ModHandle,'SQLNumParams'));
  2574.                     //SQLParamData:=Pointer(GetProcAddr(ModHandle,'SQLParamData'));
  2575.                     //SQLPutData:=Pointer(GetProcAddr(ModHandle,'SQLPutData'));
  2576.                     //SQLRowCount:=Pointer(GetProcAddr(ModHandle,'SQLRowCount'));
  2577.                     SQLNumResultCols:=Pointer(GetProcAddr(ModHandle,'SQLNumResultCols'));
  2578.                     SQLDescribeCol:=Pointer(GetProcAddr(ModHandle,'SQLDescribeCol'));
  2579.                     //SQLColAttributes:=Pointer(GetProcAddr(ModHandle,'SQLColAttributes'));
  2580.                     SQLBindCol:=Pointer(GetProcAddr(ModHandle,'SQLBindCol'));
  2581.                     SQLFetch:=Pointer(GetProcAddr(ModHandle,'SQLFetch'));
  2582.                     SQLExtendedFetch:=Pointer(GetProcAddr(ModHandle,'SQLExtendedFetch'));
  2583.                     SQLGetData:=Pointer(GetProcAddr(ModHandle,'SQLGetData'));
  2584.                     //SQLMoreResults:=Pointer(GetProcAddr(ModHandle,'SQLMoreResults'));
  2585.                     SQLError:=Pointer(GetProcAddr(ModHandle,'SQLError'));
  2586.                     //SQLColumns:=Pointer(GetProcAddr(ModHandle,'SQLColumns'));
  2587.                     SQLForeignKeys:=Pointer(GetDLLProcAddress(ModHandle,'SQLForeignKeys'));
  2588.                     SQLPrimaryKeys:=Pointer(GetProcAddr(ModHandle,'SQLPrimaryKeys'));
  2589.                     SQLProcedureColumns:=Pointer(GetProcAddr(ModHandle,'SQLProcedureColumns'));
  2590.                     SQLProcedures:=Pointer(GetProcAddr(ModHandle,'SQLProcedures'));
  2591.                     //SQLSpecialColumns:=Pointer(GetProcAddr(ModHandle,'SQLSpecialColumns'));
  2592.                     SQLStatistics:=Pointer(GetDLLProcAddress(ModHandle,'SQLStatistics'));
  2593.                     //SQLTablePrivileges:=Pointer(GetProcAddr(ModHandle,'SQLTablePrivileges'));
  2594.                     SQLTables:=Pointer(GetProcAddr(ModHandle,'SQLTables'));
  2595.                     SQLFreeStmt:=Pointer(GetProcAddr(ModHandle,'SQLFreeStmt'));
  2596.                     SQLCancel:=Pointer(GetProcAddr(ModHandle,'SQLCancel'));
  2597.                     SQLTransact:=Pointer(GetProcAddr(ModHandle,'SQLTransact'));
  2598.                     SQLDisconnect:=Pointer(GetProcAddr(ModHandle,'SQLDisconnect'));
  2599.                     SQLFreeConnect:=Pointer(GetProcAddr(ModHandle,'SQLFreeConnect'));
  2600.                     SQLFreeEnv:=Pointer(GetProcAddr(ModHandle,'SQLFreeEnv'));
  2601.                End;
  2602.  
  2603.                //Start DataBase Manager
  2604.                {
  2605.                If Pos('DB2CLI',DllName)<>0 Then
  2606.                Begin
  2607.                     If DosLoadModule(C,255,'SQLE32',sql32Handle)=0 Then
  2608.                     Begin
  2609.                          sqlestar:=Pointer(GetProcAddr(sql32Handle,'sqlestar_api'));
  2610.                          sqlestar;
  2611.                     End;
  2612.                End;
  2613.                }
  2614.  
  2615.                If DBType In [Native_DBase,Native_Paradox] Then 
  2616.                            Begin
  2617.                                 DbProcs.Host := ParamStr(0);
  2618.                End;
  2619.  
  2620.             Except
  2621.                ON EProcAddrError Do
  2622.                Begin
  2623.                     ErrorBox2('Cannot retrieve SQL Procedure: '+CurrentProcName);
  2624.                     FreeDLL(DbProcs.ModHandle);
  2625.                     Result:=False;
  2626.                End
  2627.                Else Raise;
  2628.             End;
  2629.         End; //ODBC
  2630.         Native_mSQL:
  2631.         Begin
  2632.             GetMem(DbProcs.FuncTable,sizeof(TmSqlFunc));
  2633.             Try
  2634.                With DbProcs,PmSQLFunc(DbProcs.FuncTable)^ Do
  2635.                Begin
  2636.                    msqlGetErrMsg:=Pointer(GetProcAddr(ModHandle,'msqlGetErrMsg'));
  2637.                    msqlUserConnect:=Pointer(GetProcAddr(ModHandle,'msqlUserConnect'));
  2638.                    msqlSelectDB:=Pointer(GetProcAddr(ModHandle,'msqlSelectDB'));
  2639.                    msqlQuery:=Pointer(GetProcAddr(ModHandle,'msqlQuery'));
  2640.                    msqlClose:=Pointer(GetProcAddr(ModHandle,'msqlClose'));
  2641.                    msqlDataSeek:=Pointer(GetProcAddr(ModHandle,'msqlDataSeek'));
  2642.                    msqlFieldSeek:=Pointer(GetProcAddr(ModHandle,'msqlFieldSeek'));
  2643.                    msqlFreeResult:=Pointer(GetProcAddr(ModHandle,'msqlFreeResult'));
  2644.                    msqlFetchRow:=Pointer(GetProcAddr(ModHandle,'msqlFetchRow'));
  2645.                    msqlFetchField:=Pointer(GetProcAddr(ModHandle,'msqlFetchField'));
  2646.                    msqlListDBs:=Pointer(GetProcAddr(ModHandle,'msqlListDBs'));
  2647.                    msqlListTables:=Pointer(GetProcAddr(ModHandle,'msqlListTables'));
  2648.                    msqlListFields:=Pointer(GetProcAddr(ModHandle,'msqlListFields'));
  2649.                    msqlStoreResult:=Pointer(GetProcAddr(ModHandle,'msqlStoreResult'));
  2650.                    msqlListIndex:=Pointer(GetProcAddr(ModHandle,'msqlListIndex'));
  2651.  
  2652.                    SQLFreeEnv:=@msql_SQLFreeEnv;
  2653.                    SQLDataSources:=@msql_SQLDataSources;
  2654.                    SQLAllocStmt:=@msql_SQLAllocStmt;
  2655.                    SQLFreeStmt:=@msql_SQLFreeStmt;
  2656.                    SQLAllocConnect:=@msql_SQLAllocConnect;
  2657.                    SQLFreeConnect:=@msql_SQLFreeConnect;
  2658.                    SQLDisconnect:=@msql_SQLDisconnect;
  2659.                    SQLTables:=@msql_SQLTables;
  2660.                    SQLConnect:=@msql_SQLConnect;
  2661.                    SQLError:=@msql_SQLError;
  2662.                    SQLSetConnectOption:=@msql_SQLSetConnectOption;
  2663.                    SQLPrimaryKeys:=@msql_SQLPrimaryKeys;
  2664.                    SQLNumResultCols:=@msql_SQLNumResultCols;
  2665.                    SQLSetStmtOption:=@msql_SQLSetStmtOption;
  2666.                    SQLBindParameter:=@msql_SQLBindParameter;
  2667.                    SQLDescribeCol:=@msql_SQLDescribeCol;
  2668.                    SQLBindCol:=@msql_SQLBindCol;
  2669.                    SQLFetch:=@msql_SQLFetch;
  2670.                    SQLExecDirect:=@msql_SQLExecDirect;
  2671.                    SQLCancel:=@msql_SQLCancel;
  2672.                    SQLTransact:=@msql_SQLTransact;
  2673.                    SQLExtendedFetch:=@msql_SQLExtendedFetch;
  2674.                    SQLGetData:=@msql_SQLGetData;
  2675.                    SQLNumParams:=@msql_SQLNumParams;
  2676.                    SQLProcedureColumns:=@msql_SQLProcedureColumns;
  2677.                    SQLProcedures:=@msql_SQLProcedures;
  2678.                    SQLGetCursorName:=@msql_SQLGetCursorName;
  2679.                End;
  2680.             Except
  2681.                ON EProcAddrError Do
  2682.                Begin
  2683.                     ErrorBox2('Cannot retrieve SQL Procedure: '+CurrentProcName);
  2684.                     FreeDLL(DbProcs.ModHandle);
  2685.                     FreeMem(DbProcs.FuncTable,SizeOf(TmSqlFunc));
  2686.                     DbProcs.FuncTable:=Nil;
  2687.                     Result:=False;
  2688.                End
  2689.                Else Raise;
  2690.             End;
  2691.         End;
  2692.         Native_Oracle7:
  2693.         Begin
  2694.             GetMem(DbProcs.FuncTable,sizeof(TOracle7Func));
  2695.             Try
  2696.                With DbProcs,POracle7Func(DbProcs.FuncTable)^ Do
  2697.                Begin
  2698.                    {$IFDEF OS2}
  2699.                    obndra:=Pointer(GetProcAddr(ModHandle,'OBNDRA'));
  2700.                    ocan:=Pointer(GetProcAddr(ModHandle,'OCAN'));
  2701.                    oclose:=Pointer(GetProcAddr(ModHandle,'OCLOSE'));
  2702.                    ocof:=Pointer(GetProcAddr(ModHandle,'OCOF'));
  2703.                    ocom:=Pointer(GetProcAddr(ModHandle,'OCOM'));
  2704.                    ocon:=Pointer(GetProcAddr(ModHandle,'OCON'));
  2705.                    odefin:=Pointer(GetProcAddr(ModHandle,'ODEFIN'));
  2706.                    odescr:=Pointer(GetProcAddr(ModHandle,'ODESCR'));
  2707.                    oerhms:=Pointer(GetProcAddr(ModHandle,'OERHMS'));
  2708.                    oexec:=Pointer(GetProcAddr(ModHandle,'OEXEC'));
  2709.                    ofetch:=Pointer(GetProcAddr(ModHandle,'OFETCH'));
  2710.                    ologof:=Pointer(GetProcAddr(ModHandle,'OLOGOF'));
  2711.                    olon:=Pointer(GetProcAddr(ModHandle,'OLON'));
  2712.                    oopen:=Pointer(GetProcAddr(ModHandle,'OOPEN'));
  2713.                    oparse:=Pointer(GetProcAddr(ModHandle,'OPARSE'));
  2714.                    orlon:=Pointer(GetProcAddr(ModHandle,'ORLON'));
  2715.                    orol:=Pointer(GetProcAddr(ModHandle,'OROL'));
  2716.                    odessp:=Pointer(GetProcAddr(ModHandle,'ODESSP'));
  2717.                    obndrv:=Pointer(GetProcAddr(ModHandle,'OBNDRV'));
  2718.                    {$ENDIF}
  2719.                    {$IFDEF WIN32}
  2720.                    obndra:=Pointer(GetProcAddr(ModHandle,'obndra'));
  2721.                    ocan:=Pointer(GetProcAddr(ModHandle,'ocan'));
  2722.                    oclose:=Pointer(GetProcAddr(ModHandle,'oclose'));
  2723.                    ocof:=Pointer(GetProcAddr(ModHandle,'ocof'));
  2724.                    ocom:=Pointer(GetProcAddr(ModHandle,'ocom'));
  2725.                    ocon:=Pointer(GetProcAddr(ModHandle,'ocon'));
  2726.                    odefin:=Pointer(GetProcAddr(ModHandle,'odefin'));
  2727.                    odescr:=Pointer(GetProcAddr(ModHandle,'odescr'));
  2728.                    oerhms:=Pointer(GetProcAddr(ModHandle,'oerhms'));
  2729.                    oexec:=Pointer(GetProcAddr(ModHandle,'oexec'));
  2730.                    ofetch:=Pointer(GetProcAddr(ModHandle,'ofetch'));
  2731.                    ologof:=Pointer(GetProcAddr(ModHandle,'ologof'));
  2732.                    olon:=Pointer(GetProcAddr(ModHandle,'olon'));
  2733.                    oopen:=Pointer(GetProcAddr(ModHandle,'oopen'));
  2734.                    oparse:=Pointer(GetProcAddr(ModHandle,'oparse'));
  2735.                    orlon:=Pointer(GetProcAddr(ModHandle,'orlon'));
  2736.                    orol:=Pointer(GetProcAddr(ModHandle,'orol'));
  2737.                    odessp:=Pointer(GetProcAddr(ModHandle,'odessp'));
  2738.                    obndrv:=Pointer(GetProcAddr(ModHandle,'obndrv'));
  2739.                    {$ENDIF}
  2740.  
  2741.                    SQLFreeEnv:=@Oracle7_SQLFreeEnv;
  2742.                    SQLDataSources:=@Oracle7_SQLDataSources;
  2743.                    SQLAllocStmt:=@Oracle7_SQLAllocStmt;
  2744.                    SQLFreeStmt:=@Oracle7_SQLFreeStmt;
  2745.                    SQLAllocConnect:=@Oracle7_SQLAllocConnect;
  2746.                    SQLFreeConnect:=@Oracle7_SQLFreeConnect;
  2747.                    SQLDisconnect:=@Oracle7_SQLDisconnect;
  2748.                    SQLTables:=@Oracle7_SQLTables;
  2749.                    SQLConnect:=@Oracle7_SQLConnect;
  2750.                    SQLError:=@Oracle7_SQLError;
  2751.                    SQLSetConnectOption:=@Oracle7_SQLSetConnectOption;
  2752.                    SQLPrimaryKeys:=@Oracle7_SQLPrimaryKeys;
  2753.                    SQLNumResultCols:=@Oracle7_SQLNumResultCols;
  2754.                    SQLSetStmtOption:=@Oracle7_SQLSetStmtOption;
  2755.                    SQLBindParameter:=@Oracle7_SQLBindParameter;
  2756.                    SQLDescribeCol:=@Oracle7_SQLDescribeCol;
  2757.                    SQLBindCol:=@Oracle7_SQLBindCol;
  2758.                    SQLFetch:=@Oracle7_SQLFetch;
  2759.                    SQLExecDirect:=@Oracle7_SQLExecDirect;
  2760.                    SQLCancel:=@Oracle7_SQLCancel;
  2761.                    SQLTransact:=@Oracle7_SQLTransact;
  2762.                    SQLExtendedFetch:=@Oracle7_SQLExtendedFetch;
  2763.                    SQLGetData:=@Oracle7_SQLGetData;
  2764.                    SQLNumParams:=@Oracle7_SQLNumParams;
  2765.                    SQLProcedureColumns:=@Oracle7_SQLProcedureColumns;
  2766.                    SQLProcedures:=@Oracle7_SQLProcedures;
  2767.                    SQLGetCursorName:=@Oracle7_SQLGetCursorName;
  2768.                    SQLForeignKeys:=@Oracle7_SQLForeignKeys;
  2769.                    Oracle7GetProcParams:=@Oracle7_GetProcParams;
  2770.                    aDBProcs:=@DBProcs;
  2771.                    SQLStatistics:=@Oracle7_SQLStatistics;
  2772.                End;
  2773.             Except
  2774.                ON EProcAddrError Do
  2775.                Begin
  2776.                     ErrorBox2('Cannot retrieve SQL Procedure: '+CurrentProcName);
  2777.                     FreeDLL(DbProcs.ModHandle);
  2778.                     FreeMem(DbProcs.FuncTable,SizeOf(TOracle7Func));
  2779.                     DbProcs.FuncTable:=Nil;
  2780.                     Result:=False;
  2781.                End
  2782.                Else Raise;
  2783.             End;
  2784.         End;
  2785.         Else Result:=False;
  2786.      End; //case
  2787.  
  2788.      DbProcs.Assigned:=Result;
  2789. End;
  2790.  
  2791.  
  2792. Type
  2793.     PDBServers=^TDBServers;
  2794.     TDBServers=Record
  2795.                       DllName:String[10];
  2796.                       AliasName:String;
  2797.                       DBType:TDBTypes;
  2798.                 End;
  2799.  
  2800. {$IFDEF OS2}
  2801. Const
  2802.      MaxDBServers=7;
  2803.      DBServers:Array[1..MaxDBServers] Of TDBServers=
  2804.           ((DllName:'DB2CLI';AliasName:'DB2/2 2.1';DBType:DB2),
  2805.            (DllName:'WOD502';AliasName:'Sybase SQL Anywhere 5.0';DBType:Sybase),
  2806.            (DllName:'ODBC';AliasName:'ODBC';DBType:ODBC),
  2807.            (DllName:'MSQL';AliasName:'mSQL 2.x';DBType:Native_mSQL),
  2808.            (DllName:'SDE';AliasName:'dBASE';DBType:Native_DBase),
  2809.            (DllName:'SDE';AliasName:'Paradox';DBType:Native_Paradox),
  2810.            (DllName:'ORA_D71O';AliasName:'Oracle 7.1';DBType:Native_Oracle7)
  2811.           );
  2812. {$ENDIF}
  2813. {$IFDEF Win95}
  2814. Const
  2815.      MaxDBServers=10;
  2816.      DBServers:Array[1..MaxDBServers] Of TDBServers=
  2817.           ((DllName:'WOD50t';AliasName:'Sybase SQL Anywhere 5.0';DBType:ODBC),
  2818.            (DllName:'ODBC32';AliasName:'ODBC';DBType:ODBC),
  2819.            (DllName:'MSQL';AliasName:'mSQL 2.x';DBType:Native_mSQL),
  2820.            (DllName:'SDE';AliasName:'dBASE';DBType:Native_DBase),
  2821.            (DllName:'SDE';AliasName:'Paradox';DBType:Native_Paradox),
  2822.            (DllName:'ORANT71';AliasName:'Oracle 7.1 NT';DBType:Native_Oracle7),
  2823.            (DllName:'ORA71';AliasName:'Oracle 7.1 Win95';DBType:Native_Oracle7),
  2824.            (DllName:'ORANT73';AliasName:'Oracle 7.3 NT';DBType:Native_Oracle7),
  2825.            (DllName:'ORA73';AliasName:'Oracle 7.3 Win95';DBType:Native_Oracle7),
  2826.            (DllName:'ORANT71';AliasName:'Oracle 7.1';DBType:Native_Oracle7)
  2827.           );
  2828. {$ENDIF}
  2829.  
  2830. Var DBServerList:TList;
  2831.  
  2832. Procedure AddServerAlias(Const AliasName,DllName:String;DBType:TDBTypes);
  2833. Var D,N,E:String;
  2834.     T:LongInt;
  2835.     dummy:PDBServers;
  2836. Begin
  2837.      If AliasName='' Then exit; //invalid
  2838.      FSplit(DllName,D,N,E);
  2839.      N:=D+N;
  2840.      D:=AliasName;
  2841.      UpcaseStr(D);
  2842.  
  2843.      For T:=0 To DBServerList.Count-1 Do
  2844.      Begin
  2845.           dummy:=DBServerList[T];
  2846.           E:=dummy^.AliasName;
  2847.           UpcaseStr(E);
  2848.           If D=E Then Exit; //alias already present
  2849.      End;
  2850.  
  2851.      New(dummy);
  2852.      dummy^.AliasName:=AliasName;
  2853.      dummy^.DllName:=N;
  2854.      dummy^.DBType:=DBType;
  2855.      DBServerList.Add(dummy);
  2856. End;
  2857.  
  2858. Function GetDBServersCount:LongInt;
  2859. Begin
  2860.      Result:=DBServerList.Count;
  2861. End;
  2862.  
  2863. Procedure GetDBServer(Index:LongInt;Var AliasName,DllName:String;Var DBType:TDBTypes);
  2864. Var dummy:PDBServers;
  2865. Begin
  2866.      If ((Index<0)Or(Index>DBServerList.Count-1)) Then
  2867.      Begin
  2868.           AliasName:='';
  2869.           DllName:='';
  2870.           DbType:=Unkown_DB;
  2871.      End
  2872.      Else
  2873.      Begin
  2874.           dummy:=DBServerList[Index];
  2875.           AliasName:=dummy^.AliasName;
  2876.           DllName:=dummy^.DllName;
  2877.           DBType:=dummy^.DBType;
  2878.      End;
  2879. End;
  2880.  
  2881. Procedure GetDBServerFromAlias(Const Alias:String;Var DllName:String;Var DBType:TDBTypes);
  2882. Var T:LongInt;
  2883.     dummy:PDBServers;
  2884.     S,s1:String;
  2885. Begin
  2886.      S:=alias;
  2887.      UpcaseStr(S);
  2888.      For T:=0 To DBServerList.Count-1 Do
  2889.      Begin
  2890.           dummy:=DBServerList[T];
  2891.           s1:=dummy^.AliasName;
  2892.           UpcaseStr(s1);
  2893.           If S=s1 Then
  2894.           Begin
  2895.                DllName:=dummy^.DllName;
  2896.                DBType:=dummy^.DBType;
  2897.                Exit;
  2898.           End;
  2899.      End;
  2900.  
  2901.      DllName:='';
  2902.      DBType:=Unkown_DB;
  2903. End;
  2904.  
  2905. Procedure ModifyServerAlias(Const AliasName,NewAliasName,DllName:String;DBType:TDBTypes);
  2906. Var T:LongInt;
  2907.     dummy:PDBServers;
  2908.     S,s1:String;
  2909. Begin
  2910.      S:=AliasName;
  2911.      UpcaseStr(S);
  2912.      For T:=0 To DBServerList.Count-1 Do
  2913.      Begin
  2914.           dummy:=DBServerList[T];
  2915.           s1:=dummy^.AliasName;
  2916.           UpcaseStr(s1);
  2917.           If S=s1 Then
  2918.           Begin
  2919.                If NewAliasName<>'' Then dummy^.AliasName:=NewAliasName;
  2920.                dummy^.DllName:=DllName;
  2921.                dummy^.DBType:=DBType;
  2922.                Exit;
  2923.           End;
  2924.      End;
  2925. End;
  2926.  
  2927. Procedure RemoveServerAlias(Const AliasName:String);
  2928. Var T:LongInt;
  2929.     dummy:PDBServers;
  2930.     S,s1:String;
  2931. Begin
  2932.      S:=AliasName;
  2933.      UpcaseStr(S);
  2934.      For T:=0 To DBServerList.Count-1 Do
  2935.      Begin
  2936.           dummy:=DBServerList[T];
  2937.           s1:=dummy^.AliasName;
  2938.           UpcaseStr(s1);
  2939.           If S=s1 Then
  2940.           Begin
  2941.                DBServerList.Remove(dummy);
  2942.                Dispose(dummy);
  2943.                Exit;
  2944.           End;
  2945.      End;
  2946.  
  2947. End;
  2948.  
  2949. Procedure InitDefaultServers;
  2950. Var T:LongInt;
  2951. Begin
  2952.      For T:=1 To MaxDBServers Do AddServerAlias(DBServers[T].AliasName,DBServers[T].DllName,
  2953.                                                 DBServers[T].DBType);
  2954. End;
  2955.  
  2956. Function IsDefaultServer(Const AliasName:String):Boolean;
  2957. Var s,s1:String;
  2958.     t:LongInt;
  2959. Begin
  2960.      s:=AliasName;
  2961.      UpcaseStr(s);
  2962.      Result:=False;
  2963.      For T:=1 To MaxDBServers Do
  2964.      Begin
  2965.           s1:=DBServers[t].AliasName;
  2966.           UpcaseStr(s1);
  2967.           If s1=s Then
  2968.           Begin
  2969.              Result:=True;
  2970.              exit;
  2971.           End;
  2972.      End;
  2973. End;
  2974.  
  2975. Type
  2976.     PDBAliasNames=^TDBAliasNames;
  2977.     TDBAliasNames=Record
  2978.                       AliasName:String;
  2979.                       DriverName:String;
  2980.                       UID:String;
  2981.                       Advanced:String;
  2982.                   End;
  2983.  
  2984. Var DBAliasList:TList;
  2985.  
  2986. Function GetDBAliasNamesCount:LongInt;
  2987. Begin
  2988.      Result:=DBAliasList.Count;
  2989. End;
  2990.  
  2991. Procedure GetDBAlias(Index:LongInt;Var AliasName,DriverName,Advanced,UID:String);
  2992. Var dummy:PDBAliasNames;
  2993. Begin
  2994.      If ((Index<0)Or(Index>DBAliasList.Count-1)) Then
  2995.      Begin
  2996.           AliasName:='';
  2997.           DriverName:='';
  2998.           Advanced:='';
  2999.           UID:='';
  3000.      End
  3001.      Else
  3002.      Begin
  3003.           dummy:=DBAliasList[Index];
  3004.           AliasName:=dummy^.AliasName;
  3005.           DriverName:=dummy^.DriverName;
  3006.           Advanced:=dummy^.Advanced;
  3007.           UID:=dummy^.UID;
  3008.      End;
  3009. End;
  3010.  
  3011.  
  3012. Procedure GetDBServerFromDBAlias(Const AliasName:String;Var DriverName,Advanced,UID:String);
  3013. Var T:LongInt;
  3014.     dummy:PDBAliasNames;
  3015.     S,s1:String;
  3016. Begin
  3017.      S:=AliasName;
  3018.      UpcaseStr(S);
  3019.      For T:=0 To DBAliasList.Count-1 Do
  3020.      Begin
  3021.           dummy:=DBAliasList[T];
  3022.           s1:=dummy^.AliasName;
  3023.           UpcaseStr(s1);
  3024.           If S=s1 Then
  3025.           Begin
  3026.                DriverName:=dummy^.DriverName;
  3027.                Advanced:=dummy^.Advanced;
  3028.                UID:=dummy^.UID;
  3029.                Exit;
  3030.           End;
  3031.      End;
  3032.  
  3033.      DriverName:='';
  3034.      Advanced:='';
  3035.      UID:='';
  3036. End;
  3037.  
  3038.  
  3039. Procedure AddDatabaseAlias(Const AliasName,DriverName,Advanced,UID:String);
  3040. Var t:LongInt;
  3041.     dummy:PDBAliasNames;
  3042.     d,n,e:String;
  3043. Begin
  3044.      If AliasName='' Then exit; //invalid
  3045.      D:=AliasName;
  3046.      UpcaseStr(D);
  3047.  
  3048.      For T:=0 To DBAliasList.Count-1 Do
  3049.      Begin
  3050.           dummy:=DBAliasList[T];
  3051.           E:=dummy^.AliasName;
  3052.           UpcaseStr(E);
  3053.           If D=E Then Exit; //alias already present
  3054.      End;
  3055.  
  3056.      New(dummy);
  3057.      dummy^.AliasName:=AliasName;
  3058.      dummy^.DriverName:=DriverName;
  3059.      dummy^.Advanced:=Advanced;
  3060.      dummy^.UID:=UID;
  3061.      DBAliasList.Add(dummy);
  3062. End;
  3063.  
  3064. Procedure RemoveDataBaseAlias(Const AliasName:String);
  3065. Var T:LongInt;
  3066.     dummy:PDBAliasNames;
  3067.     S,s1:String;
  3068. Begin
  3069.      S:=AliasName;
  3070.      UpcaseStr(S);
  3071.      For T:=0 To DBAliasList.Count-1 Do
  3072.      Begin
  3073.           dummy:=DBAliasList[T];
  3074.           s1:=dummy^.AliasName;
  3075.           UpcaseStr(s1);
  3076.           If S=s1 Then
  3077.           Begin
  3078.                DBAliasList.Remove(dummy);
  3079.                Dispose(dummy);
  3080.                Exit;
  3081.           End;
  3082.      End;
  3083.  
  3084. End;
  3085.  
  3086.  
  3087. Procedure ModifyDatabaseAlias(Const AliasName,NewAliasName,DriverName,Advanced,UID:String);
  3088. Var T:LongInt;
  3089.     dummy:PDBAliasNames;
  3090.     S,s1:String;
  3091. Begin
  3092.      S:=AliasName;
  3093.      UpcaseStr(S);
  3094.      For T:=0 To DBAliasList.Count-1 Do
  3095.      Begin
  3096.           dummy:=DBAliasList[T];
  3097.           s1:=dummy^.AliasName;
  3098.           UpcaseStr(s1);
  3099.           If S=s1 Then
  3100.           Begin
  3101.                If NewAliasName<>'' Then dummy^.AliasName:=NewAliasName;
  3102.                dummy^.DriverName:=DriverName;
  3103.                dummy^.Advanced:=Advanced;
  3104.                dummy^.UID:=UID;
  3105.                Exit;
  3106.           End;
  3107.      End;
  3108. End;
  3109.  
  3110.  
  3111.  
  3112. Type
  3113.     TUnsortedAsciiIniFile = CLASS(TAsciiIniFile)
  3114.        Protected
  3115.            Procedure InitIniFile;Override;
  3116.     End;
  3117.  
  3118. Procedure TUnsortedAsciiIniFile.InitIniFile;
  3119. Begin
  3120.   Inherited InitIniFile;
  3121.   SectionSort := TRUE;
  3122.   IdentSort := FALSE;
  3123. End;
  3124.  
  3125. Procedure RegisterDBDrivers(IniName:String);
  3126. Var a,D,N,E,S:String;
  3127.     DbType:TDBTypes;
  3128.     Ini:TUnsortedAsciiIniFile;
  3129.     IniStrings:TStringList;
  3130.     t,t1:LONGINT;
  3131.     c:Integer;
  3132. Begin
  3133.      If IniName = '' Then
  3134.      Begin
  3135.           D := GetEnv('SIBYLDBE');
  3136.           If D <> '' THEN
  3137.           Begin
  3138.                If D[Length(D)] <> '\' Then D := D + '\';
  3139.           End
  3140.           Else FSplit(ParamStr(0),D,N,E);
  3141.  
  3142.           IniName := D +'SIBYL.DBD';
  3143.      End;
  3144.  
  3145.      //read available drivers from SIBYL.DBD and add it to the listbox
  3146.      Try
  3147.         Ini.Create(IniName);
  3148.      Except
  3149.         Ini:=Nil;
  3150.      End;
  3151.  
  3152.      If Ini=Nil Then exit;
  3153.  
  3154.      IniStrings.Create;
  3155.  
  3156.      Try
  3157.         Ini.ReadSectionValues('DRIVERS',IniStrings);
  3158.  
  3159.         For t:=0 To IniStrings.Count-1 Do
  3160.         Begin
  3161.              s:=IniStrings[t];
  3162.              UpcaseStr(s);
  3163.              If pos('ALIAS=',s)=1 Then
  3164.              Begin
  3165.                   a:=IniStrings[t];
  3166.                   delete(a,1,length('ALIAS='));
  3167.                   While ((length(a)>0)And(a[1]=#32)) Do Delete(a,1,1);
  3168.                   While a[length(a)]=#32 Do Dec(a[0]);
  3169.                   inc(t);
  3170.              End
  3171.              Else a:='';
  3172.  
  3173.              If t<IniStrings.Count Then s:=IniStrings[t]
  3174.              Else s:='';
  3175.              UpcaseStr(s);
  3176.              If pos('DRIVER=',s)=1 Then
  3177.              Begin
  3178.                   d:=IniStrings[t];
  3179.                   delete(d,1,length('DRIVER='));
  3180.                   While ((length(d)>0)And(d[1]=#32)) Do Delete(d,1,1);
  3181.                   While d[length(d)]=#32 Do Dec(d[0]);
  3182.                   inc(t);
  3183.              End
  3184.              Else d:='';
  3185.  
  3186.              DBType:=ODBC;
  3187.              If t<IniStrings.Count Then s:=IniStrings[t]
  3188.              Else s:='';
  3189.              UpcaseStr(s);
  3190.              If pos('DBTYPE=',s)=1 Then
  3191.              Begin
  3192.                   delete(s,1,length('DBTYPE='));
  3193.                   VAL(s,t1,c);
  3194.                   If c<>0 Then Move(t1,DBType,sizeof(DBType));
  3195.                   inc(t);
  3196.              End;
  3197.  
  3198.              IF ((a<>'')And(d<>'')) Then
  3199.              Begin
  3200.                    AddServerAlias(a,d,DbType);
  3201.                    dec(t);
  3202.              End;
  3203.         End;
  3204.      Except
  3205.      End;
  3206.  
  3207.      IniStrings.Destroy;
  3208.  
  3209.      Ini.Destroy;
  3210. End;
  3211.  
  3212. Procedure RegisterDBAliasNames(IniName:String);
  3213. Var a,D,H,N,E,S,u:String;
  3214.     DbType:TDBTypes;
  3215.     IniStrings:TStringList;
  3216.     Ini:TUnsortedAsciiIniFile;
  3217.     t,t1:LONGINT;
  3218.     c:Integer;
  3219. Begin
  3220.      If IniName = '' Then
  3221.      Begin
  3222.           D := GetEnv('SIBYLDBE');
  3223.           If D <> '' THEN
  3224.           Begin
  3225.                If D[Length(D)] <> '\' Then D := D + '\';
  3226.           End
  3227.           Else FSplit(ParamStr(0),D,N,E);
  3228.  
  3229.           IniName := D +'SIBYL.DBA';
  3230.      End;
  3231.  
  3232.      //read available drivers from SIBYL.DBA and add it to the listbox
  3233.      Try
  3234.         Ini.Create(IniName);
  3235.      Except
  3236.         Ini:=Nil;
  3237.      End;
  3238.  
  3239.      If Ini=Nil Then exit;
  3240.  
  3241.      IniStrings.Create;
  3242.  
  3243.      Try
  3244.         Ini.ReadSectionValues('ALIAS NAMES',IniStrings);
  3245.  
  3246.         For t:=0 TO IniStrings.Count-1 Do
  3247.         Begin
  3248.              s:=IniStrings[t];
  3249.              UpcaseStr(s);
  3250.              If pos('ALIAS=',s)=1 Then
  3251.              Begin
  3252.                   a:=IniStrings[t];
  3253.                   delete(a,1,length('ALIAS='));
  3254.                   While ((length(a)>0)And(a[1]=#32)) Do Delete(a,1,1);
  3255.                   While a[length(a)]=#32 Do Dec(a[0]);
  3256.                   inc(t);
  3257.              End
  3258.              Else a:='';
  3259.  
  3260.              If t<IniStrings.Count Then s:=IniStrings[t]
  3261.              Else s:='';
  3262.              UpcaseStr(s);
  3263.              If pos('DRIVER=',s)=1 Then
  3264.              Begin
  3265.                   d:=IniStrings[t];
  3266.                   delete(d,1,length('DRIVER='));
  3267.                   While ((length(d)>0)And(d[1]=#32)) Do Delete(d,1,1);
  3268.                   While d[length(d)]=#32 Do Dec(d[0]);
  3269.                   inc(t);
  3270.              End
  3271.              Else d:='';
  3272.  
  3273.              If t<IniStrings.Count Then s:=IniStrings[t]
  3274.              Else s:='';
  3275.              UpcaseStr(s);
  3276.              If pos('ADVANCED=',s)=1 Then
  3277.              Begin
  3278.                   h:=IniStrings[t];
  3279.                   delete(h,1,length('ADVANCED='));
  3280.                   While ((length(h)>0)And(h[1]=#32)) Do Delete(h,1,1);
  3281.                   While h[length(h)]=#32 Do Dec(h[0]);
  3282.                   inc(t);
  3283.              End
  3284.              Else h:='';
  3285.  
  3286.              If t<IniStrings.Count Then s:=IniStrings[t]
  3287.              Else s:='';
  3288.              UpcaseStr(s);
  3289.              If pos('UID=',s)=1 Then
  3290.              Begin
  3291.                   u:=IniStrings[t];
  3292.                   delete(u,1,length('UID='));
  3293.                   While ((length(u)>0)And(u[1]=#32)) Do Delete(u,1,1);
  3294.                   While u[length(u)]=#32 Do Dec(u[0]);
  3295.                   inc(t);
  3296.              End
  3297.              Else u:='';
  3298.  
  3299.              If ((a<>'')And(d<>'')) Then
  3300.              Begin
  3301.                   AddDatabaseAlias(a,d,h,u);
  3302.                   dec(t);
  3303.              End;
  3304.         End;
  3305.      Except
  3306.      End;
  3307.  
  3308.      IniStrings.Destroy;
  3309.  
  3310.      Ini.Destroy;
  3311. End;
  3312.  
  3313.  
  3314. Begin
  3315.      DBServerList.Create;
  3316.      DBAliasList.Create;
  3317.      //Add Default servers
  3318.      InitDefaultServers;
  3319.  
  3320.      Try
  3321.         RegisterDBDrivers('');
  3322.      Except
  3323.      End;
  3324.  
  3325.      Try
  3326.         RegisterDBAliasNames('');
  3327.      Except
  3328.      End;
  3329. End.
  3330.  
  3331.  
  3332.