<%server.ScriptTimeout =240
FreeHost_t1=20000
FreeHost_t2=20000
FreeHost_t3=30000
FreeHost_t4=240000
sql2000DBtype=true'当为true时，为db_owner角色，当为false，不具有db_owner角色

AntiCC=false'动成true将限制一秒只能访问一个页面

smsbyNew=true'动成false将用回原来的动易接口发短信

If AntiCC=True Then
if DateDiff("s",Application("AntiCC_Time"),NOW )<1 Then
Response.Redirect "e.asp?e=系统繁忙，请您稍等三秒再访问，谢谢您的支持。"
response.end
Else
Application("AntiCC_Time")=now
End if
End if

Function FormatDate(DateAndTime)
		Dim y, m, d, h, mi, s, strDateTime
		FormatDate = DateAndTime
		If Not IsNumeric(para) Then Exit Function
		If Not IsDate(DateAndTime) Then Exit Function
		y = Year(DateAndTime)
		m = Month(DateAndTime)
		If Len(m) = 1 Then m = "0" & m
		d = CStr(Day(DateAndTime))
		If Len(d) = 1 Then d = "0" & d
		h = CStr(Hour(DateAndTime))
		If Len(h) = 1 Then h = "0" & h
		mi = CStr(Minute(DateAndTime))
		If Len(mi) = 1 Then mi = "0" & mi
		s = CStr(Second(DateAndTime))
		If Len(s) = 1 Then s = "0" & s
		strDateTime = y  & m & d & h & mi				
		FormatDate = strDateTime
End Function

sub xmlvalue(vStrReturn)
                Set readServer = server.CreateObject("Microsoft.XMLDOM")				
				flag = readServer.loadXML(vStrReturn)									
				if flag = true then 						                
						i = 0
						while (i < readServer.documentElement.childNodes.length)							
							nodename = trim(readServer.documentElement.childNodes.item(i).nodename)
							nodecontentvalue = trim(readServer.documentElement.childNodes.item(i).text)							
							if nodename = "returncode" then 
								returncodevalue = cstr(nodecontentvalue)
						    end if
							'成功
							if returncodevalue="200" then
							    if nodename = "sucdate" then sucdate = cstr(nodecontentvalue)						
								if nodename = "deaddate" Then deaddate = cstr(nodecontentvalue)
								if nodename = "hostadminid" Then hostadminid = cstr(nodecontentvalue)
								if nodename = "hostpassword" Then hostpassword = cstr(nodecontentvalue)
								if nodename = "volume" Then volume = cstr(nodecontentvalue)
								if nodename = "ipaddress" Then ipaddress = cstr(nodecontentvalue)
								if nodename = "dbname" Then dbname = cstr(nodecontentvalue)
								if nodename = "dbpassword" Then dbpassword = cstr(nodecontentvalue)
								if nodename = "relatedname" Then relatedname = cstr(nodecontentvalue)
								if nodename = "os" Then os = cstr(nodecontentvalue)
								if nodename = "icpstatus" Then icpstatus = cstr(nodecontentvalue)
								if nodename = "porflag" Then porflag = cstr(nodecontentvalue)
								if nodename = "idc" Then idc = cstr(nodecontentvalue)
							'处理中
							elseif returncodevalue="210" then
							    if nodename = "failreason" then failreason = cstr(nodecontentvalue)
							elseif returncodevalue="300" then
							    if nodename = "failreason" then failreason = cstr(nodecontentvalue)
							'失败							   
							else					
								if nodename = "failreason" then failreason = cstr(nodecontentvalue)
							end if																	
							i=i+1
						Wend						
				else  
						returncodevalue=500
						nodecontentvalue="分析数据失败!"
				end If
end Sub

Function AddUser2(URL,FreeHostsharekey,username,password,comment,homedir,spacelimit,starttime,endtime,type1,type2,type3,email,host,hostcomment,MaxConnections,EnumAppsInPool,DefaultDoc,ScriptMaps,AccessFlags,LogFileDirectory,HttpErrors,MaxBandwidth)
  Dim returnstr,body
