Private strFieldCode,strFieldName,strTable,strTableData1,strTableData2,strErrorInfo,CurDeptID,CurDeptName,strXml
Private arrFieldName1,arrFieldCode1,arrFieldName2,arrFieldCode2,arrFieldName3,arrFieldCode3
Private strImportID,StudyPhase '定义导入编号，学段
CurDeptID = DBEngine.WebFunction("GetCurUserDepartmentID", "", "")
CurUserName = DBEngine.WebFunction("GetCurUserName", "", "")
StrInput = "<priMag><methodKey>getOrganName</methodKey><param id=""1"">"&CurDeptID&"</param></priMag>"
strRet = DBEngine.WebFunction("", strInput, "&PFKey=Privilege:1.0")
CurDeptName = DBEngine.GetNodeText(strRet,"organName")
'Import_Main表的对应字段
arrFieldName1 = Array("年级", "班级编号","班级名称", "入学时间", "校内学号", "姓名","曾用名", "性别","出生日期","民族", "籍贯","身份证号","政治面貌","参加时间","学生状态","健康状况","是否借读生","借读生类型","政策性照顾借读生类别","是否贫困生","是否住宿生","宿舍号","户口状况","户口所在地_派出所","邮编","户口地址_市或区","户口地址_街道或镇","户口地址_村或居委会","户口地址_组或其它","现住址_市或区","现住址_街道或镇","现住址_村或居委会","现住址_组或其它","是否军烈属","是否华归侨子女","是否重点引进人才子女","是否教师子女","家长或监护人","家长联系方式","备注")
arrFieldCode1 = Array("Grade","ClassID","ClassName","InSchDate","InnerStudNo","Name","EverName","Sex","Birthday","Nation","Natple","IDcode","Politics","JoinTime","Status","Health","IsBorrow","BorrowType","BorrowZCtype","IsPenury","IsLodge","SSno","RPRstatus","LocusPolice","Postcode","RPRAdd_borough","RPRAdds_street","RPRAdds_village","RPRAdds_other","Adds_borough","Adds_street","Adds_village","Adds_other","Other_JLS","Other_HGQ","Other_ZDYJRC","Other_JS","Pater","LinkMode","Remark")
'Import_Secd表的第一行对应字段
arrFieldName2 = Array("成员姓名1","关系1","出生日期1","工作单位1","职务1","政治面貌1","联系电话1")
arrFieldCode2 = Array("MEMBERNAME","RELATION","BIRTHDAY","WORKUNITS","DUTY","GOVVISAGE","Tel")
'Import_Secd表的第二行对应字段
arrFieldName3 = Array("成员姓名2","关系2","出生日期2","工作单位2","职务2","政治面貌2","联系电话2")
arrFieldCode3 = Array("MEMBERNAME","RELATION","BIRTHDAY","WORKUNITS","DUTY","GOVVISAGE","Tel")
'注释:
Sub DBEngine_EventLoad(strInitData, strInitType)
MainGrid.SetTableXml("")
MainGrid.SetListMode(True)
Call cmbImportType.SelectString(0,"在校生基本数据导入")
lblNotice.Caption = "提供在校生基本数据,包括学生基本信息、户口信息、家庭成员等，系统将自动生成统一学号。"
End Sub
'-----------------------------------------------------------------------------------------------
Sub MainGrid_EventWebFunction(strFunName, strInputXML, strOutputXML)
MainGrid.SetWebFunReturnValue(DBEngine.WebFunction(strFunName, strInputXML, strOutputXML))
End Sub
'注释:
Sub btnOpenXls_Click()'导入
strFileName = MainGrid.OpenFileDlg("Excel文件(*.xls)|*.xls||")
if strFileName <> "" then
FlexGrid.LoadGrid strFileName, 6, ""
ExcelToTableXml()
CreateXml()
If strErrorInfo <> "" Then
DBEngine.Msgbox "数据格式不正确，请修改后重新验证导入！"
ebError.Text = strErrorInfo
Else
StrRet = DBEngine.WebFunction("ImportTableXmlData",strXml, "")
If StrRet <> "1" Then
DBEngine.Msgbox "导入失败，请修改后重新验证导入！"
ebError.Text = "导入失败，请修改后重新验证导入！"
Else
strImportLog = "Insert Into t_s_DataImportLog(ImportID,ImportTime,TableName,ImportType,ImportMan,ImportOrg) " &_
" Values("+strImportID+",TO_Date('"+Cstr(Now())+"','YYYY-MM-DD HH24:MI:SS'),'t_InSch_BaseInfo','在校生数据导入','"+CurUserName+"','"+CurDeptName+"')"
strRet = DBEngine.WebFunction("SqlNonQuery",strImportLog,"")
DBEngine.Msgbox "导入成功！"
ebError.Text = "导入成功！"
End If
End If
End If
End Sub
'注释:
Sub btnReImport_Click()'重新导入验证
CreateXml()
If strErrorInfo <> "" Then
DBEngine.Msgbox "数据格式不正确，请修改后重新验证导入！"
ebError.Text = strErrorInfo
Else
StrRet = DBEngine.WebFunction("ImportTableXmlData",strXml, "")
If StrRet <> "1" Then
DBEngine.Msgbox "导入失败，请修改后重新验证导入！"
ebError.Text = "导入失败，请修改后重新验证导入！"
Else
strImportLog = "Insert Into t_s_DataImportLog(ImportID,ImportTime,TableName,ImportType,ImportMan,ImportOrg) " &_
" Values("&strImportID&",TO_Date('"+Cstr(Now())+"','YYYY-MM-DD HH24:MI:SS'),'t_InSch_BaseInfo','在校生数据导入','"+CurUserName+"','"+CurDeptName+"')"
strRet = DBEngine.WebFunction("SqlNonQuery",strImportLog,"")
DBEngine.Msgbox "导入成功！"
ebError.Text = "导入成功！"
End If
End If
End Sub
'-----------------------------------------------------------------------------------------------
'注释:将网格数据组成导入表的XML字符串-通用
Function CreateXml()
RowCount = MainGrid.GetRowCount
nFixedRowCount = MainGrid.GetFixedRowCount()
Dim ArchivesID()
ReDim arrArchivesID(RowCount-1) 'n行的档案编号
Dim arrFieldCode()
ReDim arrFieldCode(MainGrid.GetFieldCount) 'n列的字段名
ReDim strTable(MainGrid.GetFieldCount)
ReDim StudyPhase(RowCount - 1) 'n行的学段
strImport = "Select Nvl(Max(ImportID),0)+1 as ImportID From t_s_DataImportLog"
strRet = DBEngine.WebFunction("SqlQuery",strImport,"")
strImportID = DBEngine.GetNodeText(strRet,"ImportID")
strErrorInfo = ""
strTableData1 = ""
strTableData2 = ""
strXml = ""
strTableData1 = "<?xml version=""1.0"" encoding=""GBK"" ?><TableDatas>"
strTableData1 = strTableData1 + "<TableData><TableName>t_InSch_BaseInfo</TableName><Rows>" '需要导入的第1个表
strTableData2 = strTableData2 + "<TableData><TableName>t_InSch_FamilyInfo</TableName><Rows>" '需要导入的第2个表
'生成主键
strInput = "<Input><TableName>t_InSch_BaseInfo</TableName><FieldName>ArchivesID</FieldName><Number>"+Cstr(RowCount-2)+"</Number></Input>"
strRet = DBEngine.WebFunction("NewAutoNumberFieldValue", strInput, "")
strArchivesID = Split(StrRet,",",-1)
For i = nFixedRowCount To RowCount - 1
strTableData1 = strTableData1 + "<Row>"
strTableData2 = strTableData2 + "<Row>"
For j = 1 To MainGrid.GetFieldCount
If i = nFixedRowCount Then '只有在第一行导入时取字段名
strFieldName = MainGrid.GetFieldName(j-1)
If GetFieldCode(strFieldName,j) = False Then '失败时终止
Exit Function
End If
arrFieldCode(j) = strFieldCode
End If
strCellText = MainGrid.GetCellText(i,j)
If CheckData(arrFieldCode(j),strCellText,i,j) = False Then '分别传递字段描述,字段名、字段值、行、列至CheckData
Exit Function
End If
i = Cint(i):j = Cint(j)
If strTable(j) = "t_InSch_BaseInfo" Then
strTableData1 = strTableData1 + "<"+arrFieldCode(j)+">"+strCellText + "</"+arrFieldCode(j)+">" '添加第1个表的字段
ElseIf strTable(j) = "t_InSch_FamilyInfo1" Then
strTableData2 = strTableData2 + "<"+arrFieldCode(j)+">"+strCellText + "</"+arrFieldCode(j)+">" '添加第2个表的第一行字段
ElseIf strTable(j) = "t_InSch_FamilyInfo2" Then
strTableData2_Row2 = strTableData2_Row2 + "<"+arrFieldCode(j)+">"+strCellText + "</"+arrFieldCode(j)+">" '添加第2个表的第二行字段
End If
Next
strTableData1 = strTableData1 + "<StudyPhase>"+StudyPhase(i)+"</StudyPhase><ArchivesID>"+strArchivesID(n)+"</ArchivesID><SCHOOLID>"+CurDeptID+"</SCHOOLID><SCHOOLNAME>"+CurDeptname+"</SCHOOLNAME><CREATEMAN>"+CurUserName+"</CREATEMAN><CREATEDATE>"+Cstr(Date())+"</CREATEDATE><IMPORTID>"& strImportID &"</IMPORTID>"
strTableData1 = strTableData1 + "</Row>"
strTableData2 = strTableData2 + "<ArchivesID>"+strArchivesID(n)+"</ArchivesID><RECORDER>"+CurUserName+"</RECORDER><RECORDTIME>"+Cstr(Date())+"</RECORDTIME><IMPORTID>"& strImportID &"</IMPORTID>"
strTableData2 = strTableData2 + "</Row>"
If strTableData2_Row2 <> "" Then
strTableData2 = strTableData2 + "<Row>" + strTableData2_Row2 +"<ArchivesID>"+strArchivesID(n)+"</ArchivesID><RECORDER>"+CurUserName+"</RECORDER><RECORDTIME>"+Cstr(Date())+"</RECORDTIME><IMPORTID>"& strImportID &"</IMPORTID></Row>"
End If
strTableData2_Row2 = ""
n = n + 1
Next
strTableData1 = strTableData1 + "</Rows></TableData>"
strTableData2 = strTableData2 + "</Rows></TableData>"
strXml = strTableData1 + strTableData2 + "</TableDatas>"
End Function
'-----------------------------------------------------------------------------------------------
Function GetFieldCode(strFieldName,j) '取回字段描述对应的英文字段名
GetFieldCode = True
For x = 0 To UBound(arrFieldName1)
If strFieldName = arrFieldName1(x) Then
strFieldCode = arrFieldCode1(x)
strTable(j) = "t_InSch_BaseInfo"
Exit Function
End If
Next
For y = 0 To UBound(arrFieldName2)
If strFieldName = arrFieldName2(y) Then
strFieldCode = arrFieldCode2(y)
strTable(j) = "t_InSch_FamilyInfo1"
Exit Function
End If
Next
For z = 0 To UBound(arrFieldName3)
If strFieldName = arrFieldName3(z) Then
strFieldCode = arrFieldCode3(z)
strTable(j) = "t_InSch_FamilyInfo2"
Exit Function
End If
Next
strErrorInfo = strErrorInfo + "错误：导入模板中不存在"+strFieldName+vbCrLf
End Function
'-----------------------------------------------------------------------------------------------
'注释：此函数校验代码为自定义
Function CheckData(strFieldCode,strCellText,i,j)
CheckData = False
strCheckField = Ucase(strFieldCode)
If strCellText <> "" Then
r = Cstr(i-1):j = Cstr(j)
strCheckField = Ucase(strFieldCode)
Select Case strCheckField
Case "SEX" '校验姓名
If strCellText = "男" Then
strCellText = "1"
Else
strCellText = "0"
End If
Case "CLASSID" '校验班级编号
strSql = "Select ClassID,StudyPhase From t_ClassInfo Where ClassID = '"+strCellText+"'"
strRet = DBEngine.WebFunction("SqlQuery",strSql,"")
If DBEngine.GetElemData(strRet,"CLASSID") = "" Then
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，不存在该班级编号["+strCellText+"]"+vbCrLf
Exit Function
Else
StudyPhase(i) = DBEngine.GetElemData(strRet,"STUDYPHASE")
End If
Case "CLASSNAME" '校验班级名称是否对应班级编号
strSql = "Select ClassName From t_ClassInfo Where ClassID = "+MainGrid.GetCellText(i,j-1)
strRet = DBEngine.WebFunction("SqlQuery",strSql,"")
If DBEngine.GetElemData(strRet,"CLASSNAME") <> strCellText Then
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，不存在该班级名称["+strCellText+"]"+vbCrLf
Exit Function
End If
Case "NATION" '校验民族
strSql = "Select Code From t_a_Nation Where Name = '"+MainGrid.GetCellText(i,j)+"'"
strRet = DBEngine.WebFunction("SqlQuery",strSql,"")
If DBEngine.GetElemData(strRet,"CODE") <> "" Then
strCellText = DBEngine.GetElemData(strRet,"CODE")
Else
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，没有该民族类型"+vbCrLf
End If
Case "POLITICS" '校验政治面貌
strSql = "Select Code From t_a_POLITICS Where Name = '"+MainGrid.GetCellText(i,j)+"'"
strRet = DBEngine.WebFunction("SqlQuery",strSql,"")
If DBEngine.GetElemData(strRet,"CODE") <> "" Then
strCellText = DBEngine.GetElemData(strRet,"CODE")
Else
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，没有该类型政治面貌"+vbCrLf
End If
Case "HEALTH" '校验健康状况
strSql = "Select Code From T_A_HEALTH Where Name = '"+MainGrid.GetCellText(i,j)+"'"
strRet = DBEngine.WebFunction("SqlQuery",strSql,"")
If DBEngine.GetElemData(strRet,"CODE") <> "" Then
strCellText = DBEngine.GetElemData(strRet,"CODE")
Else
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，没有该类型健康状况"+vbCrLf
End If
Case "STATUS" '校验学生状态
strSql = "Select Code From t_a_INSCHSTATUS Where Name = '"+MainGrid.GetCellText(i,j)+"'"
strRet = DBEngine.WebFunction("SqlQuery",strSql,"")
If DBEngine.GetElemData(strRet,"CODE") <> "" Then
strCellText = DBEngine.GetElemData(strRet,"CODE")
Else
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，没有该类型学生状态"+vbCrLf
End If
Case "BORROWTYPE" '校验借读生类型
strSql = "Select Code From t_a_BORROWTYPE Where Name = '"+MainGrid.GetCellText(i,j)+"'"
strRet = DBEngine.WebFunction("SqlQuery",strSql,"")
If DBEngine.GetElemData(strRet,"CODE") <> "" Then
strCellText = DBEngine.GetElemData(strRet,"CODE")
Else
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，没有该类型借读生"+vbCrLf
End If
Case "RPRSTATUS" '校验户口状况
strSql = "Select Code From t_a_RPRSTATUS Where Name = '"+MainGrid.GetCellText(i,j)+"'"
strRet = DBEngine.WebFunction("SqlQuery",strSql,"")
If DBEngine.GetElemData(strRet,"CODE") <> "" Then
strCellText = DBEngine.GetElemData(strRet,"CODE")
Else
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，没有该类型户口状况"+vbCrLf
End If
Case "GOVVISAGE" '校验家庭成员政治面貌
strSql = "Select Code From t_a_POLITICS Where Name = '"+MainGrid.GetCellText(i,j)+"'"
strRet = DBEngine.WebFunction("SqlQuery",strSql,"")
If DBEngine.GetElemData(strRet,"CODE") <> "" Then
strCellText = DBEngine.GetElemData(strRet,"CODE")
Else
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，没有该类型政治面貌"+vbCrLf
End If
Case "IDCODE" '校验身份证
lenx = Len(strCellText)
If Not IsNumeric(Left(strCellText, 15)) And strCellText <> "" Then
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，身份证号码中含有非法字符"+vbCrLf
End If
If lenx = 15 Or lenx = 18 Then
If lenx = 15 Then
mm = Mid(strCellText, 9, 2)
dd = Mid(strCellText, 11, 2)
End If
If lenx = 18 Then
mm = Mid(strCellText, 11, 2)
dd = Mid(strCellText, 13, 2)
End If
If CInt(mm) > 12 Or CInt(dd) > 31 Then
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，身份证号码中的出生日期有误!"+vbCrLf
End If
Else
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，身份证号码位数不符合,应是15或18位!"+vbCrLf
End If
If lenx = 18 Then
If Right(strCellText, 1) <> IDEnCode_VerifyNum(strCellText) Then
strErrorInfo = strErrorInfo + "错误：第"+r+"行 第"+j+"列，请输入正确身份证号码!"+vbCrLf
End If
End If
'校验身份证重复
strSql = "Select IDCODE From t_InSch_BaseInfo Where IDCODE = '"+strCellText+"'"
strRet = DBEngine.WebFunction("SqlQuery",strSql,"")
strError = DBEngine.GetElemData(strRet, "Error")
If DBEngine.GetElemData(strRet,"IDCODE") <> "" Then
strErrorInfo = strErrorInfo + "重复：第"+r+"行 第"+j+"列，已存在身份证号码["+strCellText+"]"+vbCrLf
End If
End Select
End If
'校验逻辑性字段，如是否借读生、是否贫困生等，如为空，则默认为“否”
If strCheckField = "ISBORROW" OR strCheckField = "ISPENURY" OR strCheckField = "ISLODGE" OR strCheckField = "OTHER_JLS" OR strCheckField = "OTHER_ZDYJRC" OR strCheckField = "OTHER_JS" OR strCheckField = "OTHER_HGQ" Then
If strCellText = "否" OR strCellText = "" Then
strCellText = "0"
Else
strCellText = "1"
End If
End If
CheckData = True
End Function
'--------------------------------------------------------------------------------------------------
'返回身份证校验位
Function IDEnCode_VerifyNum(Value)
If Len(Value) = 15 Then
s_EnCode = Left(Value, 6) & "19" & Right(Value, 9)
ElseIf Len(Value) = 17 Or Len(Value) = 18 Then
s_EnCode = Left(Value, 17)
End If
nSum = Mid(s_EnCode, 1, 1) * 7
nSum = nSum + Mid(s_EnCode, 2, 1) * 9
nSum = nSum + Mid(s_EnCode, 3, 1) * 10
nSum = nSum + Mid(s_EnCode, 4, 1) * 5
nSum = nSum + Mid(s_EnCode, 5, 1) * 8
nSum = nSum + Mid(s_EnCode, 6, 1) * 4
nSum = nSum + Mid(s_EnCode, 7, 1) * 2
nSum = nSum + Mid(s_EnCode, 8, 1) * 1
nSum = nSum + Mid(s_EnCode, 9, 1) * 6
nSum = nSum + Mid(s_EnCode, 10, 1) * 3
nSum = nSum + Mid(s_EnCode, 11, 1) * 7
nSum = nSum + Mid(s_EnCode, 12, 1) * 9
nSum = nSum + Mid(s_EnCode, 13, 1) * 10
nSum = nSum + Mid(s_EnCode, 14, 1) * 5
nSum = nSum + Mid(s_EnCode, 15, 1) * 8
nSum = nSum + Mid(s_EnCode, 16, 1) * 4
nSum = nSum + Mid(s_EnCode, 17, 1) * 2
'
Check_Value = 12 - nSum Mod 11
If Check_Value = 10 Then
Check_Value = "X"
ElseIf Check_Value = 12 Then
Check_Value = "1"
ElseIf Check_Value = 11 Then
Check_Value = "0"
End If
IDEnCode_VerifyNum = Trim(Check_Value)
End Function
'-----------------------------------------------------------------------------------------------
Sub ExcelToTableXml()
nRowCount = FlexGrid.Rows
nColCount = FlexGrid.Cols
nFixedRowCount = FlexGrid.FixedRows
nFixedColCount = FlexGrid.FixedCols
strXml = "<?xml version=""1.0"" encoding=""GBK""?>"
strXml = strXml&"<Table>"
strText = ""
strXml = strXml&"<TableInfo>"
strXml = strXml&"<FieldInfoArray>"
FlexGrid.Row = 1
for i=1 To nColCount-1
FlexGrid.Col = i
strXml = strXml&"<FieldInfo>"
strXml = strXml&"<FieldName>"
strText = FlexGrid.Text
strXml = strXml&strText
strXml = strXml&"</FieldName>"
strXml = strXml&"</FieldInfo>"
Next
strXml = strXml&"</FieldInfoArray>"
strXml = strXml&"</TableInfo>"
strXml = strXml&"<Rows>"
for i=2 To nRowCount-1
FlexGrid.Row = i
strXml = strXml&"<Row>"
for j=1 To nColCount-1
FlexGrid.Row = i
FlexGrid.Col = j
strText = FlexGrid.Text
FlexGrid.Row = 1
strXml = strXml&"<"&FlexGrid.Text&">"
strXml = strXml&DBEngine.TextToDoc(strText)
strXml = strXml&"</"&FlexGrid.Text&">"
Next
strXml = strXml&"</Row>"
Next
strXml = strXml&"</Rows>"
strXml = strXml&"</Table>"
MainGrid.SetTableXML(strXml)
End Sub
'注释:
Sub cmbImportType_CloseUp()
strImportType = cmbImportType.GetItem(cmbImportType.GetCurSel())
Select Case strImportType
Case "在校生基本数据导入"
lblNotice.Caption = "提供在校生基本数据,包括学生基本信息、户口信息、家庭成员等，系统将自动生成统一学号。"
Case "分班管理数据导入"
lblNotice.Caption = "提供分班后的学生数据,包括学生所在年级、班级编号、班级名称等。"
Case "学生照片数据导入"
lblNotice.Caption = "提供在校学生的照片数据,使用系统提供的客户端工具生成的zip压缩包。"
End Select
End Sub
