<%server.ScriptTimeout =240
Dim ECapi3,Bizcn_wsurl,Bizcn_User,Bizcn_Pass

Bizcn_wsurl = "https://www.bizcn.com/rrpservices/"'Application("Domain_HTTP") 'WebService
Bizcn_User = Application("Domain_Agent_username_3") '代理用户名
Bizcn_Pass = Application("Domain_Agent_password_3")	'密码


'/*
'Usage:
'
'RegisterDomain
'
'Paramates 参数详见下面示例
'
'
'*/

'Dim s_domainname	'域名
'Dim s_term	'注册年限
'Dim s_domainpwd	'域名密码
'Dim s_dns_host	'DNS主机名,数组,2-6个
'Dim s_dns_ip	'DNS主机IP,数组,2-6个
''===以下为域名所有者联系资料
'Dim s_dom_fn,s_dom_ln,s_dom_org,s_dom_adr1,s_dom_ct,s_dom_st,s_dom_co,s_dom_pc,s_dom_ph,s_dom_fax,s_dom_em
''===以下为域名技术支持联系资料
'Dim s_tech_fn,s_tech_ln,s_tech_org,s_tech_adr1,s_tech_ct,s_tech_st,s_tech_co,s_tech_pc,s_tech_ph,s_tech_fax,s_tech_em
''===以下为财务信息联系资料
'Dim s_bill_fn,s_bill_ln,s_bill_org,s_bill_adr1,s_bill_ct,s_bill_st,s_bill_co,s_bill_pc,s_bill_ph,s_bill_fax,s_bill_em
''===以下为管理员联系资料
'Dim s_admi_fn,s_admi_ln,s_admi_org,s_admi_adr1,s_admi_ct,s_admi_st,s_admi_co,s_admi_pc,s_admi_ph,s_admi_fax,s_admi_em
''===以下为中文联系资料
'Dim s_dom_org_m,s_dom_fn_m,s_dom_ln_m,s_dom_adr_m,s_dom_ct_m,s_dom_st_m,s_admi_org_m,s_admi_fn_m,s_admi_ln_m
'	s_domainname = "x11a111b222c333.com"
'	s_term = "1"
'	s_domainpwd = "aI1wlaD8V"
'	s_dns_host = Array("dns.bizcn.com","dns.cnmsn.net")
'	s_dns_ip = Array("8.8.8.8","8.8.4.4")
'	s_dom_org = "Bizcn com"
'	s_dom_fn = "Bizcn"
'	s_dom_ln = "COM"
'	s_dom_adr1 = "Xm Xiamen FJ"
'	s_dom_ct = "XM"
'	s_dom_st = "FJ"
'	s_dom_co = "CN"
'	s_dom_pc = "361000"
'	s_dom_ph = "+86.13888888888"
'	s_dom_fax = "+86.5922222222"
'	s_dom_em = "test@bizcn.com"
'	s_tech_fn = "Bizcn"
'	s_tech_ln = "Com"
'	s_tech_org = "Bizcn Com"
'	s_tech_adr1 = "XM Xiamen FJ"
'	s_tech_ct = "XM"
'	s_tech_st = "FJ"
'	s_tech_co = "CN"
'	s_tech_pc = "361000"
'	s_tech_ph = "+86.13888888888"
'	s_tech_fax = "+86.5922222222"
'	s_tech_em = "test@bizcn.com"
'	s_bill_fn = "Bizcn"
'	s_bill_ln = "Com"
'	s_bill_org = "Bizcn Com"
'	s_bill_adr1 = "XM Xiamen FJ"
'	s_bill_ct = "XM"
'	s_bill_st = "FJ"
'	s_bill_co = "CN"
'	s_bill_pc = "361000"
'	s_bill_ph = "+86.13888888888"
'	s_bill_fax = "+86.5922222222"
'	s_bill_em = "test@bizcn.com"
'	s_admi_fn = "Bizcn"
'	s_admi_ln = "Com"
'	s_admi_org = "Bizcn Com"
'	s_admi_adr1 = "XM Xiamen FJ"
'	s_admi_ct = "XM"
'	s_admi_st = "FJ"
'	s_admi_co = "CN"
'	s_admi_pc = "361000"
'	s_admi_ph = "+86.13888888888"
'	s_admi_fax = "+86.5922222222"
'	s_admi_em = "test@bizcn.com"
'	s_dom_org_m = "商中在线科技"
'	s_dom_fn_m = "商中"
'	s_dom_ln_m = "在线"
'	s_dom_adr_m = "厦门市思明区"
'	s_dom_ct_m = "厦门"
'	s_dom_st_m = "福建"
'	s_admi_org_m = "商中在线"
'	s_admi_fn_m = "商中"
'	s_admi_ln_m = "在线"
'	s_admi_adr_m = "厦门市思明区"
'	s_admi_ct_m = "厦门"
'	s_admi_st_m = "福建"
'	dom_st_m中文字段得是中文
'Dim RegOrderID
'
'RegOrderID = RegisterDomain(s_domainname,_
's_term, s_domainpwd, s_dns_host, s_dns_ip, _
's_dom_fn, s_dom_ln, s_dom_org, s_dom_adr1, s_dom_ct, s_dom_st, s_dom_co, s_dom_pc, s_dom_ph, s_dom_fax, s_dom_em, _
's_tech_fn, s_tech_ln, s_tech_org, s_tech_adr1, s_tech_ct, s_tech_st, s_tech_co, s_tech_pc, s_tech_ph, s_tech_fax, s_tech_em, _
's_bill_fn, s_bill_ln, s_bill_org, s_bill_adr1, s_bill_ct, s_bill_st, s_bill_co, s_bill_pc, s_bill_ph, s_bill_fax, s_bill_em, _
's_admi_fn, s_admi_ln, s_admi_org, s_admi_adr1, s_admi_ct, s_admi_st, s_admi_co, s_admi_pc, s_admi_ph, s_admi_fax, s_admi_em, _
's_dom_org_m, s_dom_fn_m, s_dom_ln_m, s_dom_adr_m, s_dom_ct_m, s_dom_st_m, _
's_admi_org_m, s_admi_fn_m, s_admi_ln_m, s_admi_adr_m, s_admi_ct_m, s_admi_st_m)
'
'if lcase(cstr(RegOrderID))<>"false" then '域名密码域名格式为:至少六位的大小写字母加数字,可有特殊字符
'	Response.write "注册成功,订单号为:" & RegOrderID
'else
'	Response.write "注册域名失败"
'end if

