Sub init(ServerURL)
	gServerURl = ServerURL
	'之所以将值制空 是为了不出现安全提醒
	gServerURL = ""
	'菜单过程
	AnalyseMenu()
End Sub
Sub Window_OnUnload()
	'释放菜单过程的对象资源
	Set objxmlMenu = Nothing
	Set objFMenu = Nothing
	Set objFMenuID = Nothing
	Set objFMenuText = Nothing
	Set objSMenu = Nothing
	Set objSMenuID = Nothing
	Set objSMenuText = Nothing
	Set objTMenu = Nothing
	Set objTMenuID = Nothing
	Set objTMenuText = Nothing
	'释放查询过程的对象资源
	Set objxmlCondition = Nothing
	Set objCondition = Nothing
	'
	Set objxmlResult = Nothing
End Sub
'创建菜单界面--------------------------------------------------------------------------------------------
Dim PageID 
Dim objxmlMenu
Dim objFMenu
Dim objFMenuID
Dim objFMenuText
Dim objSMenu
Dim objSMenuID
Dim objSMenuText
Dim objTMenu
Dim objTMenuID
Dim objTMenuText
Sub AnalyseMenu()
	on error resume next
	Set objxmlMenu = CreateObject("Msxml.DOMDocument")
	objxmlMenu.async = false
	strxml = XmlHttpGet(gServerURl & "menu.asp")
	objxmlMenu.loadxml(strxml)
	'msgbox(strxml)
	Set objFMenu = objxmlMenu.documentElement.selectNodes("FMenu")
	Set objFMenuID = objxmlMenu.documentElement.selectNodes("FMenu/MenuID")
	Set objFMenuText = objxmlMenu.documentElement.selectNodes("FMenu/MenuText")
	Set objSMenu = objxmlMenu.documentElement.selectNodes("SMenu")
	Set objSMenuID = objxmlMenu.documentElement.selectNodes("SMenu/MenuID")
	Set objSMenuText = objxmlMenu.documentElement.selectNodes("SMenu/MenuText")
	Set objTMenu = objxmlMenu.documentElement.selectNodes("TMenu")
	Set objTMenuID = objxmlMenu.documentElement.selectNodes("TMenu/MenuID")
	Set objTMenuText = objxmlMenu.documentElement.selectNodes("TMenu/MenuText")
	'现在初始定义是 001
	PageID = "001"
	BuildMenu("FMenuID" & PageID)
	BuildMenu("SMenuID" & PageID)
End Sub
Sub BuildMenu(mMenuID)
	on error resume next
	ShowMenuText
	ClearDocument()
	strMenuID = ""
	strMenuText = ""
	strMenuHtml = ""
	mMenuID = Trim (mMenuID)
	'TableFMenu		代表一级菜单存放的位置
	If (Left(mMenuID, 7)="FMenuID") Then
		For i = 0 To objFMenu.length - 1
			strMenuID =objFMenuID.item(i).text
			strMenuText =objFMenuText.item(i).text
			If strMenuID = Right(mMenuID, 3) Then
				strMenuID = "SMenuID" & strMenuID
				strMenuHtml = strMenuHtml & "<a name='a" & i & "' href='#' wjtype='F'>" & strMenuText & "</a>&nbsp;&nbsp;"
			End If
		Next
		document.all.item("TableFMenu").innerHTML = "&nbsp;" & strMenuHtml
		Exit Sub
	End If
	'TableSMenu		代表二级菜单存放的位置
	If (Left(mMenuID, 7)="SMenuID") Then
		For i = 0 To objSMenu.length - 1
			strMenuID = objSMenuID.item(i).text
			strMenuText = objSMenuText.item(i).text
			If Left(strMenuID, 3) = Mid(mMenuID, 8, 3) Then
				strMenuID = "TMenuID" & strMenuID
				strMenuHtml = strMenuHtml & "<a name='a" & i & "' href='#' wjtype='S' title='" & strMenuText & "' onclick='vbscript:BuildMenu " & """" & CStr(strMenuID) & """" & "'>" & Left(strMenuText, 6) & "</a>&nbsp;&nbsp;"
			End If
		Next
		document.all.item("TableSMenu").innerHTML = "&nbsp;" & strMenuHtml & "<br><br>"
		Exit Sub
	End If
	'TableTMenu		代表三级菜单存放的位置
	If (Left(mMenuID, 7)="TMenuID") Then
		For i = 0 To objTMenu.length - 1
			strMenuID = objTMenuID.item(i).text
			strMenuText = objTMenuText.item(i).text
			If Left(strMenuID, 6)=Mid(mMenuID, 8, 6) Then
				strMenuHtml = strMenuHtml & "<a name='a" & i & "' href='#' wjtype='T' title='" & strMenuText & "' onclick='vbscript:AnalyseCondition " & """" & CStr(strMenuID) & """" & "'>" & Left(strMenuText, 6) & "</a>&nbsp;&nbsp;"
				'strMenuHtml = strMenuHtml & "<a href='#' onmouseover='vbscript:AnalyseCondition " & """" & strMenuID & """" & "'>" & strMenuText & "</a>&nbsp;&nbsp;"
			End If
		Next
		document.all.item("TableTMenu").innerHTML = "&nbsp;&nbsp;&nbsp;" & strMenuHtml & "<br>"
		Exit Sub
	End If
