modpub.bas

在线图书馆系统 包括VB程序设计的后台与ASP的网页

Attribute VB_Name = "ModPub"
Public ConnString As String
Public cnString As String
Public Login As Boolean
Public OperatorId As String
Public OperatorPass As String
Public OK As Boolean
Public SF As Boolean
Public Connstr As String
Public FirstEnter As Boolean
Public ReaderID As String
Public OperatorPopedom As String  ' 操作员权限
'ODBC API 声明
Global giHEnv As Long
Global giHDB As Long
Global giHStmt As Long
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&) As Integer
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
Declare Function SQLDriverConnect Lib "odbc32.dll" (ByVal hdbc&, ByVal hWnd As Long, ByVal szCSIn$, ByVal cbCSIn%, ByVal szCSOut$, ByVal cbCSMax%, cbCSOut%, ByVal fDrvrComp%) As Integer
 Declare Function SQLBrowseConnect Lib "odbc32.dll" (ByVal hdbc&, ByVal szConnStrIn$, ByVal cbConnStrIn%, ByVal szConnStrOut$, ByVal cbConnStrOutMax%, pcbConnStrOut%) 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


Public rc As Long '注释：ODBC函数的返回码
Public henv As Long '注释：ODBC环境句柄
Public hdbc As Long


Declare Function SQLError Lib "odbc32.dll" (ByVal henv&, ByVal hdbc&, ByVal hstmt&, ByVal szSqlState$, pfNativeError&, ByVal szErrorMsg$, ByVal cbErrorMsgMax%, pcbErrorMsg%) As Integer


Sub Main()
    '使用非DSN连接到数据库
    ConnString = "Driver={SQLServer};Server=(local);UID=DLuser;PWD=;Database=DigitalLibrary"
    '使用本地的SQLOLEDB连接到数据库
    Connstr = "Provider=MSDASQL.1;Persist Security Info=False;User ID=Dluser;Data Source=DLA"
    '使用DSN连接到数据库
    cnString = "DSN=DLA;Database=DigitalLibrary;UID=DLuser;PWD=;"
    Login = False
    
    
    Dim fLogin As New FrmLogin
    fLogin.Show vbModal
    If OK = False Then
        'Login Failed so exit app
        End
    End If
    Unload fLogin
    
    Set fMainForm = New FrmMain
    fMainForm.Show

'    Set frmT = New FrmBookSort
'    frmT.Show
End Sub

'按下回车键来进入下一文本框,可提高录入速度
'Keyasc用来保存当前按键，SendKeys函数用来指定按键。将返回Tab键，下一个控件自动获得输入焦点
Public Sub EnterToTab(Keyasc As Integer)
    '判断是否为回车键
    If Keyasc = 13 Then
        '转换成Tab键
        SendKeys "{TAB}"
    End If
End Sub

'执行SQL并返回记录集对象
Public Function ExecuteSQL(ByVal sql As String, MsgStr As String) As ADODB.Recordset
    '声明一个连接
    Dim cnn As ADODB.Connection
    '声明一个记录集对象
    Dim rst As ADODB.Recordset
    Dim sTokens() As String
    
    '异常处理
    On Error GoTo ExecuteSQL_Error
    '分解字符串并存入数组
    sTokens = Split(sql)
    
    '建立连接
    Set cnn = New ADODB.Connection
    
    '打开连接
    cnn.Open cnString
    
    '判断查询语句关键字
    If InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then
        '执行查询语句
        cnn.Execute sql
        MsgStr = sTokens(0) & " query successful"
    Else
        Set rst = New ADODB.Recordset
        rst.Open Trim$(sql), cnn, adOpenKeyset, adLockOptimistic
        '返回记录集对象
        Set ExecuteSQL = rst
        MsgStr = "查询到" & rst.RecordCount & "条记录"
    End If
ExecuteSQL_Exit:
    Set rst = Nothing
    Set cnn = Nothing
    Exit Function
ExecuteSQL_Error:
    MsgStr = "错误:" & Err.Description
    Resume ExecuteSQL_Exit
End Function