Function RegisterDomain(Domain_name,_
term,domainpwd,dns_host,dns_ip,_
dom_fn,dom_ln,dom_org,dom_adr1,dom_ct,dom_st,dom_co,dom_pc,dom_ph,dom_fax,dom_em,_
tech_fn,tech_ln,tech_org,tech_adr1,tech_ct,tech_st,tech_co,tech_pc,tech_ph,tech_fax,tech_em,_
bill_fn,bill_ln,bill_org,bill_adr1,bill_ct,bill_st,bill_co,bill_pc,bill_ph,bill_fax,bill_em,_
admi_fn,admi_ln,admi_org,admi_adr1,admi_ct,admi_st,admi_co,admi_pc,admi_ph,admi_fax,admi_em,_
dom_org_m,dom_fn_m,dom_ln_m,dom_adr_m,dom_ct_m,dom_st_m,_
admi_org_m,admi_fn_m,admi_ln_m, admi_adr_m, admi_ct_m, admi_st_m)


province_m=dom_st_m
province_m=Replace(province_m,"Beijing","北京")
province_m=Replace(province_m,"Hongkong","香港")
province_m=Replace(province_m,"Aomen","澳门")
province_m=Replace(province_m,"Taiwan","台湾")
province_m=Replace(province_m,"Shanghai","上海")
'province_m=Replace(province_m,"深圳","SZ")
province_m=Replace(province_m,"Guangdong","广东")
province_m=Replace(province_m,"Shandong","山东")
province_m=Replace(province_m,"Sichuan","四川")
province_m=Replace(province_m,"Fujian","福建")
province_m=Replace(province_m,"Jiangsu","江苏")
province_m=Replace(province_m,"Zhejiang","浙江")
province_m=Replace(province_m,"Tianjin","天津")
province_m=Replace(province_m,"Chongqing","重庆")
province_m=Replace(province_m,"Hebei","河北")
province_m=Replace(province_m,"Henan","河南")
province_m=Replace(province_m,"Heilongjiang","黑龙江")
province_m=Replace(province_m,"Jinlin","吉林")
province_m=Replace(province_m,"Liaoning","辽宁")
province_m=Replace(province_m,"Neimenggu","内蒙古")
province_m=Replace(province_m,"Hainan","海南")
province_m=Replace(province_m,"Shanxi3","山西")'注意
province_m=Replace(province_m,"Shanxi","陕西")'注意
province_m=Replace(province_m,"Anhui","安徽")
province_m=Replace(province_m,"Jiangxi","江西")
province_m=Replace(province_m,"Gansu","甘肃")
province_m=Replace(province_m,"Xinjiang","新疆")
province_m=Replace(province_m,"Hubei","湖北")
province_m=Replace(province_m,"Hunan","湖南")
province_m=Replace(province_m,"Yunnan","云南")
province_m=Replace(province_m,"Guangxi","广西")
province_m=Replace(province_m,"Ningxia","宁夏")
province_m=Replace(province_m,"Guizhou","贵州")
province_m=Replace(province_m,"Qinghai","青海")
province_m=Replace(province_m,"Xizang","西藏")
dom_st_m=province_m
admi_st_m=dom_st_m

	Dim XmlCls,WsReturn
	Set XmlCls = New KKS_XMLCLS '初始化XML类
	XmlCls.Debug = True 'Debug 开关,与下面输出XmlCls.ErrorMsg 匹配
	XmlCls.W = Bizcn_wsurl & "addDomainService"	'设置 WebService Url
	XmlCls.U = Bizcn_User	'设置 WebService 用户名
	XmlCls.P = Bizcn_Pass	'设置 WebService 密码
	dim Data,Strings,i
	i=0
    Strings = "" &_
	"<create>"  & _
    "<domainname>" & cstr(Domain_name) & "</domainname>"  & _
    "<term>" & term & "</term>"
	If IsArray(dns_host)<>true then
		RegisterDomain = False 'DNS HOST值错误
		Exit Function
	End if
	If IsArray(dns_ip)<>true then
		RegisterDomain = False 'DNS IP值错误
		Exit Function
	End if
	If ubound(dns_host)<>ubound(dns_ip) then
		RegisterDomain = False 'HOST 和 IP 个数不匹配
		Exit Function
	End if
	for i=0 to ubound(dns_host)
		Strings = Strings & "<dns_host" & i+1 & ">" & dns_host(i) & "</dns_host" & i+1 & ">"  & _
    "<dns_ip" & i+1 & ">" & dns_ip(i) & "</dns_ip" & i+1 & ">" 
	next
    Strings = Strings & "<dom_org>" & dom_org & "</dom_org>"  & _
    "<dom_fn>" & dom_fn & "</dom_fn>"  & _
    "<dom_ln>" & dom_ln & "</dom_ln>"  & _
    "<dom_adr1>" & dom_adr1 & "</dom_adr1>"  & _
    "<dom_ct>" & dom_ct & "</dom_ct>"  & _
    "<dom_st>" & dom_st & "</dom_st>"  & _
    "<dom_co>" & dom_co & "</dom_co>"  & _
    "<dom_pc>" & dom_pc & "</dom_pc>"  & _
    "<dom_ph>" & dom_ph & "</dom_ph>"  & _
    "<dom_fax>" & dom_fax & "</dom_fax>"  & _
    "<dom_em>" & dom_em & "</dom_em>"  & _
    "<tech_fn>" & tech_fn & "</tech_fn>"  & _
    "<tech_ln>" & tech_ln & "</tech_ln>"  & _
    "<tech_org>" & tech_org & "</tech_org>"  & _
    "<tech_adr1>" & tech_adr1 & "</tech_adr1>"  & _
    "<tech_ct>" & tech_ct & "</tech_ct>"  & _
    "<tech_st>" & tech_st & "</tech_st>"  & _
    "<tech_co>" & tech_co & "</tech_co>"  & _
    "<tech_pc>" & tech_pc & "</tech_pc>"  & _
    "<tech_ph>" & tech_ph & "</tech_ph>"  & _
    "<tech_fax>" & tech_fax & "</tech_fax>"  & _
    "<tech_em>" & tech_em & "</tech_em>"  & _
    "<bill_fn>" & bill_fn & "</bill_fn>"  & _
    "<bill_ln>" & bill_ln & "</bill_ln>"  & _
    "<bill_org>" & bill_org & "</bill_org>"  & _
    "<bill_adr1>" & bill_adr1 & "</bill_adr1>"  & _
    "<bill_ct>" & bill_ct & "</bill_ct>"  & _
    "<bill_st>" & bill_st & "</bill_st>"  & _
    "<bill_co>" & bill_co & "</bill_co>"  & _
    "<bill_pc>" & bill_pc & "</bill_pc>"  & _
    "<bill_ph>" & bill_ph & "</bill_ph>"  & _
    "<bill_fax>" & bill_fax & "</bill_fax>"  & _
    "<bill_em>" & bill_em & "</bill_em>"  & _
    "<admi_fn>" & admi_fn & "</admi_fn>"  & _
    "<admi_ln>" & admi_ln & "</admi_ln>"  & _
    "<admi_org>" & admi_org & "</admi_org>"  & _
    "<admi_adr1>" & admi_adr1 & "</admi_adr1>"  & _
    "<admi_ct>" & admi_ct & "</admi_ct>"  & _
    "<admi_st>" & admi_st & "</admi_st>"  & _
    "<admi_co>" & admi_co & "</admi_co>"  & _
    "<admi_pc>" & admi_pc & "</admi_pc>"  & _
    "<admi_ph>" & admi_ph & "</admi_ph>"  & _
    "<admi_fax>" & admi_fax & "</admi_fax>"  & _
    "<admi_em>" & admi_em & "</admi_em>"  & _
    "<domainpwd>" & domainpwd & "</domainpwd>"  & _
    "<dom_org_m>" & dom_org_m & "</dom_org_m>"  & _
    "<dom_fn_m>" & dom_fn_m & "</dom_fn_m>"  & _
    "<dom_ln_m>" & dom_ln_m & "</dom_ln_m>"  & _
    "<dom_adr_m>" & dom_adr_m & "</dom_adr_m>"  & _
    "<dom_ct_m>" & dom_ct_m & "</dom_ct_m>"  & _
    "<dom_st_m>" & dom_st_m & "</dom_st_m>"  & _
    "<admi_org_m>" & admi_org_m & "</admi_org_m>"  & _
    "<admi_fn_m>" & admi_fn_m & "</admi_fn_m>"  & _
    "<admi_ln_m>" & admi_ln_m & "</admi_ln_m>"  & _
    "<admi_adr_m>" & admi_adr_m & "</admi_adr_m>"  & _
    "<admi_ct_m>" & admi_ct_m & "</admi_ct_m>"  & _
    "<admi_st_m>" & admi_st_m & "</admi_st_m>"  & _
    "</create>" 

