func.asp

功能最强大的ASP网站

<!--#include file="func2.asp"-->
<%
'3721网络名实产品的ＩＤ号, 根据不同的系统配置该ＩＤ号
session("PID_3721")="P1060"
session("PID_CUR")="P1028"


'on error resume next
if session("CERT") = "" then
set rs=server.createobject("adodb.recordset")
sql="select * from config "
rs.open sql,conn,1,1

do while not rs.eof
	session(rs("name"))=rs("config")
rs.movenext
loop
rs.close
set rs=nothing
end if


on error resume next
err.clear
set lqhm = server.CreateObject("lqhm.host")
if err then
	 Session("mesg") = "引用lqhm组件出错,请确认组件已正确安装,描述=["&err.description&"]"
        Response.Redirect "../result.asp"
        Response.End
end if
On Error GoTo 0


'#####################################################################################

'通用发信函数
Function SendSysMail(MailName,username,orderid,email)
	set rsb = conn.execute ("select * from mailcfg where CfgName='" & MailName & "' ")
	Body = rsb("CfgBody")
	rsb.close
	
	set rsset = conn.execute ("select * from mailcfg ")
	do while not rsset.eof
		CfgName = rsset("CfgName")
		CfgBody = rsset("CfgBody")
		Body = replace(Body,"[" & CfgName & "]",CfgBody)
		rsset.movenext
	loop
	
	if orderid <> "" then
		set rsFld = conn.execute ("select * from [userorder] where ID='" & orderid & "' ")
		if not rsFld.eof then
			For Each fld In rsFld.Fields
				if not isnull(rsFld(fld.Name)) then
					Body = replace(Body,"[TableUserOrder-" & fld.Name & "]",rsFld(fld.Name))
					if email = "" and  lcase(fld.Name)="email" then email= rsFld(fld.Name)
				end if
			next
		end if
	end if
	
	if username <> "" then
		set rsFld = conn.execute ("select * from [user] where username='" & username & "' ")
		if not rsFld.eof then
			For Each fld In rsFld.Fields
				if not isnull(rsFld(fld.Name)) then
					Body = replace(Body,"[TableUser-" & fld.Name & "]",rsFld(fld.Name))
					if email = "" and  lcase(fld.Name)="email" then email= rsFld(fld.Name)
				end if
			next
		end if
		rsFld.close
	end if
	
	ManageUser = get_manageuser(username)
	if ManageUser <> "" and username <> ManageUser then
		set rsFld = conn.execute ("select * from [user] where username='" & ManageUser & "' ")
		if not rsFld.eof then
			For Each fld In rsFld.Fields
				if not isnull(rsFld(fld.Name)) then
					Body = replace(Body,"[TableUserM-" & fld.Name & "]",rsFld(fld.Name))
					if email = "" and  lcase(fld.Name)="email" then email= rsFld(fld.Name)
				end if
			next
		end if
		rsFld.close
	end if
	
	
	
'发送邮件
ret = SendEMail(email,Body)
SendSysMail = ret
End function

'格式化电话号码,如:+86.1081234567
Function FmtTel (tel_i)
dim regEx,Matches
set regEx=New RegExp
regEx.Pattern="^\+\w*\.*\w*$"
regEx.IgnoreCase = True
tel = replace(tel_i,"-","")
Set Matches = regEx.execute(tel)
if Matches.count then
FmtTel =tel	
else
FmtTel="+86." & tel
end if

'把区号前的0去掉.
FmtTel = replace(FmtTel,".0",".")

if not len(FmtTel)>15 then
FmtTel = mid(FmtTel,1,15)
End if
End FUnction

Function RequestA(pName)
	str = request(pName)
	if str <> "" then
	str = replace(str,"'","")
	str = replace(str," ","")
	str = replace(str,"&","")
	end if
	RequestA = str
End function


'检察英文字段,把汉字虑掉,再把为空的字段填上默认值
Function FmtEn(vstrIn)
	For i = 1 To Len(vstrIn)
        ThisChr = Mid(vstrIn, i, 1)
        If Abs(Asc(ThisChr)) < &HFF Then
            strReturn = strReturn & ThisChr
        End If
    Next
	if isnull(strReturn) or strReturn = "" then
		FmtEn = "is null"
	else
		FmtEn = strReturn
	end if
