frmreadpapers.frm

此源码是针对配套的光学标记阅读机使用

      Wend
     
     sqlfsad = "select kh,lx,fs from fs"
      Set rsfsad = TransactSQL(sqlfsad)
   ' If rsfsad.EOF = True Then
       rsfsad.AddNew
       rsfsad.Fields(0) = kh
       rsfsad.Fields(1) = lx
       rsfsad.Fields(2) = zf
       rsfsad.Update
       rsfsad.Close
       Dim n As Integer
       n = n + 1
       'Print n
   ' End If
     rsyy.MoveNext
    ' sql = "select kh,lx,fs from fs  "
'showdata (sql)
Next ii
    
    End If
 

End Sub

Private Sub Command3_Click()
Dim answer As String
answer = MsgBox("确定要清空数据库中的所有数据吗？清空后将无法恢复", vbYesNo, "警告")
If answer = vbYes Then
sql = "delete  * from fs"
Dim rs As ADODB.Recordset

TransactSQL (sql)
sql = "delete * from ttxx"
TransactSQL (sql)
MsgBox "数据库已经清空！", vbOKOnly + vbExclamation
End If
End Sub

Private Sub Form_Load()

    IsReading = False
    mytimer.Interval = 50
    Me.txtResult.Text = ""
    mytimer.Enabled = False
    xianshi = 0
    
          'setgrid
       '  setgridhead
         sethead
           '获得阅读状态设置
    ' omrreadtotal = OMR_ReadTotal()
             Label6.Caption = OMR_ReadTotal()
            omrtype = OMR_GetType()
    Select Case omrtype
        Case 112:
             Label1.Caption = "OMR11B"
        Case 311:
             Label1.Caption = "OMR31A"
        Case 981:
            Label1.Caption = "OMR98A"
        Case 982:
            Label1.Caption = "OMR98B"
        Case 983:
            Label1.Caption = "OMR98BD"
        Case 500:
            Label1.Caption = "OMR50U"
        Case 200:
            Label1.Caption = "OMR20U"
        Case 900:
           Label1.Caption = "OMR90U"
        Case 0:
          Label1.Caption = "OMR未打开或机型设置不正确"
 End Select

End Sub
Public Function openkeyname(ByVal KeyName As String) As String '打开评分文件并将结果输入到一个字符串中
            Open "" & KeyName & "" For Input As #1
             openkeyname = Input(LOF(1), 1)
            Close #1
           
End Function


Public Sub showdata(ByVal sql As String)
   Dim rs As New ADODB.Recordset
   Set rs = getRS(sql)
   If Not rs.RecordCount = 0 Then
          
               With Me.MSHFlexGrid1
                 .Rows = 1
                    While Not rs.EOF
                      .Rows = .Rows + 1
                      .TextMatrix(.Rows - 1, 0) = rs(0)
                      .TextMatrix(.Rows - 1, 1) = rs(1)
                      .TextMatrix(.Rows - 1, 2) = rs(2)
                     rs.MoveNext
                     Wend
                 End With
        
   End If
   
End Sub


Public Sub sethead()
On Error GoTo setheaderror

Me.MSHFlexGrid1.Row = 0
Me.MSHFlexGrid1.Col = 0

Me.MSHFlexGrid1.ColWidth(0) = 1000
Me.MSHFlexGrid1.ColWidth(1) = 2000
Me.MSHFlexGrid1.ColWidth(2) = 2000
'Me.MSHFlexGrid1.Width = 2000
Me.MSHFlexGrid1.Text = "试卷类型"
Me.MSHFlexGrid1.Col = 1

Me.MSHFlexGrid1.Text = "准考证号码"
Me.MSHFlexGrid1.Col = 2
Me.MSHFlexGrid1.Text = "填涂信息"
Exit Sub
setheaderror:
If Err.Number <> 0 Then
    MsgBox Err.Description
End If
End Sub