'	response.write Strings
'		response.end

dsdom("postcon")=Strings

	Data = XmlCls.MakeWSXml("addDomain",Strings)	'方法: renewDomain
	WsReturn = XmlCls.GetWS(Data,"orderid")	'无返回值,Result Code 为 200 即为操作成功,返回True/Flase
'	response.write XmlCls.ErrorMsg ' 可输出错误信息
ECapi3=XmlCls.ErrorMsg&Strings
	RegisterDomain = cstr(WsReturn)
End Function

'/*
'Usage:
'
'ModDomainPassword
'
'Paramates String Domain_name 要续费域名
'Paramates String Password 域名密码
''
'Dim NewPassword
'NewPassword = "Aa147258!"
'if ModDomainPassword("ddyui22a2.com", NewPassword)=True then '域名密码域名格式为:至少六位的大小写字母加数字,可有特殊字符
'	Response.write "修改成功,新密码为:" & NewPassword
'else
'	Response.write "修改域名密码失败"
'end if
'
'
'*/

Function ModDomainPassword(ByVal Domain_name,ByVal Password)
	Dim XmlCls,WsReturn
	Set XmlCls = New KKS_XMLCLS '初始化XML类
	XmlCls.Debug = True 'Debug 开关,与下面输出XmlCls.ErrorMsg 匹配
	XmlCls.W = Bizcn_wsurl & "modDomainPasswdService"	'设置 WebService Url
	XmlCls.U = Bizcn_User	'设置 WebService 用户名
	XmlCls.P = Bizcn_Pass	'设置 WebService 密码

	dim Data,Strings
    Strings = "     <modpasswd>"  & _
    "<domainname>" & cstr(Domain_name) & "</domainname>"  & _
    "<domainpwd><![CDATA[" & cstr(Password) & "]]></domainpwd>"  & _
    "     </modpasswd>" 
	Data = XmlCls.MakeWSXml("modPasswd",Strings)	'方法: renewDomain
	WsReturn = XmlCls.GetWS(Data,"")	'无返回值,Result Code 为 200 即为操作成功,返回True/Flase
	ECapi3=XmlCls.ErrorMsg&Strings
	'response.write XmlCls.ErrorMsg ' 可输出错误信息
	ModDomainPassword = cBool(WsReturn)
