⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 得分.frm

📁 The crystallize of the initial study, one class examination system of calculator, everyone gives ord
💻 FRM
字号:
VERSION 5.00
Begin VB.Form Form6 
   BackColor       =   &H80000009&
   Caption         =   "评分"
   ClientHeight    =   4410
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7230
   Icon            =   "得分.frx":0000
   LinkTopic       =   "Form6"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4410
   ScaleWidth      =   7230
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "退出"
      Height          =   495
      Left            =   5520
      TabIndex        =   0
      Top             =   3720
      Width           =   1455
   End
   Begin VB.Label Label1 
      BackColor       =   &H80000009&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "考试结束"
      Height          =   3615
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   7095
   End
End
Attribute VB_Name = "Form6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=======================================
'设定属性
Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" _
(ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
'=======================================
'读取属性
Private Declare Function GetFileAttributes Lib "kernel32" Alias _
    "GetFileAttributesA" (ByVal lpFileName As String) As Long
'=======================================
'定义常量
Const FILE_ATTRIBUTE_READONLY = &H1     '只读
Const FILE_ATTRIBUTE_HIDE = &H2         '隐藏
Const FILE_ATTRIBUTE_ARCHIVE = &H20     '存档
Const FILE_ATTRIBUTE_SYSTEM = &H4       '系统
Const FILE_ATTRIBUTE_NORMAL = &H80      '设定为一般 (取消前四种属性)
Dim InputFileName As String
Dim transflag As Boolean
Dim strcmm As String
Dim i As Integer
Dim ssearch As String

Private Sub Command1_Click()
End
Unload Me
End Sub

Private Sub Form_Load()
Dim op As Integer
Dim striopt As Integer
Dim stricheck As Integer
Dim caozuofs As Integer                 '存放操作题分数
caozuofs = caozuopf()
caozuofs = CInt(caozuofs / 10)
op = CInt(dzcount / Int(Form4.Label3.Caption) * 15)
striopt = opt
stricheck = check
Label1.Caption = "你的得分情况如下:" & vbCrLf & Chr(10) & "打字题得分为:" & op & _
vbCrLf & Chr(10) & "操作题得分为:" & caozuofs & vbclrf & Chr(10)
Label1.Caption = Label1.Caption & vbCrLf & "单选题:做对了" & striopt & "题,得分为" & striopt * 1 & vbCrLf & Chr(10)
Label1.Caption = Label1.Caption & vbCrLf & "多选题:做对了" & stricheck & "题,得分为" & stricheck * 2 & vbCrLf
Label1.Caption = Label1.Caption & vbCrLf & "你最后得分为:" & Val(op + caozuofs + striopt + stricheck * 2) & vbCrLf
 If Val(op + caozuofs + striopt + stricheck * 2) >= 50 Then
    Label1.Caption = Label1.Caption & "恭喜你,你已经成功通过考试!"
Else
    Label1.Caption = Label1.Caption & "对不起你没有通过考试!"
 End If


End Sub

Public Function caozuopf() As Integer
Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
Dim a, b, c, d, e, f As Integer
Dim caozuofs As Integer                 '存放操作题分数
Select Case q
     Case 1
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\XUE\DOWN.BAT") = True Then
        a = 10
        End If
        If (GetFileAttributes("c:\" & Trim(Form1.Text1.Text) & "\BI\GRE.ARJ") And _
        FILE_ATTRIBUTE_READONLY And FILE_ATTRIBUTE_ARCHIVE) Then
        b = 20
        End If
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\DONG\WORD.ABS") = False Then
        c = 15
        End If
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\EXCEL\NEW.FAT") = True Then
        d = 15
        End If
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\SEVE\STER.WRI") = False Then
        e = 10
        End If
        If fso.FolderExists("c:\" & Trim(Form1.Text1.Text) & "\WAN\WEB") = True Then
        f = 10
        End If
        caozuofs = a + b + c + d + e + f
        
     Case 2
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\EDU\CLAS\PRG.BAS") = False Then
        a = 15
        End If
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\NET\SET.COM") = True Then
        b = 15
        End If
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\DEL\JUN.EXE") = False Then
        c = 10
        End If
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\FAN\XIO.DOC") = True Then
        d = 10
        End If
        If fso.FolderExists("c:\" & Trim(Form1.Text1.Text) & "\JIN") = True Then
        e = 10
        End If
        If (GetFileAttributes("c:\" & Trim(Form1.Text1.Text) & "\SU\CHUI.FOR") And _
        FILE_ATTRIBUTE_HIDE And FILE_ATTRIBUTE_ARCHIVE) Then
        f = 20
        End If
        caozuofs = a + b + c + d + e + f
        
     Case 3
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\NEWS\WATER.FOR") = False Then
        a = 15
        End If
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\BAD\WER.BAS") = True Then
        b = 15
        End If
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\PRG\LAKE.TXT") = False Then
        c = 10
        End If
        If (GetFileAttributes("c:\" & Trim(Form1.Text1.Text) & "\RIVER\CIA.WPS") And _
        FILE_ATTRIBUTE_HIDE And FILE_ATTRIBUTE_ARCHIVE) Then
        d = 20
        End If
        If fso.FolderExists("c:\" & Trim(Form1.Text1.Text) & "\LIFE\MION") = True Then
        f = 10
        End If
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\STU\RET.WRI") = True Then
        e = 10
        End If
        caozuofs = a + b + c + d + e + f
        
      Case 4
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\ADE.TXT") = True Then
        a = 10
        End If
        If (GetFileAttributes("c:\" & Trim(Form1.Text1.Text) & "\ADE.TXT") And _
        FILE_ATTRIBUTE_HIDE) Then
        b = 10
        End If
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\JEEP\TAXI.BAS") = True Then
        c = 10
        End If
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\COLOR\COLOR.EXE") = False Then
        d = 10
        End If
        If fso.FolderExists("c:\" & Trim(Form1.Text1.Text) & "\CARD\TER.TXT") = True Then
        e = 10 '检测内容
        End If
        If fso.FolderExists("c:\" & Trim(Form1.Text1.Text) & "\GOOD\PEA") = False Then
        f = 10
        End If
        If fso.FolderExists("c:\" & Trim(Form1.Text1.Text) & "\APPLE\PEA") = True Then
        g = 10
        End If
        caozuofs = a + b + c + d + e + f + g
      Case 5
        If (GetFileAttributes("c:\" & Trim(Form1.Text1.Text) & "\BAD\SONG.TML") And _
        FILE_ATTRIBUTE_HIDE And FILE_ATTRIBUTE_READONLY) Then
        a = 20
        End If
        If fso.FileExists("c:\" & Trim(Form1.Text1.Text) & "\HOOL\PORK.COM") = False Then
        b = 10
        End If
        If fso.FolderExists("c:\" & Trim(Form1.Text1.Text) & "\UNIT\DOWN") = True Then
        c = 10
        End If
        If fso.FolderExists("c:\" & Trim(Form1.Text1.Text) & "\TREE\TANK") = True Then
        d = 10
        End If
        If fso.FolderExists("c:\" & Trim(Form1.Text1.Text) & "\IDE\BOOK") = False Then
        e = 10
        End If
        If fso.FolderExists("c:\" & Trim(Form1.Text1.Text) & "\MY\BOOK") = True Then
        f = 10
        End If
        caozuofs = a + b + c + d + e + f
End Select
        caozuopf = caozuofs
End Function
Private Function opt() As Integer '单项选择
    Static a As Integer
    Dim form3rs As ADODB.Recordset
    Dim conn As ADODB.Connection
    Set conn = New ADODB.Connection
    Set form3rs = New ADODB.Recordset
        conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & table & ";Persist Security Info=False"
        form3rs.Open "select * from test where st_no like 'A%'", conn, adOpenKeyset, adLockOptimistic
            While Not form3rs.EOF And Not form3rs.BOF
            If Trim(form3rs!ksda) = Trim(form3rs!st_da) Then
              a = a + 1
             End If
             form3rs.MoveNext
             Wend
            opt = a
'          If Not form3rs.EOF Then
'             form3rs.MoveNext
'          Else
'             Exit Function
'          End If
        form3rs.Close
        conn.Close
     Set form3rs = Nothing
     Set conn = Nothing
 End Function
Private Function check() As Integer '多项选择
    Static a As Integer
    Dim form3rs As ADODB.Recordset
    Dim conn As ADODB.Connection
    Set conn = New ADODB.Connection
    Set form3rs = New ADODB.Recordset
        conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & table & ";Persist Security Info=False"
        form3rs.Open "select * from test where st_no like 'X%'", conn, adOpenKeyset, adLockOptimistic
            While Not form3rs.EOF And Not form3rs.BOF
            If Trim(form3rs!ksda) = Trim(form3rs!st_da) Then
              a = a + 1
               
             End If
             form3rs.MoveNext
             Wend
            check = a
'          If Not form3rs.EOF Then
'             form3rs.MoveNext
'           Else
'             Exit Function
'          End If
        form3rs.Close
        conn.Close
     Set form3rs = Nothing
     Set conn = Nothing
 End Function

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -