starmodule.bas

一个功能强大、程序条理分明的学生学籍管理系统

Attribute VB_Name = "StarModule"
Option Explicit
'定义字符串常量，用来在注册表中创建该项目的主键
Public Const REGSUBKEY = "Software\学生管理系统"

'一下三个公用变量用来存放数据库的信息，在程序中，这三个值主要通过
'读取注册表获得。这三个变量可以用来登录数据库
Public mOdbcAlias As String
Public mDbUser As String
Public mDbPsw As String

'一下两个变量分别是判断是否登录数据库成功的变量
'和一个链接数据库的对象变量
Public blnConnected As Boolean
Public gcnnConnection As ADODB.Connection

'传送公共变量dbUser和usrPsw，系统用户和密码。在未来的程序中用得到
Public dbUser As String
Public usrPsw As String
'定义用户权限级别
Public strUsrLevel As String

Public Const BLOCKSIZE = 4096   '读写数据库大文件所用

Function GetFileData(ByVal strPath As String, ByRef byteArray() As Byte) As Boolean
    Dim hFileHandle
    
    ReDim byteArray(FileLen(strPath))
    hFileHandle = FreeFile
    Open strPath For Binary Access Read Lock Write As #hFileHandle
    Get #hFileHandle, , byteArray
    GetFileData = True
    Close #hFileHandle
End Function

Function SaveToFile(ByVal strPath As String, ByRef varData() As Byte) As Boolean
    Dim hFileHandle As Long
    
    hFileHandle = FreeFile
    Open strPath For Binary Access Write Lock Write As #hFileHandle
    Put #hFileHandle, , varData
    Close #hFileHandle
    SaveToFile = True
End Function

Public Sub oldGetFromDB(ByRef PFld As ADODB.Field, ByRef DiskFile As String)
'功    能：ADO 2.0的保存数据库中的图片等文件到磁盘文件
'参    数：
'     输入：PFld            ADODB.Field     要读取的数据库字段
'           DiskFile        String         要保存的文件路径

    Dim varData() As Byte '定义数据块数组
    
    On Error GoTo err:
    
    varData = PFld.GetChunk(PFld.ActualSize)
    
    If DiskFile <> vbNullString Then
        SaveToFile DiskFile, varData
    End If
    
err:
    MsgBox err.Number & " " & err.Description
End Sub

Public Sub oldSaveToDB(ByRef fld As ADODB.Field, DiskFile As String)
'功    能：ADO 2.0的保存图片等文件到数据库
'参    数：
'     输入：Fld            ADODB.Field     要写入的数据库字段
'           DiskFile        String         文件的原始路径
    
    Dim varArray() As Byte
    On Error GoTo err:
    
    If DiskFile <> vbNullString Then
        If GetFileData(DiskFile, varArray()) Then
            fld.AppendChunk varArray
        End If
    End If
    
err:
    MsgBox err.Number & " " & err.Description
End Sub

'**********************************************************
'功能：ADO 2.5的保存图片等文件到数据库,利用Stream
'输入：
'     Fld            ADODB.Field     要写入的数据库字段
'     DiskFile       String         文件的原始路径
'输出： 无
'***********************************************************
Public Sub newSaveToDB(ByRef fld As ADODB.Field, DiskFile As String)
    '定义一个ADODB流对象，用来存取图片对象
    Dim mStream As ADODB.Stream
    
    Set mStream = New ADODB.Stream
    '设置流的类型为二进制型
    mStream.Type = adTypeBinary
    mStream.Open
    
    If DiskFile <> vbNullString Then
        '从磁盘文件读取一个二进制文件
        mStream.LoadFromFile DiskFile
        '通过存放二进制文件的流，将二进制文件写入数据库字段
        fld = mStream.Read
    End If
    
    mStream.Close
    Set mStream = Nothing
End Sub

'**********************************************************
'功能：ADO 2.5中利用Stream，将数据库中存放的图片文件存放到磁盘
'输入：
'     Fld            ADODB.Field     要读取的数据库字段
'     DiskFile       String         文件的目的路径
'输出： 无
'***********************************************************
Public Sub newGetFromDB(ByVal PFld As ADODB.Field, ByVal DiskFile As String)
    Dim mStream As ADODB.Stream
    
    Set mStream = New ADODB.Stream
    mStream.Type = adTypeBinary
    mStream.Open
    
    If DiskFile <> vbNullString Then
        '将数据库字段中的图片文件等写入到流中
        mStream.Write PFld
        '将流中的图片文件存储到磁盘文件，存放磁盘文件的方式是创造或覆盖
        mStream.SaveToFile DiskFile, adSaveCreateOverWrite
    End If
    
    mStream.Close
    Set mStream = Nothing