End Function

'/*
'Usage:
'
'RenewDomain
'
'Paramates String Domain_name 要续费域名
'Paramates int term 域名续费年限
'
'Dim RenewOrderID
'
'RenewOrderID = RenewDomain("abc.net",1)
'if CBool(RenewOrderID)<>false then
'	Response.write "续费成功,订单号为:" & RenewOrderID
'else
'	Response.write "续费失败"
'end if
'
'
'*/

Function RenewDomain(ByVal Domain_name,ByVal term)
	Dim XmlCls,WsReturn
	Set XmlCls = New KKS_XMLCLS '初始化XML类
	XmlCls.Debug = True 'Debug 开关,与下面输出XmlCls.ErrorMsg 匹配
	XmlCls.W = Bizcn_wsurl & "renewDomainService"	'设置 WebService Url
	XmlCls.U = Bizcn_User	'设置 WebService 用户名
	XmlCls.P = Bizcn_Pass	'设置 WebService 密码

	dim Data,Strings
    Strings = "     <renew>"  & _
    "<domain>" & cstr(Domain_name) & "</domain>"  & _
    "<term>" & cstr(term) & "</term>"  & _
    "     </renew>"
	Data = XmlCls.MakeWSXml("renewDomain",Strings)	'方法: renewDomain
	WsReturn = XmlCls.GetWS(Data,"orderid")	'获取orderid标签的值
