tdbc::odbc

Check-in [78e0a63cc6]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix typo (__WIN64 -> _WIN64). Make tdbcodbc ready for the 9.0 era, in which string lengths can be >32bit
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 78e0a63cc6ccaad70a80325aca5f3aef439696620c1c15ca22c6f169d4e7b9c2
User & Date: jan.nijtmans 2019-12-15 17:19:21
Context
2020-02-12
12:38
Make compile warning-free using -Wall -Wextra check-in: fba03660d1 user: jan.nijtmans tags: trunk
2019-12-15
17:19
Fix typo (__WIN64 -> _WIN64). Make tdbcodbc ready for the 9.0 era, in which string lengths can be >32bit check-in: 78e0a63cc6 user: jan.nijtmans tags: trunk
2019-11-20
16:35
TEA update check-in: e2009447de user: dgp tags: trunk, tdbcodbc-1-1-1
2019-09-13
16:27
Fix for a typo in defining the SQLLEN and SQLULEN data types on Win64. (__WIN64 should be just _WIN64.) Closed-Leaf check-in: 0837f4e778 user: kbk tags: bug-647ec7268f
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/fakesql.h.

65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
typedef WCHAR SQLWCHAR;

typedef SQLSMALLINT SQLRETURN;

/* TODO - Check how the SQLLEN and SQLULEN types are handled on
 *        64-bit Unix. */

#if defined(__WIN64)
typedef Tcl_WideInt SQLLEN;
typedef Tcl_WideUInt SQLULEN;
#else
typedef SQLINTEGER SQLLEN;
typedef SQLUINTEGER SQLULEN;
#endif







|







65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
typedef WCHAR SQLWCHAR;

typedef SQLSMALLINT SQLRETURN;

/* TODO - Check how the SQLLEN and SQLULEN types are handled on
 *        64-bit Unix. */

#if defined(_WIN64)
typedef Tcl_WideInt SQLLEN;
typedef Tcl_WideUInt SQLULEN;
#else
typedef SQLINTEGER SQLLEN;
typedef SQLUINTEGER SQLULEN;
#endif

Changes to generic/tdbcodbc.c.

44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
..
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
...
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
...
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
...
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
...
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
...
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
...
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
...
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
...
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
...
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
...
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
...
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
...
832
833
834
835
836
837
838
839
840
841
842
843

844
845
846
847
848
849
850
...
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
...
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
....
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
....
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
....
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
....
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
....
2587
2588
2589
2590
2591
2592
2593
2594

2595
2596
2597
2598
2599
2600
2601
....
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
....
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
....
3845
3846
3847
3848
3849
3850
3851
3852

3853
3854
3855
3856
3857
3858
3859
....
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
....
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
....
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
....
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
....
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
....
5205
5206
5207
5208
5209
5210
5211
5212

5213
5214
5215
5216
5217
5218
5219
....
5225
5226
5227
5228
5229
5230
5231
5232

5233
5234
5235
5236
5237
5238
5239
static Tcl_LoadHandle odbcLoadHandle = NULL;
				/* Handle to the ODBC client library */
static Tcl_LoadHandle odbcInstLoadHandle = NULL;
				/* Handle to the ODBC installer library */
static SQLHENV hEnv = SQL_NULL_HENV;
				/* Handle to the global ODBC environment */
static int hEnvRefCount = 0;	/* Reference count on the global environment */
static size_t sizeofSQLWCHAR = sizeof(SQLWCHAR);
				/* Preset, will be autodetected later */

/*
 * Objects to create within the literal pool
 */

................................................................................
};

/*
 * Structure that holds per-interpreter data for the ODBC package.
 */

typedef struct PerInterpData {
    int refCount;		/* Reference count */
    SQLHENV hEnv;		/* ODBC environment handle */
    Tcl_Obj* literals[LIT__END];
				/* Literal pool */
} PerInterpData;
#define IncrPerInterpRefCount(x)  \
    do {			  \
	++((x)->refCount);	  \
................................................................................
 *	contains its statements is taken down, destroying them. It's
 *	not safe to take down the ConnectionData until nothing is
 *	referring to it, which avoids taking down the hDBC until the
 *	other objects that refer to it vanish.
 */

typedef struct ConnectionData {
    int refCount;		/* Reference count. */
    PerInterpData* pidata;	/* Per-interpreter data */
    Tcl_Obj* connectionString;	/* Connection string actually used to
				 * connect to the database */
    SQLHDBC hDBC;		/* Connection handle */
    int flags;			/* Flags describing the state of the
				 * connection */
} ConnectionData;
................................................................................
 *	Just as with connections, statements need to defer taking down
 *	their client data until other objects (i.e., result sets) that
 * 	refer to them have had a chance to clean up. Hence, this
 *	structure is reference counted as well.
 */

typedef struct StatementData {
    int refCount;		/* Reference count */
    Tcl_Object connectionObject;
				/* The connection object */
    ConnectionData* cdata;	/* Data for the connection to which this
				 * statement pertains. */
    Tcl_Obj* subVars;	        /* List of variables to be substituted, in the
				 * order in which they appear in the
				 * statement */
    SQLHSTMT hStmt;		/* Handle to the ODBC statement */
    SQLWCHAR* nativeSqlW;	/* SQL statement as wide chars */
    int nativeSqlLen;		/* Length of the statement */
    SQLWCHAR* nativeMatchPatternW;
				/* Match pattern for metadata queries */
    int nativeMatchPatLen;	/* Length of the match pattern */
    struct ParamData* params;	/* Pointer to an array of ParamData
				 * structures that describe the data types
				 * of substituted parameters. */
    int typeNum;		/* Type number for a query of data types */
    int flags;			/* Flags tracking the state of the
				 * StatementData */
} StatementData;
................................................................................
    int value;		/* Constant value */
} OdbcConstant;

/*
 * Constants for the directions of parameter transmission
 */

const static OdbcConstant OdbcParamDirections[] = {
    { "in",		PARAM_KNOWN | PARAM_IN, },
    { "out",		PARAM_KNOWN | PARAM_OUT },
    { "inout",		PARAM_KNOWN | PARAM_IN | PARAM_OUT },
    { NULL,		0 }
};

/*
 * ODBC constants for the names of data types
 */

const static OdbcConstant OdbcTypeNames[] = {
    { "bigint",		SQL_BIGINT },
    { "binary",		SQL_BINARY },
    { "bit",		SQL_BIT } ,
    { "char",		SQL_CHAR } ,
    { "date",		SQL_DATE } ,
    { "decimal",	SQL_DECIMAL } ,
    { "double",		SQL_DOUBLE } ,
................................................................................
    { "timestamp",	SQL_TIMESTAMP } ,
    { "tinyint",	SQL_TINYINT } ,
    { "varbinary",	SQL_VARBINARY } ,
    { "varchar",	SQL_VARCHAR } ,
    { NULL,		-1 }
};