End Sub
'创建菜单界面--------------------------------------------------------------------------------------------
'创建查询条件界面-----------------------------------------------------------------------------------------
Dim objxmlCondition
Dim objCondition
Sub AnalyseCondition(mMenuID)
	on error resume next
	'msgbox(mMenuID)
	Set objxmlCondition = CreateObject("Msxml.DOMDocument")
	objxmlCondition.async = false
	strxml = XmlHttpGet(gServerURl & "Condition.asp?TMenuID=" & mMenuID)
	objxmlCondition.loadxml(strxml)
	'msgbox(strxml)
	Set objCondition = objxmlCondition.documentElement.selectNodes("Condition")
	BuildCondition()
	'将当前操作的菜单 id 保存到全局
	document.all.item("objTMenuID").value = mMenuID
End Sub
Sub BuildCondition()
	on error resume next
	ShowMenuText
	ClearDocument()
	strConditionHtml = ""
	'TableQuery		代表查询条件存放的位置
	For i = 0 To objCondition.length - 1 
		Set objNode = objCondition.item(i).childNodes 
		strConditionName = "wjcn_" & i
		strConditionText = objNode.item(0).text
		strConditionType = objNode.item(1).text
		strConditionValues = objNode.item(2).text
		
		'对数据类型还要加判断 如果是日期型 就要调用日期的选择函数
		If strConditionType="135" Then
			strConditionHtml = strConditionHtml & strConditionText
			strConditionValues = date
			strConditionHtml = strConditionHtml & " <input type='text' "
			strConditionHtml = strConditionHtml & "id='" & strConditionName & "' Size='12' "
			strConditionHtml = strConditionHtml & "ConditionType='" & strConditionType & "' "
			strConditionHtml = strConditionHtml & "value='" & strConditionValues & "' "
			strConditionHtml = strConditionHtml & "onfocus='javascript:show_cele_date(" & strConditionName & "," & """" & """" & " ," & """" & """" & " ," & strConditionName& ");' "
			strConditionHtml = strConditionHtml & "</input>&nbsp;&nbsp;"
			'msgbox(strConditionHtml)
		Else						'Varchar 200
			strConditionHtml = strConditionHtml & "<font color='red'>" & strConditionText & "</font>"
			strConditionHtml = strConditionHtml & " <select "
			strConditionHtml = strConditionHtml & "id='" & strConditionName & "' "
			strConditionHtml = strConditionHtml & "ConditionType='" & strConditionType & "'>"
			'处理一下数据  有时候后面跟了一个多余的分号
			If Right(strConditionValues, 1)=";" Then
				strConditionValues = Left(strConditionValues, Len(strConditionValues) - 1)
			End If
			arrstrConditionValues = Split(strConditionValues, ";")
			For j = Lbound(arrstrConditionValues) To Ubound(arrstrConditionValues)
				strConditionHtml = strConditionHtml & "<option value='" & arrstrConditionValues(j) & "'>" & arrstrConditionValues(j) & "</Option>"
				'msgbox(strConditionHtml)
			Next
			strConditionHtml = strConditionHtml & "</select>&nbsp;&nbsp;"
		End If
		Set objNode = Nothing
	Next
	strConditionHtml = strConditionHtml & "<input type='button' name='submit' value='查询=>' onclick='Vbscript:AnalyseSubmit()'>"
	document.all.item("TableQuery").innerHTML = "<br>" & strConditionHtml
	'msgbox(strConditionHtml)
End Sub
'创建查询条件界面-----------------------------------------------------------------------------------------
Sub AnalyseSubmit()
	ShowMessage()
	'分析页面输入的条件
	strCondition = ""
	Set oForm = document.all.item("form1")
	For i = 0 To oForm.length - 1
		strFormID = oForm(i).id
		If Left(strFormID, 5)="wjcn_" Then
		'Name:Type:Value
			strCondition = strCondition & (oForm(i).id & ":" & oForm(i).ConditionType & ":" & oForm(i).value & ";")
		End If
	Next
	strCondition = Left(strCondition, Len(strCondition) - 1)
	strServer = "Result.asp?Condition=" & strCondition & "&TMenuID=" & (document.all.item("objTMenuID").value)
	'msgbox(strServer)
	'查询结果
	AnalyseResult(strServer)
