module1.bas

The crystallize of the initial study, one class examination system of calculator, everyone gives ord

Attribute VB_Name = "Module1"
'====================================

'Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
                ByVal lpoperation As String, ByVal lpfile As String, ByVal lpparameters As String, _
                ByVal lpdirectory As String, ByVal nshowcmd As Long) As Long
'====================================
'Windows API,取得指定窗口的菜单的句柄
'====================================

Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

'====================================
'Windows API,删除指定的菜单条目
'====================================

Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

'====================================
'Windows API中用到的系统常量
'====================================

Private Const MF_BYCOMMAND = &H0
Private Const MF_BYPOSITION = &H400
Private Const MF_REMOVE = &H1000&
Private Const SC_CLOSE = &HF060
Private Const SC_MAXIMIZE = &HF030
Private Const SC_MINIMIZE = &HF020
'====================================
'文件属性常量
'====================================
                
Type ksinfo
    zkzh As String
    name As String
    danxcj As Integer
    duoxcj As Integer
    dazicj As Integer
    windowscj As Integer
    excelcj As Integer
    ppcj As Integer
    time As String
End Type
'====================================
'考试信息
'====================================

Type stinfo
    st_no As String
    st_lr As String
    st_item1 As String
    st_item2 As String
    st_item3 As String
    st_item4 As String
    st_da As String
    ksda As String
    st_hj As String
    st_dal As String
    st_comment As String
    PointID As String
    Nd As String
    Syn As String
End Type
'====================================
'试题信息
'====================================


Type stinfo1
    st_no As String
    st_lr As String
    st_item1 As String
    st_item2 As String
    st_item3 As String
    st_item4 As String
    st_da As String
    ksda As String
    st_hj As String
    st_dal As String
    st_comment As String
    PointID As String
    Nd As String
    Syn As String
End Type

Type stinfo2
    st_no As String
    st_lr As String
    st_item1 As String
    st_item2 As String
    st_item3 As String
    st_item4 As String
    st_da As String
    ksda As String
    st_hj As String
    st_dal As String
    st_comment As String
    PointID As String
    Nd As String
    Syn As String
End Type

Type stinfo3
    st_no As String
    st_lr As String
    st_item1 As String
    st_item2 As String
    st_item3 As String
    st_item4 As String
    st_da As String
    ksda As String
    st_hj As String
    st_dal As String
    st_comment As String
    PointID As String
    Nd As String
    Syn As String
End Type

Type stinfo4
    st_no As String
    st_lr As String
    st_item1 As String
    st_item2 As String
    st_item3 As String
    st_item4 As String
    st_da As String
    ksda As String
    st_hj As String
    st_dal As String
    st_comment As String
    PointID As String
    Nd As String
    Syn As String
End Type

Type stinfo5
    st_no As String
    st_lr As String
    st_item1 As String
    st_item2 As String
    st_item3 As String
    st_item4 As String
    st_da As String
    ksda As String
    st_hj As String
    st_dal As String
    st_comment As String
    PointID As String
    Nd As String
    Syn As String
End Type



Public q As Integer


Public kschange As ksinfo
Public stchange As stinfo
Public st1change As stinfo1
Public st2change As stinfo2
Public st3change As stinfo3
Public st4change As stinfo4
Public st5change As stinfo5
Public cnn As ADODB.Connection
Public cnn1 As ADODB.Connection
Public cnn2 As ADODB.Connection
Public cmm As ADODB.Command
Public rs As ADODB.Recordset
Public rs1 As ADODB.Recordset
Public rs2 As ADODB.Recordset
Public strcnn As String
Public strcnn1 As String
Public dzcount As Integer
Public i As Integer
Public j As Integer
Public table As String                                          '表名称
Public update As String                                         '更新单选和多选项在form1和form3中的option1，check1用

'====================================
'使窗口右上角的关闭按钮无效
'====================================

Public Sub subCloseDisable(lhandle As Long)

    Dim lWndMenu As Long                                        '定义菜单的句柄
    lWndMenu = GetSystemMenu(lhandle, 0)                        '得到系统菜单的句柄
    RemoveMenu lWndMenu, SC_CLOSE, MF_REMOVE Or MF_BYCOMMAND    '移去"关闭"按钮项

End Sub

'====================================
'窗体右上角的最大化按钮无效
'====================================

Public Sub subMaxDisable(lhandle As Long)

    Dim lWndMenu As Long                                        '定义菜单的句柄
    lWndMenu = GetSystemMenu(lhandle, 0)                        '得到系统菜单的句柄
    RemoveMenu lWndMenu, SC_MAXIMIZE, MF_REMOVE Or MF_BYCOMMAND '移去"最大化"按钮项

