TclODBCでnvarcharを使えるようにする をテンプレートにして作成

Start:
TclODBC2.3.1でMicrosoft SQL Server 2008に接続してnvarchar... Index: database.cxx ========================================================... RCS file: /cvsroot/tclodbc/tclodbc/database.cxx,v retrieving revision 1.7 diff -u -r1.7 database.cxx --- database.cxx 20 Mar 2004 22:14:19 -0000 ... +++ database.cxx 20 Jun 2009 17:18:13 -0000 @@ -293,7 +293,7 @@ if (objc < 4 || objc > 6) { THROWSTR("wrong # args, should be eval ... } else { - TclSqlStatement stmt(*this, Tcl_GetStrin... + TclSqlStatement stmt(*this, objv[3], useMultipleResultSe... TclObj proc (objv[2]); @@ -312,7 +312,7 @@ if (objc < 4 || objc > 6) { THROWSTR("wrong # args, should be read ... } else { - TclSqlStatement stmt(*this, Tcl_GetStrin... + TclSqlStatement stmt(*this, objv[3], useMultipleResultSe... TclObj arraySpec (objv[2]); @@ -331,7 +331,7 @@ if (objc < 2 || objc > 4) { THROWSTR("wrong # args, should be sql [... } else { - TclSqlStatement stmt(*this, Tcl_GetStrin... + TclSqlStatement stmt(*this, objv[1], useMultipleResultSe... if (objc == 4) { stmt.SetArgDefs(interp, objv[2]); Index: statemnt.cxx ========================================================... RCS file: /cvsroot/tclodbc/tclodbc/statemnt.cxx,v retrieving revision 1.7 diff -u -r1.7 statemnt.cxx --- statemnt.cxx 20 Mar 2004 22:14:19 -0000 ... +++ statemnt.cxx 20 Jun 2009 17:18:13 -0000 @@ -627,6 +627,13 @@ if (EncodedType(resultBuffer[i].fSqlType)) element.Decode(pDb->Encoding()); + + if (UnicodeType(resultBuffer[i].fSqlType)) { + Tcl_Encoding e = Tcl_GetEncoding(NULL, ... + element.Decode(e); + Tcl_FreeEncoding(e); + } + row.appendElement(element); } } @@ -720,12 +727,13 @@ RETCODE rc; useMultipleResultSets = multiSets; - - // encode TclObj to selected character set - sql.Encode(db.Encoding()); - + + int wsqllen; + SQLWCHAR *wsql; + wsql = (SQLWCHAR*)Tcl_GetUnicodeFromObj(sql, &wsqll... + // prepare statement - while ((rc = SQLPrepare(stmt, (UCHAR*) sql.EncodedV... + while (((rc = SQLPrepareW(stmt, wsql, wsqllen))) ==... if (rc == SQL_ERROR) THROWOBJ(SqlErr(env, db.DBC(), stmt)) @@ -834,6 +842,12 @@ if (EncodedType(argDefBuffer[i].fSqlType)) sqlArg.Encode(pDb->Encoding()); + if (UnicodeType(argDefBuffer[i].fSqlType)) { + Tcl_Encoding e = Tcl_GetEncoding(NULL, ... + sqlArg.Encode(e); + Tcl_FreeEncoding(e); + } + sqlarglen = sqlArg.EncodedLenght(); if (sqlarglen == 0) { Index: strings.cxx ========================================================... RCS file: /cvsroot/tclodbc/tclodbc/strings.cxx,v retrieving revision 1.4 diff -u -r1.4 strings.cxx --- strings.cxx 20 Mar 2004 22:14:19 -0000 1.4 +++ strings.cxx 20 Jun 2009 17:18:14 -0000 @@ -110,7 +110,7 @@ // in the struct. NumStr sqlType [] = { - {19, NULL }, + {22, NULL }, {SQL_BIGINT, "BIGINT" }, {SQL_BINARY, "BINARY" }, {SQL_BIT, "BIT" }, @@ -129,7 +129,10 @@ {SQL_TIMESTAMP, "TIMESTAMP" }, {SQL_TINYINT, "TINYINT" }, {SQL_VARBINARY, "VARBINARY" }, - {SQL_VARCHAR, "VARCHAR" } + {SQL_VARCHAR, "VARCHAR" }, + {SQL_WCHAR, "WCHAR" }, + {SQL_WVARCHAR, "WVARCHAR" }, + {SQL_WLONGVARCHAR, "WLONGVARCHAR"} }; NumStr attrDef [] = { Index: tclodbc.cxx ========================================================... RCS file: /cvsroot/tclodbc/tclodbc/tclodbc.cxx,v retrieving revision 1.5 diff -u -r1.5 tclodbc.cxx --- tclodbc.cxx 19 Mar 2004 20:32:21 -0000 1.5 +++ tclodbc.cxx 20 Jun 2009 17:18:14 -0000 @@ -116,26 +116,25 @@ ///////////////////////////////////////////////////////... // MISANCELLOUS HELPER FUNCTIONS // - TclObj SqlErr (HENV env, HDBC dbc, HSTMT stmt) { - char SqlMessage[SQL_MAX_MESSAGE_LENGTH]; - char SqlState[6]; + SQLWCHAR SqlMessage[SQL_MAX_MESSAGE_LENGTH]; + SQLWCHAR SqlState[6]; SDWORD NativeError; SWORD Available; RETCODE rc; TclObj errObj; - rc = SQLError(env, dbc, stmt, - (UCHAR*) SqlState, &NativeError, (UCHAR*) S... + rc = SQLErrorW(env, dbc, stmt, + SqlState, &NativeError, SqlMessage, SQL_MAX_MESSAGE_LENGTH-1, &Available); // sql error object is a triple: // {standard error code} {native error code} {error... if (rc != SQL_ERROR) { - errObj.appendElement(TclObj(SqlState)); + errObj.appendElement(TclObj(Tcl_NewUnicodeObj((... errObj.appendElement(TclObj(NativeError)); - errObj.appendElement(TclObj(SqlMessage,Availabl... + errObj.appendElement(TclObj(Tcl_NewUnicodeObj((... } else { errObj.appendElement("FATAL ERROR: Failed to re... } @@ -214,11 +213,28 @@ case SQL_VARBINARY: case SQL_LONGVARBINARY: return SQL_C_BINARY; + case SQL_WCHAR: + case SQL_WVARCHAR: + case SQL_WLONGVARCHAR: + return SQL_C_BINARY; default: return SQL_C_CHAR; } } +// this routine determines which sql types is unicode +BOOL UnicodeType (int i) +{ + switch (i) { + case SQL_WCHAR: + case SQL_WVARCHAR: + case SQL_WLONGVARCHAR: + return TRUE; + default: + return FALSE; + } +} + ///////////////////////////////////////////////////////... // TCL COMMAND INTERFACE @@ -339,7 +355,7 @@ extern "C" { _declspec(dllexport) -Tclodbc_Init(Tcl_Interp *interp) +int Tclodbc_Init(Tcl_Interp *interp) { #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { Index: tclodbc.hxx ========================================================... RCS file: /cvsroot/tclodbc/tclodbc/tclodbc.hxx,v retrieving revision 1.5 diff -u -r1.5 tclodbc.hxx --- tclodbc.hxx 25 Mar 2005 20:49:21 -0000 1.5 +++ tclodbc.hxx 20 Jun 2009 17:18:14 -0000 @@ -542,6 +542,8 @@ SWORD MapSqlType (SDWORD colType); +BOOL UnicodeType (int i); + #ifdef _DEBUG int tclodbc_validateNumStrArrays(); int tclodbc_validateStrToNumFunction(); このパッチでは、次の点を改良した。 + UNICODE文字列型に対応した。 + SQL文は全てunicode文字列として扱うことにした。（Tclの内... + varchar型のデータの取得に関しては従来どおり、database s... + エラーメッセージはUnicodeで取得して、そのままUTF-8に変... **ダウンロード [#w0d8e76c] http://reddog.s35.xrea.com/software/tclodbc2.5r1-win32-bi... **雑感 [#p689b144] TclODBCのソースコードが読みにくい。C++な上、Tcl7.6とソー... **参考リンク [#z7ed9f86] -http://sourceforge.net/projects/tclodbc -http://msdn.microsoft.com/en-us/library/ms714177(VS.85).... **コメントをどーぞ [#d131bb86] #comment ---- [[CategoryTclTk]]

End:
TclODBC2.3.1でMicrosoft SQL Server 2008に接続してnvarchar... Index: database.cxx ========================================================... RCS file: /cvsroot/tclodbc/tclodbc/database.cxx,v retrieving revision 1.7 diff -u -r1.7 database.cxx --- database.cxx 20 Mar 2004 22:14:19 -0000 ... +++ database.cxx 20 Jun 2009 17:18:13 -0000 @@ -293,7 +293,7 @@ if (objc < 4 || objc > 6) { THROWSTR("wrong # args, should be eval ... } else { - TclSqlStatement stmt(*this, Tcl_GetStrin... + TclSqlStatement stmt(*this, objv[3], useMultipleResultSe... TclObj proc (objv[2]); @@ -312,7 +312,7 @@ if (objc < 4 || objc > 6) { THROWSTR("wrong # args, should be read ... } else { - TclSqlStatement stmt(*this, Tcl_GetStrin... + TclSqlStatement stmt(*this, objv[3], useMultipleResultSe... TclObj arraySpec (objv[2]); @@ -331,7 +331,7 @@ if (objc < 2 || objc > 4) { THROWSTR("wrong # args, should be sql [... } else { - TclSqlStatement stmt(*this, Tcl_GetStrin... + TclSqlStatement stmt(*this, objv[1], useMultipleResultSe... if (objc == 4) { stmt.SetArgDefs(interp, objv[2]); Index: statemnt.cxx ========================================================... RCS file: /cvsroot/tclodbc/tclodbc/statemnt.cxx,v retrieving revision 1.7 diff -u -r1.7 statemnt.cxx --- statemnt.cxx 20 Mar 2004 22:14:19 -0000 ... +++ statemnt.cxx 20 Jun 2009 17:18:13 -0000 @@ -627,6 +627,13 @@ if (EncodedType(resultBuffer[i].fSqlType)) element.Decode(pDb->Encoding()); + + if (UnicodeType(resultBuffer[i].fSqlType)) { + Tcl_Encoding e = Tcl_GetEncoding(NULL, ... + element.Decode(e); + Tcl_FreeEncoding(e); + } + row.appendElement(element); } } @@ -720,12 +727,13 @@ RETCODE rc; useMultipleResultSets = multiSets; - - // encode TclObj to selected character set - sql.Encode(db.Encoding()); - + + int wsqllen; + SQLWCHAR *wsql; + wsql = (SQLWCHAR*)Tcl_GetUnicodeFromObj(sql, &wsqll... + // prepare statement - while ((rc = SQLPrepare(stmt, (UCHAR*) sql.EncodedV... + while (((rc = SQLPrepareW(stmt, wsql, wsqllen))) ==... if (rc == SQL_ERROR) THROWOBJ(SqlErr(env, db.DBC(), stmt)) @@ -834,6 +842,12 @@ if (EncodedType(argDefBuffer[i].fSqlType)) sqlArg.Encode(pDb->Encoding()); + if (UnicodeType(argDefBuffer[i].fSqlType)) { + Tcl_Encoding e = Tcl_GetEncoding(NULL, ... + sqlArg.Encode(e); + Tcl_FreeEncoding(e); + } + sqlarglen = sqlArg.EncodedLenght(); if (sqlarglen == 0) { Index: strings.cxx ========================================================... RCS file: /cvsroot/tclodbc/tclodbc/strings.cxx,v retrieving revision 1.4 diff -u -r1.4 strings.cxx --- strings.cxx 20 Mar 2004 22:14:19 -0000 1.4 +++ strings.cxx 20 Jun 2009 17:18:14 -0000 @@ -110,7 +110,7 @@ // in the struct. NumStr sqlType [] = { - {19, NULL }, + {22, NULL }, {SQL_BIGINT, "BIGINT" }, {SQL_BINARY, "BINARY" }, {SQL_BIT, "BIT" }, @@ -129,7 +129,10 @@ {SQL_TIMESTAMP, "TIMESTAMP" }, {SQL_TINYINT, "TINYINT" }, {SQL_VARBINARY, "VARBINARY" }, - {SQL_VARCHAR, "VARCHAR" } + {SQL_VARCHAR, "VARCHAR" }, + {SQL_WCHAR, "WCHAR" }, + {SQL_WVARCHAR, "WVARCHAR" }, + {SQL_WLONGVARCHAR, "WLONGVARCHAR"} }; NumStr attrDef [] = { Index: tclodbc.cxx ========================================================... RCS file: /cvsroot/tclodbc/tclodbc/tclodbc.cxx,v retrieving revision 1.5 diff -u -r1.5 tclodbc.cxx --- tclodbc.cxx 19 Mar 2004 20:32:21 -0000 1.5 +++ tclodbc.cxx 20 Jun 2009 17:18:14 -0000 @@ -116,26 +116,25 @@ ///////////////////////////////////////////////////////... // MISANCELLOUS HELPER FUNCTIONS // - TclObj SqlErr (HENV env, HDBC dbc, HSTMT stmt) { - char SqlMessage[SQL_MAX_MESSAGE_LENGTH]; - char SqlState[6]; + SQLWCHAR SqlMessage[SQL_MAX_MESSAGE_LENGTH]; + SQLWCHAR SqlState[6]; SDWORD NativeError; SWORD Available; RETCODE rc; TclObj errObj; - rc = SQLError(env, dbc, stmt, - (UCHAR*) SqlState, &NativeError, (UCHAR*) S... + rc = SQLErrorW(env, dbc, stmt, + SqlState, &NativeError, SqlMessage, SQL_MAX_MESSAGE_LENGTH-1, &Available); // sql error object is a triple: // {standard error code} {native error code} {error... if (rc != SQL_ERROR) { - errObj.appendElement(TclObj(SqlState)); + errObj.appendElement(TclObj(Tcl_NewUnicodeObj((... errObj.appendElement(TclObj(NativeError)); - errObj.appendElement(TclObj(SqlMessage,Availabl... + errObj.appendElement(TclObj(Tcl_NewUnicodeObj((... } else { errObj.appendElement("FATAL ERROR: Failed to re... } @@ -214,11 +213,28 @@ case SQL_VARBINARY: case SQL_LONGVARBINARY: return SQL_C_BINARY; + case SQL_WCHAR: + case SQL_WVARCHAR: + case SQL_WLONGVARCHAR: + return SQL_C_BINARY; default: return SQL_C_CHAR; } } +// this routine determines which sql types is unicode +BOOL UnicodeType (int i) +{ + switch (i) { + case SQL_WCHAR: + case SQL_WVARCHAR: + case SQL_WLONGVARCHAR: + return TRUE; + default: + return FALSE; + } +} + ///////////////////////////////////////////////////////... // TCL COMMAND INTERFACE @@ -339,7 +355,7 @@ extern "C" { _declspec(dllexport) -Tclodbc_Init(Tcl_Interp *interp) +int Tclodbc_Init(Tcl_Interp *interp) { #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { Index: tclodbc.hxx ========================================================... RCS file: /cvsroot/tclodbc/tclodbc/tclodbc.hxx,v retrieving revision 1.5 diff -u -r1.5 tclodbc.hxx --- tclodbc.hxx 25 Mar 2005 20:49:21 -0000 1.5 +++ tclodbc.hxx 20 Jun 2009 17:18:14 -0000 @@ -542,6 +542,8 @@ SWORD MapSqlType (SDWORD colType); +BOOL UnicodeType (int i); + #ifdef _DEBUG int tclodbc_validateNumStrArrays(); int tclodbc_validateStrToNumFunction(); このパッチでは、次の点を改良した。 + UNICODE文字列型に対応した。 + SQL文は全てunicode文字列として扱うことにした。（Tclの内... + varchar型のデータの取得に関しては従来どおり、database s... + エラーメッセージはUnicodeで取得して、そのままUTF-8に変... **ダウンロード [#w0d8e76c] http://reddog.s35.xrea.com/software/tclodbc2.5r1-win32-bi... **雑感 [#p689b144] TclODBCのソースコードが読みにくい。C++な上、Tcl7.6とソー... **参考リンク [#z7ed9f86] -http://sourceforge.net/projects/tclodbc -http://msdn.microsoft.com/en-us/library/ms714177(VS.85).... **コメントをどーぞ [#d131bb86] #comment ---- [[CategoryTclTk]]

Page: