common.vb

系统概要: 本系统采用VB.NET开发. 开发平台:Windows XP Professional SP2 (English Version) 开发环境:Visual Studio .NET

'
'    Copyright(C)2006,济南大学材料科学与工程学院
'    All right reserved.
'
'    文件名称:Common.vb
'    文件标识:
'    摘    要:
'
'    当前版本:1.0.0
'    作    者:梁  海
'    完成日期:2006-12-3
'
'    取代版本:
'    原作者  :
'    完成日期:
'
'    修改历史:
'
'
Imports System.IO
Imports System.Data.SqlClient

Public Module Common

    '
    '    函数名称:getParameters(ByVal key As String) As String
    '    摘    要:参数:key表示要读取的键值
    '             返回Web.config中的<appSettings>中设置的键值
    '

    Friend Function getParameters(ByVal key As String) As String

        Return System.Configuration.ConfigurationSettings.AppSettings(key).ToString()

    End Function

    '
    '    函数名称:TextEncode(Byval strEncode As String) As String
    '    摘    要:参数:strEncode表示需要过滤字符串,将可能会引起SQL操作的字符去掉
    '             返回过滤后的字符串
    '
    Public Function TextEncode(ByVal strEncode As String) As String

        strEncode = strEncode.Replace(Chr(34), "  ")           '///除去双引号
        strEncode = strEncode.Replace(Chr(39), "  ")           '///除去单引号

        Return strEncode

    End Function

    '
    '    函数名称:ExamPaper(ByVal SID As String) As DataSet
    '    摘    要:根据考生号,抽取考试题,返回考试题的数据集
    ' 
    Friend Function ExamPaper(ByVal SID As String) As DataSet

        Dim dsPaper As New DataSet
        Dim oSql As New SqlDataAccess
        Dim dtExam As DataTable

        oSql.Sql = "Select * From vExam Where (SID='" + SID + "')"
        dtExam = oSql.DataTable()
        If dtExam.Rows.Count > 0 Then
            If CType(dtExam.Rows(0).Item("Mode"), Boolean) Then
                dsPaper = RandomExam(CType(dtExam.Rows(0).Item("EID"), Integer), SID)
            Else
                dsPaper = UnRandomExam(CType(dtExam.Rows(0).Item("Questions"), String), SID)
            End If
        Else
            Return Nothing
        End If

        Return dsPaper

    End Function

    '
    '    函数名称:UnRandomExam(ByVal strQuestions As String) As DataSet
    '    摘    要:根据考场布置,抽取固定考试题
    ' 
    Friend Function UnRandomExam(ByVal strQuestions As String, ByVal SID As String) As DataSet

        Dim oSql As New SqlDataAccess
        Dim dsPaper As New DataSet
        Dim dtExamInfo As DataTable
        Dim dtChoose As DataTable
        Dim dtVacancy As DataTable
        Dim dtDrawing As DataTable
        Dim Questions As String()

        '试题题号
        '格式:选择题编号1,编号2...|填空题1,填粉题2...|作图题1
        Questions = strQuestions.Split("|"c)

        '考试信息
        dsPaper.Tables.Add("ExamInfo")
        With dsPaper.Tables("ExamInfo").Columns
            .Add("SID")
            .Add("EID")
            .Add("StartDateTime")
            .Add("EndDateTime")
            .Add("AllTime")
        End With

        '选择题
        dsPaper.Tables.Add("Choose")
        With dsPaper.Tables("Choose").Columns
            .Add("NO")
            .Add("ID")
            .Add("Question")
            .Add("OptionA")
            .Add("OptionB")
            .Add("OptionC")
            .Add("OptionD")
            .Add("OptionE")
            .Add("OptionF")
            .Add("Answer")
            .Add("Difficulty")
            .Add("Point")
        End With

        '填空题
        dsPaper.Tables.Add("Vacancy")
        With dsPaper.Tables("Vacancy").Columns
            .Add("NO")
            .Add("ID")
            .Add("Question")
            .Add("Answer")
            .Add("Difficulty")
            .Add("Point")
        End With

        '作图题
        dsPaper.Tables.Add("Drawing")
        With dsPaper.Tables("Drawing").Columns
            .Add("NO")
            .Add("ID")
            .Add("Question")
            .Add("XmlFile")
            .Add("Difficulty")
            .Add("Point")
        End With

        '添加考试信息
        oSql.Sql = "Select * From vExam Where (SID='" + SID + "')"
        dtExamInfo = oSql.DataTable()
        Dim drExamInfo As DataRow
        drExamInfo = dsPaper.Tables("ExamInfo").NewRow
        With dtExamInfo.Rows(0)
            drExamInfo.Item("SID") = .Item("SID")
            drExamInfo.Item("EID") = .Item("EID")
            drExamInfo.Item("StartDateTime") = .Item("StartDateTime")
            drExamInfo.Item("EndDateTime") = .Item("EndDateTime")
            drExamInfo.Item("AllTime") = .Item("AllTime")
        End With
        dsPaper.Tables("ExamInfo").Rows.Add(drExamInfo)

        '抽取选择题
        oSql.Sql = "Select ID,Question,OptionA,OptionB,OptionC,OptionD,OptionE,OptionF,Difficulty,Point " + _
                   "From Choose Where ID IN (" + Questions(0) + ")"
        dtChoose = oSql.DataTable()
        For i As Integer = 0 To dtChoose.Rows.Count - 1
            Dim dr As DataRow
            dr = dsPaper.Tables("Choose").NewRow
            With dtChoose.Rows(i)
                dr.Item("NO") = i + 1
                dr.Item("ID") = .Item("ID")
                dr.Item("Question") = .Item("Question")
                dr.Item("OptionA") = .Item("OptionA")
                dr.Item("OptionB") = .Item("OptionB")
                dr.Item("OptionC") = .Item("OptionC")
                dr.Item("OptionD") = .Item("OptionD")
                dr.Item("OptionE") = .Item("OptionE")
                dr.Item("OptionF") = .Item("OptionF")
                dr.Item("Difficulty") = .Item("Difficulty")
                dr.Item("Point") = .Item("Point")
            End With
            dsPaper.Tables("Choose").Rows.Add(dr)
        Next

        '抽取填空题
        oSql.Sql = "Select ID,Question,Difficulty,Point From Vacancy Where ID IN (" + Questions(1) + ")"
        dtVacancy = oSql.DataTable()
        For i As Integer = 0 To dtVacancy.Rows.Count - 1
            Dim dr As DataRow
            dr = dsPaper.Tables("Vacancy").NewRow
            With dtVacancy.Rows(i)
                dr.Item("NO") = i + 1
                dr.Item("ID") = .Item("ID")
                dr.Item("Question") = .Item("Question")
                dr.Item("Difficulty") = .Item("Difficulty")
                dr.Item("Point") = .Item("Point")
            End With
            dsPaper.Tables("Vacancy").Rows.Add(dr)
        Next

        '抽取作图题
        oSql.Sql = "Select ID,Question,XmlFile,Difficulty,Point From Drawing Where ID IN (" + Questions(2) + ")"
        dtDrawing = oSql.DataTable()
        For i As Integer = 0 To dtDrawing.Rows.Count - 1
            Dim dr As DataRow
            dr = dsPaper.Tables("Drawing").NewRow
            With dtDrawing.Rows(i)
                dr.Item("NO") = i + 1
                dr.Item("ID") = .Item("ID")
                dr.Item("Question") = .Item("Question")
                dr.Item("XmlFile") = .Item("XmlFile")
                dr.Item("Difficulty") = .Item("Difficulty")
                dr.Item("Point") = .Item("Point")
            End With
            dsPaper.Tables("Drawing").Rows.Add(dr)
        Next

        '将试题信息提交到试卷表中
        Dim strSql As String
        strSql = "Select Count(*) From Paper Where (SID='" + SID + "')"
        oSql.Sql = strSql
        If CType(oSql.ExecuteScalar(), Integer) > 0 Then
            strSql = "Update Paper Set EID=" + CStr(dsPaper.Tables("ExamInfo").Rows(0).Item("EID")) + _
                     ",Choose='" + Questions(0) + "',Vacancy='" + Questions(1) + _
                     "',Drawing='" + Questions(2) + "' Where (SID='" + SID + "')"
        Else
            strSql = "Insert into Paper(SID,EID,Choose,Vacancy,Drawing) Values('" + SID + "'," + _
                     CStr(dsPaper.Tables("ExamInfo").Rows(0).Item("EID")) + ",'" + Questions(0) + "','" + _
                     Questions(1) + "','" + Questions(2) + "')"

        End If
        oSql.Sql = strSql
        oSql.ExecuteNonQuery()

        Return dsPaper

    End Function

    '
    '    函数名称:RandomExam(ByVal EID As String) As DataSet
    '    摘    要:根据考场布置,抽取随机考试题
    ' 
    Friend Function RandomExam(ByVal EID As Integer, ByVal SID As String) As DataSet

        Dim Questions As String()
        Dim Choose As Integer
        Dim Vacancy As Integer
        Dim Drawing As Integer
        Dim strQuestions As String
        Dim strQuestions2 As String
        Dim oSql As SqlDataAccess
        Dim dsExam As DataSet
        Dim dsPaper As DataSet

        oSql = New SqlDataAccess
        oSql.Sql = "Select * From Exam Where (EID=" + EID.ToString() + ")"
        dsExam = oSql.DataSet
        If dsExam.Tables(0).Rows.Count > 0 Then
            With dsExam.Tables(0).Rows(0)
                '计算每题型抽题量
                Choose = CInt(CInt(.Item("ChoosePoint")) / CInt(.Item("PointOfChoose")))
                Vacancy = CInt(CInt(.Item("VacancyPoint")) / CInt(.Item("PointOfVacancy")))
                Drawing = CInt(CInt(.Item("DrawingPoint")) / CInt(.Item("PointOfDrawing")))
                '抽题范围
                strQuestions = CType(.Item("Questions"), String)
            End With
            Questions = strQuestions.Split("|"c)
            '重组抽题列表
            strQuestions2 = RandomQuestions(Choose, Questions(0))
            strQuestions2 += "|" + RandomQuestions(Vacancy, Questions(1))
            strQuestions2 += "|" + RandomQuestions(Drawing, Questions(2))
        End If
        '根据重组的抽题列表,按固定抽题方式抽题
        dsPaper = UnRandomExam(strQuestions2, SID)

        Return dsPaper

    End Function

    '
    '    函数名称:RandomQuestions(ByVal Count As Integer, ByVal Questions As String) As String
    '    摘    要:洗牌算法,产生随机考试题编号列表
    ' 
    Friend Function RandomQuestions(ByVal Count As Integer, ByVal Questions As String) As String

        Dim Templist As Collection      '随机数集合
        Dim Randomlist As Collection    '不重复的随机数集合
        Dim itemp As Integer            '随机数索引
        Dim rand As Integer             '临时随机数
        Dim Question As String()
        Dim Questions2 As String

        Question = Questions.Split(","c)

        '创建随机数集合对象
        Templist = New Collection

        '初始化随机数集合
        For i As Integer = 0 To Question.GetUpperBound(0)
            Templist.Add(Question(i))
        Next

        '如果设置为考试标记的题数少于所要抽取的题量
        '则将抽取的题量设为总题量
        If Templist.Count < Count Then
            Count = Templist.Count
        End If

        '产生不重复的随机数集合
        '洗牌算法
        For i As Integer = 1 To Count
            itemp = CInt((Templist.Count() - 1) * Rnd()) + 1
            rand = CType(Templist(itemp), Integer)
            If i = 1 Then
                Questions2 = rand.ToString()
            Else
                Questions2 += "," + rand.ToString()
            End If
            Templist.Remove(itemp)
        Next

        Return Questions2

    End Function

    '
    '    函数名称:GetExamFileName(ByVal SID As String) As String
    '    摘    要:取得试卷文件名
    '             为了统一试卷文件名为设置
    '             试卷文件名:考号＋.XML扩展名
    ' 
    Friend Function GetExamFileName(ByVal SID As String) As String

        Dim FileName As String

        '试卷文件名
        FileName = SID + ".xml"

        Return FileName

    End Function

    '
    '    函数名称:NowToString(ByVal SID As String) As String
    '    摘    要:将当前时间以数字串型式表示，以方便按时间命名文件
    ' 
    Friend Function NowToString() As String

        Dim strWord As String
        Dim dtNow As DateTime

        dtNow = Now()
        strWord = dtNow.Year.ToString + dtNow.Month.ToString + _
                  dtNow.Day.ToString() + dtNow.Hour.ToString + _
                  dtNow.Minute.ToString + dtNow.Second.ToString()

        Return strWord

    End Function

    '    函数名称:WriteLog(ByVal strError As String)
    '    摘    要:参数:strError 应用程序出错记录
    '             将应用程序出错信息写到web.config中LOG指定的系统出错日志
    '
    Friend Sub WriteLog(ByVal strError As String)

        Dim fs As FileStream
        Dim rw As StreamWriter
        fs = New FileStream(getParameters("LOG"), FileMode.Append, FileAccess.Write)
        rw = New StreamWriter(fs, System.Text.Encoding.GetEncoding(getParameters("ENCODING")))

        Try
            rw.WriteLine(Now.ToString & Chr(10) & "        " & strError)
        Catch ex As Exception
            'Throw New Exception("Occur Error On Write SQL Log!")
        Finally
            rw.Flush()
            rw.Close()
            fs.Close()
            rw = Nothing
            fs = Nothing
        End Try

    End Sub

End Module