Private Sub MyTimer_Timer()

    Dim sResultStr As String
    Dim lResultNum As Long
    mytimer.Enabled = False
    Select Case OMR_IsReading()
    Case 0:     '阅读完毕
        sResultStr = Space(2000)
        lResultNum = OMR_GetResult(sResultStr, True)
        
        If Len(txtResult.Text) > 0 Then
        Else
            txtResult.Text = sResultStr
        End If
        If Left(sResultStr, 1) = "O" Then
                '将结果存入到数据库
            sResultStr = Mid(sResultStr, 2)
             read (sResultStr)
        
            
            If OMR_ReadNoWait() = 0 Then    'OK
                cmdread.Caption = "停止阅读"
                mytimer.Enabled = True
                IsReading = True
            Else
               Dim errsb As Integer
               errsb = MsgBox("阅读失败", vbOKOnly, "警告")
               If errsb = 1 Then
               Exit Sub
               End If
            End If
        Else
            cmdread.Caption = "阅读"
            mytimer.Enabled = False
            IsReading = False
            sResultStr = Space(100)
            strlen = OMR_CRetMess(OMR_GetLastError(), sResultStr)
            txtResult.Text = sResultStr
        End If
        
    Case -1:    '阅读失败
        cmdread.Caption = "阅读"
        mytimer.Enabled = False
        IsReading = False
        sResultStr = Space(100)
        strlen = OMR_CRetMess(OMR_GetLastError(), sResultStr)
        txtResult.Text = sResultStr
        Dim errsb2 As Integer
        
        errsb2 = MsgBox(sResultStr, vbOKOnly, "阅读失败")
        If errsb2 = 1 Then
        Exit Sub
        End If
    Case 1:     '正在阅读
    End Select
    
    mytimer.Enabled = True

End Sub

Public Sub read(jieguo As String)
            Dim lx As String
            Dim kh As String
            Dim sql As String
            Dim rs As ADODB.Recordset
            Dim bdkey As String
        
            lx = Mid(jieguo, 1, 1)
            kh = Mid(jieguo, 2, 14)
            jieguo = Mid(jieguo, 16, 200)
        
             '判断标准答案中是否有相应的标准答案
            If lx = " " Then
               MsgBox "试卷类型没有填涂!", vbOKOnly, "提示"
               Exit Sub
            Else
                sql = "select lx,jieguo  from bdkey where lx='" & lx & "'"
                Set rs = getRS(sql)
                If rs.EOF = True Then
                  MsgBox "此试卷类型试卷类型没有填涂!", vbOKOnly, "提示"
                  Exit Sub
               Else
                   bdkey = rs(1)
               End If
            End If
            '判断是否设置分数
            Dim sqllx As String
           Dim rslx As ADODB.Recordset
           sqllx = "select * from setfs where lx='" & lx & "'"
           Set rslx = getRS(sqllx)
           If rslx.EOF = True Then
              MsgBox "此准考证号码没有对应的标答案!", vbOKOnly, "提示"
              rslx.Close
              Exit Sub
           Else
            
           End If
            
            '判断准考证号码是否填涂
            
          If kh = " " Then
               MsgBox "准考证号码没有填涂!", vbOKOnly, "提示"
               Exit Sub
          End If
           '判断数据库中是否有此准考证号码
           
            sql = "select kh from kh where kh='" & kh & "'"
           Set rs = getRS(sql)
           If rs.EOF = True Then
              MsgBox "准考证号码填涂有误!", vbOKOnly, "提示"
              Exit Sub
           Else
    
               Dim sql1 As String
               Dim rs1 As ADODB.Recordset
              sql1 = "select lx, kh,ttxx from ttxx where kh='" & kh & "' "
              Set rs1 = TransactSQL(sql1)
              If rs1.EOF = True Then
                 rs1.AddNew
                 rs1.Fields(0) = lx
                 rs1.Fields(1) = kh
                 rs1.Fields(2) = jieguo
                 rs1.Update
                 rs1.Close
                 showdata (sql1)
               ' Call pf(jieguo, kh, lx, bdkey)
              Else
                 MsgBox "此准考证号码已经阅读过!", vbOKOnly, "提示"
                 Exit Sub
             End If
             rs.Close
           End If
           
End Sub
Public Sub pf(jieguo As String, kh As String, lx As String, bdkey As String)
      Dim sql As String
      Dim rs As ADODB.Recordset
      Dim n As Integer
      Dim qst As Integer
      Dim zzt As Integer
      Dim fs As Integer
      Dim zf As Integer
      zf = 0
      sql = "select qst,zzt,fs from setfs where lx='" & lx & "'"
      Set rs = TransactSQL(sql)
      n = rs.RecordCount
      For n = 1 To n
        qst = rs(0)
        zzt = rs(1)
        fs = rs(2)
        fs = Val(fs)
        qst = Val(qst)
        zzt = Val(zzt)
        
        Dim i As Integer
         For i = qst To zzt
            jieguo = Mid(jieguo, qst, 1)
            bdkey = Mid(bdkey, qst, 1)
          If bdkey = "0" Then
          Else
            If StrComp(jieguo, bdkey, 1) = 0 Then
             
            zf = zf + Val(fs)
            End If
          End If
         Next i
        
         rs.MoveNext
      Next n
      rs.Close
      sql = "select lx,kh,fs from fs"
      Set rs = getRS(sql)
      rs.AddNew
      rs(0) = lx
      rs(1) = kh
      rs(2) = zf
      rs.Update
      rs.Close
      
    showdata (sql)
      
End Sub