const static OdbcConstant OdbcIsolationLevels[] = {
    { "readuncommitted",	SQL_TXN_READ_UNCOMMITTED },
    { "readcommitted",		SQL_TXN_READ_COMMITTED },
    { "repeatableread",		SQL_TXN_REPEATABLE_READ },
    { "serializable",		SQL_TXN_SERIALIZABLE },
    { NULL,			0 }
};

const static OdbcConstant OdbcErrorCodeNames[] = {
    { "GENERAL_ERR",			ODBC_ERROR_GENERAL_ERR },
    { "INVALID_BUFF_LEN",		ODBC_ERROR_INVALID_BUFF_LEN },
    { "INVALID_HWND",			ODBC_ERROR_INVALID_HWND },
    { "INVALID_STR",			ODBC_ERROR_INVALID_STR },
    { "INVALID_REQUEST_TYPE",		ODBC_ERROR_INVALID_REQUEST_TYPE },
    { "COMPONENT_NOT_FOUND",		ODBC_ERROR_COMPONENT_NOT_FOUND },
    { "INVALID_NAME",			ODBC_ERROR_INVALID_NAME },
................................................................................
    { "OUT_OF_MEM",			ODBC_ERROR_OUT_OF_MEM },
    { "OUTPUT_STRING_TRUNCATED",	ODBC_ERROR_OUTPUT_STRING_TRUNCATED },
    { NULL,				0 }
};

/* Prototypes for static functions appearing in this file */

static void DStringAppendWChars(Tcl_DString* ds, SQLWCHAR* ws, int len);
static SQLWCHAR* GetWCharStringFromObj(Tcl_Obj* obj, int* lengthPtr);

static void TransferSQLError(Tcl_Interp* interp, SQLSMALLINT handleType,
			     SQLHANDLE handle, const char* info);
static int SQLStateIs(SQLSMALLINT handleType, SQLHANDLE handle,
		      const char* sqlstate);
static int LookupOdbcConstant(Tcl_Interp* interp, const OdbcConstant* table,
			      const char* kind, Tcl_Obj* name,
................................................................................
static int DatasourcesObjCmd(ClientData clientData, Tcl_Interp* interp,
			      int objc, Tcl_Obj *const objv[]);
static int DriversObjCmd(ClientData clientData, Tcl_Interp* interp,
			 int objc, Tcl_Obj *const objv[]);
 
/* Metadata type that holds connection data */

const static Tcl_ObjectMetadataType connectionDataType = {
    TCL_OO_METADATA_VERSION_CURRENT,
				/* version */
    "ConnectionData",		/* name */
    DeleteConnectionMetadata,	/* deleteProc */
    CloneConnection		/* cloneProc - should cause an error
				 * 'cuz connections aren't clonable */
};

/* Metadata type that holds statement data */

const static Tcl_ObjectMetadataType statementDataType = {
    TCL_OO_METADATA_VERSION_CURRENT,
				/* version */
    "StatementData",		/* name */
    DeleteStatementMetadata,	/* deleteProc */
    CloneStatement		/* cloneProc - should cause an error
				 * 'cuz statements aren't clonable */
};

/* Metadata type for result set data */

const static Tcl_ObjectMetadataType resultSetDataType = {
    TCL_OO_METADATA_VERSION_CURRENT,
				/* version */
    "ResultSetData",		/* name */
    DeleteResultSetMetadata,	/* deleteProc */
    CloneResultSet		/* cloneProc - should cause an error
				 * 'cuz result sets aren't clonable */
};

/* Method types of the connection methods that are implemented in C */

const static Tcl_MethodType ConnectionConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    ConnectionConstructor,	/* callProc */
    DeleteCmd,			/* deleteProc */
    CloneCmd			/* cloneProc */
};
const static Tcl_MethodType ConnectionBeginTransactionMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "begintransaction",		/* name */
    ConnectionBeginTransactionMethod,
				/* callProc */
    NULL,			/* deleteProc */
    CloneCmd			/* cloneProc */
};
const static Tcl_MethodType ConnectionConfigureMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "configure",		/* name */
    ConnectionConfigureMethod,	/* callProc */
    NULL,			/* deleteProc */
    CloneCmd			/* cloneProc */
};
const static Tcl_MethodType ConnectionEndXcnMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "endtransaction",		/* name */
    ConnectionEndXcnMethod,	/* callProc */
    NULL,			/* deleteProc */
    CloneCmd			/* cloneProc */
};
const static Tcl_MethodType ConnectionHasBigintMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "HasBigint",		/* name */
    ConnectionHasBigintMethod,
				/* callProc */
    NULL,			/* deleteProc */
    CloneCmd			/* cloneProc */
};
const static Tcl_MethodType ConnectionHasWvarcharMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "HasWvarchar",		/* name */
    ConnectionHasWvarcharMethod,
				/* callProc */
    NULL,			/* deleteProc */
    CloneCmd			/* cloneProc */
................................................................................
};

/*
 * Methods to create on the connection class. Note that 'init', 'commit' and
 * 'rollback' are all special because they have non-NULL clientData.
 */

const static Tcl_MethodType* ConnectionMethods[] = {
    &ConnectionBeginTransactionMethodType,
    &ConnectionConfigureMethodType,
    &ConnectionHasBigintMethodType,
    &ConnectionHasWvarcharMethodType,
    NULL
};

/* Method types of the statement methods that are implemented in C */

const static Tcl_MethodType StatementConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    StatementConstructor,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
const static Tcl_MethodType StatementConnectionMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "connection",		/* name */
    StatementConnectionMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
const static Tcl_MethodType StatementParamListMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "ParamList",		/* name */
    StatementParamListMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
const static Tcl_MethodType StatementParamtypeMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "paramtype",		/* name */
    StatementParamtypeMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};

/*
 * Methods to create on the statement class.
 */

const static Tcl_MethodType* StatementMethods[] = {
    &StatementConnectionMethodType,
    &StatementParamListMethodType,
    &StatementParamtypeMethodType,
    NULL
};

/*
 * Constructor type for the class that implements the fake 'statement'
 * used to query the names and attributes of database tables.
 */

const static Tcl_MethodType TablesStatementConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    TablesStatementConstructor,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};

/*
 * Method types for the class that implements the fake 'statement'
 * used to query the names and attributes of database columns.
 */

const static Tcl_MethodType ColumnsStatementConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    ColumnsStatementConstructor,
				/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
................................................................................
};

/*
 * Method types for the class that implements the fake 'statement'
 * used to query the names and attributes of primary keys.
 */

const static Tcl_MethodType PrimarykeysStatementConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    PrimarykeysStatementConstructor,
				/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
................................................................................
};

/*
 * Method types for the class that implements the fake 'statement'
 * used to query the names and attributes of foreign keys.
 */

const static Tcl_MethodType ForeignkeysStatementConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    ForeignkeysStatementConstructor,
				/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
................................................................................
};

/*
 * Constructor type for the class that implements the fake 'statement'
 * used to query the names and attributes of database types.
 */

const static Tcl_MethodType TypesStatementConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    &TypesStatementConstructor,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};

/* Method types of the result set methods that are implemented in C */

const static Tcl_MethodType ResultSetConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    ResultSetConstructor,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
const static Tcl_MethodType ResultSetColumnsMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */    "columns",			/* name */
    ResultSetColumnsMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
const static Tcl_MethodType ResultSetNextresultsMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "nextresults",		/* name */
    ResultSetNextresultsMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
const static Tcl_MethodType ResultSetNextrowMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "nextrow",			/* name */
    ResultSetNextrowMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
const static Tcl_MethodType ResultSetRowcountMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "rowcount",			/* name */
    ResultSetRowcountMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};


const static Tcl_MethodType* ResultSetMethods[] = {
    &ResultSetColumnsMethodType,
    &ResultSetNextresultsMethodType,
    &ResultSetRowcountMethodType,
    NULL
};
 
/*
................................................................................
 *-----------------------------------------------------------------------------
 */