End Sub
'创建查询结果界面-----------------------------------------------------------------------------------------
Dim objxmlResult
Sub AnalyseResult(strServer)
	on error resume next
	'提交页面的条件查询返回数据 xml 
	Set objxmlResult = CreateObject("Msxml.DOMDocument")
	objxmlResult.async = false
	strxml = XmlHttpGet(gServerURl & strServer)
	objxmlResult.loadxml(strxml)
	'msgbox(strxml)
	BuildResult
End Sub
Sub BuildResult()
	on error resume next
	Set objRecord = objxmlResult.documentElement.selectNodes("Record")
	If (CInt(objRecord.length) = 0) Then
		document.all.item("TableResult").innerHTML = "<font color='blue'>无符合条件记录返回</font><br>"
		Exit Sub
	End If
	strHtml = "<font color='blue'>共返回符合条件的记录 " & CStr(objRecord.length) & " 条</font><br>"
	Set objRecord = Nothing
	strHtml = strHtml & "<table id='TableContent' onmouseover='vbscript:ShowTdTitle()' border='1' bordercolorlight='#cccccc' bordercolordark='#ffffff' width='94%'  cellpadding='0' cellspacing='0' class='text' >"
	'添加表格头
	Set objResult = objxmlResult.documentElement.selectNodes("Field")
	strHtml = strHtml & "<tr>"
	For i = 0 To objResult.length - 1 
		Set objNodes = objResult.item(i).childNodes 
		For j = 0 To objNodes.length - 1
			If j = 0 Then
				strHtml = strHtml & "<td class='TextCaption' title='" & objNodes.item(j).text & "'>&nbsp;" & objNodes.item(j).text & "</td>"
			Else
				strHtml = strHtml & "<td class='TextCol' title='" & objNodes.item(j).text & "'>&nbsp;" & objNodes.item(j).text & "</td>"
			End If
		Next
		Set objNodes = Nothing
	Next
	strHtml = strHtml & "</tr>"
	Set objResult = Nothing
	'添加表格数据
	Set objResult = objxmlResult.documentElement.selectNodes("Record")
	For i = 0 To objResult.length - 1 
		Set objNodes = objResult.item(i).childNodes 
		strHtml = strHtml & "<tr>"
		For j = 0 To objNodes.length - 1
			If j = 0 Then
				strHtml = strHtml & "<td class='TextRow' nowrap>&nbsp;" & objNodes.item(j).text & "</td>"
			Else
				If (i mod 2 = 0) Then
					strHtml = strHtml & "<td class='TextEven'>&nbsp;" & objNodes.item(j).text & "</td>"
				Else
					strHtml = strHtml & "<td class='TextOdd'>&nbsp;" & objNodes.item(j).text & "</td>"
				End If
			End If
		Next
		strHtml = strHtml & "</tr>"
		Set objNodes = Nothing
	Next
	Set objResult = Nothing

	strHtml = strHtml & "</table>"
	document.all.item("TableResult").innerHTML = strHtml
	'msgbox(strHtml)
End Sub
'创建查询结果界面-----------------------------------------------------------------------------------------
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function XmlHttpGet(strServer)
	Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
	xmlhttp.open "Get", strServer, false
	'xmlhttp.setRequestHeader "ContentType", "Text/xml;charset=gb2312"
	xmlhttp.send
	XmlHttpGet = xmlhttp.ResponseXML.xml
	Set xmlhttp = Nothing
End Function
Sub ClearDocument()
	'清空界面
	'If document.all.item("TableQuery").innerHTML <> "" Then
		document.all.item("TableQuery").innerHTML = "&nbsp;<br>"
		document.all.item("TableResult").innerHTML = "&nbsp;<br>"
		'document.all.item("TMenuText").innerHTML = "&nbsp;<br>"
	'End If
End Sub
Sub ShowMessage()
	'document.all.item("TableResult").innerHTML = "正在查询数据库，请稍候......"
End Sub
Sub ShowMenuText()
	on error resume next
	Set oSource = window.event.srcElement
	If oSource.wjtype="S" Then
			For i = 0 To document.anchors.length - 1 
			If document.anchors(i).wjtype = "S" Then
				document.anchors(i).style.backgroundColor = ""
			End If
		Next
		oSource.style.backgroundColor = "red"
	End If
	If oSource.wjtype="T" Then
		For i = 0 To document.anchors.length - 1 
			If document.anchors(i).wjtype = "T" Then
				document.anchors(i).style.backgroundColor = ""
			End If
		Next
		oSource.style.backgroundColor = "blue"
	End If
	document.all.item("TMenuText").innerHtml = "<font color='red'>" & oSource.title & "</font>"
End Sub
Sub ShowTdTitle()
	on error resume next
	Set oSource = window.event.srcElement
	If oSource.tagName = "TD" Then
		oSource.Title = TableContent.rows(0).cells(oSource.cellIndex).title
	End If
End Sub