end FUnction


'检察英文字段,把汉字虑掉,再把为空的字段填上默认值,并去掉数字
Function FmtEnNoNum(vstrIn)
	For i = 1 To Len(vstrIn)
        ThisChr = Mid(vstrIn, i, 1)
        If (Abs(Asc(ThisChr)) < &HFF) and ( not IsNumeric(ThisChr)) Then
            strReturn = strReturn & ThisChr
        End If

    Next
	if isnull(strReturn) or strReturn = "" then
		FmtEnNoNum = "is null"
	else
		FmtEnNoNum = strReturn
	end if
end FUnction

Function FilterDbChar(str)
	FilterDbChar = str
if str = "" or isempty(str) then 
	FilterDbChar = ""
else
	FilterDbChar = replace(FilterDbChar,"'","")
	FilterDbChar = replace(FilterDbChar," ","")
	FilterDbChar = replace(FilterDbChar,"&","")
end if
end Function

'判型是否可以提交订单
Function IsOrderLimit(applyTime, applyType, Slt)
if session("OrderLimit") <> "1" then  exit function
Price = applytime*GetProductPrice(session("username"), applyType, Slt)
IsOrderLimit = IsHandle(session("username"), Price)
end Function

'是否支持实时开通(根据订单ID号)
Function IFHandleOnLine(ID)
	set rsproduct = conn.execute("select * from product where ID=(select applytype from userorder where ID='" & ID & "') ")

	if rsproduct.eof then
		IFHandleOnLine = "N"
	else 
		IsTryA= split(rsproduct("IsTry"),"|")
		IsTry = IsTryA(0)
		IFHandleOnLine = IsTry
	end if
	rsproduct.close
	set rsproduct = nothing
End Function

'是否支持实时开通(根据产品ID号)
Function IFHandleOnLineP(ID)
	set rsproduct = conn.execute("select * from product where ID='" & ID & "' ")

	if rsproduct.eof then
		IFHandleOnLineP = "N"
	else 
		IsTryA= split(rsproduct("IsTry"),"|")
		IsTry = IsTryA(0)
		IFHandleOnLineP = IsTry
	end if
	rsproduct.close
	set rsproduct = nothing
End Function

Function CheckMoney(id)
set rstt = conn.execute(" select * from userorder where ID='" & id & "' ")
	username = rstt("username")
	Price = rstt("price")
	PriceA = rstt("priceA")
	rstt.close
	set rstt = nothing
	
	ManageUser = get_manageuser(username)
	
	if IsHandle(username, Price) <> "" then
		CheckMoney = "错误:会员资金不足" 
		exit function
	end if
	
	'如果是特殊代理所辖客户,则判断代理用户是否有足够的金额
	if (IsAgent(ManageUser)="Y") and (username <> ManageUser) then
		if IsHandle(ManageUser, PriceA) <> "" then
		CheckMoney = "错误:管理会员资金不足" 
		exit function
	end if
	end if

end Function

'业务注册时实时受理并开通
Function HandleOnLine(id)
	if IFHandleOnLine(id) <> "Y" then
		HandleOnLine = "该产品不支持实时开通"
		exit function
	end if
	
	ret = CheckMoney(id)
	if ret <> "" then
		HandleOnLine = "错误:会员资金不足" 
		exit function
	end if
	
	
	HandleOnLine = LqsmOnLineCreate(id,ErrMsg)
	if HandleOnLine <> "0" then 
		HandleOnLine = "实时开通错误[" & HandleOnLine & "]:" & ErrMsg
		exit function
	end if
	
	'添加控制面板
	ret = AddPanal(id)
	
	HandleOnLine = TransHandle(id, "1")
	if  HandleOnLine <> ""  then 
		action=applyname & "订单已实时开通成功，但处理出错,订单编号["&id&"]"
		put_apply username,domainname,action
		HandleOnLine = "订单已实时开通成功，但业务处理出错"
		exit function
	end if

	ret = SendSysMail("SysMail-Handle",username,id,email)
	HandleOnLine = ""