'	response.write XmlCls.ErrorMsg ' 可输出错误信息
	ECapi3=XmlCls.ErrorMsg&Strings
	RenewDomain = cstr(WsReturn)
End Function

Function CheckDomain(ByVal Domain_name)
	Dim XmlCls,WsReturn
	Set XmlCls = New KKS_XMLCLS '初始化XML类
	XmlCls.Debug = True 'Debug 开关,与下面输出XmlCls.ErrorMsg 匹配
	XmlCls.W = Bizcn_wsurl & "checkDomainsService"	'设置 WebService Url
	XmlCls.U = Bizcn_User	'设置 WebService 用户名
	XmlCls.P = Bizcn_Pass	'设置 WebService 密码

	dim Data,Strings
	Strings = "         <check>"  & _
	"            <name>" & Domain_name & "</name>"  & _
	"         </check>" 
	Data = XmlCls.MakeWSXml("checkDomains",Strings)	'方法: checkDomains
	WsReturn = XmlCls.GetWS(Data,Array("domain","avail"))'获取Domain标签的avail属性值
'	response.write XmlCls.ErrorMsg ' 可输出错误信息
ECapi3=XmlCls.ErrorMsg
	CheckDomain = cstr(WsReturn)
End Function



'/*
'Usage:
'
'CheckDomain
'
'Paramates Array Domain_name 查询的域名
'
'Dim Domains,Batch_Result,i
'Domains = Array("abc.net","bdfaerad43sadf34cd.net")
'Batch_Result = CheckDomain_Batch(Domains)
'for i=0 to ubound(Domains)
'	if cstr(Batch_Result(i))="1" then
'		Response.write Domains(i) & "  可注册<br />" & VbCrLf
'	else
'		Response.write Domains(i) & " 不可注册<br />" & VbCrLf
'	end if
'next
'
'
'*/

Function CheckDomain_Batch(ByVal Domains)
	if not isArray(Domains) then Domains = Array(Domains)
	Dim XmlCls,WsReturn,i
	Set XmlCls = New KKS_XMLCLS '初始化XML类
	XmlCls.Debug = True 'Debug 开关,与下面输出XmlCls.ErrorMsg 匹配
	XmlCls.W = Bizcn_wsurl & "checkDomainsService"	'设置 WebService Url
	XmlCls.U = Bizcn_User	'设置 WebService 用户名
	XmlCls.P = Bizcn_Pass	'设置 WebService 密码

	dim Data,Strings
	Strings = "         <check>"
	for i=0 to ubound(Domains)
		if Domains(i)<>"" then
			Strings = Strings & "            <name>" & Domains(i) & "</name>"
		end if
	next
	Strings = Strings & "         </check>" 
	Data = XmlCls.MakeWSXml("checkDomains",Strings)	'方法: checkDomains
'	Response.write Data
	WsReturn = XmlCls.GetWS(Data,Array("domain","avail",ubound(Domains)))'获取Domain标签的avail属性值
	response.write XmlCls.ErrorMsg ' 可输出错误信息
	CheckDomain_Batch = WsReturn
