$PBExportHeader$n_odbcapi.sru forward global type n_odbcapi from nonvisualobject end type end forward global type n_odbcapi from nonvisualobject autoinstantiate end type type prototypes Function integer SQLAllocHandle ( & integer HandleType, & long InputHandle, & Ref long OutputHandlePtr & ) Library "odbc32.dll" Function integer SQLFreeHandle ( & integer HandleType, & long Handle & ) Library "odbc32.dll" Function integer SQLSetEnvAttr ( & long EnvironmentHandle, & long Attribute, & ulong ValuePtr, & long StringLength & ) Library "odbc32.dll" Function integer SQLGetDiagRec ( & integer HandleType, & long Handle, & integer RecNumber, & Ref string Sqlstate, & Ref long NativeErrorPtr, & Ref string MessageText, & integer BufferLength, & Ref integer TextLengthPtr & ) Library "odbc32.dll" Alias For "SQLGetDiagRec" Function integer SQLBindCol ( & long StatementHandle, & UInt ColumnNumber, & integer TargetType, & Ref string TargetValuePtr, & long BufferLength, & Ref integer StrLen_or_IndPtr & ) Library "odbc32.dll" Alias For "SQLBindCol" Function integer SQLBindCol ( & long StatementHandle, & UInt ColumnNumber, & integer TargetType, & Ref integer TargetValuePtr, & long BufferLength, & Ref integer StrLen_or_IndPtr & ) Library "odbc32.dll" Function integer SQLBindCol ( & long StatementHandle, & UInt ColumnNumber, & integer TargetType, & Ref long TargetValuePtr, & long BufferLength, & Ref integer StrLen_or_IndPtr & ) Library "odbc32.dll" Function integer SQLFetch ( & long statementhandle & ) Library "odbc32.dll" Function integer SQLDataSources ( & long EnvironmentHandle, & UInt Direction, & Ref string ServerName, & integer BufferLength1, & Ref integer NameLength1Ptr, & Ref string Description, & integer BufferLength2 , & Ref integer NameLength2Ptr & ) Library "odbc32.dll" Alias For "SQLDataSources" Function integer SQLTables ( & long StatementHandle, & string CatalogName, & integer NameLength1, & string SchemaName, & integer NameLength2, & string TableName, & integer NameLength3, & string TableType, & integer NameLength4 & ) Library "odbc32.dll" Alias For "SQLTables" Function integer SQLColumns ( & long StatementHandle, & string CatalogName, & integer NameLength1, & string SchemaName, & integer NameLength2, & string TableName, & integer NameLength3, & string ColumnName, & integer NameLength4 & ) Library "odbc32.dll" Alias For "SQLColumns" Function integer SQLPrimaryKeys ( & long StatementHandle, & string CatalogName, & integer NameLength1, & string SchemaName, & integer NameLength2, & string TableName, & integer NameLength3 & ) Library "odbc32.dll" Alias For "SQLPrimaryKeys" Function integer SQLForeignKeys ( & long StatementHandle, & string PKCatalogName, & integer NameLength1, & string PKSchemaName, & integer NameLength2, & string PKTableName, & integer NameLength3, & string FKCatalogName, & integer NameLength4, & string FKSchemaName, & integer NameLength5, & string FKTableName, & integer NameLength6 & ) Library "odbc32.dll" Alias For "SQLForeignKeys" Function integer SQLProcedures ( & long StatementHandle, & string CatalogName, & integer NameLength1, & string SchemaName, & integer NameLength2, & string ProcName, & integer NameLength3 & ) Library "odbc32.dll" Alias For "SQLProcedures" Function integer SQLGetInfo ( & long ConnectionHandle, & integer InfoType, & Ref string InfoValuePtr, & integer BufferLength, & Ref int StringLengthPtr & ) Library "odbc32.dll" Alias For "SQLGetInfo" Function integer SQLExecDirect ( & long StatementHandle, & string StatementText, & long TextLength & ) Library "odbc32.dll" Alias For "SQLExecDirect" Function integer SQLBrowseConnect ( & long ConnectionHandle, & string InConnectionString, & integer StringLength1, & Ref string OutConnectionString, & integer BufferLength, & Ref integer StringLength2Ptr & ) Library "odbc32.dll" Alias For "SQLBrowseConnect" Function integer SQLSetConnectAttr ( & long ConnectionHandle, & integer Attribute, & long ValuePtr, & integer StringLength & ) Library "odbc32.dll" Function integer SQLSetConnectAttr ( & long ConnectionHandle, & integer Attribute, & string ValuePtr, & integer StringLength & ) Library "odbc32.dll" Alias For "SQLSetConnectAttr" end prototypes type variables // return values from functions Constant Integer SQL_SUCCESS = 0 Constant Integer SQL_SUCCESS_WITH_INFO = 1 Constant Integer SQL_NO_DATA = 100 Constant Integer SQL_ERROR = -1 Constant Integer SQL_INVALID_HANDLE = -2 Constant Integer SQL_NEED_DATA = 99 // other values Constant Integer SQL_NTS = -3 Constant Long SQL_NULL_HANDLE = 0 Constant Integer SQL_MAX_DSN_LENGTH = 32 Constant Long SQL_ATTR_ODBC_VERSION = 200 Constant ULong SQL_OV_ODBC3 = 3 // SQLAllocHandle constants Constant Integer SQL_HANDLE_ENV = 1 Constant Integer SQL_HANDLE_DBC = 2 Constant Integer SQL_HANDLE_STMT = 3 Constant Integer SQL_HANDLE_DESC = 4 // SQLTables column numbers constant UInt SQLTAB_TABLE_CAT = 1 Constant UInt SQLTAB_TABLE_SCHEM = 2 Constant UInt SQLTAB_TABLE_NAME = 3 Constant UInt SQLTAB_TABLE_TYPE = 4 Constant UInt SQLTAB_REMARKS = 5 // SQLColumns column numbers constant UInt SQLCOL_TABLE_CAT = 1 Constant UInt SQLCOL_TABLE_SCHEM = 2 Constant UInt SQLCOL_TABLE_NAME = 3 Constant UInt SQLCOL_COLUMN_NAME = 4 Constant UInt SQLCOL_DATA_TYPE = 5 Constant UInt SQLCOL_TYPE_NAME = 6 Constant UInt SQLCOL_COLUMN_SIZE = 7 Constant UInt SQLCOL_BUFFER_LENGTH = 8 Constant UInt SQLCOL_DECIMAL_DIGITS = 9 Constant UInt SQLCOL_NUM_PREC_RADIX = 10 Constant UInt SQLCOL_NULLABLE = 11 Constant UInt SQLCOL_REMARKS = 12 Constant UInt SQLCOL_COLUMN_DEF = 13 Constant UInt SQLCOL_SQL_DATA_TYPE = 14 Constant UInt SQLCOL_SQL_DATETIME_SUB = 15 Constant UInt SQLCOL_CHAR_OCTET_LENGTH = 16 Constant UInt SQLCOL_ORDINAL_POSITION = 17 Constant UInt SQLCOL_IS_NULLABLE = 18 // SQLPrimaryKeys column numbers Constant UInt SQLPK_TABLE_CAT = 1 Constant UInt SQLPK_TABLE_SCHEM = 2 Constant UInt SQLPK_TABLE_NAME = 3 Constant UInt SQLPK_COLUMN_NAME = 4 Constant UInt SQLPK_KEY_SEQ = 5 Constant UInt SQLPK_PK_NAME = 6 // SQLForeignKeys column numbers Constant UInt SQLFK_PKTABLE_CAT = 1 Constant UInt SQLFK_PKTABLE_SCHEM = 2 Constant UInt SQLFK_PKTABLE_NAME = 3 Constant UInt SQLFK_PKCOLUMN_NAME = 4 Constant UInt SQLFK_FKTABLE_CAT = 5 Constant UInt SQLFK_FKTABLE_SCHEM = 6 Constant UInt SQLFK_FKTABLE_NAME = 7 Constant UInt SQLFK_FKCOLUMN_NAME = 8 Constant UInt SQLFK_KEY_SEQ = 9 Constant UInt SQLFK_UPDATE_RULE = 10 Constant UInt SQLFK_DELETE_RULE = 11 Constant UInt SQLFK_FK_NAME = 12 Constant UInt SQLFK_PK_NAME = 13 Constant UInt SQLFK_DEFERRABILITY = 14 // SQLProcedures column numbers Constant UInt SQLSP_PROCEDURE_CAT = 1 Constant UInt SQLSP_PROCEDURE_SCHEM = 2 Constant UInt SQLSP_PROCEDURE_NAME = 3 Constant UInt SQLSP_REMARKS = 7 Constant UInt SQLSP_PROCEDURE_TYPE = 8 // SQL data type codes Constant Long SQL_CHAR = 1 Constant Long SQL_NUMERIC = 2 Constant Long SQL_DECIMAL = 3 Constant Long SQL_INTEGER = 4 Constant Long SQL_SMALLINT = 5 Constant Long SQL_FLOAT = 6 Constant Long SQL_REAL = 7 Constant Long SQL_DOUBLE = 8 Constant Long SQL_DATETIME = 9 Constant Long SQL_VARCHAR = 12 Constant Long SQL_NVARCHAR = 247 Constant Long SQL_TEXT = -1 Constant Long SQL_BINARY = -2 Constant Long SQL_VARBINARY = -3 Constant Long SQL_IMAGE = -4 Constant Long SQL_TINYINT = -6 Constant Long SQL_BIT = -7 Constant Long SQL_WCHAR = -8 Constant Long SQL_WVARCHAR = -9 Long SQL_CHARACTER = SQL_CHAR // DateTime sub-types Constant Long SQL_CODE_DATE = 1 Constant Long SQL_CODE_TIME = 2 Constant Long SQL_CODE_TIMESTAMP = 3 // FetchOrientation Constant UInt SQL_FETCH_NEXT = 1 Constant UInt SQL_FETCH_FIRST = 2 Constant UInt SQL_FETCH_LAST = 3 Constant UInt SQL_FETCH_PRIOR = 4 Constant UInt SQL_FETCH_ABSOLUTE = 5 Constant UInt SQL_FETCH_RELATIVE = 6 // FetchOrientation for SQLDataSources only Constant UInt SQL_FETCH_FIRST_USER = 31 Constant UInt SQL_FETCH_FIRST_SYSTEM = 32 // SQL Server Constant Integer DEFAULT_RESULT_SIZE = 1024 Constant Integer SQL_COPT_SS_BASE_EX = 1240 Constant Integer SQL_COPT_SS_BROWSE_CONNECT = SQL_COPT_SS_BASE_EX + 1 Constant Integer SQL_COPT_SS_BROWSE_SERVER = SQL_COPT_SS_BASE_EX + 2 Constant Integer SQL_MORE_INFO_NO = 0 Constant Integer SQL_MORE_INFO_YES = 1 Constant Integer SQL_ATTR_LOGIN_TIMEOUT = 103 end variables forward prototypes public function integer of_columns (string as_schema, string as_tablename, ref s_columns astr_columns[]) public function integer of_tables (string as_tabletype, ref s_tables astr_table[]) public function integer of_sprocs (ref s_sprocs astr_sprocs[]) public function integer of_sprocsource (string as_schema, string as_sprocname, ref string as_source) public function string of_replaceall (string as_oldstring, string as_findstr, string as_replace) public function integer of_datasources (string as_type, ref string as_name[], ref string as_driver[]) public function integer of_primarykeys (string as_schema, string as_tablename, ref s_primarykeys astr_pkeys[]) public function integer of_foreignkeys (string as_schema, string as_tablename, ref s_foreignkeys astr_fkeys[]) public function integer of_sqlerror (string as_function, integer ai_handletype, long al_handle) public subroutine of_sqlwarning (string as_function, integer ai_handletype, long al_handle) public function integer of_parse (string as_text, string as_sep, ref string as_array[]) public function integer of_sqlservers (ref string as_servers[]) public function integer of_sqlserverinstance (string as_server, ref string as_instance) end prototypes public function integer of_columns (string as_schema, string as_tablename, ref s_columns astr_columns[]);// get list of columns Long ll_handle, ll_position, ll_width, ll_coldecimal Integer li_rc, li_count, li_strlen, li_coltype String ls_catalog, ls_schema, ls_colname, ls_datatype String ls_nullable, ls_default // null out the search vars SetNull(ls_catalog) SetNull(ls_colname) If as_schema = "" Then SetNull(as_schema) End If // allocate a statement handle li_rc = SQLAllocHandle(SQL_HANDLE_STMT, sqlca.DbHandle(), ll_handle) If li_rc = SQL_ERROR Then Return of_SQLError("of_Columns", SQL_HANDLE_STMT, ll_handle) End If // get a list of columns li_rc = SQLColumns(ll_handle, ls_catalog, 0, as_schema, Len(as_schema), & as_tablename, Len(as_tablename), ls_colname, 0) If li_rc = SQL_ERROR Then Return of_SQLError("of_Columns", SQL_HANDLE_STMT, ll_handle) End If // bind local variables to result set columns SQLBindCol( ll_handle, SQLCOL_ORDINAL_POSITION, & SQL_INTEGER, ll_position, 0, li_strlen) ls_colname = Space(128) SQLBindCol( ll_handle, SQLCOL_COLUMN_NAME, & SQL_CHARACTER, ls_colname, Len(ls_colname), li_strlen) SQLBindCol( ll_handle, SQLCOL_DATA_TYPE, & SQL_SMALLINT, li_coltype, 0, li_strlen) SQLBindCol( ll_handle, SQLCOL_COLUMN_SIZE, & SQL_INTEGER, ll_width, 0, li_strlen) SQLBindCol( ll_handle, SQLCOL_DECIMAL_DIGITS, & SQL_INTEGER, ll_coldecimal, 0, li_strlen) ls_datatype = Space(128) SQLBindCol( ll_handle, SQLCOL_TYPE_NAME, & SQL_CHARACTER, ls_datatype, Len(ls_datatype), li_strlen) ls_nullable = Space(128) SQLBindCol( ll_handle, SQLCOL_IS_NULLABLE, & SQL_CHARACTER, ls_nullable, Len(ls_nullable), li_strlen) ls_default = Space(128) SQLBindCol( ll_handle, SQLCOL_COLUMN_DEF, & SQL_CHARACTER, ls_default, Len(ls_default), li_strlen) // fetch the first row li_rc = SQLFetch(ll_handle) Do While li_rc = SQL_SUCCESS li_count += 1 astr_columns[li_count].Position = ll_position astr_columns[li_count].Name = Trim(ls_colname) astr_columns[li_count].DataType = Trim(ls_datatype) Choose Case li_coltype Case SQL_DECIMAL, SQL_NUMERIC, SQL_FLOAT astr_columns[li_count].Width = ll_width astr_columns[li_count].Decimal = ll_coldecimal Case SQL_CHAR, SQL_VARCHAR, SQL_WCHAR, SQL_WVARCHAR, & SQL_NVARCHAR, SQL_BINARY, SQL_VARBINARY astr_columns[li_count].Width = ll_width End Choose If Upper(ls_nullable) = "YES" Then astr_columns[li_count].Nullable = True End If astr_columns[li_count].Default = Trim(ls_default) // fetch the next row li_rc = SQLFetch(ll_handle) LOOP // release the statement handle SQLFreeHandle(SQL_HANDLE_STMT, ll_handle) Return li_count end function public function integer of_tables (string as_tabletype, ref s_tables astr_table[]);// get list of tables Long ll_handle Integer li_rc, li_count, li_strlen String ls_catalog, ls_schema, ls_tabname, ls_tabtype // null out the search vars SetNull(ls_catalog) SetNull(ls_schema) SetNull(ls_tabname) // allocate a statement handle li_rc = SQLAllocHandle(SQL_HANDLE_STMT, sqlca.DbHandle(), ll_handle) If li_rc = SQL_ERROR Then Return of_SQLError("of_Tables", SQL_HANDLE_STMT, ll_handle) End If // get a list of tables li_rc = SQLTables(ll_handle, ls_catalog, 0, ls_schema, & 0, ls_tabname, 0, as_tabletype, Len(as_tabletype)) If li_rc = SQL_ERROR Then Return of_SQLError("of_Tables", SQL_HANDLE_STMT, ll_handle) End If // bind local variables to result set columns ls_schema = Space(128) SQLBindCol( ll_handle, SQLTAB_TABLE_SCHEM, & SQL_CHARACTER, ls_schema, Len(ls_schema), li_strlen) ls_tabname = Space(128) SQLBindCol( ll_handle, SQLTAB_TABLE_NAME, & SQL_CHARACTER, ls_tabname, Len(ls_tabname), li_strlen) ls_tabtype = Space(128) SQLBindCol( ll_handle, SQLTAB_TABLE_TYPE, & SQL_CHARACTER, ls_tabtype, Len(ls_tabtype), li_strlen) // fetch the first row li_rc = SQLFetch(ll_handle) Do While li_rc = SQL_SUCCESS li_count += 1 astr_table[li_count].Schema = Trim(ls_schema) astr_table[li_count].Name = Trim(ls_tabname) astr_table[li_count].TableType = Trim(ls_tabtype) // fetch the next row li_rc = SQLFetch(ll_handle) Loop // release the statement handle SQLFreeHandle(SQL_HANDLE_STMT, ll_handle) Return li_count end function public function integer of_sprocs (ref s_sprocs astr_sprocs[]);// get list of stored procedures Long ll_handle Integer li_rc, li_count, li_strlen String ls_catalog, ls_schema, ls_sprocname // null out the search vars SetNull(ls_catalog) SetNull(ls_schema) SetNull(ls_sprocname) // allocate a statement handle li_rc = SQLAllocHandle(SQL_HANDLE_STMT, sqlca.DbHandle(), ll_handle) If li_rc = SQL_ERROR Then Return of_SQLError("of_Sprocs", SQL_HANDLE_STMT, ll_handle) End If // get a list of procedures li_rc = SQLProcedures(ll_handle, ls_catalog, 0, & ls_schema, 0, ls_sprocname, 0) If li_rc = SQL_ERROR Then Return of_SQLError("of_Sprocs", SQL_HANDLE_STMT, ll_handle) End If // bind local variables to result set columns ls_schema = Space(128) SQLBindCol( ll_handle, SQLSP_PROCEDURE_SCHEM, & SQL_CHARACTER, ls_schema, Len(ls_schema), li_strlen) ls_sprocname = Space(128) SQLBindCol( ll_handle, SQLSP_PROCEDURE_NAME, & SQL_CHARACTER, ls_sprocname, Len(ls_sprocname), li_strlen) // fetch the first row li_rc = SQLFetch(ll_handle) Do While li_rc = SQL_SUCCESS li_count += 1 astr_sprocs[li_count].Schema = ls_schema If Pos(ls_sprocname, ";") = 0 Then astr_sprocs[li_count].Name = ls_sprocname Else astr_sprocs[li_count].Name = Left(ls_sprocname, Pos(ls_sprocname, ";") - 1) End If // fetch the next row li_rc = SQLFetch(ll_handle) Loop // release the statement handle SQLFreeHandle(SQL_HANDLE_STMT, ll_handle) Return li_count end function public function integer of_sprocsource (string as_schema, string as_sprocname, ref string as_source);// get stored procedure source Constant Integer SQL_DBMS_NAME = 17 Integer li_strlen, li_rc String ls_dbms, ls_spsource, ls_procsql Long ll_handle ls_dbms = Space(128) // get dbms name SQLGetInfo(sqlca.DBHandle(), SQL_DBMS_NAME, ls_dbms, 128, li_strlen) // get stored procedure select syntax ls_spsource = ProfileString("pbodb80.ini", ls_dbms, "PBSyntax", "") ls_procsql = ProfileString("pbodb80.ini", ls_spsource, "PBSelectProcSyntax", "") If ls_procsql = "" Then MessageBox("SQL Warning", & "PBSelectProcSyntax not found in pbodb80.ini!") Return -1 End If // replace syntax arguments with values ls_procsql = of_ReplaceAll(ls_procsql, "&ObjectOwner", as_schema) ls_procsql = of_ReplaceAll(ls_procsql, "&ObjectName", as_sprocname) ls_procsql = of_ReplaceAll(ls_procsql, "&ObjectNumber", "1") ls_procsql = of_ReplaceAll(ls_procsql, "''", "'") // allocate a statement handle li_rc = SQLAllocHandle(SQL_HANDLE_STMT, sqlca.DbHandle(), ll_handle) If li_rc = SQL_ERROR Then Return of_SQLError("of_SprocSource", SQL_HANDLE_STMT, ll_handle) End If // execute the sql statement li_rc = SQLExecDirect(ll_handle, ls_procsql, Len(ls_procsql)) If li_rc = SQL_ERROR Then Return of_SQLError("of_SprocSource", SQL_HANDLE_STMT, ll_handle) End If // bind local variables to result set columns ls_spsource = Space(32768) SQLBindCol(ll_handle, 1, SQL_CHARACTER, ls_spsource, Len(ls_spsource), li_strlen) // fetch the first row li_rc = SQLFetch(ll_handle) Do While li_rc = SQL_SUCCESS // replace LF with CRLF ls_spsource = of_ReplaceAll(ls_spsource, "~n", "~r~n") // add data to output variable as_source += ls_spsource // fetch the next row ls_spsource = Space(32768) li_rc = SQLFetch(ll_handle) Loop // release the statement handle SQLFreeHandle(SQL_HANDLE_STMT, ll_handle) Return 1 end function public function string of_replaceall (string as_oldstring, string as_findstr, string as_replace);String ls_newstring Long ll_findstr, ll_replace, ll_pos // get length of strings ll_findstr = Len(as_findstr) ll_replace = Len(as_replace) // find first occurrence ls_newstring = as_oldstring ll_pos = Pos(ls_newstring, as_findstr) Do While ll_pos > 0 // replace old with new ls_newstring = Replace(ls_newstring, ll_pos, ll_findstr, as_replace) // find next occurrence ll_pos = Pos(ls_newstring, as_findstr, (ll_pos + ll_replace)) Loop Return ls_newstring end function public function integer of_datasources (string as_type, ref string as_name[], ref string as_driver[]);// get a list of datasources Long ll_handle Integer li_rc, li_direction, li_count, li_svrlen, li_deslen String ls_name, ls_driver // set the type direction choose case Upper(as_type) case "SYSTEM" li_direction = SQL_FETCH_FIRST_SYSTEM case "USER" li_direction = SQL_FETCH_FIRST_USER case else li_direction = SQL_FETCH_FIRST end choose // allocate an environment handle li_rc = SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, ll_handle) If li_rc = SQL_ERROR Then Return of_SQLError("of_DataSources", SQL_HANDLE_ENV, ll_handle) End If // set the ODBC version li_rc = SQLSetEnvAttr(ll_handle, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, 0); If li_rc = SQL_ERROR Then Return of_SQLError("of_DataSources", SQL_HANDLE_ENV, ll_handle) End If ls_name = Space(SQL_MAX_DSN_LENGTH) ls_driver = Space(256) // get the datasources do while SQLDataSources(ll_handle, li_direction, & ls_name, SQL_MAX_DSN_LENGTH, li_svrlen, & ls_driver, Len(ls_driver), li_deslen) = SQL_SUCCESS li_count += 1 as_name[li_count] = ls_name as_driver[li_count] = ls_driver ls_name = Space(SQL_MAX_DSN_LENGTH) ls_driver = Space(256) li_direction = SQL_FETCH_NEXT loop If li_rc = SQL_ERROR Then Return of_SQLError("of_DataSources", SQL_HANDLE_ENV, ll_handle) End If // release the statement handle SQLFreeHandle(SQL_HANDLE_ENV, ll_handle) Return li_count end function public function integer of_primarykeys (string as_schema, string as_tablename, ref s_primarykeys astr_pkeys[]);// get list of primary keys Long ll_handle Integer li_rc, li_count, li_strlen, li_colseq String ls_catalog, ls_schema, ls_colname, ls_pkname // null out the search vars SetNull(ls_catalog) If as_schema = "" Then SetNull(as_schema) End If // allocate a statement handle li_rc = SQLAllocHandle(SQL_HANDLE_STMT, sqlca.DbHandle(), ll_handle) If li_rc = SQL_ERROR Then Return of_SQLError("of_PrimaryKeys", SQL_HANDLE_STMT, ll_handle) End If // get a list of primary key columns li_rc = SQLPrimaryKeys(ll_handle, ls_catalog, 0, as_schema, Len(as_schema), & as_tablename, Len(as_tablename)) If li_rc = SQL_ERROR Then Return of_SQLError("of_PrimaryKeys", SQL_HANDLE_STMT, ll_handle) End If // bind local variables to result set columns SQLBindCol( ll_handle, SQLPK_KEY_SEQ, & SQL_SMALLINT, li_colseq, 0, li_strlen) ls_colname = Space(128) SQLBindCol( ll_handle, SQLPK_COLUMN_NAME, & SQL_CHARACTER, ls_colname, Len(ls_colname), li_strlen) ls_pkname = Space(128) SQLBindCol( ll_handle, SQLPK_PK_NAME, & SQL_CHARACTER, ls_pkname, Len(ls_pkname), li_strlen) // fetch the first row li_rc = SQLFetch(ll_handle) Do While li_rc = SQL_SUCCESS li_count += 1 astr_pkeys[li_count].ColSeq = li_colseq astr_pkeys[li_count].Colname = Trim(ls_colname) astr_pkeys[li_count].PKName = Trim(ls_pkname) // fetch the next row li_rc = SQLFetch(ll_handle) LOOP // release the statement handle SQLFreeHandle(SQL_HANDLE_STMT, ll_handle) Return li_count end function public function integer of_foreignkeys (string as_schema, string as_tablename, ref s_foreignkeys astr_fkeys[]);// get list of foreign keys Long ll_handle Integer li_rc, li_count, li_strlen, li_colseq String ls_null, ls_fkname, ls_fkcolumn, ls_pkschema, ls_pktable, ls_pkcolumn SetNull(ls_null) If as_schema = "" Then SetNull(as_schema) End If // allocate a statement handle li_rc = SQLAllocHandle(SQL_HANDLE_STMT, sqlca.DbHandle(), ll_handle) If li_rc = SQL_ERROR Then Return of_SQLError("of_ForeignKeys", SQL_HANDLE_STMT, ll_handle) End If // get a list of foreign key columns li_rc = SQLForeignKeys(ll_handle, ls_null, 0, ls_null, 0, ls_null, 0, & ls_null, 0, as_schema, Len(as_schema), as_tablename, Len(as_tablename)) If li_rc = SQL_ERROR Then Return of_SQLError("of_ForeignKeys", SQL_HANDLE_STMT, ll_handle) End If // bind local variables to result set columns SQLBindCol( ll_handle, SQLFK_KEY_SEQ, & SQL_SMALLINT, li_colseq, 0, li_strlen) ls_fkname = Space(128) SQLBindCol( ll_handle, SQLFK_FK_NAME, & SQL_CHARACTER, ls_fkname, Len(ls_fkname), li_strlen) ls_fkcolumn = Space(128) SQLBindCol( ll_handle, SQLFK_FKCOLUMN_NAME, & SQL_CHARACTER, ls_fkcolumn, Len(ls_fkcolumn), li_strlen) ls_pkschema = Space(128) SQLBindCol( ll_handle, SQLFK_PKTABLE_SCHEM, & SQL_CHARACTER, ls_pkschema, Len(ls_pkschema), li_strlen) ls_pktable = Space(128) SQLBindCol( ll_handle, SQLFK_PKTABLE_NAME, & SQL_CHARACTER, ls_pktable, Len(ls_pktable), li_strlen) ls_pkcolumn = Space(128) SQLBindCol( ll_handle, SQLFK_PKCOLUMN_NAME, & SQL_CHARACTER, ls_pkcolumn, Len(ls_pkcolumn), li_strlen) // fetch the first row li_rc = SQLFetch(ll_handle) Do While li_rc = SQL_SUCCESS li_count += 1 astr_fkeys[li_count].colseq = li_colseq astr_fkeys[li_count].fkname = Trim(ls_fkname) astr_fkeys[li_count].fkcolumn = Trim(ls_fkcolumn) astr_fkeys[li_count].pkschema = Trim(ls_pkschema) astr_fkeys[li_count].pktable = Trim(ls_pktable) astr_fkeys[li_count].pkcolumn = Trim(ls_pkcolumn) // fetch the next row li_rc = SQLFetch(ll_handle) LOOP // release the statement handle SQLFreeHandle(SQL_HANDLE_STMT, ll_handle) Return li_count end function public function integer of_sqlerror (string as_function, integer ai_handletype, long al_handle);// display sql error message String ls_sqlstate, ls_errtext, ls_title Integer li_rc, li_textlen Long ll_errcode ls_sqlstate = Space(5) ls_errtext = Space(128) li_rc = SQLGetDiagRec(ai_handletype, al_handle, 1, & ls_sqlstate, ll_errcode, ls_errtext, 128, li_textlen) If ll_errcode = 0 Then ls_title = as_function + " SQL Error" Else ls_title = as_function + " SQL Error #" + String(ll_errcode) End If MessageBox( ls_title, "SQLSTATE = " + & ls_sqlstate + "~r~n" + ls_errtext, StopSign!) // release the statement handle SQLFreeHandle(SQL_HANDLE_STMT, al_handle) Return -1 end function public subroutine of_sqlwarning (string as_function, integer ai_handletype, long al_handle);// display sql warning message String ls_sqlstate, ls_errtext, ls_title Integer li_rc, li_textlen Long ll_errcode ls_sqlstate = Space(5) ls_errtext = Space(128) li_rc = SQLGetDiagRec(ai_handletype, al_handle, 1, & ls_sqlstate, ll_errcode, ls_errtext, 128, li_textlen) If ll_errcode = 0 Then ls_title = as_function + " SQL Error" Else ls_title = as_function + " SQL Error #" + String(ll_errcode) End If MessageBox( ls_title, "SQLSTATE = " + & ls_sqlstate + "~r~n" + ls_errtext, Information!) end subroutine public function integer of_parse (string as_text, string as_sep, ref string as_array[]);String ls_empty[], ls_work Long ll_pos, ll_each as_array = ls_empty If IsNull(as_text) Or as_text = "" Then Return 0 ll_pos = Pos(as_text, as_sep) DO WHILE ll_pos > 0 ls_work = Trim(Left(as_text, ll_pos - 1)) as_text = Trim(Mid(as_text, ll_pos + 1)) as_array[UpperBound(as_array) + 1] = ls_work ll_pos = Pos(as_text, as_sep) LOOP as_array[UpperBound(as_array) + 1] = Trim(as_text) Return UpperBound(as_array) end function public function integer of_sqlservers (ref string as_servers[]);// get list of servers with SQL Server Integer li_rc, li_InStrLen, li_LenNeeded, li_count Long ll_hEnv, ll_hConn, ll_pos String ls_InString, ls_OutString ls_InString = "DRIVER=SQL SERVER" li_InStrLen = Len(ls_InString) ls_OutString = Space(DEFAULT_RESULT_SIZE) // allocate an environment handle li_rc = SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, ll_hEnv) If li_rc = SQL_ERROR Then Return of_SQLError("of_SQLServers", SQL_HANDLE_ENV, ll_hEnv) End If // set the ODBC version li_rc = SQLSetEnvAttr(ll_hEnv, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, 0); If li_rc = SQL_ERROR Then Return of_SQLError("of_SQLServers", SQL_HANDLE_ENV, ll_hEnv) End If // allocate a connection handle li_rc = SQLAllocHandle(SQL_HANDLE_DBC, ll_hEnv, ll_hConn) If li_rc = SQL_ERROR Then Return of_SQLError("of_SQLServers", SQL_HANDLE_DBC, ll_hConn) End If // set connection attribute li_rc = SQLSetConnectAttr(ll_hConn, SQL_COPT_SS_BROWSE_CONNECT, SQL_MORE_INFO_NO, 0) If li_rc = SQL_ERROR Then Return of_SQLError("of_SQLServers", SQL_HANDLE_DBC, ll_hConn) End If // browse for list of servers li_rc = SQLBrowseConnect(ll_hConn, ls_InString, li_InStrLen, & ls_OutString, DEFAULT_RESULT_SIZE, li_LenNeeded) If li_rc = SQL_NEED_DATA Then If DEFAULT_RESULT_SIZE < li_LenNeeded Then ls_OutString = Space(DEFAULT_RESULT_SIZE) SQLBrowseConnect(ll_hConn, ls_InString, li_InStrLen, & ls_OutString, li_LenNeeded, li_LenNeeded) End If // parse out the server list ll_pos = Pos(ls_OutString, "={") + 2 ls_OutString = Mid(ls_OutString, ll_pos) ll_pos = Pos(ls_OutString, "};") - 1 ls_OutString = Left(ls_OutString, ll_pos) li_count = of_Parse(ls_OutString, ",", as_servers) End If // release the connection handle SQLFreeHandle(SQL_HANDLE_DBC, ll_hConn) // release the environment handle SQLFreeHandle(SQL_HANDLE_ENV, ll_hEnv) Return li_count end function public function integer of_sqlserverinstance (string as_server, ref string as_instance);// return the SQL Server instance name Integer li_rc, li_InStrLen, li_LenNeeded Long ll_hEnv, ll_hConn, ll_pos String ls_InString, ls_OutString ls_InString = "DRIVER=SQL SERVER" li_InStrLen = Len(ls_InString) ls_OutString = Space(DEFAULT_RESULT_SIZE) as_Instance = "" // allocate an environment handle li_rc = SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, ll_hEnv) If li_rc = SQL_ERROR Then Return of_SQLError("of_SQLServerInstance", SQL_HANDLE_ENV, ll_hEnv) End If // set the ODBC version li_rc = SQLSetEnvAttr(ll_hEnv, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, 0); If li_rc = SQL_ERROR Then Return of_SQLError("of_SQLServerInstance", SQL_HANDLE_ENV, ll_hEnv) End If // allocate a connection handle li_rc = SQLAllocHandle(SQL_HANDLE_DBC, ll_hEnv, ll_hConn) If li_rc = SQL_ERROR Then Return of_SQLError("of_SQLServerInstance", SQL_HANDLE_DBC, ll_hConn) End If // set connection attribute li_rc = SQLSetConnectAttr(ll_hConn, SQL_COPT_SS_BROWSE_CONNECT, SQL_MORE_INFO_YES, 0) If li_rc = SQL_ERROR Then Return of_SQLError("of_SQLServerInstance", SQL_HANDLE_DBC, ll_hConn) End If // set timeout attribute li_rc = SQLSetConnectAttr(ll_hConn, SQL_ATTR_LOGIN_TIMEOUT, 1, 0) If li_rc = SQL_ERROR Then Return of_SQLError("of_SQLServerInstance", SQL_HANDLE_DBC, ll_hConn) End If // set server name li_rc = SQLSetConnectAttr(ll_hConn, SQL_COPT_SS_BROWSE_SERVER, as_server, Len(as_server)) If li_rc = SQL_ERROR Then Return of_SQLError("of_SQLServerInstance", SQL_HANDLE_DBC, ll_hConn) End If // browse for list of servers li_rc = SQLBrowseConnect(ll_hConn, ls_InString, li_InStrLen, & ls_OutString, DEFAULT_RESULT_SIZE, li_LenNeeded) If li_rc = SQL_NEED_DATA Then If DEFAULT_RESULT_SIZE < li_LenNeeded Then ls_OutString = Space(DEFAULT_RESULT_SIZE) SQLBrowseConnect(ll_hConn, ls_InString, li_InStrLen, & ls_OutString, li_LenNeeded, li_LenNeeded) End If // parse out the instance name ll_pos = Pos(ls_OutString, "={") If ll_pos > 0 Then ls_OutString = Mid(ls_OutString, ll_pos + 2) ll_pos = Pos(ls_OutString, ";") If ll_pos > 0 Then ls_OutString = Left(ls_OutString, ll_pos - 1) If ls_OutString = "}" Then as_Instance = as_Server Else as_Instance = ls_OutString End If End If End If If as_Instance = "" Then as_Instance = as_Server End If End If // release the connection handle SQLFreeHandle(SQL_HANDLE_DBC, ll_hConn) // release the environment handle SQLFreeHandle(SQL_HANDLE_ENV, ll_hEnv) Return 0 end function on n_odbcapi.create call super::create TriggerEvent( this, "constructor" ) end on on n_odbcapi.destroy TriggerEvent( this, "destructor" ) call super::destroy end on
File: n_odbcapi.sru
Size: 30574
Date: Mon, 31 Dec 2018 21:14:38 +0100
Size: 30574
Date: Mon, 31 Dec 2018 21:14:38 +0100
- nonvisualobject autoinstantiate n_odbcapi(sru)
- of_columns (string as_schema, string as_tablename, ref s_columns astr_columns[]) returns integer
- of_datasources (string as_type, ref string as_name[], ref string as_driver[]) returns integer
- of_foreignkeys (string as_schema, string as_tablename, ref s_foreignkeys astr_fkeys[]) returns integer
- of_parse (string as_text, string as_sep, ref string as_array[]) returns integer
- of_primarykeys (string as_schema, string as_tablename, ref s_primarykeys astr_pkeys[]) returns integer
- of_replaceall (string as_oldstring, string as_findstr, string as_replace) returns string
- of_sprocs (ref s_sprocs astr_sprocs[]) returns integer
- of_sprocsource (string as_schema, string as_sprocname, ref string as_source) returns integer
- of_sqlerror (string as_function, integer ai_handletype, long al_handle) returns integer
- of_sqlserverinstance (string as_server, ref string as_instance) returns integer
- of_sqlservers (ref string as_servers[]) returns integer
- of_sqlwarning (string as_function, integer ai_handletype, long al_handle)
- of_tables (string as_tabletype, ref s_tables astr_table[]) returns integer