static void
DStringAppendWChars(
    Tcl_DString* ds,		/* Output string */
    SQLWCHAR* ws,		/* Input string */
    int len			/* Length of the input string in characters */
) {
    int i;
    char buf[4] = "";

    if (sizeofSQLWCHAR == sizeof(unsigned short)) {
	unsigned short* ptr16 = (unsigned short*) ws;

	for (i = 0; i < len; ++i) {
	    unsigned int ch;
	    int bytes;

	    ch = ptr16[i];
	    bytes = Tcl_UniCharToUtf(ch, buf);
	    Tcl_DStringAppend(ds, buf, bytes);
	}
    } else {
	unsigned int* ptr32 = (unsigned int*) ws;

	for (i = 0; i < len; ++i) {
	    unsigned int ch;
	    int bytes;

	    ch = ptr32[i];
	    if (ch > 0x10ffff) {
		ch = 0xfffd;
	    }
	    bytes = Tcl_UniCharToUtf(ch, buf);
	    Tcl_DStringAppend(ds, buf, bytes);
................................................................................
 *
 *-----------------------------------------------------------------------------
 */

static SQLWCHAR*
GetWCharStringFromObj(
    Tcl_Obj* obj,		/* Tcl object whose string rep is desired */
    int* lengthPtr		/* Length of the string */
) {
    int len;			/* Length of the input string in bytes */
    char* bytes = Tcl_GetStringFromObj(obj, &len);
				/* UTF-8 representation of the input string */

    char* end = bytes + len;	/* End of UTF-8 representation */
    SQLWCHAR* retval;		/* Buffer to hold the converted string */
    SQLWCHAR* wcPtr;
    int shrink = 0;
    Tcl_UniChar ch = 0;

    len = (len + 1) * sizeofSQLWCHAR;
................................................................................

	    if (Tcl_UtfCharComplete(bytes, end - bytes)) {
		bytes += Tcl_UtfToUniChar(bytes, &ch);
	    } else {
		ch = *bytes++ & 0x00ff;
	    }
	    uch = ch;
#if TCL_UTF_MAX > 4
	    if (uch > 0xffff) {
		*ptr16++ = (((uch - 0x10000) >> 10) & 0x3ff) | 0xd800;
		uch = ((uch - 0x10000) & 0x3ff) | 0xdc00;
	    }
#endif
	    if (uch > 0x7f) {
		shrink = 1;
	    }
	    *ptr16++ = uch;
	}
	*ptr16 = 0;
	len = ptr16 - (unsigned short*) retval;
................................................................................

	    if (Tcl_UtfCharComplete(bytes, end - bytes)) {
		bytes += Tcl_UtfToUniChar(bytes, &ch);
	    } else {
		ch = *bytes++ & 0x00ff;
	    }
	    uch = ch;
#if TCL_UTF_MAX <= 4
	    if ((uch & 0xfc00) == 0xd800) {
		if (Tcl_UtfCharComplete(bytes, end - bytes)) {
		    len = Tcl_UtfToUniChar(bytes, &ch);
		    if ((ch & 0xfc00) == 0xdc00) {
			bytes += len;
			uch = (((uch & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
		    }
		}
	    }
#endif
	    if (uch > 0x7f) {
		shrink = 1;
	    }
	    *ptr32++ = uch;
	}
	*ptr32 = 0;
	len = ptr32 - (unsigned int*) retval;
................................................................................
 *-----------------------------------------------------------------------------
 */

static void
DismissHEnv(void)
{
    Tcl_MutexLock(&hEnvMutex);
    if (--hEnvRefCount == 0) {
	SQLFreeHandle(SQL_HANDLE_ENV, hEnv);
	hEnv = SQL_NULL_HANDLE;
	if (odbcInstLoadHandle != NULL) {
	    Tcl_FSUnloadFile(NULL, odbcInstLoadHandle);
	    odbcInstLoadHandle = NULL;
	}
	Tcl_FSUnloadFile(NULL, odbcLoadHandle);
................................................................................
				/* Pointer to the driver connection options */
    HWND* hParentWindowPtr	/* Handle to the parent window for a
				 * connection dialog */
) {

    /* Configuration options */

    const static char* options[] = {
	"-encoding",
	"-isolation",
	"-parent",
	"-readonly",
	"-timeout",
	NULL
    };
................................................................................
				/* Number of leading args to skip */
    SQLHDBC hDBC = SQL_NULL_HDBC;
				/* Handle to the database connection */
    SQLRETURN rc;		/* Return code from ODBC calls */
    HWND hParentWindow = NULL;	/* Windows handle of the main window */
    SQLWCHAR* connectionStringReq;
				/* Connection string requested by the caller */
    int connectionStringReqLen;
				/* Length of the requested connection string */
    SQLWCHAR connectionString[1025*2];
				/* Connection string actually used */
    SQLSMALLINT connectionStringLen;
				/* Length of the actual connection string */
    Tcl_DString connectionStringDS;
				/* Connection string converted to UTF-8 */
................................................................................
    ConnectionData* cdata;	/* The connection object's data */
    StatementData* sdata;	/* The statement's object data */
    Tcl_Obj* tokens = NULL;	/* The tokens of the statement to be prepared */
    int tokenc;			/* Length of the 'tokens' list */
    Tcl_Obj** tokenv;		/* Exploded tokens from the list */
    Tcl_Obj* nativeSql;		/* SQL statement mapped to ODBC form */
    char* tokenStr;		/* Token string */
    int tokenLen;		/* Length of a token */
    RETCODE rc;			/* Return code from ODBC */
    SQLSMALLINT nParams;	/* Number of parameters in the ODBC statement */
    int i, j;

    /* Find the connection object, and get its data. */

    if (objc != skip+2) {
................................................................................
    if (Tcl_ListObjGetElements(interp, tokens, &tokenc, &tokenv) != TCL_OK) {
	Tcl_DecrRefCount(tokens);
	goto freeSData;
    }
    nativeSql = Tcl_NewObj();
    Tcl_IncrRefCount(nativeSql);
    for (i = 0; i < tokenc; ++i) {
	tokenStr = Tcl_GetStringFromObj(tokenv[i], &tokenLen);


	switch (tokenStr[0]) {
	case '$':
	case ':':
	    Tcl_AppendToObj(nativeSql, "?", 1);
	    Tcl_ListObjAppendElement(NULL, sdata->subVars,
				     Tcl_NewStringObj(tokenStr+1, tokenLen-1));
................................................................................
				/* The number of parameters to skip */
    Tcl_Object connectionObject;
				/* The database connection as a Tcl_Object */
    ConnectionData* cdata;	/* The connection object's data */
    StatementData* sdata;	/* The statement's object data */
    RETCODE rc;			/* Return code from ODBC */

    const static char* options[] = {	/* Option table */
	"-foreign",
	"-primary",
	NULL
    };
    enum {
	OPT_FOREIGN=0,
	OPT_PRIMARY,
................................................................................
    int nBound;			/* Number of substituted parameters that
				 * have been bound successfully */
    SQLSMALLINT dataType;	/* Data type of a parameter */
    Tcl_Obj* paramNameObj;	/* Name of a substituted parameter */
    const char* paramName;	/* Name of a substituted parameter */
    Tcl_Obj* paramValObj;	/* Value of a substituted parameter */
    const char* paramVal;	/* Value of a substituted parameter */
    int paramLen;		/* String length of the parameter value */
    Tcl_DString paramExternal;	/* Substituted parameter, converted to
				 * system encoding */
    int paramExternalLen;	/* Length of the substituted parameter
				 * after conversion */
    SQLRETURN rc;		/* Return code from ODBC calls */
    unsigned char* byteArrayPtr; /* Pointer to a BINARY or VARBINARY
				 * parameter, expressed as a byte array.*/
................................................................................
		} else {

		    /*
		     * We need to convert the character string to system
		     * encoding and store in rdata->bindStrings[nBound].
		     */
		    dataType = SQL_C_CHAR;
		    paramVal = Tcl_GetStringFromObj(paramValObj, &paramLen);

		    Tcl_DStringInit(&paramExternal);
		    Tcl_UtfToExternalDString(NULL, paramVal, paramLen,
					     &paramExternal);
		    paramExternalLen = Tcl_DStringLength(&paramExternal);
		    rdata->bindStrings[nBound] = (SQLCHAR*)
			ckalloc(paramExternalLen + 1);
		    memcpy(rdata->bindStrings[nBound],
................................................................................
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {
    PerInterpData* pidata = (PerInterpData*) clientData;
    SQLSMALLINT initDirection = SQL_FETCH_FIRST;
    SQLSMALLINT direction;
    const static struct flag {
	const char* name;
	SQLSMALLINT value;
    } flags[] = {
	{ "-system", SQL_FETCH_FIRST_SYSTEM },
	{ "-user", SQL_FETCH_FIRST_USER },
	{ NULL, 0 }
    };
................................................................................
static int
DatasourceObjCmdW(
    ClientData clientData,	/* Unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {
    const static struct flag {
	const char* name;
	WORD value;
    } flags[] = {
	{ "add",		ODBC_ADD_DSN },
	{ "add_system",		ODBC_ADD_SYS_DSN },
	{ "configure",		ODBC_CONFIG_DSN },
	{ "configure_system",	ODBC_CONFIG_SYS_DSN },
................................................................................
    };
    int flagIndex;		/* Index of the subcommand */

    WCHAR* driverName;		/* Name of the ODBC driver */
    WCHAR* attributes;		/* NULL-delimited attribute values */
    char errorMessage[SQL_MAX_MESSAGE_LENGTH+1];
				/* Error message from ODBC operations */
    int driverNameLen;		/* Length of the driver name */
    Tcl_Obj* attrObj;		/* NULL-delimited attribute values */
    int attrLen;		/* Length of the attribute values */
    const char* sep;		/* Separator for attribute values */
    DWORD errorCode;		/* Error code */
    WORD errorMessageLen;	/* Length of the returned error message */
    RETCODE errorMessageStatus;	/* Status of the error message formatting */
    Tcl_DString retvalDS;	/* Return value */
    Tcl_DString errorMessageDS;	/* DString to convert error message
				 * from system encoding */
................................................................................
static int
DatasourceObjCmdA(
    ClientData clientData,	/* Unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {
    const static struct flag {
	const char* name;
	WORD value;
    } flags[] = {
	{ "add",		ODBC_ADD_DSN },
	{ "add_system",		ODBC_ADD_SYS_DSN },
	{ "configure",		ODBC_CONFIG_DSN },
	{ "configure_system",	ODBC_CONFIG_SYS_DSN },
................................................................................
				 * encoding */
    char* attributes;		/* Attributes of the data source in
				 * system encoding */
    char errorMessage[SQL_MAX_MESSAGE_LENGTH+1];
				/* Error message from ODBC operations */
    Tcl_DString errorMessageDS;	/* Error message in UTF-8 */
    char* p;
    int driverNameLen;		/* Length of the driver name */
    Tcl_Obj* attrObj;		/* NULL-delimited attribute values */
    int attrLen;		/* Length of the attribute values */
    const char* sep;		/* Separator for attribute values */
    DWORD errorCode;		/* Error code */
    WORD errorMessageLen;	/* Length of the returned error message */
    RETCODE errorMessageStatus;	/* Status of the error message formatting */
    Tcl_DString retvalDS;	/* Return value */
    Tcl_Obj* errorCodeObj;	/* Tcl error code */
    int i, j;
................................................................................
				  "operation", 0, &flagIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    /* Convert driver name to the appropriate encoding */

    Tcl_DStringInit(&driverNameDS);
    p = Tcl_GetStringFromObj(objv[2], &driverNameLen);

    Tcl_UtfToExternalDString(NULL, p, driverNameLen, &driverNameDS);
    driverName = Tcl_DStringValue(&driverNameDS);
    driverNameLen = Tcl_DStringLength(&driverNameDS);

    /*
     * Convert driver attributes to the appropriate encoding, separated
     * by NUL bytes.
................................................................................
    for (i = 3; i < objc; ++i) {
	Tcl_AppendToObj(attrObj, sep, -1);
	Tcl_AppendObjToObj(attrObj, objv[i]);
	sep = "\xc0\x80";
    }
    Tcl_AppendToObj(attrObj, "\xc0\x80", 2);
    Tcl_DStringInit(&attributesDS);
    p = Tcl_GetStringFromObj(attrObj, &attrLen);

    Tcl_UtfToExternalDString(NULL, p, attrLen, &attributesDS);
    attributes = Tcl_DStringValue(&attributesDS);
    attrLen = Tcl_DStringLength(&attributesDS);
    Tcl_DecrRefCount(attrObj);

    /*
     * Configure the data source






|







 







|







 







|







 







|









|


|







 







|










|







 







|







|







 







|
|







 







|










|










|










|







|








|







|







|








|







 







|









|







|







|







|












|











|













|







 







|







 







|







 







|










|







|






|







|







|









|







 







|

|







|










|







 







|

<
|

>







 







<
|



<







 







<
|








<







 







|







 







|







 







|







 







|







 







|
>







 







|







 







|







 







|
>







 







|







 







|







 







|

|







 







|







 







|

|







 







|
>







 







|
>







44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
..
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
...
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
...
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
...
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
...
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
...
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
...
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
...
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
...
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
...
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
...
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
...
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
...
832
833
834
835
836
837
838
839
840

841
842
843
844
845
846
847
848
849
850
...
862
863
864
865
866
867
868

869
870
871
872

873
874
875
876
877
878
879
...
886
887
888
889
890
891
892

893
894
895
896
897
898
899
900
901

902
903
904
905
906
907
908
....
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
....
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
....
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
....
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
....
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
....
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
....
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
....
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
....
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
....
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
....
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
....
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
....
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
....
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
....
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
static Tcl_LoadHandle odbcLoadHandle = NULL;
				/* Handle to the ODBC client library */
static Tcl_LoadHandle odbcInstLoadHandle = NULL;
				/* Handle to the ODBC installer library */
static SQLHENV hEnv = SQL_NULL_HENV;
				/* Handle to the global ODBC environment */
static size_t hEnvRefCount = 0;	/* Reference count on the global environment */
static size_t sizeofSQLWCHAR = sizeof(SQLWCHAR);
				/* Preset, will be autodetected later */

/*
 * Objects to create within the literal pool
 */

................................................................................
};

/*
 * Structure that holds per-interpreter data for the ODBC package.
 */

typedef struct PerInterpData {
    size_t refCount;		/* Reference count */
    SQLHENV hEnv;		/* ODBC environment handle */
    Tcl_Obj* literals[LIT__END];
				/* Literal pool */
} PerInterpData;
#define IncrPerInterpRefCount(x)  \
    do {			  \
	++((x)->refCount);	  \
................................................................................
 *	contains its statements is taken down, destroying them. It's
 *	not safe to take down the ConnectionData until nothing is
 *	referring to it, which avoids taking down the hDBC until the
 *	other objects that refer to it vanish.
 */

typedef struct ConnectionData {
    size_t refCount;		/* Reference count. */
    PerInterpData* pidata;	/* Per-interpreter data */
    Tcl_Obj* connectionString;	/* Connection string actually used to
				 * connect to the database */
    SQLHDBC hDBC;		/* Connection handle */
    int flags;			/* Flags describing the state of the
				 * connection */
} ConnectionData;
................................................................................
 *	Just as with connections, statements need to defer taking down
 *	their client data until other objects (i.e., result sets) that
 * 	refer to them have had a chance to clean up. Hence, this
 *	structure is reference counted as well.
 */

typedef struct StatementData {
    size_t refCount;		/* Reference count */
    Tcl_Object connectionObject;
				/* The connection object */
    ConnectionData* cdata;	/* Data for the connection to which this
				 * statement pertains. */
    Tcl_Obj* subVars;	        /* List of variables to be substituted, in the
				 * order in which they appear in the
				 * statement */
    SQLHSTMT hStmt;		/* Handle to the ODBC statement */
    SQLWCHAR* nativeSqlW;	/* SQL statement as wide chars */
    size_t nativeSqlLen;		/* Length of the statement */
    SQLWCHAR* nativeMatchPatternW;
				/* Match pattern for metadata queries */
    size_t nativeMatchPatLen;	/* Length of the match pattern */
    struct ParamData* params;	/* Pointer to an array of ParamData
				 * structures that describe the data types
				 * of substituted parameters. */
    int typeNum;		/* Type number for a query of data types */
    int flags;			/* Flags tracking the state of the
				 * StatementData */
} StatementData;
................................................................................
    int value;		/* Constant value */
} OdbcConstant;

/*
 * Constants for the directions of parameter transmission
 */

static const OdbcConstant OdbcParamDirections[] = {
    { "in",		PARAM_KNOWN | PARAM_IN, },
    { "out",		PARAM_KNOWN | PARAM_OUT },
    { "inout",		PARAM_KNOWN | PARAM_IN | PARAM_OUT },
    { NULL,		0 }
};

/*
 * ODBC constants for the names of data types
 */

static const OdbcConstant OdbcTypeNames[] = {
    { "bigint",		SQL_BIGINT },
    { "binary",		SQL_BINARY },
    { "bit",		SQL_BIT } ,
    { "char",		SQL_CHAR } ,
    { "date",		SQL_DATE } ,
    { "decimal",	SQL_DECIMAL } ,
    { "double",		SQL_DOUBLE } ,
................................................................................
    { "timestamp",	SQL_TIMESTAMP } ,
    { "tinyint",	SQL_TINYINT } ,
    { "varbinary",	SQL_VARBINARY } ,
    { "varchar",	SQL_VARCHAR } ,
    { NULL,		-1 }
};

static const OdbcConstant OdbcIsolationLevels[] = {
    { "readuncommitted",	SQL_TXN_READ_UNCOMMITTED },
    { "readcommitted",		SQL_TXN_READ_COMMITTED },
    { "repeatableread",		SQL_TXN_REPEATABLE_READ },
    { "serializable",		SQL_TXN_SERIALIZABLE },
    { NULL,			0 }
};

static const OdbcConstant OdbcErrorCodeNames[] = {
    { "GENERAL_ERR",			ODBC_ERROR_GENERAL_ERR },
    { "INVALID_BUFF_LEN",		ODBC_ERROR_INVALID_BUFF_LEN },
    { "INVALID_HWND",			ODBC_ERROR_INVALID_HWND },
    { "INVALID_STR",			ODBC_ERROR_INVALID_STR },
    { "INVALID_REQUEST_TYPE",		ODBC_ERROR_INVALID_REQUEST_TYPE },
    { "COMPONENT_NOT_FOUND",		ODBC_ERROR_COMPONENT_NOT_FOUND },
    { "INVALID_NAME",			ODBC_ERROR_INVALID_NAME },
................................................................................
    { "OUT_OF_MEM",			ODBC_ERROR_OUT_OF_MEM },
    { "OUTPUT_STRING_TRUNCATED",	ODBC_ERROR_OUTPUT_STRING_TRUNCATED },
    { NULL,				0 }
};

/* Prototypes for static functions appearing in this file */

static void DStringAppendWChars(Tcl_DString* ds, SQLWCHAR* ws, size_t len);
static SQLWCHAR* GetWCharStringFromObj(Tcl_Obj* obj, size_t* lengthPtr);

static void TransferSQLError(Tcl_Interp* interp, SQLSMALLINT handleType,
			     SQLHANDLE handle, const char* info);
static int SQLStateIs(SQLSMALLINT handleType, SQLHANDLE handle,
		      const char* sqlstate);
static int LookupOdbcConstant(Tcl_Interp* interp, const OdbcConstant* table,
			      const char* kind, Tcl_Obj* name,
................................................................................
static int DatasourcesObjCmd(ClientData clientData, Tcl_Interp* interp,
			      int objc, Tcl_Obj *const objv[]);
static int DriversObjCmd(ClientData clientData, Tcl_Interp* interp,
			 int objc, Tcl_Obj *const objv[]);
 
/* Metadata type that holds connection data */

static const Tcl_ObjectMetadataType connectionDataType = {
    TCL_OO_METADATA_VERSION_CURRENT,
				/* version */
    "ConnectionData",		/* name */
    DeleteConnectionMetadata,	/* deleteProc */
    CloneConnection		/* cloneProc - should cause an error
				 * 'cuz connections aren't clonable */
};

/* Metadata type that holds statement data */

static const Tcl_ObjectMetadataType statementDataType = {
    TCL_OO_METADATA_VERSION_CURRENT,
				/* version */
    "StatementData",		/* name */
    DeleteStatementMetadata,	/* deleteProc */
    CloneStatement		/* cloneProc - should cause an error
				 * 'cuz statements aren't clonable */
};

/* Metadata type for result set data */

static const Tcl_ObjectMetadataType resultSetDataType = {
    TCL_OO_METADATA_VERSION_CURRENT,
				/* version */
    "ResultSetData",		/* name */
    DeleteResultSetMetadata,	/* deleteProc */
    CloneResultSet		/* cloneProc - should cause an error
				 * 'cuz result sets aren't clonable */
};

/* Method types of the connection methods that are implemented in C */

static const Tcl_MethodType ConnectionConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    ConnectionConstructor,	/* callProc */
    DeleteCmd,			/* deleteProc */
    CloneCmd			/* cloneProc */
};
static const Tcl_MethodType ConnectionBeginTransactionMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "begintransaction",		/* name */
    ConnectionBeginTransactionMethod,
				/* callProc */
    NULL,			/* deleteProc */
    CloneCmd			/* cloneProc */
};
static const Tcl_MethodType ConnectionConfigureMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "configure",		/* name */
    ConnectionConfigureMethod,	/* callProc */
    NULL,			/* deleteProc */
    CloneCmd			/* cloneProc */
};
static const Tcl_MethodType ConnectionEndXcnMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "endtransaction",		/* name */
    ConnectionEndXcnMethod,	/* callProc */
    NULL,			/* deleteProc */
    CloneCmd			/* cloneProc */
};
static const Tcl_MethodType ConnectionHasBigintMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "HasBigint",		/* name */
    ConnectionHasBigintMethod,
				/* callProc */
    NULL,			/* deleteProc */
    CloneCmd			/* cloneProc */
};
static const Tcl_MethodType ConnectionHasWvarcharMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "HasWvarchar",		/* name */
    ConnectionHasWvarcharMethod,
				/* callProc */
    NULL,			/* deleteProc */
    CloneCmd			/* cloneProc */
................................................................................
};

/*
 * Methods to create on the connection class. Note that 'init', 'commit' and
 * 'rollback' are all special because they have non-NULL clientData.
 */

static const Tcl_MethodType* ConnectionMethods[] = {
    &ConnectionBeginTransactionMethodType,
    &ConnectionConfigureMethodType,
    &ConnectionHasBigintMethodType,
    &ConnectionHasWvarcharMethodType,
    NULL
};

/* Method types of the statement methods that are implemented in C */

static const Tcl_MethodType StatementConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    StatementConstructor,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
static const Tcl_MethodType StatementConnectionMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "connection",		/* name */
    StatementConnectionMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
static const Tcl_MethodType StatementParamListMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "ParamList",		/* name */
    StatementParamListMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
static const Tcl_MethodType StatementParamtypeMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "paramtype",		/* name */
    StatementParamtypeMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};

/*
 * Methods to create on the statement class.
 */

static const Tcl_MethodType* StatementMethods[] = {
    &StatementConnectionMethodType,
    &StatementParamListMethodType,
    &StatementParamtypeMethodType,
    NULL
};

/*
 * Constructor type for the class that implements the fake 'statement'
 * used to query the names and attributes of database tables.
 */

static const Tcl_MethodType TablesStatementConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    TablesStatementConstructor,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};

/*
 * Method types for the class that implements the fake 'statement'
 * used to query the names and attributes of database columns.
 */

static const Tcl_MethodType ColumnsStatementConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    ColumnsStatementConstructor,
				/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
................................................................................
};

/*
 * Method types for the class that implements the fake 'statement'
 * used to query the names and attributes of primary keys.
 */

static const Tcl_MethodType PrimarykeysStatementConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    PrimarykeysStatementConstructor,
				/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
................................................................................
};

/*
 * Method types for the class that implements the fake 'statement'
 * used to query the names and attributes of foreign keys.
 */

static const Tcl_MethodType ForeignkeysStatementConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    ForeignkeysStatementConstructor,
				/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
................................................................................
};

/*
 * Constructor type for the class that implements the fake 'statement'
 * used to query the names and attributes of database types.
 */

static const Tcl_MethodType TypesStatementConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    &TypesStatementConstructor,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};

/* Method types of the result set methods that are implemented in C */

static const Tcl_MethodType ResultSetConstructorType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "CONSTRUCTOR",		/* name */
    ResultSetConstructor,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
static const Tcl_MethodType ResultSetColumnsMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */    "columns",			/* name */
    ResultSetColumnsMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
static const Tcl_MethodType ResultSetNextresultsMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "nextresults",		/* name */
    ResultSetNextresultsMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
static const Tcl_MethodType ResultSetNextrowMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "nextrow",			/* name */
    ResultSetNextrowMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};
static const Tcl_MethodType ResultSetRowcountMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT,
				/* version */
    "rowcount",			/* name */
    ResultSetRowcountMethod,	/* callProc */
    NULL,			/* deleteProc */
    NULL			/* cloneProc */
};


static const Tcl_MethodType* ResultSetMethods[] = {
    &ResultSetColumnsMethodType,
    &ResultSetNextresultsMethodType,
    &ResultSetRowcountMethodType,
    NULL
};
 
/*
................................................................................
 *-----------------------------------------------------------------------------
 */

static void
DStringAppendWChars(
    Tcl_DString* ds,		/* Output string */
    SQLWCHAR* ws,		/* Input string */
    size_t len			/* Length of the input string in characters */
) {
    size_t i;
    char buf[4] = "";

    if (sizeofSQLWCHAR == sizeof(unsigned short)) {
	unsigned short* ptr16 = (unsigned short*) ws;

	for (i = 0; i < len; ++i) {
	    unsigned int ch;
	    size_t bytes;

	    ch = ptr16[i];
	    bytes = Tcl_UniCharToUtf(ch, buf);
	    Tcl_DStringAppend(ds, buf, bytes);
	}
    } else {
	unsigned int* ptr32 = (unsigned int*) ws;

	for (i = 0; i < len; ++i) {
	    unsigned int ch;
	    size_t bytes;

	    ch = ptr32[i];
	    if (ch > 0x10ffff) {
		ch = 0xfffd;
	    }
	    bytes = Tcl_UniCharToUtf(ch, buf);
	    Tcl_DStringAppend(ds, buf, bytes);
................................................................................
 *
 *-----------------------------------------------------------------------------
 */

static SQLWCHAR*
GetWCharStringFromObj(
    Tcl_Obj* obj,		/* Tcl object whose string rep is desired */
    size_t* lengthPtr		/* Length of the string */
) {

    char* bytes = Tcl_GetString(obj);
				/* UTF-8 representation of the input string */
    size_t len = obj->length;	/* Length of the input string in bytes */
    char* end = bytes + len;	/* End of UTF-8 representation */
    SQLWCHAR* retval;		/* Buffer to hold the converted string */
    SQLWCHAR* wcPtr;
    int shrink = 0;
    Tcl_UniChar ch = 0;

    len = (len + 1) * sizeofSQLWCHAR;
................................................................................

	    if (Tcl_UtfCharComplete(bytes, end - bytes)) {
		bytes += Tcl_UtfToUniChar(bytes, &ch);
	    } else {
		ch = *bytes++ & 0x00ff;
	    }
	    uch = ch;

	    if ((sizeof(Tcl_UniChar) > 2) && (uch > 0xffff)) {
		*ptr16++ = (((uch - 0x10000) >> 10) & 0x3ff) | 0xd800;
		uch = ((uch - 0x10000) & 0x3ff) | 0xdc00;
	    }

	    if (uch > 0x7f) {
		shrink = 1;
	    }
	    *ptr16++ = uch;
	}
	*ptr16 = 0;
	len = ptr16 - (unsigned short*) retval;
................................................................................

	    if (Tcl_UtfCharComplete(bytes, end - bytes)) {
		bytes += Tcl_UtfToUniChar(bytes, &ch);
	    } else {
		ch = *bytes++ & 0x00ff;
	    }
	    uch = ch;

	    if ((sizeof(Tcl_UniChar) == 2) && ((uch & 0xfc00) == 0xd800)) {
		if (Tcl_UtfCharComplete(bytes, end - bytes)) {
		    len = Tcl_UtfToUniChar(bytes, &ch);
		    if ((ch & 0xfc00) == 0xdc00) {
			bytes += len;
			uch = (((uch & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
		    }
		}
	    }

	    if (uch > 0x7f) {
		shrink = 1;
	    }
	    *ptr32++ = uch;
	}
	*ptr32 = 0;
	len = ptr32 - (unsigned int*) retval;
................................................................................
 *-----------------------------------------------------------------------------
 */

static void
DismissHEnv(void)
{
    Tcl_MutexLock(&hEnvMutex);
    if (hEnvRefCount-- <= 1) {
	SQLFreeHandle(SQL_HANDLE_ENV, hEnv);
	hEnv = SQL_NULL_HANDLE;
	if (odbcInstLoadHandle != NULL) {
	    Tcl_FSUnloadFile(NULL, odbcInstLoadHandle);
	    odbcInstLoadHandle = NULL;
	}
	Tcl_FSUnloadFile(NULL, odbcLoadHandle);
................................................................................
				/* Pointer to the driver connection options */
    HWND* hParentWindowPtr	/* Handle to the parent window for a
				 * connection dialog */
) {

    /* Configuration options */

    static const char* options[] = {
	"-encoding",
	"-isolation",
	"-parent",
	"-readonly",
	"-timeout",
	NULL
    };
................................................................................
				/* Number of leading args to skip */
    SQLHDBC hDBC = SQL_NULL_HDBC;
				/* Handle to the database connection */
    SQLRETURN rc;		/* Return code from ODBC calls */
    HWND hParentWindow = NULL;	/* Windows handle of the main window */
    SQLWCHAR* connectionStringReq;
				/* Connection string requested by the caller */
    size_t connectionStringReqLen;
				/* Length of the requested connection string */
    SQLWCHAR connectionString[1025*2];
				/* Connection string actually used */
    SQLSMALLINT connectionStringLen;
				/* Length of the actual connection string */
    Tcl_DString connectionStringDS;
				/* Connection string converted to UTF-8 */
................................................................................
    ConnectionData* cdata;	/* The connection object's data */
    StatementData* sdata;	/* The statement's object data */
    Tcl_Obj* tokens = NULL;	/* The tokens of the statement to be prepared */
    int tokenc;			/* Length of the 'tokens' list */
    Tcl_Obj** tokenv;		/* Exploded tokens from the list */
    Tcl_Obj* nativeSql;		/* SQL statement mapped to ODBC form */
    char* tokenStr;		/* Token string */
    size_t tokenLen;		/* Length of a token */
    RETCODE rc;			/* Return code from ODBC */
    SQLSMALLINT nParams;	/* Number of parameters in the ODBC statement */
    int i, j;

    /* Find the connection object, and get its data. */

    if (objc != skip+2) {
................................................................................
    if (Tcl_ListObjGetElements(interp, tokens, &tokenc, &tokenv) != TCL_OK) {
	Tcl_DecrRefCount(tokens);
	goto freeSData;
    }
    nativeSql = Tcl_NewObj();
    Tcl_IncrRefCount(nativeSql);
    for (i = 0; i < tokenc; ++i) {
	tokenStr = Tcl_GetString(tokenv[i]);
	tokenLen = tokenv[i]->length;

	switch (tokenStr[0]) {
	case '$':
	case ':':
	    Tcl_AppendToObj(nativeSql, "?", 1);
	    Tcl_ListObjAppendElement(NULL, sdata->subVars,
				     Tcl_NewStringObj(tokenStr+1, tokenLen-1));
................................................................................
				/* The number of parameters to skip */
    Tcl_Object connectionObject;
				/* The database connection as a Tcl_Object */
    ConnectionData* cdata;	/* The connection object's data */
    StatementData* sdata;	/* The statement's object data */
    RETCODE rc;			/* Return code from ODBC */

    static const char* options[] = {	/* Option table */
	"-foreign",
	"-primary",
	NULL
    };
    enum {
	OPT_FOREIGN=0,
	OPT_PRIMARY,
................................................................................
    int nBound;			/* Number of substituted parameters that
				 * have been bound successfully */
    SQLSMALLINT dataType;	/* Data type of a parameter */
    Tcl_Obj* paramNameObj;	/* Name of a substituted parameter */
    const char* paramName;	/* Name of a substituted parameter */
    Tcl_Obj* paramValObj;	/* Value of a substituted parameter */
    const char* paramVal;	/* Value of a substituted parameter */
    size_t paramLen;		/* String length of the parameter value */
    Tcl_DString paramExternal;	/* Substituted parameter, converted to
				 * system encoding */
    int paramExternalLen;	/* Length of the substituted parameter
				 * after conversion */
    SQLRETURN rc;		/* Return code from ODBC calls */
    unsigned char* byteArrayPtr; /* Pointer to a BINARY or VARBINARY
				 * parameter, expressed as a byte array.*/
................................................................................
		} else {

		    /*
		     * We need to convert the character string to system
		     * encoding and store in rdata->bindStrings[nBound].
		     */
		    dataType = SQL_C_CHAR;
		    paramVal = Tcl_GetString(paramValObj);
		    paramLen = paramValObj->length;
		    Tcl_DStringInit(&paramExternal);
		    Tcl_UtfToExternalDString(NULL, paramVal, paramLen,
					     &paramExternal);
		    paramExternalLen = Tcl_DStringLength(&paramExternal);
		    rdata->bindStrings[nBound] = (SQLCHAR*)
			ckalloc(paramExternalLen + 1);
		    memcpy(rdata->bindStrings[nBound],
................................................................................
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {
    PerInterpData* pidata = (PerInterpData*) clientData;
    SQLSMALLINT initDirection = SQL_FETCH_FIRST;
    SQLSMALLINT direction;
    static const struct flag {
	const char* name;
	SQLSMALLINT value;
    } flags[] = {
	{ "-system", SQL_FETCH_FIRST_SYSTEM },
	{ "-user", SQL_FETCH_FIRST_USER },
	{ NULL, 0 }
    };
................................................................................
static int
DatasourceObjCmdW(
    ClientData clientData,	/* Unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {
    static const struct flag {
	const char* name;
	WORD value;
    } flags[] = {
	{ "add",		ODBC_ADD_DSN },
	{ "add_system",		ODBC_ADD_SYS_DSN },
	{ "configure",		ODBC_CONFIG_DSN },
	{ "configure_system",	ODBC_CONFIG_SYS_DSN },
................................................................................
    };
    int flagIndex;		/* Index of the subcommand */

    WCHAR* driverName;		/* Name of the ODBC driver */
    WCHAR* attributes;		/* NULL-delimited attribute values */
    char errorMessage[SQL_MAX_MESSAGE_LENGTH+1];
				/* Error message from ODBC operations */
    size_t driverNameLen;		/* Length of the driver name */
    Tcl_Obj* attrObj;		/* NULL-delimited attribute values */
    size_t attrLen;		/* Length of the attribute values */
    const char* sep;		/* Separator for attribute values */
    DWORD errorCode;		/* Error code */
    WORD errorMessageLen;	/* Length of the returned error message */
    RETCODE errorMessageStatus;	/* Status of the error message formatting */
    Tcl_DString retvalDS;	/* Return value */
    Tcl_DString errorMessageDS;	/* DString to convert error message
				 * from system encoding */
................................................................................
static int
DatasourceObjCmdA(
    ClientData clientData,	/* Unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {
    static const struct flag {
	const char* name;
	WORD value;
    } flags[] = {
	{ "add",		ODBC_ADD_DSN },
	{ "add_system",		ODBC_ADD_SYS_DSN },
	{ "configure",		ODBC_CONFIG_DSN },
	{ "configure_system",	ODBC_CONFIG_SYS_DSN },
................................................................................
				 * encoding */
    char* attributes;		/* Attributes of the data source in
				 * system encoding */
    char errorMessage[SQL_MAX_MESSAGE_LENGTH+1];
				/* Error message from ODBC operations */
    Tcl_DString errorMessageDS;	/* Error message in UTF-8 */
    char* p;
    size_t driverNameLen;		/* Length of the driver name */
    Tcl_Obj* attrObj;		/* NULL-delimited attribute values */
    size_t attrLen;		/* Length of the attribute values */
    const char* sep;		/* Separator for attribute values */
    DWORD errorCode;		/* Error code */
    WORD errorMessageLen;	/* Length of the returned error message */
    RETCODE errorMessageStatus;	/* Status of the error message formatting */
    Tcl_DString retvalDS;	/* Return value */
    Tcl_Obj* errorCodeObj;	/* Tcl error code */
    int i, j;
................................................................................
				  "operation", 0, &flagIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    /* Convert driver name to the appropriate encoding */

    Tcl_DStringInit(&driverNameDS);
    p = Tcl_GetString(objv[2]);
    driverNameLen = objv[2]->length;
    Tcl_UtfToExternalDString(NULL, p, driverNameLen, &driverNameDS);
    driverName = Tcl_DStringValue(&driverNameDS);
    driverNameLen = Tcl_DStringLength(&driverNameDS);

    /*
     * Convert driver attributes to the appropriate encoding, separated
     * by NUL bytes.
................................................................................
    for (i = 3; i < objc; ++i) {
	Tcl_AppendToObj(attrObj, sep, -1);
	Tcl_AppendObjToObj(attrObj, objv[i]);
	sep = "\xc0\x80";
    }
    Tcl_AppendToObj(attrObj, "\xc0\x80", 2);
    Tcl_DStringInit(&attributesDS);
    p = Tcl_GetString(attrObj);
    attrLen = attrObj->length;
    Tcl_UtfToExternalDString(NULL, p, attrLen, &attributesDS);
    attributes = Tcl_DStringValue(&attributesDS);
    attrLen = Tcl_DStringLength(&attributesDS);
    Tcl_DecrRefCount(attrObj);

    /*
     * Configure the data source