End Sub

'====================================
'窗体右上角的最小化按钮无效
'====================================

Public Sub subMinDisable(lhandle As Long)
    Dim lWndMenu As Long                                        '定义菜单的句柄
    lWndMenu = GetSystemMenu(lhandle, 0)                        '得到系统菜单的句柄
    RemoveMenu lWndMenu, SC_MINIMIZE, MF_REMOVE Or MF_BYCOMMAND '移去"最小化"按钮项
End Sub
Public Sub main()
    Set cnn = New ADODB.Connection
    Set cnn1 = New ADODB.Connection
    Set cmm = New ADODB.Command
    Set rs = New ADODB.Recordset
    Set rs1 = New ADODB.Recordset
    Set rs2 = New ADODB.Recordset
    strcnn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\soft113.mdb;Persist Security Info=False"
    strcnn1 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\kaoti.mdb;Persist Security Info=False"
    

 frmSplash.Show
  
End Sub

'====================================
'创建考生数据库
'====================================

Public Sub create(stu_id As String)
table = Trim(stu_id)

'====================================
'判断考生状态(数据库是否存在)
'====================================

      If FileExists(stu_id) = True Then
      
        If MsgBox("你已经考过一次了！是否重考？", vbYesNo, "提示窗体") = vbYes Then
            Kill table
            deletefolder
          Else
            Unload Form1
            Exit Sub
'====================================
'           deletefolder
'删除文件夹和数据库
'====================================
            Exit Sub
        End If
     End If
     
     
Dim mydatabase As Database
Dim mytable As TableDef
Set mydatabase = Workspaces(0).CreateDatabase(stu_id, dbLangGeneral)
'====================================
'添加表格
'====================================

Set mytable = mydatabase.CreateTableDef("test")
With mytable
    .Fields.Append .CreateField("stid", dbText, 4)
    .Fields.Append .CreateField("st_no", dbText, 8)
    .Fields.Append .CreateField("st_da", dbText, 10)
    .Fields.Append .CreateField("ksda", dbText, 10)
    .Fields.Append .CreateField("ksstate", dbText, 4)
End With
'====================================
'添加字段
'====================================

mydatabase.TableDefs.Append mytable

End Sub

'====================================
'事物处理
'====================================

Public Sub Committrans(strcmm As String)
Set cnn2 = New ADODB.Connection
cnn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & table & ";Persist Security Info=False"
cnn2.BeginTrans
With cmm
Set .ActiveConnection = cnn2
.CommandText = strcmm
.CommandType = adCmdText
.Prepared = True
.Execute
End With
cnn2.Committrans
cnn2.Close
Set cnn2 = Nothing

End Sub

'====================================
'取试题号
'====================================

Public Sub insert(papernum As String)

    Dim test() As String
    Dim strcmm As String
    Dim i As Integer
    Set cmm = New ADODB.Command
    Set cnn = New ADODB.Connection
    Set cmm1 = New ADODB.Command
    Set cnn1 = New ADODB.Connection
    Set rs = New ADODB.Recordset
    ReDim test(7)
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\kaoti.mdb;Persist Security Info=False"
    rs.Open papernum, cnn, adOpenKeyset, adLockOptimistic
    For i = 0 To 51
        test(1) = rs.Fields(1)
        test(0) = rs.Fields(0)
        test(7) = rs.Fields(7) & "  "
        Set cnn1 = New ADODB.Connection
            strcmm = "insert into test values('" & test(0) & "','" & test(1) & "','" & test(7) & "',0,0)"
            cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & table & ";Persist Security Info=False"
            cnn1.BeginTrans
            With cmm
                Set .ActiveConnection = cnn1
                .CommandText = strcmm
                .CommandType = adCmdText
                .Prepared = True
                .Execute
            End With
            cnn1.Committrans
            If Not rs.EOF Then
                rs.MoveNext
            Else
                Exit Sub
            End If
    Next
    rs.Close
    cnn.Close
    cnn1.Close
    Set rs = Nothing
    Set cnn = Nothing
    Set cnn1 = Nothing
End Sub

'====================================
'判断数据库是否存在
'====================================

Public Function FileExists(FileName As String) As Boolean
On Error Resume Next
FileExists = Dir$(FileName) <> ""
If Err.Number <> 0 Then
FileExists = False
End If
On Error GoTo 0
End Function

'====================================
'删除文件夹
'====================================

Private Sub deletefolder()
Dim strcmm As String
Dim fso As New FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists("c:\" & Trim(Form1.Text1.Text)) = True Then
      fso.deletefolder ("c:\" & Trim(Form1.Text1.Text))
    End If
'====================================

'Kill table
End Sub