module1.bas

这是我们公司的题库管理系统

Attribute VB_Name = "Module1"
Public fMainForm As frmMain
Public cnn As adodb.Connection
Public rs As adodb.Recordset
Public sConnect As String
Public sSQL As String
Public exploreColName, exploreRowName As String   '用于题库浏览
Public addSuperCategoryId As String
'Public argName As String    '用于参数设置
Public testId As Integer   '用于frmTestVerify
Public userName As String
Public userPW As String
Public userGroupId As Integer

Public userNameEditable As Boolean  '用于决定添加或编辑用户时用户名是否可编辑

Public categoryId As Integer    ' Is decided when log on

Public searchItemId As Integer    '用于显示检索结果的单个试题

Public verifyCategory As Integer
Public verifyStatus As String
Public verifyTypeId As String
Public verifyLevelId As String
Public verifyTargetId As String
Public ifFromSearch As Boolean     '用于对检索结果试题进行审核用
Public searchMethod As Integer

Sub Main()
    
    'sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Password='';User ID=Admin;Data Source=" & App.Path & "\itempool.mdb;Mode=Share Deny None;Extended Properties='';Jet OLEDB:System database='';Jet OLEDB:Registry Path='';Jet OLEDB:Database Password='wfitempool';Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password='';Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"
    sConnect = "DSN=weifang;UID=wfitempool;PWD=wfitempool"
    Dim fSplash As New frmSplash
    fSplash.Show vbModal
    If Not fSplash.OK Then
        '登录失败，退出应用程序
        End
    End If
    Unload fSplash
    Set fMainForm = New frmMain
    Load fMainForm
    fMainForm.Show
    
    searchItemId = -1  '确保试题制作界面的正常显示
End Sub



Sub LoadResStrings(frm As Form)
    On Error Resume Next


    Dim ctl As Control
    Dim obj As Object
    Dim fnt As Object
    Dim sCtlType As String
    Dim nVal As Integer


    '设置窗体的 caption 属性
    frm.Caption = LoadResString(CInt(frm.Tag))
    

    '设置字体
    Set fnt = frm.Font
    fnt.Name = LoadResString(20)
    fnt.Size = CInt(LoadResString(21))
    

    '设置控件的标题，对菜单项使用 caption 属性并对所有其他控件使用 Tag 属性
    For Each ctl In frm.Controls
        Set ctl.Font = fnt
        sCtlType = TypeName(ctl)
        If sCtlType = "Label" Then
            ctl.Caption = LoadResString(CInt(ctl.Tag))
        ElseIf sCtlType = "Menu" Then
            ctl.Caption = LoadResString(CInt(ctl.Caption))
        ElseIf sCtlType = "TabStrip" Then
            For Each obj In ctl.Tabs
                obj.Caption = LoadResString(CInt(obj.Tag))
                obj.ToolTipText = LoadResString(CInt(obj.ToolTipText))
            Next
        ElseIf sCtlType = "Toolbar" Then
            For Each obj In ctl.Buttons
                obj.ToolTipText = LoadResString(CInt(obj.ToolTipText))
            Next
        ElseIf sCtlType = "ListView" Then
            For Each obj In ctl.ColumnHeaders
                obj.Text = LoadResString(CInt(obj.Tag))
            Next
        Else
            nVal = 0
            nVal = Val(ctl.Tag)
            If nVal > 0 Then ctl.Caption = LoadResString(nVal)
            nVal = 0
            nVal = Val(ctl.ToolTipText)
            If nVal > 0 Then ctl.ToolTipText = LoadResString(nVal)
        End If
    Next


End Sub


Function getSuperId(ByVal argId As Integer) As Integer
    Dim idCnn As adodb.Connection
    Dim idRS As adodb.Recordset
    Dim idSQL As String
    
    idSQL = "select * from CATEGORIES where CATEGORY_ID = " & argId
    Set idCnn = New Connection
    idCnn.Open sConnect
    Set idRS = New Recordset
    idRS.CursorLocation = adUseClient
    idRS.Open idSQL, idCnn, adOpenForwardOnly, adLockReadOnly

    getSuperId = idRS!SUPER_CATEGORY_ID

    idRS.Close
    Set idRS = Nothing
    idCnn.Close
    Set idCnn = Nothing
    
End Function

Function idToNum(ByVal argId As Integer) As String
    Dim idCnn As adodb.Connection
    Dim idRS As adodb.Recordset
    Dim idSQL As String
    
    idSQL = "select * from CATEGORIES where CATEGORY_ID = " & argId
    Set idCnn = New Connection
    idCnn.Open sConnect
    Set idRS = New Recordset
    idRS.CursorLocation = adUseClient
    idRS.Open idSQL, idCnn, adOpenForwardOnly, adLockReadOnly

    idToNum = idRS!NUM

    idRS.Close
    Set idRS = Nothing
    idCnn.Close
    Set idCnn = Nothing
    
End Function