If ostype="linux" Then
InCmd="CMD_API_ACCOUNT_USER"
hostary=Split(host,",")
If UBound(hostary)>0 Then hostary(0)=hostary(1)
host=Replace(Replace(hostary(0),":80:",""),",","")
body="action=create&username="&username&"&email="&email&"&passwd="&password&"&passwd2="&password&"&domain="&host&"&package="&packagename&"&ip="&hostip&"&add=Submit"
returnstr=DAAPIPOST(URL,"sefreehost",FreeHostsharekey,InCmd,body)
returnstr=returnstr&"发送给API的信息:"&Replace(body,"&"," ")
else
  homedir=replace(homedir&"\"&username,"\\","\")
body=URLEncoding("username="&username&"&password="&password&"&comment="&comment&"&homedir="&homedir&"&spacelimit="&spacelimit&"&starttime="&starttime&"&type1="&type1&"&type2="&type2&"&type3="&type3&"&endtime="&endtime&"&email="&email&"&host="&host&"&hostcomment="&hostcomment&"&MaxConnections="&MaxConnections&"&EnumAppsInPool="&EnumAppsInPool&"&DefaultDoc="&DefaultDoc&"&ScriptMaps="&ScriptMaps&"&AccessFlags="&AccessFlags&"&LogFileDirectory="&LogFileDirectory&"&HttpErrors="&HttpErrors&"&MaxBandwidth="&MaxBandwidth)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?AddUser2", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End if
  AddUser2 = returnstr
End Function

Function ModifyUser2(URL,FreeHostsharekey,username,comment,homedirX,spacelimit,starttime,endtime,type1,type2,type3,email,host,hostcomment,MaxConnections,EnumAppsInPool,DefaultDoc,ScriptMaps,AccessFlags,LogFileDirectory,HttpErrors,MaxBandwidth)
  Dim returnstr,body
If ostype="linux" Then
If packagename<>"" Then
'按包升级
InCmd="CMD_API_MODIFY_USER"
body="action=package&user="&username&"&package="&packagename
returnstr=DAAPIPOST(URL,"sefreehost",FreeHostsharekey,InCmd,body)
returnstr=returnstr&"发送给API的信息:"&Replace(body,"&"," ")
Else
'按单独定义升级
InCmd="CMD_API_MODIFY_USER"
If Maxbytes=0 Then unlimited="unlimited"
body="action=customize&user="&username&"&vdomains="&vdomains&"&bandwidth="&Maxbytes&"&ubandwidth="&unlimited&"&quota="&spacelimt&"&vdomains="&vdomains&"&nsubdomains="&allowdomain&"&nemails="&nemails&"&nemailf="&nemailf&"&nemailml="&nemailml&"&nemailr="&nemailr&"&mysql="&mysql&"&domainptr="&domainptr&"&ftp="&ftp&"&php="&php&"&cgi="&cgi
bodyary=Split(body,"&")
body=""
For i=0 To UBound(bodyary)
If Right(bodyary(i),1)<>"=" Then body=body&bodyary(i)&"&"
next
returnstr=DAAPIPOST(URL,"sefreehost",FreeHostsharekey,InCmd,body)
returnstr=returnstr&"发送给API的信息:"&Replace(body,"&"," ")
End if
else
  if homedirX<>"" then homedirX=replace(homedirX&"\"&username,"\\","\")
body=URLEncoding("username="&username&"&comment="&comment&"&homedir="&homedirX&"&spacelimit="&spacelimit&"&starttime="&starttime&"&type1="&type1&"&type2="&type2&"&type3="&type3&"&endtime="&endtime&"&email="&email&"&host="&host&"&hostcomment="&hostcomment&"&MaxConnections="&MaxConnections&"&EnumAppsInPool="&EnumAppsInPool&"&DefaultDoc="&DefaultDoc&"&ScriptMaps="&ScriptMaps&"&AccessFlags="&AccessFlags&"&LogFileDirectory="&LogFileDirectory&"&HttpErrors="&HttpErrors&"&MaxBandwidth="&MaxBandwidth)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?ModifyUser2", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End if
  ModifyUser2 = returnstr
End Function

Function DelUser(URL,FreeHostsharekey,username)
  Dim returnstr,body
If ostype="linux" Then
InCmd="CMD_SELECT_USERS?confirmed=Confirm&delete=yes&select0="&username
returnstr=DAAPIGET(URL,"admin",FreeHostsharekey,InCmd)
else
body=URLEncoding("username="&LCase(username))
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?DelUser", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End if
  DelUser = returnstr
End Function

Function ShowUser2(URL,FreeHostsharekey,username)
'CMD_API_SHOW_DOMAINS
  Dim returnstr,body
body=URLEncoding("username="&username)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?ShowUser2", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  ShowUser2 = returnstr
End Function

Function ResetPassword(URL,FreeHostsharekey,username,password)
  Dim returnstr,body
If ostype="linux" Then
InCmd="CMD_API_USER_PASSWD"
body="username="&username&"&passwd="&password&"&passwd2="&password
returnstr=DAAPIPOST(URL,"admin",FreeHostsharekey,InCmd,body)
returnstr=returnstr&"发送给API的信息:"&Replace(body,"&"," ")
else
body=URLEncoding("username="&username&"&password="&password)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?ResetPassword", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End if
  ResetPassword = returnstr
End Function

Function PauseSite(URL,FreeHostsharekey,username,tourl,op)
  Dim returnstr,body
If ostype="linux" Then
If op=1 then
InCmd="CMD_SELECT_USERS?select0="&username&"&location=CMD_RESELLER_SHOW&dosuspend=Suspend"
Else
InCmd="CMD_SELECT_USERS?select0="&username&"&location=CMD_RESELLER_SHOW&dounsuspend=Unsuspend"
End if
returnstr=DAAPIGET(URL,"admin",FreeHostsharekey,InCmd)
If InStr(returnstr,"RESELLER")>1 Then returnstr="API-P成功"
'returnstr=returnstr&"发送给API的信息:"&InCmd&FreeHostsharekey
else
body=URLEncoding("username="&username&"&url="&tourl&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?PauseSite", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End if
  PauseSite = returnstr
End Function

Function OPSite(URL,FreeHostsharekey,username,op)
  Dim returnstr,body
If ostype="linux" Then
If op=1 then
InCmd="CMD_SELECT_USERS?select0="&username&"&location=CMD_RESELLER_SHOW&dosuspend=Suspend"
Else
InCmd="CMD_SELECT_USERS?select0="&username&"&location=CMD_RESELLER_SHOW&dounsuspend=Unsuspend"
End if
returnstr=DAAPIGET(URL,"admin",FreeHostsharekey,InCmd)
If InStr(returnstr,"RESELLER")>1 Then returnstr="API-S成功"
else
body=URLEncoding("username="&username&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?OPSite", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End if
  OPSite = returnstr
End Function

Function OPASPERR(URL,FreeHostsharekey,username,op)
  Dim returnstr,body
body=URLEncoding("username="&username&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?OPASPERR", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  OPASPERR = returnstr
End Function


Function OPLOG(URL,FreeHostsharekey,username,LogFileDirectory,op)
  Dim returnstr,body
body=URLEncoding("username="&username&"&LogFileDirectory="&LogFileDirectory&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?OPLOG", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  OPLOG = returnstr
End Function


Function DenySiteIP(URL,FreeHostsharekey,username,IPARRY)
  Dim returnstr,body
body=URLEncoding("username="&username&"&IPARRY="&IPARRY)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?DenySiteIP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  DenySiteIP = returnstr
End Function

Function OPHTMDIR(URL,FreeHostsharekey,username,htmdir,op)
  Dim returnstr,body
body=URLEncoding("username="&username&"&htmdir="&htmdir&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?OPHTMDIR", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  OPHTMDIR = returnstr
End Function

Function OPWEBACL(URL,FreeHostsharekey,username,opdir,op)
  Dim returnstr,body
body=URLEncoding("username="&username&"&opdir="&opdir&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?OPWEBACL", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  OPWEBACL = returnstr
End Function



Function GETvalue(inV,beginV,endV)
	strReturn = ""
	posA=InStr(1,inV,beginV) 
	posB=InStr(1,inV,endV) 
	strReturn=Mid(inV, posA, posB-posA) 
	strReturn=replace(strReturn,beginV,"")
	GETvalue = strReturn
End Function

Function URLEncoding(vstrIn)
    strReturn = ""
    For i = 1 To Len(vstrIn)
        ThisChr = Mid(vStrIn,i,1)
        If Abs(Asc(ThisChr)) < &HFF Then
            strReturn = strReturn & ThisChr
        Else
            innerCode = Asc(ThisChr)
            If innerCode < 0 Then
                innerCode = innerCode + &H10000
            End If
            Hight8 = (innerCode  And &HFF00)\ &HFF
            Low8 = innerCode And &HFF
            strReturn = strReturn & "%" & Hex(Hight8) &  "%" & Hex(Low8)
        End If
    Next
    URLEncoding = strReturn
End Function

'Function bytes2BSTR(vIn)
 '   strReturn = ""
  '  For i = 1 To LenB(vIn)
   '     ThisCharCode = AscB(MidB(vIn,i,1))
    '    If ThisCharCode < &H80 Then
     '       strReturn = strReturn & Chr(ThisCharCode)
      '  Else
       '     NextCharCode = AscB(MidB(vIn,i+1,1))
        '    strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + Clng(NextCharCode))
         '   i = i + 1
      '  End If
'    Next
 '   bytes2BSTR = strReturn
'End Function

Function Bytes2bStr(vin)
  Dim BytesStream,StringReturn
  Set BytesStream = Server.CreateObject("ADODB.Stream")
  BytesStream.Type = 2
  BytesStream.Open
  BytesStream.WriteText vin
  BytesStream.Position = 0
  BytesStream.Charset = "gb2312"
  BytesStream.Position = 2
  StringReturn =BytesStream.ReadText
  BytesStream.close
  Set BytesStream = Nothing
  Bytes2bStr = StringReturn
End Function

Function Bytes2bStr_utf(vin,codepage)
  Dim BytesStream,StringReturn
  Set BytesStream = Server.CreateObject("ADODB.Stream")
  BytesStream.Type = 2
  BytesStream.Open
  BytesStream.WriteText vin
  BytesStream.Position = 0
  BytesStream.Charset = codepage
  BytesStream.Position = 2
  StringReturn =BytesStream.ReadText
  BytesStream.close
  Set BytesStream = Nothing
  Bytes2bStr_utf = StringReturn
End Function

Function tran_ado(strA , strInCode , strOutCode ) 
 Dim Stm
  Set Stm = Server.CreateObject("ADODB.Stream")
     Stm.Type = 2
    Stm.Mode = 0
    Stm.Open
    Stm.Charset = strOutCode
    Stm.WriteText strA
    Stm.Position = 0
    Stm.Type = 2
    Stm.Charset = strInCode
    tran_ado = Stm.ReadText()
    Stm.Close
End Function


Function SystemEmailTest(ID)
Set conn=Server.CreateObject("ADODB.Connection")
	conn.Open Application("FreeHostDBlink")
Set dsemailserver = Server.CreateObject("ADODB.Recordset")	
	Sqlemailserver="Select * from FreeHost.FreeHost_Serveremaillist where id="&ID
	dsemailserver.Open Sqlemailserver,conn,1,1
  Dim returnstr
if not dsemailserver.eof then
if dsemailserver("softtype")="Imail" then
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
'xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
'body=URLEncoding("username="&dsemailserver("admname")&"&pwhidden="&dsemailserver("admpass"))
xml.Open "POST", dsemailserver("site")&"/FreeHost.dll", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",dsemailserver("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
else
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
body=URLEncoding("username="&dsemailserver("admname")&"&pwhidden="&dsemailserver("admpass"))
xml.Open "POST", dsemailserver("site")&"/"&dsemailserver("softtype")&"freehost.asp", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
'xml.setRequestHeader "FreeHost",Application("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
end if
else
	returnstr = "不存在的服务器！"
end if
dsemailserver.close
set dsemailserver=nothing
conn.close
set conn=nothing
	SystemEmailTest = returnstr
End Function

Function ModifyEmail(ID,Email,pw,admuser,SetMailBoxSize)
Set conn=Server.CreateObject("ADODB.Connection")
	conn.Open Application("FreeHostDBlink")
Set dsemailserver = Server.CreateObject("ADODB.Recordset")	
	Sqlemailserver="Select * from FreeHost.FreeHost_Serveremaillist where id="&ID
	dsemailserver.Open Sqlemailserver,conn,1,1
  Dim returnstr
if not dsemailserver.eof then
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
body=URLEncoding("username="&dsemailserver("admname")&"&pwhidden="&dsemailserver("admpass")&"&Email="&Email&"&pw="&pw&"&admuser="&admuser&"&SetMailBoxSize="&SetMailBoxSize)
xml.Open "POST", dsemailserver("site")&"/"&dsemailserver("softtype")&"freehost.asp?ModifyEmail", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
'xml.setRequestHeader "FreeHost",Application("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
else
	returnstr = "不存在的服务器！"
end if
dsemailserver.close
set dsemailserver=nothing
conn.close
set conn=nothing
	ModifyEmail = returnstr
End Function

Function AddEmail(ID,Email,pw,SetMailBoxSize)
Set conn=Server.CreateObject("ADODB.Connection")
	conn.Open Application("FreeHostDBlink")
Set dsemailserver = Server.CreateObject("ADODB.Recordset")	
	Sqlemailserver="Select * from FreeHost.FreeHost_Serveremaillist where id="&ID
	dsemailserver.Open Sqlemailserver,conn,1,1
  Dim returnstr
if not dsemailserver.eof then
if dsemailserver("softtype")="Imail" then
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
emailarry=split(email,"@")
emailname=emailarry(0)
domain=emailarry(1)
imailFlags=128

body=URLEncoding("emailname="&emailname&"&domain="&domain&"&pass="&pw&"&op=ad"&"&maxuser=0&maxsize="&(SetMailBoxSize*1024)&"&imailFlags="&imailFlags)
xml.Open "POST", dsemailserver("site")&"/FreeHost.dll?ImailOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",dsemailserver("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
else
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
body=URLEncoding("username="&dsemailserver("admname")&"&pwhidden="&dsemailserver("admpass")&"&Email="&Email&"&pw="&pw&"&admuser="&admuser&"&SetMailBoxSize="&SetMailBoxSize)
'response.write body
xml.Open "POST", dsemailserver("site")&"/"&dsemailserver("softtype")&"freehost.asp?AddEmail", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
'xml.setRequestHeader "FreeHost",Application("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
end if
else
	returnstr = "不存在的服务器！"
end if
dsemailserver.close
set dsemailserver=nothing
conn.close
set conn=nothing
	AddEmail = returnstr
End Function

Function SetAdmEmail(ID,Email,domain,maxuser,maxsize)
Set conn=Server.CreateObject("ADODB.Connection")
	conn.Open Application("FreeHostDBlink")
Set dsemailserver = Server.CreateObject("ADODB.Recordset")	
	Sqlemailserver="Select * from FreeHost.FreeHost_Serveremaillist where id="&ID
	dsemailserver.Open Sqlemailserver,conn,1,1
  Dim returnstr
if not dsemailserver.eof then
if dsemailserver("softtype")="Imail" then
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
emailarry=split(email,"@")
emailname=emailarry(0)
domain=emailarry(1)
imailFlags=384
pw="123456"
maxuser=maxuser+1
If maxsize>4194300 Then maxsize=0'imail超出4G后的设置
body=URLEncoding("emailname="&emailname&"&domain="&domain&"&pass="&pw&"&op=ad"&"&maxuser="&maxuser&"&maxsize="&(maxsize*1024)&"&imailFlags="&imailFlags)
xml.Open "POST", dsemailserver("site")&"/FreeHost.dll?ImailOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",dsemailserver("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
else
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
body=URLEncoding("username="&dsemailserver("admname")&"&pwhidden="&dsemailserver("admpass")&"&Email="&Email&"&maxuser="&maxuser&"&domain="&domain&"&maxsize="&maxsize)
xml.Open "POST", dsemailserver("site")&"/"&dsemailserver("softtype")&"freehost.asp?SetAdmEmail", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
end if
else
	returnstr = "不存在的服务器！"
end if
dsemailserver.close
set dsemailserver=nothing
conn.close
set conn=nothing
	SetAdmEmail = returnstr
End Function

Function DelAdmEmail(ID,domain)
Set connemail=Server.CreateObject("ADODB.Connection")
	connemail.Open Application("FreeHostDBlink")
Set dsemailserver = Server.CreateObject("ADODB.Recordset")	
	Sqlemailserver="Select * from FreeHost.FreeHost_Serveremaillist where id="&ID
	dsemailserver.Open Sqlemailserver,connemail,1,1
  Dim returnstr
if not dsemailserver.eof then
if dsemailserver("softtype")="Imail" then
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
body=URLEncoding("emailname=x&domain="&domain&"&pass=0&op=deldomain&maxuser=0&maxsize=0&imailFlags=0")
xml.Open "POST", dsemailserver("site")&"/FreeHost.dll?ImailOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",dsemailserver("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
else
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
body=URLEncoding("username="&dsemailserver("admname")&"&pwhidden="&dsemailserver("admpass")&"&Email="&Email&"&maxuser="&maxuser&"&domain="&domain&"&maxsize="&maxsize)
xml.Open "POST", dsemailserver("site")&"/"&dsemailserver("softtype")&"freehost.asp?DelAdmEmail", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
'xml.setRequestHeader "FreeHost",Application("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
end if
else
	returnstr = "不存在的服务器！"
end if
dsemailserver.close
set dsemailserver=nothing
connemail.close
set connemail=nothing
	DelAdmEmail = returnstr
End Function

Function ModAdmEmail(ID,Email,domain,maxuser,maxsize)
Set connemail=Server.CreateObject("ADODB.Connection")
	connemail.Open Application("FreeHostDBlink")
Set dsemailserver = Server.CreateObject("ADODB.Recordset")	
	Sqlemailserver="Select * from FreeHost.FreeHost_Serveremaillist where id="&ID
	dsemailserver.Open Sqlemailserver,connemail,1,1
  Dim returnstr
if not dsemailserver.eof then
if dsemailserver("softtype")="Imail" then
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
emailarry=split(email,"@")
emailname=emailarry(0)
domain=emailarry(1)
imailFlags=384
pw="123456"
maxuser=maxuser+1
If maxsize>4194300 Then maxsize=0'imail超出4G
body=URLEncoding("emailname="&emailname&"&domain="&domain&"&pass="&pw&"&op=moddomain"&"&maxuser="&maxuser&"&maxsize="&(maxsize*1024)&"&imailFlags="&imailFlags)
'response.write body
xml.Open "POST", dsemailserver("site")&"/FreeHost.dll?ImailOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",dsemailserver("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
else
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
body=URLEncoding("username="&dsemailserver("admname")&"&pwhidden="&dsemailserver("admpass")&"&maxuser="&maxuser&"&domain="&domain&"&maxsize="&maxsize&"&admmailname="&Application("admmailname"))
xml.Open "POST", dsemailserver("site")&"/"&dsemailserver("softtype")&"freehost.asp?ModAdmEmail", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
'xml.setRequestHeader "FreeHost",Application("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
end if
else
	returnstr = "不存在的服务器！"
end if
dsemailserver.close
set dsemailserver=nothing
connemail.close
set connemail=nothing
	ModAdmEmail = returnstr
End Function

Function ChpassEmail(ID,emailname,domain,pw)
Set connemail=Server.CreateObject("ADODB.Connection")
	connemail.Open Application("FreeHostDBlink")
Set dsemailserver = Server.CreateObject("ADODB.Recordset")	
	Sqlemailserver="Select * from FreeHost.FreeHost_Serveremaillist where id="&ID
	dsemailserver.Open Sqlemailserver,connemail,1,1
  Dim returnstr
if not dsemailserver.eof then
if dsemailserver("softtype")="Imail" then
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
body=URLEncoding("emailname="&emailname&"&domain="&domain&"&pass="&pw&"&op=chpwd"&"&maxuser=0&maxsize=0&imailFlags=0")
xml.Open "POST", dsemailserver("site")&"/FreeHost.dll?ImailOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",dsemailserver("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
else
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
body=URLEncoding("username="&dsemailserver("admname")&"&pwhidden="&dsemailserver("admpass")&"&emailname="&emailname&"&domain="&domain&"&pw="&pw&"&SetMailBoxSize="&websize)
xml.Open "POST", dsemailserver("site")&"/"&dsemailserver("softtype")&"freehost.asp?ChpassEmail", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
'xml.setRequestHeader "FreeHost",Application("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
end if
else
	returnstr = "不存在的服务器！"
end if
dsemailserver.close
set dsemailserver=nothing
connemail.close
set connemail=nothing
	ChpassEmail = returnstr
End Function

Function DelEmail(ID,Email)
Set connemail=Server.CreateObject("ADODB.Connection")
	connemail.Open Application("FreeHostDBlink")
Set dsemailserver = Server.CreateObject("ADODB.Recordset")	
	Sqlemailserver="Select * from FreeHost.FreeHost_Serveremaillist where id="&ID
	dsemailserver.Open Sqlemailserver,connemail,1,1
  Dim returnstr
if not dsemailserver.eof then
if dsemailserver("softtype")="Imail" then
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
emailarry=split(email,"@")
emailname=emailarry(0)
domain=emailarry(1)
body=URLEncoding("emailname="&emailname&"&domain="&domain&"&pass="&pw&"&op=deluser"&"&maxuser=0&maxsize=0&imailFlags=0")
xml.Open "POST", dsemailserver("site")&"/FreeHost.dll?ImailOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",dsemailserver("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
else
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
body=URLEncoding("username="&dsemailserver("admname")&"&pwhidden="&dsemailserver("admpass")&"&Email="&Email)
xml.Open "POST", dsemailserver("site")&"/"&dsemailserver("softtype")&"freehost.asp?DelEmail", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
'xml.setRequestHeader "FreeHost",Application("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
end if
else
	returnstr = "不存在的服务器！"
end if
dsemailserver.close
set dsemailserver=nothing
connemail.close
set connemail=nothing
	DelEmail = returnstr
End Function


Function PauseEmail(ID,Email,op)
Set connemail=Server.CreateObject("ADODB.Connection")
	connemail.Open Application("FreeHostDBlink")
Set dsemailserver = Server.CreateObject("ADODB.Recordset")	
	Sqlemailserver="Select * from FreeHost.FreeHost_Serveremaillist where id="&ID
	dsemailserver.Open Sqlemailserver,connemail,1,1
  Dim returnstr
if not dsemailserver.eof then
if dsemailserver("softtype")="Imail" then
emailarry=split(email,"@")
emailname=emailarry(0)
domain=emailarry(1)
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
if op=1 then body=URLEncoding("emailname="&emailname&"&domain="&domain&"&pass="&pw&"&op=notact"&"&maxuser=0&maxsize=0&imailFlags=0")
if op=0 then body=URLEncoding("emailname="&emailname&"&domain="&domain&"&pass="&pw&"&op=act"&"&maxuser=0&maxsize=0&imailFlags=0")
xml.Open "POST", dsemailserver("site")&"/FreeHost.dll?ImailOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",dsemailserver("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
else
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
body=URLEncoding("username="&dsemailserver("admname")&"&pwhidden="&dsemailserver("admpass")&"&Email="&Email&"&op="&op)
xml.Open "POST", dsemailserver("site")&"/"&dsemailserver("softtype")&"freehost.asp?PauseEmail", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
'xml.setRequestHeader "FreeHost",Application("FreeHostsharekey")
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
end if
else
	returnstr = "不存在的服务器！"
end if
dsemailserver.close
set dsemailserver=nothing
connemail.close
set connemail=nothing
	PauseEmail = returnstr
End Function

Function DOPOST(tar,ref,body)
  Dim returnstr
  body=Cstr(body)
	Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "REFERER",ref
xml.send body
cookie = xml.getResponseHeader("Set-Cookie")
'Response.Write cookie
session("dopost_cookie")=cookie
sID = mid(cookie,instr(1,cookie,"=")+1,instr(1,cookie,";")-(instr(1,cookie,"=")+1))
returnstr = bytes2BSTR(xml.responsebody)
	DOPOST = returnstr
		DOPOST = replace(DOPOST,"<a href=""/cgi-bin/","<a href=""a.asp?http://agent.dns.com.cn/cgi-bin/")
End Function


Function TOLOGINDNS(tar)
TOLOGINDNS=true
'Application("TOLOGINDNS_Time")=dateadd("h",-2,now)
if Application("TOLOGINDNS_Time")="" then Application("TOLOGINDNS_Time")=dateadd("h",-2,now)
if DateDiff("n", Application("TOLOGINDNS_Time"),NOW )>15 then
  Dim returnstr
  body=URLEncoding("Username="&Application("Domain_Agent_username_1")&"&Password="&Application("Domain_Agent_password_1"))
	Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
'xml.setRequestHeader "REFERER",ref
xml.send body
cookie = xml.getResponseHeader("Set-Cookie")
Application("TOLOGINDNS_cookie")=cookie
Application("TOLOGINDNS_Time")=Now
returnstr = bytes2BSTR(xml.responsebody)
if Instr(1, returnstr,  "英文域名注册", 1)>0 then
TOLOGINDNS=true
else
Application("TOLOGINDNS_Time")=dateadd("h",-2,now)
TOLOGINDNS=false
end if

'response.write Application("TOLOGINDNS_cookie")
'response.write returnstr
'response.end

end if
'	TOLOGINDNS = returnstr
	'	TOLOGINDNS = replace(TOLOGINDNS,"<a href=""/cgi-bin/","<a href=""a.asp?http://agent.dns.com.cn/cgi-bin/")
End Function


Function TOLOGINDNS_XIN(tar)
TOLOGINDNS_XIN=true
if Application("TOLOGINDNS_Time_XIN")="" then Application("TOLOGINDNS_Time_XIN")=dateadd("h",-2,now)
if DateDiff("n", Application("TOLOGINDNS_Time_XIN"),NOW )>15 then
  Dim returnstr
  body=URLEncoding("Username="&Application("Domain_Agent_username_2")&"&password="&Application("Domain_Agent_password_2"))
	Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
'xml.setRequestHeader "REFERER",ref
xml.send body
TOLOGINDNS_XIN=true
On Error Resume Next
cookie = xml.getResponseHeader("Set-Cookie")
Application("TOLOGINDNS_cookie_XIN")=cookie
Application("TOLOGINDNS_Time_XIN")=Now
if err.number <> 0 then
TOLOGINDNS_XIN=false
Application("TOLOGINDNS_Time_XIN")=dateadd("h",-2,now)
end if
'sID = mid(cookie,instr(1,cookie,"=")+1,instr(1,cookie,";")-(instr(1,cookie,"=")+1))
returnstr = bytes2BSTR(xml.responsebody)
if Instr(1, returnstr,  "英文域名注册", 1)>0 then
TOLOGINDNS_XIN=true
else
Application("TOLOGINDNS_Time_XIN")=dateadd("h",-2,now)
TOLOGINDNS_XIN=false
end if

'response.write returnstr
'response.end

end if
'	TOLOGINDNS = returnstr
	'	TOLOGINDNS = replace(TOLOGINDNS,"<a href=""/cgi-bin/","<a href=""a.asp?http://agent.dns.com.cn/cgi-bin/")
End Function


Function ShowDirSize(URL,FreeHostsharekey,username)
  Dim returnstrX,body
username=username&"\"
'username=replace(username,"\\","\")
username=replace(username,"\\","\")
'username=replace(username,"\","\\")
'username=server.URLEncode (username)
body=URLEncoding("username="&username)
'Response.Write username
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?ShowDirSize", False

xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstrX = bytes2BSTR(xml.responsebody)
'Response.Write returnstr
Set xml = Nothing
  ShowDirSize = returnstrX
End Function

Function Sqlaction(URL,FreeHostsharekey,userid,pwd,sql)'2.0增加
  Dim returnstr,body
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SQLACTION", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  Sqlaction = returnstr
End Function


Function SqlAdd(URL,FreeHostsharekey,userid,pwd,homedir,userspacelimt,logspacelimt,sqlname,sqlpassword)'2.0增加
  Dim returnstr,body
  homedir=replace(homedir&"\"&sqlname,"\\","\")
'sql="USE master CREATE DATABASE "&sqlname&" ON ( NAME = "&sqlname&", FILENAME = '"&homedir&".mdf', SIZE = 4MB, MAXSIZE = "&userspacelimt&"MB,  FILEGROWTH = 1 ) LOG ON ( NAME = '"&sqlname&"_log', FILENAME = '"&homedir&".ldf', SIZE = 4MB,MAXSIZE = "&logspacelimt&"MB, FILEGROWTH = 4MB );EXECUTE sp_addlogin '" & sqlname & "','"& sqlpassword & "','" & sqlname&"'"
sql="USE master CREATE DATABASE "&sqlname&" ON ( NAME = "&sqlname&", FILENAME = '"&homedir&".mdf', SIZE = 5MB, MAXSIZE = "&userspacelimt&"MB,  FILEGROWTH = 1 ) LOG ON ( NAME = '"&sqlname&"_log', FILENAME = '"&homedir&".ldf', SIZE = 5MB,MAXSIZE = "&logspacelimt&"MB, FILEGROWTH = 5MB );EXECUTE sp_addlogin '" & sqlname & "','"& sqlpassword & "','" & sqlname&"'"
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SQLACTION", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
sql="Use "&sqlname&" EXECUTE sp_grantdbaccess '"&sqlname&"';EXECUTE sp_addrolemember 'db_owner','"&sqlname&"'"
if sql2000DBtype=false then sql="Use "&sqlname&" EXECUTE sp_grantdbaccess '"&sqlname&"';EXECUTE sp_addrolemember 'db_accessadmin','"&sqlname&"';EXECUTE sp_addrolemember 'db_securityadmin','"&sqlname&"';EXECUTE sp_addrolemember 'db_ddladmin','"&sqlname&"';EXECUTE sp_addrolemember 'db_backupoperator','"&sqlname&"';EXECUTE sp_addrolemember 'db_datareader','"&sqlname&"';EXECUTE sp_addrolemember 'db_datawriter','"&sqlname&"'"
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
xml.Open "POST", Url&"/FreeHost.dll?SQLACTION", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)
Set xml = Nothing
  SqlAdd = returnstr
End Function

Function SqlAddmysql(URL,FreeHostsharekey,userid,pwd,homedir,userspacelimt,logspacelimt,sqlname,sqlpassword)'2.0增加
  Dim returnstrY,body
  homedir=replace(homedir&"\"&sqlname,"\\","\")
sql="CREATE DATABASE "&sqlname
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstrY = bytes2BSTR(xml.responsebody)
sql="GRANT ALL ON "&sqlname&".* TO "&sqlname&"@'localhost' IDENTIFIED BY '"&sqlpassword&"';"
'if mysqlis415 then sql="GRANT ALL ON "&sqlname&".* TO "&sqlname&"@'"&server.URLEncode ("%")&"' IDENTIFIED BY '"&sqlpassword&"';"
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstrYY = returnstrY&bytes2BSTR(xml.responsebody)
sql="GRANT ALL ON "&sqlname&".* TO "&sqlname&"@'"&server.URLEncode ("%")&"' IDENTIFIED BY '"&sqlpassword&"';"
'%类主机
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstrYY = returnstrY&bytes2BSTR(xml.responsebody)
'OLD PASS
sql="set password for "&sqlname&"@'localhost'=old_password('"&sqlpassword&"');"
If MySQLver>5.1 Then sql="set password for "&sqlname&"@'localhost'=password('"&sqlpassword&"');"
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstrYY&bytes2BSTR(xml.responsebody)
'%类
sql="set password for "&sqlname&"@'"&server.URLEncode ("%")&"'=old_password('"&sqlpassword&"');"
If MySQLver>5.1 Then sql="set password for "&sqlname&"@'"&server.URLEncode ("%")&"'=password('"&sqlpassword&"');"
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstrYY&bytes2BSTR(xml.responsebody)

Set xml = Nothing

  SqlAddmysql = returnstr
End Function

Function SqlModify(URL,FreeHostsharekey,userid,pwd,userspacelimt,logspacelimt,sqlname)'2.0增加
  Dim returnstr,body
'sql="ALTER DATABASE "&sqlname&" MODIFY FILE ( NAME = "&sqlname&", MAXSIZE = "&userspacelimt&"MB);ALTER DATABASE "&sqlname&" MODIFY FILE ( NAME = "&sqlname&"_Data, MAXSIZE = "&userspacelimt&"MB);ALTER DATABASE "&sqlname&" MODIFY FILE ( NAME = "&sqlname&"_log, MAXSIZE = "&logspacelimt&"MB)"
sql="ALTER DATABASE "&sqlname&" MODIFY FILE ( NAME = "&sqlname&", MAXSIZE = "&userspacelimt&"MB);ALTER DATABASE "&sqlname&" MODIFY FILE ( NAME = "&sqlname&"_log, MAXSIZE = "&logspacelimt&"MB)"
'response.write sql
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SQLACTION", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)
Set xml = Nothing
  SqlModify = returnstr
End Function

Function PauseSQL(URL,FreeHostsharekey,userid,pwd,sqlname,sqlpassword,op)'2.0增加
  Dim returnstr,body
if op=1 then'暂停
Randomize
id=id&Int((10000 - 0 + 1) * Rnd + 0)
if softtype="SQL2000" then
sql="USE "&sqlname&" EXEC sp_password NULL, '"&id&"7i24.com', '"&sqlname&"'"
else
sql="set password for "&sqlname&"@'localhost'=password('"&id&"7i24.com');"'为4.0版本设置
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
if softtype="SQL2000" then
xml.Open "POST", Url&"/FreeHost.dll?SQLACTION", False
else
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
end If

sql="set password for "&sqlname&"@'"&server.URLEncode ("%")&"'=old_password('"&id&"7i24.com');"
If MySQLver>5.1 Then sql="set password for "&sqlname&"@'"&server.URLEncode ("%")&"'=password('"&id&"7i24.com');"
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)

Set xml = Nothing
sql="set password for "&sqlname&"@'localhost'=password('"&id&"7i24.com');"'为4.0版本设置
end if
elseif op=0 then'恢复
if softtype="SQL2000" then
sql="EXEC sp_password NULL, '"&sqlpassword&"', '"&sqlname&"'"
else
sql="GRANT ALL ON "&sqlname&".* TO "&sqlname&"@'"&server.URLEncode ("%")&"' IDENTIFIED BY '"&sqlpassword&"';"
end if
elseif op=2 then'del
if softtype="SQL2000" then
sql="USE master DROP DATABASE "&sqlname&";EXEC sp_droplogin '"&sqlname&"'"
else

sql="DELETE FROM mysql.user where User="""&sqlname&""";"
'response.write sql
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
sql="FLUSH PRIVILEGES;"
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)
Set xml = Nothing

sql="DELETE FROM mysql.db where db="""&sqlname&""";"
'response.write sql
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing

'response.write returnstr
sql="DROP DATABASE "&sqlname&";"
end if
end If
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
'response.write sql
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
if softtype="SQL2000" then
xml.Open "POST", Url&"/FreeHost.dll?SQLACTION", False
else
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
end if
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)
Set xml = Nothing


if op=0 then'恢复
if softtype<>"SQL2000" then'密码兼容
sql="set password for "&sqlname&"@'localhost'=password('"&sqlpassword&"');"'为4.0版本设置
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)

sql="set password for "&sqlname&"@'localhost'=old_password('"&sqlpassword&"');"
If MySQLver>5.1 Then sql="set password for "&sqlname&"@'localhost'=password('"&sqlpassword&"');"
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)
'%
sql="set password for "&sqlname&"@'"&server.URLEncode ("%")&"'=old_password('"&sqlpassword&"');"
If MySQLver>5.1 Then sql="set password for "&sqlname&"@'"&server.URLEncode ("%")&"'=password('"&sqlpassword&"');"
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)

end if
end if
  PauseSQL = returnstr
End Function

Function ResetSQLPassword(URL,FreeHostsharekey,userid,pwd,sqlname,sqlpassword)
  Dim returnstr,body
if softtype="SQL2000" then
sql="USE "&sqlname&" USE "&sqlname&" EXEC sp_password NULL, '"&sqlpassword&"', '"&sqlname&"';EXECUTE sp_addrolemember 'db_owner','"&sqlname&"';EXECUTE sp_defaultdb '"&sqlname&"','"&sqlname&"';USE "&sqlname&" exec sp_change_users_login 'Auto_Fix','"&sqlname&"';"
else
sql="GRANT ALL ON "&sqlname&".* TO "&sqlname&"@'"&server.URLEncode ("%")&"' IDENTIFIED BY '"&sqlpassword&"';"
end if
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
if softtype="SQL2000" then
xml.Open "POST", Url&"/FreeHost.dll?SQLACTION", False
else
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
end if
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)
if softtype<>"SQL2000" then
'SET PASSWORD FOR system@"%" = PASSWORD('manager'); '为4.0设置
sql="set password for "&sqlname&"@'localhost'=password('"&sqlpassword&"');"
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)
'%类

sql="set password for "&sqlname&"@'"&server.URLEncode ("%")&"'=password('"&sqlpassword&"');"
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)
sql="set password for "&sqlname&"@'localhost'=old_password('"&sqlpassword&"');"
If MySQLver>5.1 Then sql="set password for "&sqlname&"@'localhost'=password('"&sqlpassword&"');"
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)
'%类主机
sql="set password for "&sqlname&"@'"&server.URLEncode ("%")&"'=old_password('"&sqlpassword&"');"
If MySQLver>5.1 Then sql="set password for "&sqlname&"@'"&server.URLEncode ("%")&"'=password('"&sqlpassword&"');"
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
xml.Open "POST", Url&"/FreeHost.dll?SQLACTIONmysql", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = returnstr&bytes2BSTR(xml.responsebody)

end if
Set xml = Nothing
  ResetSQLPassword = returnstr
End Function

Function P_A(tar,ref,body)
  Dim returnstr
Set xml = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
xml.Option(6)=0
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "Accept-Encoding","none"
xml.setRequestHeader "REFERER",ref
xml.setRequestHeader "Cookie",session("dopost_cookieA")
xml.send body
  P_A = returnstr&bytes2BSTR(xml.responsebody)
    if session("dopost_cookieA")="" then 
	session("dopost_cookieA") = xml.getResponseHeader("Set-Cookie")
	if session("dopost_cookieA")<>"" then  session("dopost_cookieA") =left(session("dopost_cookieA"),instr(1,session("dopost_cookieA"),";")-1)
  end If 
Set xml = Nothing
End Function

Function P_B(tar)
body="module=&login_name="&Application("Domain_Agent_username_3")&"&password="&Application("Domain_Agent_password_3")&"&x=20&y=13"
Set xml = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
xml.Option(6)=0
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "Accept-Encoding","none"
xml.send body
session("dopost_cookieA") = xml.getResponseHeader("Set-Cookie")
session("dopost_cookieA") =left(session("dopost_cookieA"),instr(1,session("dopost_cookieA"),";")-1)
P_B = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End Function

Function P_C(tar,ref,cookieIN)
Set xml = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
xml.Option(6)=0
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", tar, False
xml.setRequestHeader "User-Agent","Mozilla/2.0 (compatible; MSIE 5.0B; Windows NT)"
xml.setRequestHeader "Accept-Encoding","none"
xml.setRequestHeader "REFERER",ref
xml.setRequestHeader "Cookie",cookieIN
xml.send
P_C = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End Function

Function IsValidEmail(email)
dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
   IsValidEmail = false
   exit function
end if
for each name in names
   if Len(name) <= 0 then
     IsValidEmail = false
     exit function
   end if
   for i = 1 to Len(name)
     c = Lcase(Mid(name, i, 1))
     if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
       IsValidEmail = false
       exit function
     end if
   next
   if Left(name, 1) = "." or Right(name, 1) = "." then
      IsValidEmail = false
      exit function
   end if
next
if InStr(names(1), ".") <= 0 then
   IsValidEmail = false
   exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 and i <> 4 then
   IsValidEmail = false
   exit function
end if
if InStr(email, "..") > 0 then
   IsValidEmail = false
end if
End Function

Function TOLOGINDNS_CH_PRE(tar)
if Application("TOLOGINDNS_CH_PRE_Time")="" then Application("TOLOGINDNS_CH_PRE_Time")=dateadd("h",-2,now)
if DateDiff("n", Application("TOLOGINDNS_CH_PRE_Time"),NOW )>10 then
Dim returnstr
body=URLEncoding("user_id=989654&password=123456&B1=%BF%AA%CA%BC%B5%C7%C2%BC")
	Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "User-Agent","Mozilla/2.0 (compatible; MSIE 5.0B; Windows NT)"
'xml.setRequestHeader "REFERER",ref
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
TOLOGINDNS_CH_PRE=true
On Error Resume Next
cookie = xml.getResponseHeader("Set-Cookie")
Application("TOLOGINDNS_CH_PRE_cookie")=cookie
Application("TOLOGINDNS_CH_PRE_Time")=Now
if err.number <> 0 then
TOLOGINDNS_CH_PRE=false
Application("TOLOGINDNS_CH_PRE_Time")=dateadd("h",-2,now)
end if
else
TOLOGINDNS_CH_PRE=true
end if
End Function

Function TOLOGINDNS_CH_POST_PRE(tar,ref,body)
  Dim returnstr
  body=Cstr(body)
	Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "REFERER",ref
xml.setRequestHeader "User-Agent","Mozilla/2.0 (compatible; MSIE 5.0B; Windows NT)"
xml.setRequestHeader "Accept-Language","zh-cn"
cookie = Application("TOLOGINDNS_CH_PRE_cookie")
xml.setRequestHeader "COOKIE", left(cookie,instr(1,cookie,";")-1)
xml.setRequestHeader "COOKIE", left(cookie,instr(1,cookie,";")-1)
xml.send body

'response.write tar&"<br>"
'response.write ref&"<br>"
'response.write cookie&"<br>"
'response.write body&"<br>"

returnstr = bytes2BSTR(xml.responsebody)
	TOLOGINDNS_CH_POST_PRE = returnstr
End Function

Function TOLOGINDNS_CH(tar)
if Application("TOLOGINDNS_CH_Time")="" then Application("TOLOGINDNS_CH_Time")=dateadd("h",-2,now)
if DateDiff("n", Application("TOLOGINDNS_CH_Time"),NOW )>10 then
Dim returnstr
body=URLEncoding("user_id="&Application("Domain_Agent_username_4")&"&password="&Application("Domain_Agent_password_4")&"&B1=%BF%AA%CA%BC%B5%C7%C2%BC")
	Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
'xml.setRequestHeader "REFERER",ref
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
TOLOGINDNS_CH=true
On Error Resume Next
cookie = xml.getResponseHeader("Set-Cookie")
Application("TOLOGINDNS_CH_cookie")=cookie
Application("TOLOGINDNS_CH_Time")=Now
if err.number <> 0 then
TOLOGINDNS_CH=false
Application("TOLOGINDNS_CH_Time")=dateadd("h",-2,now)
end if
else
TOLOGINDNS_CH=true
end if
End Function

Function TOLOGINDNS_CH_GET(tar)
Dim returnstr
Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", tar, False
cookie =  Application("TOLOGINDNS_CH_cookie")
xml.setRequestHeader "COOKIE", left(cookie,instr(1,cookie,";")-1)
xml.setRequestHeader "COOKIE", left(cookie,instr(1,cookie,";")-1)
xml.send
returnstr = bytes2BSTR(xml.responsebody)
TOLOGINDNS_CH_GET = returnstr
End Function

Function TOLOGINDNS_CH_GET_PRE(tar,ref)
Dim returnstr
Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", tar, False
xml.setRequestHeader "REFERER",ref
cookie =  Application("TOLOGINDNS_CH_PRE_cookie")
xml.setRequestHeader "COOKIE", left(cookie,instr(1,cookie,";")-1)
xml.setRequestHeader "COOKIE", left(cookie,instr(1,cookie,";")-1)
xml.send
returnstr = bytes2BSTR(xml.responsebody)
cookie = xml.getResponseHeader("Set-Cookie")
response.write cookie&"hi"
TOLOGINDNS_CH_GET_PRE = returnstr
End Function

Function TOLOGINDNS_CH_POST(tar,ref,body)
  Dim returnstr
  body=Cstr(body)
	Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "REFERER",ref
xml.setRequestHeader "Accept-Encoding","none"
cookie = Application("TOLOGINDNS_CH_cookie")
xml.setRequestHeader "COOKIE", left(cookie,instr(1,cookie,";")-1)
xml.setRequestHeader "COOKIE", left(cookie,instr(1,cookie,";")-1)
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
'returnstr = (xml.ResponseText)
If xml.status<>200   Then returnstr=""  
	TOLOGINDNS_CH_POST = returnstr
End Function

Function DOPOST_CH(tar,ref,body)
  Dim returnstr
  body=Cstr(body)
	Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "REFERER",ref
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	DOPOST_CH = returnstr
End Function



Function ONLY_GET(tar,ref)
Dim returnstr
Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", tar, False
If ref<>"" Then xml.setRequestHeader "REFERER",ref
xml.setRequestHeader "UserAgent","Mozilla/2.0 (compatible; MSIE 5.0B; Windows NT)"
'  HttpObj.UserAgent = "Mozilla/2.0 (compatible; MSIE 5.0B; Windows NT)"
xml.send
returnstr = bytes2BSTR(xml.responsebody)
ONLY_GET = returnstr
End Function

Function ONLY_POST(tar,ref,body)
  Dim returnstr
  'body=Cstr(body)
	Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "REFERER",ref
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	ONLY_POST = returnstr
End Function


Function ONLY_POST_utf(tar,ref,body,codepage)
  Dim returnstr
  'body=Cstr(body)
	Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded;charset=UTF-8"
xml.setRequestHeader "REFERER",ref
xml.send body
returnstr = bytes2BSTR_utf(xml.responsebody,codepage)
	ONLY_POST_utf = returnstr
End Function

Function ONLY_POST_utf_Session(tar,ref,body,codepage)
  Dim returnstr
  'body=Cstr(body)
	Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", tar, False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "REFERER",ref
xml.send body
session("httpscookie") = xml.getResponseHeader("Set-Cookie")
returnstr = bytes2BSTR_utf(xml.responsebody,codepage)
	ONLY_POST_utf_Session = returnstr
End Function

'Function ONLY_POST(tar,ref,body)
'  Dim returnstr
'Set xml = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
'xml.Option(6)=0
'xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
'xml.Open "POST", tar, False
'xml.setRequestHeader "Content-Length",Len(body)
'xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
'xml.setRequestHeader "Accept-Encoding","GB2312"
'xml.setRequestHeader "REFERER",ref
'xml.send body
'ONLY_POST = bytes2BSTR(xml.responsebody)
'Set xml = Nothing
'End Function

Function SystemCMD(URL,FreeHostsharekey,CMD)
  Dim returnstr,body
body=URLEncoding("CMD="&CMD)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SystemCMD", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  SystemCMD = returnstr
End Function

Function RAROP(URL,FreeHostsharekey,RARcon,username,password)
  Dim returnstr,body
body=URLEncoding("RARcon="&RARcon&"&username="&username&"&password="&password)
'response.write body
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?RAROP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  RAROP = returnstr
End Function

Function SystemNetStop(URL,FreeHostsharekey,CMD)
  Dim returnstr,body
body=URLEncoding("CMD="&CMD)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SystemNetStop", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  SystemNetStop = returnstr
End Function

Function SystemNetStart(URL,FreeHostsharekey,CMD)
  Dim returnstr,body
body=URLEncoding("CMD="&CMD)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SystemNetStart", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  SystemNetStart = returnstr
End Function

Function SystemIISRESET(URL,FreeHostsharekey,CMD)
  Dim returnstr,body
body=URLEncoding("CMD="&CMD)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SystemIISRESET", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  SystemIISRESET = returnstr
End Function

Function ShowAllDrive(URL,FreeHostsharekey,CMD)
  Dim returnstr,body
body=URLEncoding("CMD="&CMD)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?ShowAllDrive", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  ShowAllDrive = returnstr
End Function

Function DNSOP(URL,opcon,FreeHostsharekey)
  Dim returnstr,body
body=URLEncoding("opcon="&opcon)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?DNSOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  DNSOP = returnstr
End Function




Function GETHTTPSLOGIN(tar,ref)
Dim returnstr
Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", tar, False
xml.setRequestHeader "User-Agent","Mozilla/2.0 (compatible; MSIE 5.0B; Windows NT)"
xml.setRequestHeader "REFERER",ref
xml.send
returnstr = bytes2BSTR(xml.responsebody)
session("httpscookie") = xml.getResponseHeader("Set-Cookie")
'Response.Write session("httpscookie")
	GETHTTPSLOGIN = returnstr
End Function


Function GETHTTPS(tar,ref)
Dim returnstr
Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", tar, False
xml.setRequestHeader "REFERER",ref
xml.setRequestHeader "COOKIE", left(session("httpscookie"),instr(1,session("httpscookie"),";")-1)
xml.setRequestHeader "COOKIE", left(session("httpscookie"),instr(1,session("httpscookie"),";")-1)
xml.send
returnstr = bytes2BSTR(xml.responsebody)
'session("httpscookie") = xml.getResponseHeader("Set-Cookie")
'Response.Write session("httpscookie")
	GETHTTPS = returnstr
End Function



Function P_GETx(tar,ref)
Dim returnstr
Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", tar, False
xml.setRequestHeader "User-Agent","Mozilla/2.0 (compatible; MSIE 5.0B; Windows NT)"
xml.setRequestHeader "REFERER",ref
xml.send
returnstr = bytes2BSTR(xml.responsebody)
	P_GETx = returnstr
End Function

Function AddUserSub(URL,FreeHostsharekey,username,password,comment,homedir,spacelimit,starttime,endtime,type1,type2,type3,email,host,hostcomment,MaxConnections,EnumAppsInPool,DefaultDoc,ScriptMaps,AccessFlags,LogFileDirectory,HttpErrors,MaxBandwidth)
  Dim returnstr,body
  homedir=replace(homedir&"\"&username,"\\","\")&"\web\"&trim(dsph ("dirname"))
body=URLEncoding("username="&username&"&password="&password&"&comment="&comment&"&homedir="&homedir&"&spacelimit="&spacelimit&"&starttime="&starttime&"&type1="&type1&"&type2="&type2&"&type3="&type3&"&endtime="&endtime&"&email="&email&"&host="&host&"&hostcomment="&hostcomment&"&MaxConnections="&MaxConnections&"&EnumAppsInPool="&EnumAppsInPool&"&DefaultDoc="&DefaultDoc&"&ScriptMaps="&ScriptMaps&"&AccessFlags="&AccessFlags&"&LogFileDirectory="&LogFileDirectory&"&HttpErrors="&HttpErrors&"&MaxBandwidth="&MaxBandwidth)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?AddUserSub", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  AddUserSub = returnstr
End Function

Function AddUserSubNotchek(URL,FreeHostsharekey,username,password,comment,homedir,spacelimit,starttime,endtime,type1,type2,type3,email,host,hostcomment,MaxConnections,EnumAppsInPool,DefaultDoc,ScriptMaps,AccessFlags,LogFileDirectory,HttpErrors,MaxBandwidth)
  Dim returnstr,body
  homedir=replace(homedir&"\"&username,"\\","\")&"\web\"&trim(dsphsub ("dirname"))
body=URLEncoding("username="&username&"&password="&password&"&comment="&comment&"&homedir="&homedir&"&spacelimit="&spacelimit&"&starttime="&starttime&"&type1="&type1&"&type2="&type2&"&type3="&type3&"&endtime="&endtime&"&email="&email&"&host="&host&"&hostcomment="&hostcomment&"&MaxConnections="&MaxConnections&"&EnumAppsInPool="&EnumAppsInPool&"&DefaultDoc="&DefaultDoc&"&ScriptMaps="&ScriptMaps&"&AccessFlags="&AccessFlags&"&LogFileDirectory="&LogFileDirectory&"&HttpErrors="&HttpErrors&"&MaxBandwidth="&MaxBandwidth)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?AddUserSubNotchek", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  AddUserSubNotchek = returnstr
End Function

Function ModifyUserSub(URL,FreeHostsharekey,username,password,IISID,comment,homedir,spacelimit,starttime,endtime,type1,type2,type3,email,host,hostcomment,MaxConnections,EnumAppsInPool,DefaultDoc,ScriptMaps,AccessFlags,LogFileDirectory,HttpErrors,MaxBandwidth)
  Dim returnstr,body
  if homedir<>"" then homedir=replace(homedir&"\"&username,"\\","\")
body=URLEncoding("username="&username&"&password="&password&"&IISID="&IISID&"&comment="&comment&"&homedir="&homedir&"&spacelimit="&spacelimit&"&starttime="&starttime&"&type1="&type1&"&type2="&type2&"&type3="&type3&"&endtime="&endtime&"&email="&email&"&host="&host&"&hostcomment="&hostcomment&"&MaxConnections="&MaxConnections&"&EnumAppsInPool="&EnumAppsInPool&"&DefaultDoc="&DefaultDoc&"&ScriptMaps="&ScriptMaps&"&AccessFlags="&AccessFlags&"&LogFileDirectory="&LogFileDirectory&"&HttpErrors="&HttpErrors&"&MaxBandwidth="&MaxBandwidth)
'Response.Write url
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?ModifyUserSub", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  ModifyUserSub = returnstr
End Function

Function ShowUserSub(URL,FreeHostsharekey,IISID)
  Dim returnstr,body
body=URLEncoding("IISID="&IISID)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?ShowUserSub", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
'Response.Write returnstr
Set xml = Nothing
  ShowUserSub = returnstr
End Function

Function DelUserSub(URL,FreeHostsharekey,IISID)
  Dim returnstr,body
body=URLEncoding("IISID="&IISID)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?DelUserSub", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  DelUserSub = returnstr
End Function

Function OPLOGSub(URL,FreeHostsharekey,username,IISID,LogFileDirectory,op)
  Dim returnstr,body
body=URLEncoding("username="&username&"&IISID="&IISID&"&LogFileDirectory="&LogFileDirectory&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?OPLOGSub", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  OPLOGSub = returnstr
End Function


Function OPSiteSub(URL,FreeHostsharekey,IISID,op)
  Dim returnstr,body
body=URLEncoding("IISID="&IISID&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?OPSiteSub", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  OPSiteSub = returnstr
End Function

Function OPASPERRSub(URL,FreeHostsharekey,IISID,op)
  Dim returnstr,body
body=URLEncoding("IISID="&IISID&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?OPASPERRSub", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  OPASPERRSub = returnstr
End Function

Function DenySiteIPSub(URL,FreeHostsharekey,IISID,IPARRY)
  Dim returnstr,body
body=URLEncoding("IISID="&IISID&"&IPARRY="&IPARRY)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?DenySiteIPSub", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  DenySiteIPSub = returnstr
End Function

Function OPHTMDIRSub(URL,FreeHostsharekey,IISID,htmdir,htmdir2,op)
  Dim returnstr,body
body=URLEncoding("IISID="&IISID&"&htmdir="&htmdir&"&htmdir2="&htmdir2&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?OPHTMDIRSub", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  OPHTMDIRSub = returnstr
End Function

Function PauseSiteSub(URL,FreeHostsharekey,IISID,tourl,op)
  Dim returnstr,body
body=URLEncoding("IISID="&IISID&"&url="&tourl&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?PauseSiteSub", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  PauseSiteSub = returnstr
End Function

Function CheckDomainDB(nametocheck)
nametocheckMain=GetDomainMain(nametocheck)
status="未提交备案"
	Set dsICPDB = Server.CreateObject("ADODB.Recordset")	
	Sql="Select * from FreeHost.FreeHost_ICPDB where domain='"&nametocheckMain&"' "
	dsICPDB.Open Sql,conn,1,3
if Not dsICPDB.Eof Then status=dsICPDB("status")
'response.write status&sql
'response.end
If Application("beianusecode")=0 And status<>"备案成功" Then

nametocheckMain=ComX.actoidc_7i24_com(Cstr(nametocheckMain))
    set MailCom= server.createobject("FreeHostMail.StarOut")

if Application("openispsystem")=true Then
	MailCom.ispID=Cdbl(Application("ispID"))
	MailCom.isppass=Application("isppass")
	MailCom.userName=Application("userName")
	MailCom.AESIV=Application("AESIV")
	MailCom.AESKey=Application("AESKey")
	MailCom.SOAP_Url_QS=Application("SOAP_Url_QS")
	MailCom.SOAP_Url_UP=Application("SOAP_Url_UP")
	MailCom.queryConditionType=0
	msg=MailCom.isp_querybeianstatus_7i24_com(nametocheckMain)
	msg_code=MailCom.msg_code
	return_FileName=MailCom.return_FileName
	File_OUT_str=MailCom.File_OUT_str
'response.write msg&msg_code
'response.End
If Not msg_code="0" Then
status=msg&" 出错代码:"&msg_code
else
If CStr(MailCom.Bazt)="1" Then
status="未提交备案"
Else
status="备案成功"
ICP_SN=MailCom.Ztbah
'ICP_Who=MailCom.Ztbah
End If
End if

else
	MailCom.siteurl=Application("siteurl")
	status=MailCom.CheckDomainDB_7i24_com(nametocheckMain)
	ICP_SN=MailCom.ICP_SN
	ICP_Who=MailCom.ICP_Who
End If

	set MailCom= Nothing
	

If InStr(status,"出错")>1 Then
response.write "由于网络忙,连接工信部备案数据库出错,请返回重试,详细出错信息:"&status
response.end
End if

	If status="备案成功" Or (status="已提交备案，尚未备案成功" And Application("beianupsaok")=True) Then
			if dsICPDB.Eof Then dsICPDB.addnew
'dsICPDB("username")=ds("username")
'dsICPDB("ftpname")=dsph("ftpname")
dsICPDB("domain")=ComX.idntoac_7i24_com(nametocheckMain)
dsICPDB("status")="备案成功"
dsICPDB("firstaddtime")=Now
If ICP_SN<>"" Then dsICPDB("ICP_SN")=ICP_SN
If ICP_Who<>"" Then dsICPDB("ICP_Who")=ICP_Who
'dsph("alldomainok")=0
dsICPDB.update
    End If
End if
	If status="备案成功" Or (status="已提交备案，尚未备案成功" And Application("beianupsaok")=True) Then
	CheckDomainDB=True
	Else
	CheckDomainDB=False
	End if
dsICPDB.close
End Function

Function FTPOP(URL,FreeHostsharekey,username,op)
  Dim returnstr,body
If ostype="linux" Then
If op=1 then
InCmd="CMD_SELECT_USERS?select0="&username&"&location=CMD_RESELLER_SHOW&dosuspend=Suspend"
Else
InCmd="CMD_SELECT_USERS?select0="&username&"&location=CMD_RESELLER_SHOW&dounsuspend=Unsuspend"
End if
'returnstr=DAAPIGET(URL,"admin",FreeHostsharekey,InCmd)
'If InStr(returnstr,"RESELLER")>1 Then returnstr="API-T成功"
else
body=URLEncoding("username="&username&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?FTPOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End if
  FTPOP = returnstr
End Function

Function MIMEOP(URL,FreeHostsharekey,username,FileType,MimeType,op)
  Dim returnstr,body
body=URLEncoding("username="&username&"&FileType="&FileType&"&MimeType="&MimeType&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?MIMEOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  MIMEOP = returnstr
End Function

Function FSOOP(URL,FreeHostsharekey,username,op)
  Dim returnstr,body
body=URLEncoding("username="&username&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?FSOOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  FSOOP = returnstr
End Function

Function POOLOP(URL,FreeHostsharekey,poolname)
  Dim returnstr,body
body=URLEncoding("poolname="&poolname)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?POOLOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  POOLOP = returnstr
End Function

Function CreateDir(URL,FreeHostsharekey,dirname)
  Dim returnstr,body
body=URLEncoding("dirname="&dirname)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?CreateDir", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  CreateDir = returnstr
End Function

Function DelDir(URL,FreeHostsharekey,dirname)
  Dim returnstr,body
body=URLEncoding("dirname="&dirname)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?DelDir", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  DelDir = returnstr
End Function

Function SqlBACKUP(URL,FreeHostsharekey,userid,pwd,sqlname,backupdir)
  Dim returnstr,body
sql="USE master BACKUP DATABASE "&sqlname&" TO DISK = '"&backupdir&"'  With INIT"
'response.write sql
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SQLACTION", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
SqlBACKUP = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End Function

Function SqlRESTORE(URL,FreeHostsharekey,userid,pwd,sqlname,backupdir,homedir,name1,name2)
  Dim returnstr,body
  sql="USE master Alter Database "&sqlname&" Set OFFLine With rollback Immediate;RESTORE DATABASE "&sqlname&" FROM DISK = '"&backupdir&"' WITH RECOVERY,REPLACE,MOVE '"&name1&"' TO '"&homedir&"\"&sqlname&".mdf',MOVE '"&name2&"' TO '"&homedir&"\"&sqlname&".ldf';Alter Database "&sqlname&" Set ONLine With rollback Immediate;USE "&sqlname&" exec sp_change_users_login 'Auto_Fix','"&sqlname&"';"
  sql=sql&"Use "&sqlname&" EXECUTE sp_grantdbaccess '"&sqlname&"';EXECUTE sp_addrolemember 'db_owner','"&sqlname&"'"
  if sql2000DBtype=false then sql=sql&"Use "&sqlname&" EXECUTE sp_grantdbaccess '"&sqlname&"';EXECUTE sp_addrolemember 'db_accessadmin','"&sqlname&"';EXECUTE sp_addrolemember 'db_securityadmin','"&sqlname&"';EXECUTE sp_addrolemember 'db_ddladmin','"&sqlname&"';EXECUTE sp_addrolemember 'db_backupoperator','"&sqlname&"';EXECUTE sp_addrolemember 'db_datareader','"&sqlname&"';EXECUTE sp_addrolemember 'db_datawriter','"&sqlname&"'"
  sql=sql&"USE master Alter Database "&sqlname&" modify file(name='"&name1&"', newname='"&sqlname&"');Alter Database "&sqlname&" modify file(name='"&name2&"', newname='"&sqlname&"_Log')"
'response.write sql
body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SQLACTION", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
SqlRESTORE = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End Function

Function SqlGetName(URL,FreeHostsharekey,userid,pwd,backupdir,Cname,sql)
  Dim returnstr,body
 body=URLEncoding("userid="&userid&"&pwd="&pwd&"&sql="&sql&"&Cname="&Cname)
' response.write body
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?SQLACTION2", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
SqlGetName = Trim(Replace(bytes2BSTR(xml.responsebody),vbcrlf,""))
Set xml = Nothing
End Function

Function Mysqldump(URL,FreeHostsharekey,varcon)
  Dim returnstr,body
body=URLEncoding("varcon="&varcon)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?Mysqldump", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  Mysqldump = returnstr
End Function

Function MysqlRestore(URL,FreeHostsharekey,varcon)
  Dim returnstr,body
body=URLEncoding("varcon="&varcon)
'response.write body
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?MysqlRestore", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  MysqlRestore = returnstr
End Function

Function CreateFTP(URL,FreeHostsharekey,username,ftppass,ftpdir,varcon,createuser,addacl, ftptype)
  Dim returnstr,body
body=URLEncoding("username="&username&"&ftppass="&ftppass&"&ftpdir="&ftpdir&"&varcon="&varcon&"&createuser="&createuser&"&addacl="&addacl&"&ftptype="&ftptype)
'response.write body
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?CreateFTP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  CreateFTP = returnstr
End Function

Function DelFTP(URL,FreeHostsharekey,username,ftpdir,varcon,todeluser,delacl,todelftp)
  Dim returnstr,body
body=URLEncoding("username="&username&"&ftpdir="&ftpdir&"&varcon="&varcon&"&deluser="&todeluser&"&delacl="&delacl&"&delftp="&todelftp)
'response.write body
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?DelFTP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  DelFTP = returnstr
End Function

Function OPIpsec(URL,FreeHostsharekey,opvar,opip,opport)
  Dim returnstr,body
body=URLEncoding("opvar="&opvar&"&opip="&opip&"&opport="&opport)
'response.write body
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?OPIpsec", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  OPIpsec = returnstr
End Function



Function OPFileExists(URL,FreeHostsharekey,dir)
  Dim returnstr,body
body="dir="&server.urlencode(dir)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?OPFileExists", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  OPFileExists = returnstr
End Function

Function MakeLOG(URL,FreeHostsharekey,username,iblname)
  Dim returnstr,body
body=URLEncoding("username="&username&"&iblname="&iblname)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?MakeLOG", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  MakeLOG = returnstr
End Function

Function CleanRoot(URL,FreeHostsharekey,dirname)
  Dim returnstr,body
body=URLEncoding("dirname="&dirname)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?CleanRoot", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  CleanRoot = returnstr
End Function

Function GetXMLLOG(URL)
  Dim returnstr,body,txml
  txml=dateadd("y",-1,now)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", Url&"/log/"&year(txml)&"-"&month(txml)&"-"&day(txml)&".xml", False
xml.send body
returnstr = xml.responsebody
Set xml = Nothing
  GetXMLLOG = returnstr
End Function

Function CountLOG(URL,FreeHostsharekey,timedif)
  Dim returnstr,body
body=URLEncoding("timedif="&timedif)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?CountLOG", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  CountLOG = returnstr
End Function

Function LIT_RetrunStr(Url,Str)	'直接读取返回值
Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"?"&Str, False
xml.send
LIT_RetrunStr = bytes2BSTR(xml.responsebody)
Set xml=nothing
End Function

Function Post_RetrunStr(Url,Str)	'直接读取返回值
		Set xml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
		xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
		xml.Open "POST", Url, False
		xml.setRequestHeader "Content-Length",Len(body)
		xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
		xml.setRequestHeader "Cache-Control","no-cache"
		xml.send Str
		Post_RetrunStr = bytes2BSTR(xml.responsebody)
End Function

Function siteback(URL,FreeHostsharekey,backupday,backupdir,nottype)
  Dim returnstr,body
body=URLEncoding("backupday="&backupday&"&backupdir="&backupdir&"&nottype="&nottype)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?siteback", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  siteback = returnstr
End Function

Function RAROPadm(URL,FreeHostsharekey,RARcon)
  Dim returnstr,body
body=URLEncoding("RARcon="&RARcon)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?RAROPadm", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  RAROPadm = returnstr
End Function

Function RBSop(URL,FreeHostsharekey,rbsvar)
  Dim returnstr,body
body=URLEncoding("rbsvar="&rbsvar)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?RBS", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  RBSop = returnstr
End Function

Function RBSop2(URL,FreeHostsharekey,rbsvar)
  Dim returnstr,body
body=URLEncoding("rbsvar="&rbsvar)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?RBS2", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  RBSop2 = returnstr
End Function

Function Regimailop(URL,FreeHostsharekey,regpath,key,keyvalue,op)
  Dim returnstr,body
  If IsNumeric(keyvalue) Then
  If keyvalue>4294967290 Then keyvalue=0'imail超出4G后的设置
  End if
body=URLEncoding("regpath="&regpath&"&key="&key&"&keyvalue="&keyvalue&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?Regimailop", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  Regimailop = returnstr
End Function

Function ListDomainmail(URL,FreeHostsharekey,admname,admpass,domain)
	Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
body=URLEncoding("username="&admname&"&pwhidden="&admpass&"&domain="&domain)
xml.Open "POST", Url&"/webeasymailfreehost.asp?ListDomainmail", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
	Set xml = Nothing
	ListDomainmail = returnstr
End Function

Function RBS2(URL,FreeHostsharekey,rbsvar)
  Dim returnstr,body
body=URLEncoding("rbsvar="&rbsvar)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?RBS2", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  RBS2 = returnstr
End Function

Function CleanWeb(URL,FreeHostsharekey,username,dirname)
  Dim returnstr,body
body=URLEncoding("username="&username&"&iblname="&dirname)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?CleanIT", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  CleanWeb = returnstr
End Function

Function BUILDACL(URL,FreeHostsharekey,var)
  Dim returnstr,body
body=URLEncoding("var="&var)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?BUILDACL", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  BUILDACL = returnstr
End Function

Function COPYDIR(URL,FreeHostsharekey,oridir,todir)
  Dim returnstr,body
body=URLEncoding("oridir="&oridir&"&todir="&todir)
'response.write body
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?COPYDIR", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  COPYDIR = returnstr
End Function

Function GBtoUTF8(szInput)   
Dim wch, uch, szRet   
Dim x   
Dim nAsc, nAsc2, nAsc3   
'如果输入参数为空，则退出函数   
If szInput = "" Then  
GBtoUTF8= szInput   
Exit Function  
End If  
'开始转换   
For x = 1 To Len(szInput)   
wch = Mid(szInput, x, 1)   
nAsc = AscW(wch)   
If nAsc < 0 Then nAsc = nAsc + 65536   
If (nAsc And &HFF80) = 0 Then  
szRet = szRet & wch   
Else  
If (nAsc And &HF000) = 0 Then  
uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)   
szRet = szRet & uch   
Else  
uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _   
Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _   
Hex(nAsc And &H3F Or &H80)   
szRet = szRet & uch   
End If  
End If  
Next  
GBtoUTF8= szRet   
End Function 

Function SendSms(SendNum,Content,SendTiming,SendTime,Reserve)
If Application("smsBy")=True Then
If SendTiming=1 Then

dtNow = Now()
If hour(now)<9 And SendTiming=1 Then SendTime=Year(dtNow) & Right("0" & Month(dtNow), 2) & Right("0" & Day(dtNow), 2) & "120000"
dtNow =dateadd("d",1,now)
If hour(now)>20 And SendTiming=1 Then SendTime=Year(dtNow) & Right("0" & Month(dtNow), 2) & Right("0" & Day(dtNow), 2) & "120000"
If hour(now)>=9 And hour(now)<=20 Then
SendTiming=0
SendTime=""
End if
Else
SendTime=""
End If
body="cdkey="&Application("SMSUserName")&"&password="&Application("SMSKey")&"&phone="&SendNum&"&message="&GBtoUTF8(Content)&"&addserial="&Reserve&"&sendtime="&SendTime

Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
If SendTiming=1 Then
xml.Open "GET", "http://sdk999ws.eucp.b2m.cn:8080/sdkproxy/sendsms.action?"&body, False
else
xml.Open "GET", "http://sdk999ws.eucp.b2m.cn:8080/sdkproxy/sendsms.action?"&body, False
End if
xml.send
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing



If InStr(returnstr,"<error>0</error>") Then
returnstr="发送成功"
Else
If InStr(returnstr,"</error>") Then
arysms=Split(returnstr,"</error>")
returnstr="发送失败，代码为："&Replace(arysms(0),"<error>","")
Else
returnstr="发送失败,原因未知。"
End if
End If

Else

If smsbyNew=True then'快信
If hour(now)<9 And SendTiming=1 Then SendTime=Year(now)&"-"&month(now)&"-"&day(now)&" 12:00:00"
If hour(now)>20 And SendTiming=1 Then SendTime=Year(dateadd("d",1,now))&"-"&month(dateadd("d",1,now))&"-"&day(dateadd("d",1,now))&" 12:00:00"
If SendTiming=0 Then SendTime=""
'http://sdk.kuai-xin.com:8888/sms.aspx?action=send&userid=12&account=账号&password=密码&mobile=15023239810,13527576163&content=内容&sendTime=&taskName=本次任务描述&checkcontent=1&mobilenumber=10&countnumber=12&telephonenumber=2
'body="action=send&userid="&server.URLEncode(Application("smsByUserid"))&"&account="&server.URLEncode(Application("SMSUserName"))&"&password="&server.URLEncode(Application("SMSKey"))&"&mobile="&server.URLEncode(SendNum)&"&content="&encodeUrlUtf8(Content)&"&sendTime="&server.URLEncode(SendTime)&"&taskName=&checkcontent=0&mobilenumber=1&countnumber=1&telephonenumber=0"
body="action=send&account="&server.URLEncode(Application("SMSUserName"))&"&password="&server.URLEncode(Application("SMSKey"))&"&mobile="&server.URLEncode(SendNum)&"&content="&server.URLEncode(Content)&"&sendTime="&server.URLEncode(SendTime)&"&taskName=&checkcontent=0&mobilenumber=1&countnumber=1&telephonenumber=0"'2016-8-11
'Response.write body
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
'xml.Open "GET", "http://sdk.kuai-xin.com:8888/sms.aspx?"&body, False
xml.Open "GET", "http://sz.ipyy.com/smsGBK.aspx?"&body, False'2016-8-11
xml.send
'returnstr = Bytes2bStr_utf(xml.responsebody,"utf-8")
returnstr = bytes2BSTR(xml.responsebody)'2016-8-11
Set xml = Nothing
If InStr(returnstr,"Success") Then
returnstr="发送成功"
Else
If InStr(returnstr,"Faild") Then
arysms=Split(returnstr,"</message>")
arysms2=Split(arysms(0),"<message>")
returnstr="发送失败，代码为："&Replace(arysms2(1),"<message>","")
Else
returnstr="发送失败,原因未知。"
End if
End If

Else'原来的动易
If IsNull(SendNum) Then SendNum=""
If IsNull(Content) Then Content=""
If IsNull(Reserve) Then Reserve=""
Randomize
dtNow = Now()
ranNum = Int(900 * Rnd) + 100
SmsID = Year(dtNow) & Right("0" & Month(dtNow), 2) & Right("0" & Day(dtNow), 2) & Right("0" & Hour(dtNow), 2) & Right("0" & Minute(dtNow), 2) & Right("0" & Second(dtNow), 2) & ranNum
'SendTime=Now
If hour(now)<9 And SendTiming=1 Then SendTime=Year(now)&"-"&month(now)&"-"&day(now)&" 12:00:00"
If hour(now)>20 And SendTiming=1 Then SendTime=Year(dateadd("d",1,now))&"-"&month(dateadd("d",1,now))&"-"&day(dateadd("d",1,now))&" 12:00:00"
MD5String=MD5(SmsID&Application("SMSUserName") & Application("SMSKey") & SendNum & Content & SendTiming & SendTime)
body="ID="&server.URLEncode(SmsID)&"&UserName="&server.URLEncode(Application("SMSUserName"))&"&SendNum="&server.URLEncode(SendNum)&"&Content="&server.URLEncode(Content)&"&SendTiming="&server.URLEncode(SendTiming)&"&SendTime="&server.URLEncode(SendTime)&"&Reserve="&Reserve&"&MD5String="&MD5String
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", "http://sms.powereasy.net/MessageGate/Message.aspx?"&body, False
xml.send
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
end if
End If

FreeHost_oplog username,"信息","<b>短信返回</b>:手机号:"&SendNum&" 内容："&Content&" 返回信息："&returnstr
  SendSms = returnstr
End Function

Function encodeUrlUtf8(InstrValue)
     ' 程序使用的编码 utf-8=65001,GB2312=936
'    Session.CodePage=65001
 '   encodeUrlUtf8 = server.urlencode(InstrValue)
  '  Session.CodePage=936
Response.Codepage = 65001
	    encodeUrlUtf8 = Server.URLEncode(InstrValue)
    Response.Codepage = 936
End Function


function SendSmsNetcn(SendNum,Content,SendTiming,SendTime,Reserve)
If IsNull(SendNum) Then SendNum=""
If IsNull(Content) Then Content=""
If IsNull(Reserve) Then Reserve=""
If hour(now)<9 And SendTiming=1 Then
SendTime=Right(Year(now))&Right("0"&month(now),2)&Right("0"&day(now),2)&"120000"
Else
SendTime=""
End if
'04 05 24 16 58 23
	sendStr="user_id=" & Application("SMSUserName") & "&password=" & Application("SMSKey") & "&mobile_phone=" & SendNum & "&msg=" & server.URLEncode(Content) & "&send_date=" & SendTime & "&subcode=" & Application("SMSUserName")
'	response.write sendStr
'		response.end
	set xml=server.CreateObject("MSXML2.ServerXMLHTTP")
	xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
	xml.Open "POST", "http://bms.hichina.com/sms_gateway/sms_api", False
	xml.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
	xml.setRequestHeader "Content-Length",Len(sendStr)
	xml.Send sendStr	
'returnstr = xml.responsetext
returnstr = Replace(Trim(bytes2BSTR(xml.responsebody)),vbcrlf,"")
If returnstr ="0" Then returnstr ="发送成功"
If returnstr ="1" Then returnstr ="用户名或密码校验错误或未授权"
If returnstr ="2" Then returnstr ="无可发许可,请在万网中充钱"
If returnstr ="3" Then returnstr ="提交失败"
If returnstr ="5" Then returnstr ="发送数量大于允许发送条数"
If returnstr ="6" Then returnstr ="短信内容超长"
If returnstr ="11" Then returnstr ="未知的万网错误,联系万网分析,返回码是11"
SendSmsNetcn=returnstr
end function


Function VPSOP(URL,FreeHostsharekey,vpscon,op)
  Dim returnstr,body
body=URLEncoding("vpscon="&vpscon&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?VPSOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  VPSOP = returnstr
End Function

Function DAAPIGET(URL,Dauser,FreeHostsharekey,InCmd)
Dim objXMLHTTP
Set objXMLHTTP = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
objXMLHTTP.Option(6)=0
objXMLHTTP.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
objXMLHTTP.open "GET", URL&"/"&InCmd, false ,Dauser ,FreeHostsharekey
objXMLHTTP.setRequestHeader "Authorization","Basic " & Base64Encode(Dauser&":"&FreeHostsharekey)
objXMLHTTP.send
    If objXMLHTTP.status=200 Then
		DAAPIGET=objXMLHTTP.ResponseText
    Else
		DAAPIGET="ERROR http status:"&objXMLHTTP.status
		If InStr(InCmd,"suspend=")>1 Then
		If InStr(objXMLHTTP.GetResponseHeader("location"),"CMD_RESELLER_SHOW")>1 Then
		DAAPIGET="suspend操作成功"'&objXMLHTTP.GetResponseHeader("location")
		else
		DAAPIGET="ERROR http status:"&objXMLHTTP.status
		End if
		End if
    End If
End Function

Function DAAPIPOST(URL,Dauser,FreeHostsharekey,InCmd,PostBody)
Dim objXMLHTTP
Set objXMLHTTP = Server.CreateObject("WinHttp.WinHttpRequest.5.1")
objXMLHTTP.Option(6)=0
objXMLHTTP.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
objXMLHTTP.open "POST", URL&"/"&InCmd, false ,Dauser,FreeHostsharekey
objXMLHTTP.setRequestHeader "Content-Type","application/x-www-form-urlencoded"
objXMLHTTP.setRequestHeader "Content-Length",Len(PostBody)
objXMLHTTP.setRequestHeader "Authorization","Basic " & Base64Encode(Dauser&":"&FreeHostsharekey)
objXMLHTTP.send PostBody
    If objXMLHTTP.status=200 Then
		DAAPIPOST=objXMLHTTP.ResponseText
'			response.write objXMLHTTP.status&"Basic " & Base64Encode(Dauser&":"&FreeHostsharekey)
    Else
		DAAPIPOST="ERROR http status:"&objXMLHTTP.status
   End If
End Function

Function Base64Encode(inData)
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim sOut, I
  For I = 1 To Len(inData) Step 3
    Dim nGroup, pOut
    nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
      &H100 * MyASC(Mid(inData, I + 1, 1)) + _
      MyASC(Mid(inData, I + 2, 1))
    nGroup = Oct(nGroup)
    nGroup = String(8 - Len(nGroup), "0") & nGroup
    pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
    sOut = sOut + pOut    
  Next
  Select Case Len(inData) Mod 3
    Case 1: 
      sOut = Left(sOut, Len(sOut) - 2) + "=="
    Case 2: 
      sOut = Left(sOut, Len(sOut) - 1) + "="
  End Select
  Base64Encode = sOut
End Function
Function MyASC(OneChar)
  If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function

Function URLDecode(enStr)
  dim deStr
  dim c,i,v
  deStr=""
  for i=1 to len(enStr)
    c=Mid(enStr,i,1)
    if c="%" then
      v=eval("&h"+Mid(enStr,i+1,2))
      if v<128 then
        deStr=deStr&chr(v)
        i=i+2
      else
        if isvalidhex(mid(enstr,i,3)) then
          if isvalidhex(mid(enstr,i+3,3)) then
            v=eval("&h"+Mid(enStr,i+1,2)+Mid(enStr,i+4,2))
            deStr=deStr&chr(v)
            i=i+5
          else
            v=eval("&h"+Mid(enStr,i+1,2)+cstr(hex(asc(Mid(enStr,i+3,1)))))
            deStr=deStr&chr(v)
            i=i+3 
          end if 
        else 
          destr=destr&c
        end if
      end if
    else
      if c="+" then
        deStr=deStr&" "
      else
        deStr=deStr&c
      end if
    end if
  next
  URLDecode=deStr
End Function

Function EnomAPI(InVar)
EnomAPIURL="http://reseller.enom.com/interface.asp?"
'EnomAPIURL="http://resellertest.enom.com/interface.asp?"
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", EnomAPIURL&InVar, False
xml.send
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  EnomAPI = returnstr
End Function

Function GetDomainMain(inDomain)
inDomainNew=LCase(trim(replace(inDomain,"http://","")))

domainErrcheck=ComX.idntoac_7i24_com(cstr(inDomainNew))
If domainErrcheck="" or RegExpTest("[^.A-Za-z0-9--]",domainErrcheck) Then
response.write "此域名检查非法,请改正:原:"&inDomainNew&" idn后:"&domainErrcheck
response.end
End If
inDomainNew=domainErrcheck
if left(inDomainNew,4)="www." then inDomainNew=right(inDomainNew,len(inDomainNew)-4)'删除www.
Enddomaintypeid=GetDomaintype(inDomainNew)
domainarry=split(inDomainNew,".")
If Enddomaintypeid=1 Or Enddomaintypeid=30 Or Enddomaintypeid=4 Or Enddomaintypeid=5 Or Enddomaintypeid=8 Or Enddomaintypeid=9 Or Enddomaintypeid=10 Or Enddomaintypeid=20 Or Enddomaintypeid=31 Or Enddomaintypeid=52  Or Enddomaintypeid=53 Or Enddomaintypeid=25 Or Enddomaintypeid=26 Or Enddomaintypeid=27 Or Enddomaintypeid=24 Or Enddomaintypeid=57  Or Enddomaintypeid=71  Or Enddomaintypeid=72 Or Enddomaintypeid=73 Or Enddomaintypeid=74 Or Enddomaintypeid=75 Or Enddomaintypeid=76 Or Enddomaintypeid=77 Or Enddomaintypeid=58  Or Enddomaintypeid=60 Then'.com .net .org .la
if ubound(domainarry)=1 Then'xxx.com
inDomainNew=inDomainNew
ElseIf ubound(domainarry)>1 Then'yyyy.xxx.com
inDomainNew=domainarry(ubound(domainarry)-1)&"."&domainarry(ubound(domainarry))
End If
End If

If Enddomaintypeid=2 Or Enddomaintypeid=4 Or Enddomaintypeid=11 Or Enddomaintypeid=12  Or Enddomaintypeid=8 Then'.cn
if ubound(domainarry)=1 Then'xxx.cn
inDomainNew=inDomainNew
ElseIf ubound(domainarry)>1 Then'fdsf.yyyy.com.cn

If domainarry(ubound(domainarry)-1)="edu" Or domainarry(ubound(domainarry)-1)="com" or domainarry(ubound(domainarry)-1)="net" or domainarry(ubound(domainarry)-1)="org" or domainarry(ubound(domainarry)-1)="name" or domainarry(ubound(domainarry)-1)="cc" or domainarry(ubound(domainarry)-1)="biz" or domainarry(ubound(domainarry)-1)="mobi" or domainarry(ubound(domainarry)-1)="gov"  or domainarry(ubound(domainarry)-1)="bj"  or domainarry(ubound(domainarry)-1)="fj"  or domainarry(ubound(domainarry)-1)="sh"  or domainarry(ubound(domainarry)-1)="jx"  or domainarry(ubound(domainarry)-1)="tj"  or domainarry(ubound(domainarry)-1)="sd"  or domainarry(ubound(domainarry)-1)="cq"  or domainarry(ubound(domainarry)-1)="ha"  or domainarry(ubound(domainarry)-1)="he"  or domainarry(ubound(domainarry)-1)="hb"  or domainarry(ubound(domainarry)-1)="sx"  or domainarry(ubound(domainarry)-1)="hn"  or domainarry(ubound(domainarry)-1)="nm"  or domainarry(ubound(domainarry)-1)="gd"  or domainarry(ubound(domainarry)-1)="ln"  or domainarry(ubound(domainarry)-1)="gx"  or domainarry(ubound(domainarry)-1)="jl"  or domainarry(ubound(domainarry)-1)="hi"  or domainarry(ubound(domainarry)-1)="hl"  or domainarry(ubound(domainarry)-1)="sc"  or domainarry(ubound(domainarry)-1)="js"  or domainarry(ubound(domainarry)-1)="gz"  or domainarry(ubound(domainarry)-1)="zj"  or domainarry(ubound(domainarry)-1)="yn"  or domainarry(ubound(domainarry)-1)="ah"  or domainarry(ubound(domainarry)-1)="xz"  or domainarry(ubound(domainarry)-1)="sn"  or domainarry(ubound(domainarry)-1)="tw"  or domainarry(ubound(domainarry)-1)="gs"  or domainarry(ubound(domainarry)-1)="hk"  or domainarry(ubound(domainarry)-1)="qh"  or domainarry(ubound(domainarry)-1)="mo"  or domainarry(ubound(domainarry)-1)="nx"  or domainarry(ubound(domainarry)-1)="xj"  or domainarry(ubound(domainarry)-1)="ac" or domainarry(ubound(domainarry)-1)="co" Then
inDomainNew=domainarry(ubound(domainarry)-2)&"."&domainarry(ubound(domainarry)-1)&"."&domainarry(ubound(domainarry))
Else
inDomainNew=domainarry(ubound(domainarry)-1)&"."&domainarry(ubound(domainarry))
End If

End If
End If

GetDomainMain=inDomainNew
End Function

Function GetDomaintype(inDomain)
domaintypeid=0
enc="E"
domtemp=Right(inDomain,"3")
domtemp2=replace(replace(inDomain,".",""),"-","")
if domtemp="com" then domaintypeid=1
if domtemp=".cn" then domaintypeid=2
If Right(inDomain,"7")=".gov.cn" Then domaintypeid=70
if domtemp="biz" then domaintypeid=4
if domtemp="nfo" then domaintypeid=5
if domtemp=".cc" then domaintypeid=8
if domtemp=".co" then domaintypeid=71
if domtemp=".cm" then domaintypeid=72
if domtemp=".im" then domaintypeid=73
if domtemp="ang" then domaintypeid=74'.wang
if domtemp="top" then domaintypeid=75'.top
if domtemp="xyz" then domaintypeid=76'.xyz
if domtemp=".pw" then domaintypeid=77'.pw
if domtemp="obi" then domaintypeid=9
if domtemp=".tv" then domaintypeid=10
if domtemp=".hk" then domaintypeid=11
if domtemp=".tw" then domaintypeid=12
if domtemp="ame" then domaintypeid=20
if domtemp="sia" then domaintypeid=21
if domtemp=".in" then domaintypeid=24
if domtemp=".sh" then domaintypeid=25
if domtemp=".ws" then domaintypeid=26
if domtemp=".us" then domaintypeid=27
if domtemp=".eu" then domaintypeid=28
if domtemp=".uk" then domaintypeid=29
if domtemp="net" or domtemp="org" then domaintypeid=30
if domtemp=".me" then domaintypeid=31
if domtemp=".de" then domaintypeid=50
if domtemp=".jp" then domaintypeid=51
if domtemp=".la" then domaintypeid=52
if domtemp=".ca" then domaintypeid=53
if domtemp=".am" then domaintypeid=54
if domtemp=".at" then domaintypeid=55
if domtemp=".be" then domaintypeid=56
if domtemp=".tm" then domaintypeid=57
if domtemp=".to" then domaintypeid=58
if domtemp=".ag" then domaintypeid=59
if domtemp=".pt" then domaintypeid=60
if domtemp="tel" then domaintypeid=32
if RegExpTest("[^A-Za-z0-9]",domtemp2) then'存在中文
enc="G"
if domaintypeid=1 Or domaintypeid=30 then domaintypeid=7'中文.com
if domaintypeid=2 then domaintypeid=3'中文.cn
if domaintypeid=4 then domaintypeid=13'中文.biz
if domaintypeid=5 then domaintypeid=14'中文.info
if domaintypeid=8 then domaintypeid=15'中文.cc
if domaintypeid=9 then domaintypeid=16'中文.mobi
if domaintypeid=10 then domaintypeid=17'中文.tv
if domaintypeid=11 then domaintypeid=18'中文.hk
if domaintypeid=12 then domaintypeid=19'中文.tw
if domaintypeid=20 then domaintypeid=22'中文.name
if domaintypeid=21 then domaintypeid=23'中文.asia
If domaintypeid=0 Then domaintypeid=6'通用网址
end If
if domtemp=".中国" or domtemp=".公司" or domtemp=".网络" then domaintypeid=3
'If domaintypeid=0 Then Response.Redirect "e.asp?e=不可识别的域名类型:"&inDomain
GetDomaintype= domaintypeid
End Function

Function CLngIP(asNewIP)
asNewIP=CStr(asNewIP)
lnIpAry = Split(asNewIP, ".", 4)
For lnIndex = 0 To 3
If Not lnIndex = 3 Then
lnIpAry(lnIndex) = lnIpAry(lnIndex) * (256 ^ (3 - lnIndex))
End If
lnResults = lnResults + lnIpAry(lnIndex)
Next
CLngIP = lnResults
End Function

Function CStrIP(anNewIP)
asNewIP=Cstr(asNewIP)
For lnIndex = 3 To 0 Step -1
lnTemp = int(cdbl(anNewIP) / (256 ^ lnIndex))
lsResults = lsResults & lnTemp & "."
anNewIP = cdbl(anNewIP) - (lnTemp * (256 ^ lnIndex))
Next
lsResults = Left(lsResults, Len(lsResults) - 1)
CStrIP = lsResults
End Function 

Function StopSitebyID(URL,FreeHostsharekey,IISID,op)
  Dim returnstr,body
body=URLEncoding("IISID="&IISID&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?StopSitebyID", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  StopSitebyID = returnstr
End Function

Function AsiaAPI(InVar)
EnomAPIURL="http://www.asiaregister.com/Interface.php?"
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", EnomAPIURL&InVar, False
xml.send
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  AsiaAPI = returnstr
End Function

Function HexonetAPI(InVar)
HexonetAPIURL="http://api.ispapi.net/api/call.cgi?"
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", HexonetAPIURL&InVar, False
xml.send
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  HexonetAPI = returnstr
End Function

Function CreatePoolDirect(URL,FreeHostsharekey,Poolname)
  Dim returnstr,body
body=URLEncoding("Poolname="&Poolname)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "GET", Url&"/FreeHost.dll?CreatePoolDirect?"&body, False
xml.send
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  CreatePoolDirect = returnstr
End Function

Function AddUser3(URL,FreeHostsharekey,username,password,comment,homedir,spacelimit,starttime,endtime,type1,type2,type3,email,host,hostcomment,MaxConnections,EnumAppsInPool,DefaultDoc,ScriptMaps,AccessFlags,LogFileDirectory,HttpErrors,MaxBandwidth,siteID,outpoolname,op)
  Dim returnstr,body
If ostype="linux" Then
InCmd="CMD_API_ACCOUNT_USER"
hostary=Split(host,",")
If UBound(hostary)>0 Then hostary(0)=hostary(1)
host=Replace(Replace(hostary(0),":80:",""),",","")
body="action=create&username="&username&"&email="&email&"&passwd="&password&"&passwd2="&password&"&domain="&host&"&package="&packagename&"&ip="&hostip&"&add=Submit"
returnstr=DAAPIPOST(URL,"sefreehost",FreeHostsharekey,InCmd,body)
returnstr=returnstr&"发送给API的信息:"&Replace(body,"&"," ")
else
  homedir=replace(homedir&"\"&username,"\\","\")
body=URLEncoding("username="&username&"&password="&password&"&comment="&comment&"&homedir="&homedir&"&spacelimit="&spacelimit&"&starttime="&starttime&"&type1="&type1&"&type2="&type2&"&type3="&type3&"&endtime="&endtime&"&email="&email&"&host="&host&"&hostcomment="&hostcomment&"&MaxConnections="&MaxConnections&"&EnumAppsInPool="&EnumAppsInPool&"&DefaultDoc="&DefaultDoc&"&ScriptMaps="&ScriptMaps&"&AccessFlags="&AccessFlags&"&LogFileDirectory="&LogFileDirectory&"&HttpErrors="&HttpErrors&"&MaxBandwidth="&MaxBandwidth&"&siteID="&siteID&"&outpoolname="&outpoolname&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?AddUser3", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End if
  AddUser3 = returnstr
End Function




Function ModifyUser3(URL,FreeHostsharekey,username,comment,homedirX,spacelimit,starttime,endtime,type1,type2,type3,email,host,hostcomment,MaxConnections,EnumAppsInPool,DefaultDoc,ScriptMaps,AccessFlags,LogFileDirectory,HttpErrors,MaxBandwidth,outpoolname,op)
  Dim returnstr,body
If ostype="linux" Then
If packagename<>"" Then
'按包升级
InCmd="CMD_API_MODIFY_USER"
body="action=package&user="&username&"&package="&packagename
returnstr=DAAPIPOST(URL,"sefreehost",FreeHostsharekey,InCmd,body)
returnstr=returnstr&"发送给API的信息:"&Replace(body,"&"," ")
Else
'按单独定义升级
InCmd="CMD_API_MODIFY_USER"
If Maxbytes=0 Then unlimited="unlimited"
body="action=customize&user="&username&"&vdomains="&vdomains&"&bandwidth="&Maxbytes&"&ubandwidth="&unlimited&"&quota="&spacelimt&"&vdomains="&vdomains&"&nsubdomains="&allowdomain&"&nemails="&nemails&"&nemailf="&nemailf&"&nemailml="&nemailml&"&nemailr="&nemailr&"&mysql="&mysql&"&domainptr="&domainptr&"&ftp="&ftp&"&php="&php&"&cgi="&cgi
bodyary=Split(body,"&")
body=""
For i=0 To UBound(bodyary)
If Right(bodyary(i),1)<>"=" Then body=body&bodyary(i)&"&"
next
returnstr=DAAPIPOST(URL,"sefreehost",FreeHostsharekey,InCmd,body)
returnstr=returnstr&"发送给API的信息:"&Replace(body,"&"," ")
End if
else
  if homedirX<>"" then homedirX=replace(homedirX&"\"&username,"\\","\")
body=URLEncoding("username="&username&"&comment="&comment&"&homedir="&homedirX&"&spacelimit="&spacelimit&"&starttime="&starttime&"&type1="&type1&"&type2="&type2&"&type3="&type3&"&endtime="&endtime&"&email="&email&"&host="&host&"&hostcomment="&hostcomment&"&MaxConnections="&MaxConnections&"&EnumAppsInPool="&EnumAppsInPool&"&DefaultDoc="&DefaultDoc&"&ScriptMaps="&ScriptMaps&"&AccessFlags="&AccessFlags&"&LogFileDirectory="&LogFileDirectory&"&HttpErrors="&HttpErrors&"&MaxBandwidth="&MaxBandwidth&"&outpoolname="&outpoolname&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?ModifyUser3", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
End if
  ModifyUser3 = returnstr
End Function

Function CDNOP(URL,FreeHostsharekey,CDNcon,cachemgr,mime,squid,squid_radius_auth,hosts,op)
  Dim returnstr,body
body=URLEncoding("varcon="&server.URLEncode(CDNcon)&"&cachemgr="&server.URLEncode(cachemgr)&"&mime="&server.URLEncode(mime)&"&squid="&server.URLEncode(squid)&"&squid_radius_auth="&server.URLEncode(squid_radius_auth)&"&hosts="&server.URLEncode(hosts)&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?CDNOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
'xml.setRequestHeader "Accept-Encoding", "compress,gzip"
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  CDNOP = returnstr
End Function

Function CDNOP2(URL,FreeHostsharekey,CDNserverid,Maincpurl,op,syntime)
  Dim returnstr,body
body=URLEncoding("CDNserverid="&server.URLEncode(CDNserverid)&"&Maincpurl="&server.URLEncode(Maincpurl)&"&op="&op&"&syntime="&syntime)
'response.write body
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?CDNOP2", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  CDNOP2 = returnstr
End Function


Function PORTOP(URL,FreeHostsharekey,portxml,op)
  Dim returnstr,body
body=URLEncoding("portxml="&server.URLEncode(portxml)&"&op="&op)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?PORTOP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  PORTOP = returnstr
End Function


sub CDNrefreshDomain()
if isuseCDN=true Then'处理免备案cdn部分
CDNalldomain=""
	Set dsCDNserver = Server.CreateObject("ADODB.Recordset")	
	Sql="Select * from FreeHost.FreeHost_ServerCDNlist where cdntype='外国免备案专用' and (iserr=0 or iserr is null) and (id='"&usecdn1&"' or id='"&usecdn2&"' or id='"&usecdn3&"' or id='"&usecdn4&"' or id='"&usecdn5&"')"
	dsCDNserver.Open Sql,conn,1,3
While not dsCDNserver.Eof
CDNalldomain=""
CDNrecordcount=0
'列出这台服务器所有域名,
	Set dsph = Server.CreateObject("ADODB.Recordset")
Sql="Select (select ip from FreeHost.FreeHost_Serverlist where id=ServerlistID) as SQL_temp_ip,(select port from FreeHost.FreeHost_Serverlist where id=ServerlistID) as SQL_temp_port,id,hostname,ftpname from FreeHost.FreeHost_Product_Host where ServerlistID in (Select id from FreeHost.FreeHost_Serverlist where isuseCDN=1 and ((usecdn1='"&usecdn1&"' and usecdn1>0) or (usecdn2='"&usecdn2&"' and usecdn2>0) or (usecdn3='"&usecdn3&"' and usecdn3>0) or (usecdn4='"&usecdn4&"' and usecdn4>0) or (usecdn5='"&usecdn5&"' and usecdn5>0) ))"
'response.write dsCDNserver("id")&":"&sql&"<br>"
	dsph.Open Sql,conn,1,1
CDNrecordcount=dsph.recordcount+CDNrecordcount
while not dsph.Eof
hostname_arry=Split(dsph("hostname"), ",")
If ubound(hostname_arry)<25 then
hostname=Replace(replace(dsph("hostname"), ":80:",""),","," ")

tempCDNOld=CDNalldomain
tempCDNNew=vbcrlf&"cache_peer "&dsph("SQL_temp_ip")&" parent "&dsph("SQL_temp_port")&" 0 no-query originserver name="&dsph("ftpname")&"_"&dsph("id")
tempCDNNew=tempCDNNew&vbcrlf&"cache_peer_domain "&dsph("ftpname")&"_"&dsph("id")&" "&hostname
CDNalldomain=tempCDNOld+tempCDNNew

Else
for i=0 to ubound(hostname_arry)
If Len(hostname_arry(i))>3 Then

tempCDNOld=CDNalldomain
tempCDNNew=vbcrlf&"cache_peer "&dsph("SQL_temp_ip")&" parent "&dsph("SQL_temp_port")&" 0 no-query originserver name="&dsph("ftpname")&"_"&dsph("id")&"_"&i
tempCDNNew=tempCDNNew&vbcrlf&"cache_peer_domain "&dsph("ftpname")&"_"&dsph("id")&"_"&i&" "&replace(hostname_arry(i), ":80:","")
CDNalldomain=tempCDNOld+tempCDNNew

End if
next
End if
dsph.movenext
wend

'response.write "<br>"&dsCDNserver("site")&"<br>"
'发送给CDN服务器
URL=dsCDNserver("site")
FreeHostsharekey=dsCDNserver("FreeHostsharekey")
dsCDNserver("squid")=CDNalldomain
dsCDNserver("lastchangetime")=now
dsCDNserver.update
op=2
CDNcon="-k reconfigure -n squid"
hosts=""
squid=Replace(dsCDNserver("squidHead")&vbcrlf&"access_log "&dsCDNserver("logpath")&"access.log combined"&vbcrlf&dsCDNserver("squid"),vbcrlf&vbcrlf,vbcrlf)
'response.write squid
If CDNrecordcount<100 Or CDNSYNnow=true Then
session("waitCDNsyn")=false
If CDNrecordcount<100 then
CDNret="  CDN操作返回:"&CDNOP(URL,FreeHostsharekey,CDNcon,cachemgr,mime,squid,squid_radius_auth,hosts,op)
dsCDNserver("lastSYNtime")=now
dsCDNserver.update
Else
If CDNSYNnow=true Then CDNret="  CDN2操作返回:"&CDNOP2(URL,FreeHostsharekey,dsCDNserver("id"),Application("ctldomain"),op,dsCDNserver("syntime"))
End If
Else
session("waitCDNsyn")=true
End if
If showcdnret=True then response.write squid

'response.write squid

If showcdnret=True then response.write CDNret
dsCDNserver.movenext
Wend
End if
end Sub

sub CDNrefreshDomainVPS()
if isONEip=true Then'处理cdn部分
CDNalldomain=""
CDNrecordcount=0
	Set dsserver = Server.CreateObject("ADODB.Recordset")	
	Sql="Select * from FreeHost.FreeHost_ServerVPSlist where usecdn1='"&usecdn1&"' and isONEip=1"
	dsserver.Open Sql,conn,1,1
While not dsserver.Eof
'列出这台服务器所有域名,
	Set dsph = Server.CreateObject("ADODB.Recordset")
Sql="Select id,hostname,VPSname from FreeHost.FreeHost_Product_VPS where ServerlistID='"&dsserver("id")&"'"
	dsph.Open Sql,conn,1,1
CDNrecordcount=dsph.recordcount+CDNrecordcount
while not dsph.Eof
If Not IsNull(dsph("hostname")) Then

Set dsVPSip = Server.CreateObject("ADODB.Recordset")	
		Sql="Select ip from FreeHost.FreeHost_Product_VPS_IP where ipbyid=0 and VPSID="&dsph("id")
		dsVPSip.Open Sql,conn,1,1
If not dsVPSip.Eof Then
hostname_arry=Split(dsph("hostname"), ",")
If ubound(hostname_arry)<25 then
CDNalldomain=CDNalldomain&vbcrlf&"cache_peer "&dsVPSip("ip")&" parent "&dsserver("port")&" 0 no-query originserver name="&dsph("VPSname")&"_"&dsph("id")
CDNalldomain=CDNalldomain&vbcrlf&"cache_peer_domain "&dsph("VPSname")&"_"&dsph("id")&" "&Replace(replace(dsph("hostname"), ":"&dsserver("port")&":",""),","," ")
Else
for i=0 to ubound(hostname_arry)
If Len(hostname_arry(i))>3 then
CDNalldomain=CDNalldomain&vbcrlf&"cache_peer "&dsVPSip("ip")&" parent "&dsserver("port")&" 0 no-query originserver name="&dsph("VPSname")&"_"&dsph("id")&"_"&i
CDNalldomain=CDNalldomain&vbcrlf&"cache_peer_domain "&dsph("VPSname")&"_"&dsph("id")&"_"&i&" "&replace(hostname_arry(i), ":"&dsserver("port")&":","")
End if
next
End if


End if

End if
dsph.movenext
wend
dsserver.movenext
Wend
'发送给CDN服务器
URL=dsCDNserver("site")
FreeHostsharekey=dsCDNserver("FreeHostsharekey")
dsCDNserver("squid")=CDNalldomain
dsCDNserver("lastchangetime")=now
dsCDNserver.update
op=2
CDNcon="-k reconfigure -n squid"
hosts=""
squid=Replace(dsCDNserver("squidHead")&vbcrlf&"access_log "&dsCDNserver("logpath")&"access.log combined"&vbcrlf&dsCDNserver("squid"),vbcrlf&vbcrlf,vbcrlf)
If CDNrecordcount<100 Or CDNSYNnow=true then
dsCDNserver("lastSYNtime")=now
dsCDNserver.update
session("waitCDNsyn")=false
CDNret="  CDN操作返回:"&CDNOP(URL,FreeHostsharekey,CDNcon,cachemgr,mime,squid,squid_radius_auth,hosts,op)
Else
session("waitCDNsyn")=true
End if
If showcdnret=True then response.write squid
If showcdnret=True then response.write CDNret
'response.end
End If
end sub


sub CDNrefreshDomainCDN(InNettype)
	Set dsCDNserver = Server.CreateObject("ADODB.Recordset")	
	Sql="Select * from FreeHost.FreeHost_ServerCDNlist where cdntype='多点分布CDN加速用' and (iserr=0 or iserr is null) and (Bindserverid1='"&Bindserverid1&"' or Bindserverid1='"&Bindserverid2&"' or Bindserverid2='"&Bindserverid1&"' or Bindserverid2='"&Bindserverid2&"') and nettype='"&InNettype&"' order by id ASC"
'response.write sql
	dsCDNserver.Open Sql,conn,1,3
'While not dsCDNserver.Eof
If not dsCDNserver.Eof Then
CDNalldomain=""
CDNrecordcount=0
'列出这台服务器所有域名,
	Set dsph = Server.CreateObject("ADODB.Recordset")
Sql="Select id,hostname,ftpname from FreeHost.FreeHost_Product_CDN where hostname is not null and (Bindserverid1='"&dsCDNserver ("Bindserverid1")&"' or Bindserverid2='"&dsCDNserver ("Bindserverid2")&"' or Bindserverid1='"&dsCDNserver ("Bindserverid2")&"' or Bindserverid2='"&dsCDNserver ("Bindserverid1")&"' ) and (status='正常' or status='试用')"
	dsph.Open Sql,conn,1,1
CDNrecordcount=dsph.recordcount+CDNrecordcount
while not dsph.Eof
nettype=dsCDNserver("nettype")

hostname_arry=Split(dsph("hostname"), ",")
for i=0 to ubound(hostname_arry)
'192.168.0.222:80:agnssss.test.com
'25.5.5.5:80|MOB-53.6.66.5:858:dsa.com,5.5.5.5:80|USA-43.3.3.56:777:fuckkkk.com,5.2.2.2:900|CNC-1.2.2.1:83|MOB-3.2.2.3:84|USA-5.5.5.1:85:womeme.com

domary=Split(hostname_arry(i),":")

domain=domary(UBound(domary))
ipstrall=Left(hostname_arry(i),Len(hostname_arry(i))-Len(domain)-1)
ipary=Split(ipstrall,"|")
iparyTel=Split(ipary(0),":")
ipTel=iparyTel(0)
portTel=iparyTel(1)
ipCNC=""
portCNC=""
ipMOB=""
portMOB=""
ipUSA=""
portUSA=""
For sourceI=1 To UBound(ipary)
If InStr(ipary(sourceI),"NC-") then
iparyCNC=Split(ipary(sourceI),":")
ipCNC=Replace(iparyCNC(0),"CNC-","")
portCNC=iparyCNC(1)
End If
If InStr(ipary(sourceI),"OB-") then
iparyMOB=Split(ipary(sourceI),":")
ipMOB=Replace(iparyMOB(0),"MOB-","")
portMOB=iparyMOB(1)
End If
If InStr(ipary(sourceI),"SA-") Then
iparyUSA=Split(ipary(sourceI),":")
ipUSA=Replace(iparyUSA(0),"USA-","")
portUSA=iparyUSA(1)
End If
next

CDNcurIP=ipTel
CDNcurPort=portTel
If dsCDNserver("nettype")="联通" And ipCNC<>"" Then
CDNcurIP=ipCNC
CDNcurPort=portCNC
End If
If dsCDNserver("nettype")="移动" And ipMOB<>"" Then
CDNcurIP=ipMOB
CDNcurPort=portMOB
End If
If dsCDNserver("nettype")="外国" And ipUSA<>"" Then
CDNcurIP=ipUSA
CDNcurPort=portUSA
End if

tempCDNOld=CDNalldomain
tempCDNNew=vbcrlf&"cache_peer "&CDNcurIP&" parent "&CDNcurPort&" 0 no-query originserver name="&dsph("ftpname")&"_"&dsph("id")&"_"&i
tempCDNNew=tempCDNNew&vbcrlf&"cache_peer_domain "&dsph("ftpname")&"_"&dsph("id")&"_"&i&" "&domain
CDNalldomain=tempCDNOld+tempCDNNew


next

dsph.movenext
wend


'发送给CDN服务器
URL=dsCDNserver("site")
FreeHostsharekey=dsCDNserver("FreeHostsharekey")
dsCDNserver("squid")=CDNalldomain
dsCDNserver("lastchangetime")=now
dsCDNserver.update
op=2
CDNcon="-k reconfigure -n squid"
hosts=""
squid=Replace(dsCDNserver("squidHead")&vbcrlf&"access_log "&dsCDNserver("logpath")&"access.log combined"&vbcrlf&dsCDNserver("squid"),vbcrlf&vbcrlf,vbcrlf)
'response.write squid
If CDNrecordcount<100 Or CDNSYNnow=true Then
dsCDNserver("lastSYNtime")=now
dsCDNserver.update
session("waitCDNsyn")=False
If CDNrecordcount<100 then
CDNret="  CDN操作返回:"&CDNOP(URL,FreeHostsharekey,CDNcon,cachemgr,mime,squid,squid_radius_auth,hosts,op)
Else
If CDNSYNnow=true Then CDNret="  CDN2操作返回:"&CDNOP2(URL,FreeHostsharekey,dsCDNserver("id"),Application("ctldomain"),op,dsCDNserver("syntime"))
End if
Else
session("waitCDNsyn")=true
End if
If showcdnret=True then response.write squid

If showcdnret=True then response.write CDNret
'dsCDNserver.movenext
'Wend

dsCDNserver.movenext
End if

While not dsCDNserver.Eof
'发送给CDN服务器
URL=dsCDNserver("site")
FreeHostsharekey=dsCDNserver("FreeHostsharekey")
dsCDNserver("squid")=CDNalldomain
dsCDNserver("lastchangetime")=now
dsCDNserver.update
op=2
CDNcon="-k reconfigure -n squid"
hosts=""
squid=Replace(dsCDNserver("squidHead")&vbcrlf&"access_log "&dsCDNserver("logpath")&"access.log combined"&vbcrlf&dsCDNserver("squid"),vbcrlf&vbcrlf,vbcrlf)
'response.write squid
If CDNrecordcount<100 Or CDNSYNnow=true Then
session("waitCDNsyn")=false
If CDNrecordcount<100 then
CDNret="  CDN操作返回:"&CDNOP(URL,FreeHostsharekey,CDNcon,cachemgr,mime,squid,squid_radius_auth,hosts,op)
dsCDNserver("lastSYNtime")=now
dsCDNserver.update
Else
If CDNSYNnow=true Then CDNret="  CDN2操作返回:"&CDNOP2(URL,FreeHostsharekey,dsCDNserver("id"),Application("ctldomain"),op,dsCDNserver("syntime"))
End if
Else
session("waitCDNsyn")=true
End if
If showcdnret=True then response.write squid

If showcdnret=True then response.write CDNret

dsCDNserver.movenext
Wend

end Sub

Function ResetPHP(URL,FreeHostsharekey,username,verset)
  Dim returnstr,body
body=URLEncoding("username="&username&"&verset="&verset)
Set xml = Server.CreateObject("MSXML2.ServerXMLHTTP")
xml.setTimeouts FreeHost_t1, FreeHost_t2, FreeHost_t3, FreeHost_t4
xml.Open "POST", Url&"/FreeHost.dll?ResetPHP", False
xml.setRequestHeader "Content-Length",Len(body)
xml.setRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
xml.setRequestHeader "FreeHost",FreeHostsharekey
xml.send body
returnstr = bytes2BSTR(xml.responsebody)
Set xml = Nothing
  ResetPHP = returnstr
End Function
%>