End Function

  '---------------------------------------------------------------- 
  '程序简介: 完成asp语言对XML文档中指定节点文本的增加、删除、修改、查看 
  '入口参数: 无 
  '出口参数: 无 
  '------------------------------------------------ 
  '函数名字：ConnectXml() 
  '入口参数: filename 需要连接或打开的xml文件名 
  '出口参数: 无 
  '返回值 ：ConnectXml=0，XMLMorntekDocument就是一个成功装载XML文档的对象了。 
  ' ConnectXml<>0,则打印错误信息strError 
  '------------------------------------------------ 
Class KKS_XMLCLS

Private XMLMorntekDocument
Private p_Debug,p_ErrorMsg
Private p_XmlFileName
Private p_XmlDomObjName
Public SubNodes,Length
Public XmlStrings,LoadType
Public W,U,P


Sub Class_Initialize() 
	p_Debug=False
	p_ErrorMsg=""
	p_XmlFileName=""
	p_XmlDomObjName="Microsoft.XMLDOM"
	XmlStrings=""
	LoadType="load"
End Sub

Private Sub Class_terminate()
 If IsObject(XMLMorntekDocument) Then Set XMLMorntekDocument=Nothing
End Sub 

 Public Property Get XmlFileName
  XmlFileName=p_XmlFileName
 End Property
 Public Property Let XmlFileName(XFNStrings)
  If XFNStrings<>"" Then
   p_XmlFileName=XFNStrings
  End If
 End Property
  
 Public Property Get ErrorMsg
  ErrorMsg=p_ErrorMsg
 End Property

 Public Property Get Debug
  Debug=p_Debug
 End Property
 Public Property Let Debug(BoolDebug)
  If BoolDebug Then
   p_Debug=True
  Else
   p_Debug=False
  End If
 End Property
 
 
 Private Sub ConnectXml() 
  dim strSourceFile,strError
  Set XMLMorntekDocument = Server.CreateObject(p_XmlDomObjName) 
  XMLMorntekDocument.async = false 
  if LoadType="LoadXML" then
  	XMLMorntekDocument.loadXML(XmlStrings)
  else
	  strSourceFile = Server.MapPath(p_XmlFileName)
	  XMLMorntekDocument.load(strSourceFile)
  end if
  if XMLMorntekDocument.parseerror.errorcode<>0 then 
	  strError="<h2>error"&XMLMorntekDocument.parseerror.errorcode&"</h2>" 
	  strError=strError&XMLMorntekDocument.parseerror.reason&"<br>" 
	  strError=strError&XMLMorntekDocument.parseerror.url&"<br>" 
	  strError=strError&XMLMorntekDocument.parseerror.line&"<br>" 
	  strError=strError&XMLMorntekDocument.parseerror.filepos&"<br>" 
	  strError=strError&XMLMorntekDocument.parseerror.srcText&"<br>" 
	  p_ErrorMsg=strError 
  end if 
  End Sub

 Public Sub ReConnectXML()
 	ConnectXml()
 End Sub
  '------------------------------------------------ 
  '函数名字：RootNode() 
  '入口参数:  
  '出口参数: 无 
  '------------------------------------------------ 
  Public function RootNode()
  On Error Resume Next
  If NOT IsObject(XMLMorntekDocument) Then ConnectXml
  Set RootNode = XMLMorntekDocument.documentElement
  If Err then
  	if Debug then p_ErrorMsg = Err.Description
		Err.Clear
		Set RootNode = Nothing
  End If
  end function 
  '------------------------------------------------ 
  '函数名字：SelectXmlNodeText(elementname) 
  '入口参数: elementname 元素的名字 
  '出口参数: 无 
  '------------------------------------------------ 
  Public function SelectXmlNodeText(elementname)
  On Error Resume Next
  If NOT IsObject(XMLMorntekDocument) Then ConnectXml
   elementname="//"&elementname
   dim temp
   temp=XMLMorntekDocument.selectSingleNode(elementname).text 
  If Err then
  	if Debug then p_ErrorMsg = Err.Description
		Err.Clear
		selectXmlNodeText = ""
  Else
  		selectXmlNodeText = server.htmlencode(temp)
  End If
  end function 
  '------------------------------------------------ 
  '函数名字：GetXMLTagText(elementname) 
  '入口参数: elementname 元素的名字 
  '出口参数: 无 
  '------------------------------------------------ 
  Public function GetXMLTagText(elementname)
  On Error Resume Next
  If NOT IsObject(XMLMorntekDocument) Then ConnectXml
   dim temp
   temp=XMLMorntekDocument.getElementsByTagName(elementname).item(0).text 
  If Err then
  	if Debug then p_ErrorMsg = Err.Description
		Err.Clear
		GetXMLTagText = ""
  Else
  		GetXMLTagText = server.htmlencode(temp)
  End If
  end function 
  '------------------------------------------------ 
  '函数名字：GetXMLTagAttrib(elementname,attribname) 
  '入口参数: elementname 元素的名字 , attribname 属性的名字
  '出口参数: 无 
  '------------------------------------------------ 
  Public function GetXMLTagAttrib(elementname,attribname)
  On Error Resume Next
  If NOT IsObject(XMLMorntekDocument) Then ConnectXml
   dim temp
   temp=XMLMorntekDocument.getElementsByTagName(elementname).item(0).getAttributeNode(attribname).nodeValue
  If Err then
  	if Debug then p_ErrorMsg = Err.Description
		Err.Clear
		GetXMLTagAttrib = ""
  Else
  		GetXMLTagAttrib = server.htmlencode(temp)
  End If
  end function
  '------------------------------------------------ 
  '函数名字：SelectXmlNodeLength(elementname) 
  '入口参数: elementname 元素的名字 
  '出口参数: 无 
  '------------------------------------------------ 
  Public function SelectXmlNodeLength(elementname)
  On Error Resume Next
  If NOT IsObject(XMLMorntekDocument) Then ConnectXml
   elementname="//"&elementname
   dim temp
   temp=XMLMorntekDocument.selectNodes(elementname).length
  If Err then
  	if Debug then p_ErrorMsg = Err.Description
		Err.Clear
		SelectXmlNodeLength = 0
  Else
  		SelectXmlNodeLength = temp
  End If
  end function

  '------------------------------------------------ 
  '函数名字：GetXMLTagText(elementname) 
  '入口参数: elementname 元素的名字 
  '出口参数: 无 
  '------------------------------------------------ 
  Public function GetXMLTagTexts(elementname,IndexNum)
  On Error Resume Next
  IndexNum = cint(IndexNum)
  If NOT IsObject(XMLMorntekDocument) Then ConnectXml
   dim temp
   temp=XMLMorntekDocument.getElementsByTagName(elementname).item(IndexNum).text 
  If Err then
  	if Debug then p_ErrorMsg = Err.Description
		Err.Clear
		GetXMLTagTexts = ""
  Else
  		GetXMLTagTexts = server.htmlencode(temp)
  End If
  end function 
  '------------------------------------------------ 
  '函数名字：GetXMLTagAttrib(elementname,attribname) 
  '入口参数: elementname 元素的名字 , attribname 属性的名字
  '出口参数: 无 
  '------------------------------------------------ 
  Public function GetXMLTagAttribs(elementname,attribname,IndexNum)
  On Error Resume Next
  IndexNum = cint(IndexNum)
  If NOT IsObject(XMLMorntekDocument) Then ConnectXml
   dim temp
   temp=XMLMorntekDocument.getElementsByTagName(elementname).item(IndexNum).getAttributeNode(attribname).nodeValue
  If Err then
  	if Debug then p_ErrorMsg = Err.Description
		Err.Clear
		GetXMLTagAttribs = ""
  Else
  		GetXMLTagAttribs = server.htmlencode(temp)
  End If
  end function
  '------------------------------------------------ 
  '函数名字：InsertXmlNodeText(befelementname,elementname,elementtext) 
  '入口参数: elementname 插入的元素的名字 
  ' befelementname在此元素的名字前面插入元素 
  ' elementtext 插入的元素的文本 
  '出口参数: 无 
  '------------------------------------------------ 
  Public function InsertXmlNodeText(befelementname,elementname,elementtext)
  On Error Resume Next
  If NOT IsObject(XMLMorntekDocument) Then ConnectXml
  dim befelement,element
  set befelement=XMLMorntekDocument.selectSingleNode("//"&befelementname) 
  set element= XMLMorntekDocument.createelement(elementname)
  befelement.insertBefore element,befelement.firstchild
  element.text=elementtext
  If Err then
  	if Debug then p_ErrorMsg = Err.Description
		Err.Clear
		InsertXmlNodeText = False
  Else
  		InsertXmlNodeText = True
  End If
  end function
   
  '------------------------------------------------ 
  '函数名字：UpdateXmlNodeText(elementname,newelementtext)
  '入口参数: elementname 元素的名字
  ' newelementtext元素的新文本
  '出口参数: 无
  '------------------------------------------------ 
  Public function UpdateXmlNodeText(elementname,newelementtext)
  On Error Resume Next
  If NOT IsObject(XMLMorntekDocument) Then ConnectXml
  dim element
  set element=XMLMorntekDocument.selectSingleNode("//"&elementname)
  element.text=newelementtext
  If Err then
  	if Debug then p_ErrorMsg = Err.Description
		Err.Clear
		UpdateXmlNodeText = False
  Else
  		UpdateXmlNodeText = True
  End If
  end function
   
  '------------------------------------------------ 
  '函数名字：DeleteXmlNodeText(elementname) 
  '入口参数: elementname 元素的名字 
  '出口参数: 无 
  '------------------------------------------------ 
  Public function DeleteXmlNodeText(elementname)
  On Error Resume Next
  If NOT IsObject(XMLMorntekDocument) Then ConnectXml
  XMLMorntekDocument.selectSingleNode("//"&elementname).text =""
  If Err then
  	if Debug then p_ErrorMsg = Err.Description
		Err.Clear
		DeleteXmlNodeText = False
  Else
  		DeleteXmlNodeText = True
  End If
  end function
  
  Public Function MakeWSXml(ByVal Method,ByVal Strings)
  Dim WSXMLStrings
	WSXMLStrings = "<soapenv:Envelope xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:ws=""http://ws/"">" & _
	"<soapenv:Header/>" & _
	"<soapenv:Body>" & _
	"<ws:" & Method & ">" & _
	"<user>" & _
	"<name>" & U & "</name>" & _
	"<password>" & P& "</password>" & _
	"</user>" & Strings & _
	"</ws:" & Method & ">" & _
	"</soapenv:Body>" & _
	"</soapenv:Envelope>"
	MakeWSXml = WSXMLStrings
  End Function
  
  Public Function GetWS(ByVal WSXMLStrings,ByVal AttribName)
  On Error Resume Next
  Dim XmlHttp,Result_code,result
