2.ODBC API函数的声明方法 与使用其它动态库函数一样,在VB中使用ODBC API函数之前,必须事先声明将要使用 的函数、常量和数据结构。ODBC API函数驻留在ODBC运行动态库ODBC.DLL(16位)或ODBC 32.DLL(32位)中,该动态库位于Windows子目录system中。通常做法是在VB项目中单独使 用一个模块文件,然后将ODBC API声明语句加入其中,下面就是本文实例中使用的模块文 件module1.bas的内容:Declare Function SQLAllocEnv Lib "odbc32.dll" (phenv&) As Integer Declare Function SQLAllocConnect Lib "odbc32.dll" (ByVal henv&, phdbc&) As Integer Declare Function SQLAllocStmt Lib "odbc32.dll" (ByVal hdbc&, phstmt&) AsInteger Declare Function SQLConnect Lib "odbc32.dll" (ByVal hdbc&, ByVal szDSN$,ByVal cbDSN%, ByVal szUID$, ByVal cbUID%, ByVal szAuthStr$, ByVal cbAuthStr%) As Integer Declare Function SQLColAttributesString Lib "odbc32.dll" Alias "SQLColAttributes" (ByVal hstmt&, ByVal icol%, ByVal fDescType%, ByVal rgbDesc As String, ByVal cbDescMax%, pcbDesc%, pfDesc&) As Integer Declare Function SQLDisconnect Lib "odbc32.dll" (ByVal hdbc&) As Integer Declare Function SQLExecDirect Lib "odbc32.dll" (ByVal hstmt&, ByVal szSqlStr$, ByVal cbSqlStr&) As Integer Declare Function SQLFetch Lib "odbc32.dll" (ByVal hstmt&) As Integer Declare Function SQLFreeConnect Lib "odbc32.dll" (ByVal hdbc&) As Integer Declare Function SQLFreeEnv Lib "odbc32.dll" (ByVal henv&) As Integer Declare Function SQLFreeStmt Lib "odbc32.dll" (ByVal hstmt&, ByVal fOption%) As Integer Declare Function SQLGetData Lib "odbc32.dll" (ByVal hstmt&, ByVal icol%,ByVal fCType%, ByVal rgbValue As String, ByVal cbValueMax&, pcbValue&) As Integer Declare Function SQLNumResultCols Lib "odbc32.dll" (ByVal hstmt&, pccol%) As Integer Global Const SQL_C_CHAR As Long = 1 Global Const SQL_COLUMN_LABEL As Long = 18 Global Const SQL_DROP As Long = 1 Global Const SQL_ERROR As Long = -1 Global Const SQL_NO_DATA_FOUND As Long = 100 Global Const SQL_SUCCESS As Long = 0需要说明的是,在函数声明时,应该根据程序的运行环境选择相应的动态库。在VB子 目录samples\remauto\db_odbc中有两个文本文件ODBC16.TXT和ODBC32.TXT,分别存有所 有16位和32位ODBC API函数、常量和数据结构的声明语句,编程时可以从中拷贝所需的声 明语句。使用ODBC API的编程方法 在VB中调用ODBC API函数访问ODBC数据库,代码编写一般按下列过程进行: 1.初始化ODBC 在这个过程中,应用程序将通过调用SQLAlloEnv函数初始化ODBC接口,获取ODBC环境句柄。ODBC环境句柄是其它所有ODBC资源句柄的父句柄,因此无论程序将建立多少个ODBC连接,这个过程只需执行一次即可。例如: Dim rc As Integer 'ODBC函数的返回码 Dim henv As Long 'ODBC环境句柄 rc = SQLAllocEnv(henv) '获取ODBC环境句柄 2.与ODBC数据源建立连接 这个过程由下列两个步骤组成: *S调用SQLAllocConnect函数获取连接句柄。例如: Dim hdbc As Long '连接句柄 rc = SQLAllocConnect(henv, hdbc) '获取连接句柄 *S建立连接。这个步骤可以通过多种方法实现,最简单直观的方法是调用SQLConnect函数。例如: Dim DSN As String, UID As String, PWD As String DSN = "DataSourceName" 'ODBC数据源名称 UID = "UserID" '用户帐号 PWD = "Password" '用户口令 rc = SQLConnect(hdbc, DSN, Len(DSN), UID, Len(UID), PWD, Len(PWD)) '建立 连接 3.存取数据 用户对ODBC数据源的存取操作,都是通过SQL语句实现的。在这个过程中,应用程序将通过连接向ODBC数据库提交SQL语句,完成用户请求的操作,具体步骤如下: *S调用SQLAllocStmt函数获取语句句柄,例如: Dim hstmt As Long rc = SQLAllocStmt(hdbc, hstmt) *S执行SQL语句。执行SQL语句的方法比较多,最简单明了的方法是调用SQLAllocStmt函数,例如: Dim SQLstmt As String SQLstmt = "SELECT * FROM authors" rc = SQLExecDirect(hstmt, SQLstmt, Len(SQLstmt)) 4.检索结果集 如果SQL语句顺利提交并正确执行,那么就会产生一个结果集。检索结果集的方法很多,最简单、最直接的方法是调用SQLFetch和SQLGetData函数。SQLFetch函数的功能是将结果集的当前记录指针移至下一个记录,SQLGetData函数的功能是提取结果集中当前记录的某个字段值。通常可以采用一个循环提取结果集中所有记录的所有字段值,该循环重复执行SQLFetch和SQLGetData函数,直至SQLFetch函数返回SQL_NO_DATA_FOUND,这表示已经到达结果集的末尾。 Dim ColVal As String * 225 ColVal = String(255, 0) Do Until SQLFetch(hstmt) = SQL_NO_DATA_FOUND rc = SQLGetData(hstmt, i, SQL_C_CHAR, ColVal, Len(ColVal), SQL_NULL_DATA Loop 5.结束应用程序 在应用程序完成数据库操作、退出运行之前,必须释放程序中使用的系统资源。这些系统资源包括:语句句柄、连接句柄和ODBC环境句柄。完成这个过程的步骤如下: *S调用SQLFreeStmt函数释放语句句柄及其相关的系统资源。例如: rc = SQLFreeStmt(hstmt, SQL_DROP) *S调用SQLDisconnect函数关闭连接,例如: rc = SQLDisconnect(hdbc) *S调用SQLFreeConnect函数释放连接句柄及其相关的系统资源,例如: rc = SQLFreeConnect(hdbc) *S调用SQLFreeEnv函数释放环境句柄及其相关的系统资源,停止ODBC操作,例如: rc = SQLFreeEnv(henv) 此外,在编制程序时还有一个需要重点考虑的问题,这就是错误处理。所有ODBC API函数,若在执行期间发生错误,都将返回一个标准错误代码SQL_ERROR。一般来讲,在每次调用ODBC API函数之后,都应该检查该函数返回值,确定该函数是否成功地执行,再决定是否继续后续过程。而详细的错误信息,可以调用SQLError函数获得。SQLError函数将返回下列信息: *S标准的ODBC错误状态码; *SODBC数据源提供的内部错误编码; *S错误信息串。 简单应用实例 本实例将编制一个客户机端VB应用程序,通过Windows NT局域网查询服务器端MS SQL Server 6.5样板数据库PUBS中的AUTHORS数据表,在一个Grid控件中显示查询结果。首先,使用Windows控制面板中的ODBC驱动管理器新建一个ODBC数据源,定义数据源名称为ODBC_API_DEMO,定义登录数据库为PUBS,其它信息应根据用户的环境正确设置。然后启动VB,新建一个项目Project1,在缺省窗体Form1中加入一个Grid控件Grid1、两个CommandButton控件cmdQuery和cmdClose,在Project1中插入一个模块Module1,将前面列举的声明语句加入其中,程序代码如下: Private Sub Form_Load() Dim rc As Integer rc = SQLAllocEnv(henv) If rc <> 0 Then MsgBox "无法初始化ODBC" End End If rc = SQLAllocConnect(henv, hdbc) If rc <> 0 Then MsgBox "无法获得连接句柄" rc = SQLFreeEnv(henv) End End If Dim DSN As String, UID As String, PWD As String DSN = "ODBC_API_DEMO" UID = "guest" PWD = "" rc = SQLConnect(hdbc, DSN, Len(DSN), UID, Len(UID), PWD, Len(UID)) If rc = SQL_ERROR Then MsgBox "无法建立与ODBC数据源的连接" End End If End Sub Private Sub cmdQuery_Click() Dim hstmt As Long Dim SQLstmt As String Dim RSCols As Integer, RSRows As Long Dim rc As Integer, i As Integer, j As Integer Dim ColVal As String * 1024 Dim ColValLen As Long, ColLabLen As Integer, larg As Long rc = SQLAllocStmt(hdbc, hstmt) If rc <> SQL_SUCCESS Then MsgBox "无法获得SQL语句句柄" Exit Sub End If SQLstmt = "SELECT * FROM authors" rc = SQLExecDirect(hstmt, SQLstmt, Len(SQLstmt)) If rc <> SQL_SUCCESS Then MsgBox "SQL语句执行失败" Exit Sub End If rc = SQLNumResultCols(hstmt, RSCols) If RSCols > 1 Then Grid1.Cols = RSCols Grid1.Rows = 10 Grid1.Row = 0 Else Exit Sub End If For i = 1 To RSCols rc = SQLColAttributesString(hstmt, i, SQL_COLUMN_LABEL, ColVal, 255, Col LabLen, larg) Grid1.Col = i - 1 Grid1.Text = Left(ColVal, ColLabLen) Next i Do Until SQLFetch(hstmt) = SQL_NO_DATA_FOUND ColVal = String$(1024, 0) If Grid1.Row + 1 >= Grid1.Rows Then Grid1.Rows = Grid1.Rows + 1 End If Grid1.Row = Grid1.Row + 1 For i = 1 To RSCols rc = SQLGetData(hstmt, i, SQL_C_CHAR, ColVal, Len(ColVal), ColValLen) Grid1.Col = i - 1 Grid1.Text = Left$(ColVal, ColValLen) Next i Loop rc = SQLFreeStmt(hstmt, SQL_DROP) End Sub Private Sub cmdClose_Click() Dim rc As Integer If hdbc <> 0 Then rc = SQLDisconnect(hdbc) End If rc = SQLFreeConnect(hdbc) If henv <> 0 Then rc = SQLFreeEnv(henv) End If End End Sub
1.系统日期格式
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long Private Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean Private Const LOCALE_SLONGDATE = &H20 Private Const LOCALE_SSHORTDATE = &H1F Private Const LOCALE_STIME = &H1E Private Sub Command1_Click() Dim lngLocale As Long lngLocale = GetSystemDefaultLCID() If lngLocale = 2052 Then SetLocaleInfo lngLocale, LOCALE_SLONGDATE, "yyyy'年'M'月'd'日'"
注册ODBC代码： module-> Public Const ODBC_ADD_DSN = 1 Public Const ODBC_CONFIG_DSN = 2 Public Const ODBC_REMOVE_DSN = 3 Public Const ODBC_ADD_SYS_DSN = 4 Public Const ODBC_REMOVE_SYS_DSN = 6 Public Const vbAPINull As Long = 0&Public Const SQL_SUCCESS As Long = 0 Public Const SQL_ERROR As Long = -1 Public Const SQL_FETCH_NEXT As Long = 1Public Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long Public Declare Function SQLDataSources Lib "odbc32.dll" (ByVal henv As Long, ByVal fDirection As Integer, ByVal szDSN As String, ByVal cbDSNMax As Integer, pcbDSN As Integer, ByVal szDescription As String, ByVal cbDescriptionMax As Integer, pcbDescription As Integer) As Integer Public Declare Function SQLDrivers Lib "odbc32.dll" (ByVal henv&, ByVal fDirection%, ByVal szDriverDesc$, ByVal cbDriverDescMax%, pcbDriverDesc%, ByVal szDriverAttr$, ByVal cbDrvrAttrMax%, pcbDrvrAttr%) As Integer Public Declare Function SQLAllocEnv Lib "odbc32.dll" (env As Long) As Integer 类EODBC-> Public Enum e_DSNtype eUserDSN = 0 '用户数据源 eSysDSN '系统数据源 End EnumPublic Enum e_ODBCDRV MicrosoftAccessDriver = 0 ' "Microsoft Access Driver (*.mdb)" OracleODBCDriver ' "Oracle ODBC Driver" MicrosoftSQLServer '"SQL Server" MicrosoftTextDriver ' "Microsoft Text Driver (*.txt; *.csv)" MicrosoftExcelDriver ' "Microsoft Excel Driver (*.xls)" MicrosoftdBaseDriver ' "Microsoft dBase Driver (*.dbf)" MicrosoftODBCforOracle ' "Microsoft ODBC for Oracle" End Enum '创建数据源 成功返回TRUE，失败返回FALSE Public Function fun_CreateDSN(ByVal DSNname As String, ByVal ODBCdriver As String, ByVal DSNtype As e_DSNtype, _ ByVal SVRname As String, ByVal DBname As String, ByVal User As String, _ ByVal pwd As String, ByVal DSNdesc As String) As Boolean ' DSNname：数据源名 ' ODBCdriver：数据源驱动 ' DSNtype：数据源类型（系统、用户） ' SVRname：服务器名称 ' DBname：数据库名 ' User：用户名 ' PWD：密码 ' DSNdesc：数据源描述 On Error Resume Next Dim nRet As Long Dim sAttributes As String If DSNname <> "" Then sAttributes = "DSN=" & DSNname & Chr$(0) If DSNdesc <> "" Then sAttributes = sAttributes & "DESCRIPTION=" & DSNdesc & Chr$(0) If SVRname <> "" Then sAttributes = sAttributes & "SERVER=" & SVRname & Chr$(0) If User <> "" Then sAttributes = sAttributes & "UID=" & User & Chr$(0) If pwd <> "" Then sAttributes = sAttributes & "PWD=" & pwd & Chr$(0)
If InStr(1, LCase$(ODBCdriver), "access") > 0 Then If DBname <> "" Then sAttributes = sAttributes & "DBQ=" & DBname & Chr$(0) ElseIf InStr(1, LCase$(ODBCdriver), "sql server") > 0 Then sAttributes = "DSN=" & DSNname & Chr$(0) & "Server=" & SVRname & Chr$(0) & _ "UseProcForPrepare=Yes" & Chr$(0) Else If DBname <> "" Then sAttributes = sAttributes & "DATABASE=" & DBname & Chr$(0) End If
If DSNtype = eSysDSN Then nRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_SYS_DSN, ODBCdriver, sAttributes) ElseIf DSNtype = eUserDSN Then nRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, ODBCdriver, sAttributes) Else fun_CreateDSN = False Exit Function End If
If nRet = 0 Then fun_CreateDSN = False Else fun_CreateDSN = True End If End Function'删除数据源，成功返回TRUE，失败返回FALSE Public Function fun_DeleteDSN(ByVal DSNname As String, ByVal ODBCdriver As String, ByVal DSNtype As e_DSNtype) As Boolean ' DSNname：数据源名 ' ODBCdriver：数据源驱动 ' DSNtype：数据源类型（系统、用户） On Error Resume Next Dim nRet As Long Dim sAttributes As String sAttributes = sAttributes & "DSN=" & DSNname & Chr$(0) If DSNtype = eSysDSN Then nRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_SYS_DSN, ODBCdriver, sAttributes) ElseIf DSNtype = eUserDSN Then nRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, ODBCdriver, sAttributes) Else fun_DeleteDSN = False Exit Function End If If nRet = 0 Then fun_DeleteDSN = False Else fun_DeleteDSN = True End If End Function '枚举驱动 Public Function eNumDrivers(ByRef strArr_DRVs() As String) As Long Dim int_Ret As Integer Dim sDRVItem As String * 1024 Dim int_I As Integer Dim sDRV As String Dim iDRVLen As Integer Dim lHenv As Long '对环境处理 On Error GoTo doError ReDim strArr_DRVs(0) As String If SQLAllocEnv(lHenv) <> SQL_ERROR Then int_I = 0 sDRVItem = Space(1024) int_Ret = SQLDrivers(lHenv, SQL_FETCH_NEXT, sDRVItem, 1024, iDRVLen, 1024, 1024, iDRVLen) Do Until int_Ret <> SQL_SUCCESS sDRV = Left$(sDRVItem, iDRVLen) int_I = int_I + 1 If int_I = 1 Then ReDim strArr_DRVs(1 To 1) As String Else ReDim Preserve strArr_DRVs(1 To int_I) As String End If strArr_DRVs(int_I) = sDRV sDRVItem = Space(1024) int_Ret = SQLDrivers(lHenv, SQL_FETCH_NEXT, sDRVItem, 1024, iDRVLen, 1024, 1024, iDRVLen) Loop eNumDrivers = int_I Else eNumDrivers = 0 End If Exit Function doError: eNumDrivers = 0
End Function'搜索系统中所有的DSN(ODBC)数据源和对应的驱动 0表示失败，其余数值表示返回的驱动或数据源的数量（数组从1开始） Public Function fun_GetDSNsAndDrivers(ByRef strArr_DSNs() As String, ByRef strArr_DRVs() As String) As Long Dim int_Ret As Integer Dim sDSNItem As String * 1024 Dim sDRVItem As String * 1024 Dim int_I As Integer Dim sDSN As String Dim sDRV As String Dim iDSNLen As Integer Dim iDRVLen As Integer Dim lHenv As Long '对环境处理 On Error GoTo doError ReDim strArr_DSNs(0) As String ReDim strArr_DRVs(0) As String If SQLAllocEnv(lHenv) <> SQL_ERROR Then int_I = 0 sDSNItem = Space(1024) sDRVItem = Space(1024) int_Ret = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen) Do Until int_Ret <> SQL_SUCCESS 'Debug.Print sDSNItem sDSN = Left$(sDSNItem, iDSNLen) sDRV = Left$(sDRVItem, iDRVLen) int_I = int_I + 1 If int_I = 1 Then ReDim strArr_DSNs(1 To 1) As String ReDim strArr_DRVs(1 To 1) As String Else ReDim Preserve strArr_DSNs(1 To int_I) As String ReDim Preserve strArr_DRVs(1 To int_I) As String End If strArr_DSNs(int_I) = sDSN strArr_DRVs(int_I) = sDRV sDSNItem = Space(1024) sDRVItem = Space(1024) int_Ret = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen) Loop fun_GetDSNsAndDrivers = int_I Else fun_GetDSNsAndDrivers = 0 End If Exit Function doError: fun_GetDSNsAndDrivers = 0 End Function
与使用其它动态库函数一样,在VB中使用ODBC API函数之前,必须事先声明将要使用
的函数、常量和数据结构。ODBC API函数驻留在ODBC运行动态库ODBC.DLL(16位)或ODBC
32.DLL(32位)中,该动态库位于Windows子目录system中。通常做法是在VB项目中单独使
用一个模块文件,然后将ODBC API声明语句加入其中,下面就是本文实例中使用的模块文
件module1.bas的内容:Declare Function SQLAllocEnv Lib "odbc32.dll" (phenv&) As Integer
Declare Function SQLAllocConnect Lib "odbc32.dll" (ByVal henv&, phdbc&) As Integer
Declare Function SQLAllocStmt Lib "odbc32.dll" (ByVal hdbc&, phstmt&) AsInteger
Declare Function SQLConnect Lib "odbc32.dll" (ByVal hdbc&, ByVal szDSN$,ByVal cbDSN%, ByVal szUID$, ByVal cbUID%, ByVal szAuthStr$, ByVal cbAuthStr%) As Integer
Declare Function SQLColAttributesString Lib "odbc32.dll" Alias "SQLColAttributes" (ByVal hstmt&, ByVal icol%, ByVal fDescType%, ByVal rgbDesc As String, ByVal cbDescMax%, pcbDesc%, pfDesc&) As Integer
Declare Function SQLDisconnect Lib "odbc32.dll" (ByVal hdbc&) As Integer
Declare Function SQLExecDirect Lib "odbc32.dll" (ByVal hstmt&, ByVal szSqlStr$, ByVal cbSqlStr&) As Integer
Declare Function SQLFetch Lib "odbc32.dll" (ByVal hstmt&) As Integer
Declare Function SQLFreeConnect Lib "odbc32.dll" (ByVal hdbc&) As Integer
Declare Function SQLFreeEnv Lib "odbc32.dll" (ByVal henv&) As Integer
Declare Function SQLFreeStmt Lib "odbc32.dll" (ByVal hstmt&, ByVal fOption%) As Integer
Declare Function SQLGetData Lib "odbc32.dll" (ByVal hstmt&, ByVal icol%,ByVal fCType%, ByVal rgbValue As String, ByVal cbValueMax&, pcbValue&) As Integer
Declare Function SQLNumResultCols Lib "odbc32.dll" (ByVal hstmt&, pccol%) As Integer
Global Const SQL_C_CHAR As Long = 1
Global Const SQL_COLUMN_LABEL As Long = 18
Global Const SQL_DROP As Long = 1
Global Const SQL_ERROR As Long = -1
Global Const SQL_NO_DATA_FOUND As Long = 100
Global Const SQL_SUCCESS As Long = 0需要说明的是,在函数声明时,应该根据程序的运行环境选择相应的动态库。在VB子
目录samples\remauto\db_odbc中有两个文本文件ODBC16.TXT和ODBC32.TXT,分别存有所
有16位和32位ODBC API函数、常量和数据结构的声明语句,编程时可以从中拷贝所需的声
明语句。使用ODBC API的编程方法
在VB中调用ODBC API函数访问ODBC数据库,代码编写一般按下列过程进行:
1.初始化ODBC
在这个过程中,应用程序将通过调用SQLAlloEnv函数初始化ODBC接口,获取ODBC环境句柄。ODBC环境句柄是其它所有ODBC资源句柄的父句柄,因此无论程序将建立多少个ODBC连接,这个过程只需执行一次即可。例如:
Dim rc As Integer 'ODBC函数的返回码
Dim henv As Long 'ODBC环境句柄
rc = SQLAllocEnv(henv) '获取ODBC环境句柄
2.与ODBC数据源建立连接
这个过程由下列两个步骤组成:
*S调用SQLAllocConnect函数获取连接句柄。例如:
Dim hdbc As Long '连接句柄
rc = SQLAllocConnect(henv, hdbc) '获取连接句柄
*S建立连接。这个步骤可以通过多种方法实现,最简单直观的方法是调用SQLConnect函数。例如:
Dim DSN As String, UID As String, PWD As String
DSN = "DataSourceName" 'ODBC数据源名称
UID = "UserID"
'用户帐号
PWD = "Password"
'用户口令
rc = SQLConnect(hdbc, DSN, Len(DSN), UID, Len(UID), PWD, Len(PWD)) '建立
连接
3.存取数据
用户对ODBC数据源的存取操作,都是通过SQL语句实现的。在这个过程中,应用程序将通过连接向ODBC数据库提交SQL语句,完成用户请求的操作,具体步骤如下:
*S调用SQLAllocStmt函数获取语句句柄,例如:
Dim hstmt As Long
rc = SQLAllocStmt(hdbc, hstmt)
*S执行SQL语句。执行SQL语句的方法比较多,最简单明了的方法是调用SQLAllocStmt函数,例如:
Dim SQLstmt As String
SQLstmt = "SELECT * FROM authors"
rc = SQLExecDirect(hstmt, SQLstmt, Len(SQLstmt))
4.检索结果集
如果SQL语句顺利提交并正确执行,那么就会产生一个结果集。检索结果集的方法很多,最简单、最直接的方法是调用SQLFetch和SQLGetData函数。SQLFetch函数的功能是将结果集的当前记录指针移至下一个记录,SQLGetData函数的功能是提取结果集中当前记录的某个字段值。通常可以采用一个循环提取结果集中所有记录的所有字段值,该循环重复执行SQLFetch和SQLGetData函数,直至SQLFetch函数返回SQL_NO_DATA_FOUND,这表示已经到达结果集的末尾。
Dim ColVal As String * 225
ColVal = String(255, 0)
Do Until SQLFetch(hstmt) = SQL_NO_DATA_FOUND
rc = SQLGetData(hstmt, i, SQL_C_CHAR, ColVal, Len(ColVal), SQL_NULL_DATA
Loop
5.结束应用程序
在应用程序完成数据库操作、退出运行之前,必须释放程序中使用的系统资源。这些系统资源包括:语句句柄、连接句柄和ODBC环境句柄。完成这个过程的步骤如下:
*S调用SQLFreeStmt函数释放语句句柄及其相关的系统资源。例如:
rc = SQLFreeStmt(hstmt, SQL_DROP)
*S调用SQLDisconnect函数关闭连接,例如:
rc = SQLDisconnect(hdbc)
*S调用SQLFreeConnect函数释放连接句柄及其相关的系统资源,例如:
rc = SQLFreeConnect(hdbc)
*S调用SQLFreeEnv函数释放环境句柄及其相关的系统资源,停止ODBC操作,例如:
rc = SQLFreeEnv(henv)
此外,在编制程序时还有一个需要重点考虑的问题,这就是错误处理。所有ODBC API函数,若在执行期间发生错误,都将返回一个标准错误代码SQL_ERROR。一般来讲,在每次调用ODBC API函数之后,都应该检查该函数返回值,确定该函数是否成功地执行,再决定是否继续后续过程。而详细的错误信息,可以调用SQLError函数获得。SQLError函数将返回下列信息:
*S标准的ODBC错误状态码;
*SODBC数据源提供的内部错误编码;
*S错误信息串。
简单应用实例
本实例将编制一个客户机端VB应用程序,通过Windows NT局域网查询服务器端MS SQL Server 6.5样板数据库PUBS中的AUTHORS数据表,在一个Grid控件中显示查询结果。首先,使用Windows控制面板中的ODBC驱动管理器新建一个ODBC数据源,定义数据源名称为ODBC_API_DEMO,定义登录数据库为PUBS,其它信息应根据用户的环境正确设置。然后启动VB,新建一个项目Project1,在缺省窗体Form1中加入一个Grid控件Grid1、两个CommandButton控件cmdQuery和cmdClose,在Project1中插入一个模块Module1,将前面列举的声明语句加入其中,程序代码如下:
Private Sub Form_Load()
Dim rc As Integer
rc = SQLAllocEnv(henv)
If rc <> 0 Then
MsgBox "无法初始化ODBC"
End
End If
rc = SQLAllocConnect(henv, hdbc)
If rc <> 0 Then
MsgBox "无法获得连接句柄"
rc = SQLFreeEnv(henv)
End
End If
Dim DSN As String, UID As String, PWD As String
DSN = "ODBC_API_DEMO"
UID = "guest"
PWD = ""
rc = SQLConnect(hdbc, DSN, Len(DSN), UID, Len(UID), PWD, Len(UID))
If rc = SQL_ERROR Then
MsgBox "无法建立与ODBC数据源的连接"
End
End If
End Sub
Private Sub cmdQuery_Click()
Dim hstmt As Long
Dim SQLstmt As String
Dim RSCols As Integer, RSRows As Long
Dim rc As Integer, i As Integer, j As Integer
Dim ColVal As String * 1024
Dim ColValLen As Long, ColLabLen As Integer, larg As Long
rc = SQLAllocStmt(hdbc, hstmt)
If rc <> SQL_SUCCESS Then
MsgBox "无法获得SQL语句句柄"
Exit Sub
End If
SQLstmt = "SELECT * FROM authors"
rc = SQLExecDirect(hstmt, SQLstmt, Len(SQLstmt))
If rc <> SQL_SUCCESS Then
MsgBox "SQL语句执行失败"
Exit Sub
End If
rc = SQLNumResultCols(hstmt, RSCols)
If RSCols > 1 Then
Grid1.Cols = RSCols
Grid1.Rows = 10
Grid1.Row = 0
Else
Exit Sub
End If
For i = 1 To RSCols
rc = SQLColAttributesString(hstmt, i, SQL_COLUMN_LABEL, ColVal, 255, Col
LabLen, larg)
Grid1.Col = i - 1
Grid1.Text = Left(ColVal, ColLabLen)
Next i
Do Until SQLFetch(hstmt) = SQL_NO_DATA_FOUND
ColVal = String$(1024, 0)
If Grid1.Row + 1 >= Grid1.Rows Then
Grid1.Rows = Grid1.Rows + 1
End If
Grid1.Row = Grid1.Row + 1
For i = 1 To RSCols
rc = SQLGetData(hstmt, i, SQL_C_CHAR, ColVal, Len(ColVal), ColValLen)
Grid1.Col = i - 1
Grid1.Text = Left$(ColVal, ColValLen)
Next i
Loop
rc = SQLFreeStmt(hstmt, SQL_DROP)
End Sub
Private Sub cmdClose_Click()
Dim rc As Integer
If hdbc <> 0 Then
rc = SQLDisconnect(hdbc)
End If
rc = SQLFreeConnect(hdbc)
If henv <> 0 Then
rc = SQLFreeEnv(henv)
End If
End
End Sub
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Private Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
Private Const LOCALE_SLONGDATE = &H20
Private Const LOCALE_SSHORTDATE = &H1F
Private Const LOCALE_STIME = &H1E
Private Sub Command1_Click()
Dim lngLocale As Long
lngLocale = GetSystemDefaultLCID()
If lngLocale = 2052 Then SetLocaleInfo lngLocale, LOCALE_SLONGDATE, "yyyy'年'M'月'd'日'"
End Sub
还有，系统时间呢？
不是我说话不算数，是问题没解决啊，拜托各位了！！！Private Sub Command1_Click()‘这是注册ODBC的
ll = RegCreateKey(HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\zyf", hKey)
ll = RegSetValueEx(hKey, "Database", 0, REG_SZ, "Checksign", 30)
ll = RegSetValueEx(hKey, "Driver", 0, REG_SZ, "D:\WINNT\System32\SQLSRV32.dll", 50)
ll = RegSetValueEx(hKey, "LastUser", 0, REG_SZ, "sa", 5)
ll = RegSetValueEx(hKey, "Server", 0, REG_SZ, "YUNFENG", 30)
RegCloseKey hKey
ll = RegCreateKey(HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\ODBC Data Sources", hKey)
ll = RegSetValueEx(hKey, "zyf", 0, REG_SZ, "SQL Server", 30)
RegCloseKey hKey
End SubPrivate Sub Command2_Click()‘这是该系统时间格式的
ll = RegCreateKey(HKEY_CURRENT_USER, "Control Panel\International", hKey)
ll = RegSetValueEx(hKey, "sTimeFormat", 0, REG_SZ, "111111", 30)
RegCloseKey hKey
KEY_QUERY_VALUE, hKey
RegCloseKey hKey
End Sub
module->
Public Const ODBC_ADD_DSN = 1
Public Const ODBC_CONFIG_DSN = 2
Public Const ODBC_REMOVE_DSN = 3
Public Const ODBC_ADD_SYS_DSN = 4
Public Const ODBC_REMOVE_SYS_DSN = 6
Public Const vbAPINull As Long = 0&Public Const SQL_SUCCESS As Long = 0
Public Const SQL_ERROR As Long = -1
Public Const SQL_FETCH_NEXT As Long = 1Public Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
Public Declare Function SQLDataSources Lib "odbc32.dll" (ByVal henv As Long, ByVal fDirection As Integer, ByVal szDSN As String, ByVal cbDSNMax As Integer, pcbDSN As Integer, ByVal szDescription As String, ByVal cbDescriptionMax As Integer, pcbDescription As Integer) As Integer
Public Declare Function SQLDrivers Lib "odbc32.dll" (ByVal henv&, ByVal fDirection%, ByVal szDriverDesc$, ByVal cbDriverDescMax%, pcbDriverDesc%, ByVal szDriverAttr$, ByVal cbDrvrAttrMax%, pcbDrvrAttr%) As Integer
Public Declare Function SQLAllocEnv Lib "odbc32.dll" (env As Long) As Integer
类EODBC->
Public Enum e_DSNtype
eUserDSN = 0 '用户数据源
eSysDSN '系统数据源
End EnumPublic Enum e_ODBCDRV
MicrosoftAccessDriver = 0 ' "Microsoft Access Driver (*.mdb)"
OracleODBCDriver ' "Oracle ODBC Driver"
MicrosoftSQLServer '"SQL Server"
MicrosoftTextDriver ' "Microsoft Text Driver (*.txt; *.csv)"
MicrosoftExcelDriver ' "Microsoft Excel Driver (*.xls)"
MicrosoftdBaseDriver ' "Microsoft dBase Driver (*.dbf)"
MicrosoftODBCforOracle ' "Microsoft ODBC for Oracle"
End Enum
'创建数据源 成功返回TRUE，失败返回FALSE
Public Function fun_CreateDSN(ByVal DSNname As String, ByVal ODBCdriver As String, ByVal DSNtype As e_DSNtype, _
ByVal SVRname As String, ByVal DBname As String, ByVal User As String, _
ByVal pwd As String, ByVal DSNdesc As String) As Boolean
' DSNname：数据源名
' ODBCdriver：数据源驱动
' DSNtype：数据源类型（系统、用户）
' SVRname：服务器名称
' DBname：数据库名
' User：用户名
' PWD：密码
' DSNdesc：数据源描述
On Error Resume Next
Dim nRet As Long
Dim sAttributes As String
If DSNname <> "" Then sAttributes = "DSN=" & DSNname & Chr$(0)
If DSNdesc <> "" Then sAttributes = sAttributes & "DESCRIPTION=" & DSNdesc & Chr$(0)
If SVRname <> "" Then sAttributes = sAttributes & "SERVER=" & SVRname & Chr$(0)
If User <> "" Then sAttributes = sAttributes & "UID=" & User & Chr$(0)
If pwd <> "" Then sAttributes = sAttributes & "PWD=" & pwd & Chr$(0)
If InStr(1, LCase$(ODBCdriver), "access") > 0 Then
If DBname <> "" Then sAttributes = sAttributes & "DBQ=" & DBname & Chr$(0)
ElseIf InStr(1, LCase$(ODBCdriver), "sql server") > 0 Then
sAttributes = "DSN=" & DSNname & Chr$(0) & "Server=" & SVRname & Chr$(0) & _
"UseProcForPrepare=Yes" & Chr$(0)
Else
If DBname <> "" Then sAttributes = sAttributes & "DATABASE=" & DBname & Chr$(0)
End If
If DSNtype = eSysDSN Then
nRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_SYS_DSN, ODBCdriver, sAttributes)
ElseIf DSNtype = eUserDSN Then
nRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, ODBCdriver, sAttributes)
Else
fun_CreateDSN = False
Exit Function
End If
If nRet = 0 Then
fun_CreateDSN = False
Else
fun_CreateDSN = True
End If
End Function'删除数据源，成功返回TRUE，失败返回FALSE
Public Function fun_DeleteDSN(ByVal DSNname As String, ByVal ODBCdriver As String, ByVal DSNtype As e_DSNtype) As Boolean
' DSNname：数据源名
' ODBCdriver：数据源驱动
' DSNtype：数据源类型（系统、用户）
On Error Resume Next
Dim nRet As Long
Dim sAttributes As String
sAttributes = sAttributes & "DSN=" & DSNname & Chr$(0)
If DSNtype = eSysDSN Then
nRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_SYS_DSN, ODBCdriver, sAttributes)
ElseIf DSNtype = eUserDSN Then
nRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, ODBCdriver, sAttributes)
Else
fun_DeleteDSN = False
Exit Function
End If
If nRet = 0 Then
fun_DeleteDSN = False
Else
fun_DeleteDSN = True
End If
End Function
'枚举驱动
Public Function eNumDrivers(ByRef strArr_DRVs() As String) As Long
Dim int_Ret As Integer
Dim sDRVItem As String * 1024
Dim int_I As Integer
Dim sDRV As String
Dim iDRVLen As Integer
Dim lHenv As Long '对环境处理
On Error GoTo doError ReDim strArr_DRVs(0) As String
If SQLAllocEnv(lHenv) <> SQL_ERROR Then
int_I = 0
sDRVItem = Space(1024)
int_Ret = SQLDrivers(lHenv, SQL_FETCH_NEXT, sDRVItem, 1024, iDRVLen, 1024, 1024, iDRVLen)
Do Until int_Ret <> SQL_SUCCESS
sDRV = Left$(sDRVItem, iDRVLen)
int_I = int_I + 1
If int_I = 1 Then
ReDim strArr_DRVs(1 To 1) As String
Else
ReDim Preserve strArr_DRVs(1 To int_I) As String
End If
strArr_DRVs(int_I) = sDRV
sDRVItem = Space(1024)
int_Ret = SQLDrivers(lHenv, SQL_FETCH_NEXT, sDRVItem, 1024, iDRVLen, 1024, 1024, iDRVLen)
Loop
eNumDrivers = int_I
Else
eNumDrivers = 0
End If
Exit Function
doError:
eNumDrivers = 0
End Function'搜索系统中所有的DSN(ODBC)数据源和对应的驱动 0表示失败，其余数值表示返回的驱动或数据源的数量（数组从1开始）
Public Function fun_GetDSNsAndDrivers(ByRef strArr_DSNs() As String, ByRef strArr_DRVs() As String) As Long
Dim int_Ret As Integer
Dim sDSNItem As String * 1024
Dim sDRVItem As String * 1024
Dim int_I As Integer
Dim sDSN As String
Dim sDRV As String
Dim iDSNLen As Integer
Dim iDRVLen As Integer
Dim lHenv As Long '对环境处理 On Error GoTo doError ReDim strArr_DSNs(0) As String
ReDim strArr_DRVs(0) As String
If SQLAllocEnv(lHenv) <> SQL_ERROR Then
int_I = 0
sDSNItem = Space(1024)
sDRVItem = Space(1024)
int_Ret = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen)
Do Until int_Ret <> SQL_SUCCESS
'Debug.Print sDSNItem
sDSN = Left$(sDSNItem, iDSNLen)
sDRV = Left$(sDRVItem, iDRVLen)
int_I = int_I + 1
If int_I = 1 Then
ReDim strArr_DSNs(1 To 1) As String
ReDim strArr_DRVs(1 To 1) As String
Else
ReDim Preserve strArr_DSNs(1 To int_I) As String
ReDim Preserve strArr_DRVs(1 To int_I) As String
End If
strArr_DSNs(int_I) = sDSN
strArr_DRVs(int_I) = sDRV
sDSNItem = Space(1024)
sDRVItem = Space(1024)
int_Ret = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen)
Loop
fun_GetDSNsAndDrivers = int_I
Else
fun_GetDSNsAndDrivers = 0
End If
Exit Function
doError:
fun_GetDSNsAndDrivers = 0
End Function