const.bas

煤炭销售管理系统.完成煤炭销售的日常管理工作,和重车计量系统空车计量系统配合使用.

Attribute VB_Name = "Const"
'数据库访问常量
Public Const SQL_C_CHAR As Long = 1
Public Const SQL_COLUMN_LABEL As Long = 18
Public Const SQL_DROP As Long = 1
Public Const SQL_DRROR As Long = -1
Public Const SQL_NO_DATA_FOUND As Long = 100
Public Const SQL_SUCCESS As Long = 0
Public Const SQL_SUCCESS_WITH_INFO As Long = 1
Public Const SQL_ATTR_MAX_LENGTH As Long = 100
'数据源信息常量
Public DATABASE As String
Public DSN As String
Public DB_USER_NAME As String
Public DB_PASSWORD As String
 '一次执行connect操作可以访问数据库的次数
Public Const CONNECT_LOOP_MAX = 10


Public cn As ADODB.Connection
Public rest As ADODB.Recordset

'== 声明odbc32.dll中定义的ODBC API函数 ==
Public Declare Function SQLAllocEnv Lib "odbc32.dll" (phenv&) As Integer
Public Declare Function SQLAllocConnect Lib "odbc32.dll" (ByVal Henv&, phdbcd&) As Integer
Public Declare Function SQLAllocStmt Lib "odbc32.dll" (ByVal Hdbc&, phstmt&) As Integer
Public Declare Function SQLConnect Lib "odbc32.dll" (ByVal Hdbc&, ByVal szDSN$, _
ByVal cbDSN%, ByVal szUID$, ByVal cbUID%, ByVal szPWD$, ByVal cbPWD%) As Integer
Public Declare Function SQLColAttributes Lib "odbc32.dll" (ByVal Hstmt&, ByVal icol%, _
ByVal fDescType%, ByVal rgbDesc As String, ByVal cbDescMax%, pcbDesc%, pfDesc&) As Integer
Public Declare Function SQLDisconnect Lib "odbc32.dll" (ByVal Hdbc&) As Integer
Public Declare Function SQLExecDirect Lib "odbc32.dll" (ByVal Hstmt&, ByVal szSqlStr$, _
ByVal cbSqStr&) As Integer
Public Declare Function SQLFetch Lib "odbc32.dll" (ByVal Hstmt&) As Integer
Public Declare Function SQLFreeConnect Lib "odbc32.dll" (ByVal Hdbc&) As Integer
Public Declare Function SQLFreeEnv Lib "odbc32.dll" (ByVal Henv&) As Integer
Public Declare Function SQLFreeStmt Lib "odbc32.dll" (ByVal Hstmt&, ByVal fOption%) As Integer
Public Declare Function SQLGetData Lib "odbc32.dll" (ByVal Hstmt&, ByVal icol%, ByVal fCType%, _
ByVal rgbValue As String, ByVal cbValueMax&, pcbValue%) As Integer
Public Declare Function SQLNumResultCols Lib "odbc32.dll" (ByVal Hstmt&, pccol%) As Integer
Public Declare Function SQLGetDiagRec Lib "odbc32.dll" (ByVal HandleType%, ByVal Handle&, _
ByVal RecNumber%, Sqlstate%, NativeErrorPtr%, MessageText As String, _
ByVal Bufferlenchgth%, TextlenchgthPtr%)
'== 标记数据库是否连接 ==
Private IsConnect As Boolean
'== 标记执行Connect()函数后，访问数据库的次数 ==
Private Connect_Num As Integer
Private Henv As Long     '环境句柄
Private Hdbc As Long     '连接句柄
Private Rc As Long
Public Hstmt As Long
Dim rdoCn As New rdoConnection
Dim rdoCn2 As New rdoConnection
Dim rdoQy As New rdoQuery
Dim rdoRs As rdoResultset
Dim rdoCol As rdoColumn
Dim rdoEn As rdoEnvironment

Public Function DB_Connect1(ByVal Connectstr As String) As Boolean
 On Error GoTo chd
  Set rdoEn = rdoEnvironments(0)

With rdoCn
    .Connect = Connectstr
    .LoginTimeout = 5
    .EstablishConnection rdDriverNoPrompt, True
    rdoEn.rdoConnections.Add rdoCn
    DB_Connect1 = True
End With
Exit Function
chd:
 MsgBox "数据库连接执行失败", , "数据库配置错误"
End Function