End Sub

'*******************************************************************
'功能：连接数据库并执行判断是否连接成功
'输入：
'   cnnConnection      ADODB.Connection   要创建的连接
'输出：gADOConnection     Boolean             返回的判断结果
'********************************************************************
Public Function gADOConnection(ByRef cnnConnection As ADODB.Connection) As Boolean
    Dim itsConnectionString As String
    Dim lngErrNum As Long
    
    On Error GoTo ADOErr
    
    '链接字符串，利用读自注册表的数据库信息
    itsConnectionString = "DSN=" & mOdbcAlias & "; User ID=" & mDbUser & _
        "; Password=" & mDbPsw
    cnnConnection.ConnectionString = itsConnectionString
    cnnConnection.CursorLocation = adUseClient
    cnnConnection.Open
    gADOConnection = True
    
ADOErr:
    lngErrNum = err.Number
    If lngErrNum <> 0 Then
        gADOConnection = False
    End If
End Function

'******************************************************************
'功能：获取ADO记录集
'输入：
'   strSQL        String     用于查询SQL数据库的SQL语句
'输出： GetRecordSet  Recordset  返回的记录集
'*******************************************************************
Public Function GetRecordSet(strSql As String) As ADODB.Recordset
    On Error GoTo err
    Dim rsTemp As ADODB.Recordset
    Set rsTemp = New ADODB.Recordset
    
    Set gcnnConnection = New ADODB.Connection
    
    blnConnected = gADOConnection(gcnnConnection)
    
    If blnConnected = True Then
        '设置游标类型和数据库锁定类型
        rsTemp.CursorType = adOpenKeyset
        rsTemp.LockType = adLockOptimistic
        rsTemp.source = strSql
        Set rsTemp.ActiveConnection = gcnnConnection
        rsTemp.Open
        
        Set GetRecordSet = rsTemp
    Else
        Set GetRecordSet = Nothing
    End If
    Exit Function
err:
    MsgBox err.Number & " " & err.Description
End Function

Public Function GetCommand(strSql As String) As ADODB.Command
'功    能：获取ADO命令对象
'参    数：
'          输入： strSQL        String     用于查询SQL数据库的SQL语句
'          输出： GetCommand    Command    返回的命令对象
    Dim cmdTemp As ADODB.Command
    Set cmdTemp = New ADODB.Command
    Set gcnnConnection = New ADODB.Connection
    
    '函数不带括号，也可以采用如下语句的写法
    gADOConnection gcnnConnection
    
    cmdTemp.ActiveConnection = gcnnConnection
    cmdTemp.CommandText = strSql
    cmdTemp.CommandType = adCmdText
    
    Set GetCommand = cmdTemp
    
End Function

Public Sub Main()
    '定义标志变量，用来检测读取注册表是否成功
    Dim flag As Long
        
    flag = 0
    
    Set gcnnConnection = New ADODB.Connection
    
    '检测注册表中是否存在子键Public Const REGSUBKEY = "Software\学生管理系统"
    flag = CheckKey(HKEY_CURRENT_USER, REGSUBKEY)
   
    '如果检测到子键，那么就分别读取该键中的键值，为链接数据库所用
    If flag = 0 Then
        mOdbcAlias = GetValue(HKEY_CURRENT_USER, REGSUBKEY, _
            "ODBCAlias", REG_SZ)
        mDbUser = GetValue(HKEY_CURRENT_USER, REGSUBKEY, _
            "User", REG_SZ)
        mDbPsw = GetValue(HKEY_CURRENT_USER, REGSUBKEY, _
            "Password", REG_SZ)
            
        '创建到数据库的链接，链接成功则返回True，同时，
        '传址方式的参数，将改变链接对象gcnnConnection
        '在以后的程序中，该公共链接对象可用
        blnConnected = gADOConnection(gcnnConnection)
        
        '数据库链接通过，则出现系统登录窗口
        If (blnConnected = True) Then
            Load frmPsw
            frmPsw.Show
        Else '登录数据库失败，则显示配置数据库窗口
            Load frmDBInfo
            frmDBInfo.Show
        End If
    Else
        '如果没有检测到键值，则打开ODBC设置窗体，进行新的配置
        If (flag <> 0) Then
            Load frmDBInfo
            frmDBInfo.Show
        Else
            MsgBox "注册表创建失败！"
        End If
    End If
End Sub