'  	Set XmlHttp = server.CreateObject("Msxml2.XMLHTTP") '创建XMLHTTP对象
  	Set XmlHttp = server.CreateObject("MSXML2.ServerXMLHTTP") '创建XMLHTTP对象
	XmlHttp.Open "POST",W,false '用POST方式
	XmlHttp.setRequestHeader "Content-Type", "text/xml;charset=utf-8" '设置UTF8编码
	XmlHttp.setRequestHeader "Content-Length",LEN(WSXMLStrings) '提交内容长度
	XmlHttp.Send(WSXMLStrings)
	If XmlHttp.Status = 200 Then
		LoadType="LoadXML"
		XmlStrings = XmlHttp.responseText
'		Response.write GetXMLTagAttrib("result","code") '测试输出result code
		result_code = GetXMLTagAttrib("result","code") '200为正常
		if cstr(result_code) = "200" then
			If IsArray(AttribName) then
				if Ubound(AttribName)=1 then
					result = GetXMLTagAttrib(AttribName(0),AttribName(1))
					GetWS = cstr(result)
					exit function
				elseif Ubound(AttribName)=2 then
					ReDim ResultArray(AttribName(2))
					Dim i
					for i=0 to cInt(AttribName(2))
						ResultArray(i) = GetXMLTagAttribs(AttribName(0),AttribName(1),i)
					next
					GetWS = ResultArray
					exit function
				else
					GetWS = false
					p_ErrorMsg = "参数错误"
					Set XmlHttp = Nothing
					exit function
				end if
			elseif AttribName<>"" then
				result = GetXMLTagText(AttribName)
				GetWS = cstr(result)
				Set XmlHttp = Nothing
				exit function
			else
				GetWS = true
				Set XmlHttp = Nothing
				Exit Function
			end if
		else
			GetWS = false
			if Debug then
				p_ErrorMsg = p_ErrorMsg & VbCrlf & "服务器请求错误: Code: " & result_code & " | MSG: " & GetXMLTagText("msg")
			end if
			Set XmlHttp = Nothing
			exit function
		end if
	Else
			GetWS = false
		if Debug then
			p_ErrorMsg = p_ErrorMsg & VbCrlf & "连接错误: Code: " & XmlHttp.Status & " | MSG: " & XmlHttp.StatusText
		end if
		Set XmlHttp = Nothing
		exit function
	End if
	Set XmlHttp = Nothing
	if err then err.clear
  End Function

End Class%> 