end function

'删除控制面板
Function DelPanal(ID)
	conn.execute ("delete from PanalSet where orderID='" & ID & "' ")
end FUnction

'添加控制面板
Function AddPanal(ID)
	set rsop = conn.execute ("select a.*,b.IsTry from userorder a  left join product b on a.applytype = b.ID where a.ID='" & ID & "' ")
	username = rsop("username")
	ManageUser = rsop("ManageUser")
	ManagePass = rsop("ManagePass")
	IsDomain = rsop("IsDomain")
	Domainname = rsop("Domainname")
	
	IsTryA= split(rsop("IsTry"),"|")
	IsTry = IsTryA(0)
	if ubound(IsTryA) > 0 then
		strptype = IsTryA(1)
	else
		strptype = ""
	end if
	
	if ubound(IsTryA) > 1 then
		product = IsTryA(2)
	else
		product = ""
	end if
	
	if strptype = "" then exit function
	
	
	if ManagePass = "" or IsEmpty(ManagePass) or IsNull(ManagePass)  then ManagePass = GetRndPwd(10)

	set rspp = server.createobject("adodb.recordset")
	sql = "select * from panalset where OrderID='" & ID & "' "
	rspp.open sql,conn,1,3
	if not rspp.eof then	exit function
	rspp.addnew
	rspp("username")=username
	'rspp("ManageUser")=CreatePanalName(Domainname)
	'如果有同的控制面板存在,先删除
	rspp("ManageUser")=Domainname
	conn.execute ("delete  from panalset where ManageUser='" & Domainname & "'  and ptype like '"&mid(strptype,1,1)&"' ")
	rspp("ManagePass")=ManagePass
	rspp("OrderID")=ID
	'rspp("PType")=ptype
	'rspp("Product")="IIS,FTP,MAIL,MSSQL"
	rspp("Product")=product
	rspp("PType")=strptype
	rspp.update
	rspp.close
	set rspp = nothing
End Function

'自动生成控制面板用户名，如果域名已被使用，则在域名后面加下划线1,2,3等数字表示
Function CreatePanalName(Domainname)
	set rspt = conn.execute ("select * from panalset where ManageUser='" & Domainname & "' ")
	if rspt.eof then
		CreatePanalName = Domainname
		exit function
	end if

	for i=1 to 10
		set rspt = conn.execute ("select * from panalset where ManageUser='" &  Domainname & "_" & i & "' ")
		if rspt.eof then
			CreatePanalName = Domainname & "_" & i
			exit function
		else
			rspt.close
		end if
	next
ENd Function



'在线开通处理接口,如果不需要的,可以去掉,以提高速度
%>





<%
'公用功能函数结束,以下是业务逻辑模块
'###########################################################################################################
'获得产品名称,ID:产品ID号
Function get_name(ID)
	get_name = lqhm.get_name(ID)
End Function


'获得产品类别 ID:产品ID
Function get_class(ID)
	get_class = lqhm.get_class(ID)
End Function

'获得产品的计价单位
Function get_producttype(ID)
	get_producttype = lqhm.get_producttype(ID)
End Function

'获得得产品价格
Function GetProductPrice(UserName, PID, Slt)
	'GetProductPrice = lqhm.GetProductPrice(UserName, PID, Slt)
	if isnull(UserName) then UserName=""
	If UserName = "" or isnull(UserName) Then
        GetProductPrice = "0"
        Exit Function
    End If

    Set rsu = conn.Execute("select * from [user] where username='" & UserName & "'")
    ULevel = rsu("level")
    rsu.Close
    Set rspp = conn.Execute("select * from ProductPrice where PID='" & PID & "' and LevelCode='" & ULevel & "'")
    If rspp.EOF Then
        GetProductPrice = ""
    Else
        GetProductPrice = rspp(Slt)
    End If
    rspp.Close
End Function

'获得产品计价级别的时间
Function GetProductTime(PID, Slt)
GetProductTime = lqhm.GetProductTime(PID, Slt)