<%
'系统序列号
Sub GetSystemCdkey()
dim RscsObj,GoRefresh
set RscsObj=conn.execute("select SK_CDKey from SK_SystemConfig")
If RscsObj("SK_CDKey")="3C3MY-C9G9C-ES19G-G31M9-EGWE5" then
Else
Response.Write"对不起，软件序列号错误，请与思康技术有限公司联系授权!!!"
Response.end
End if
RscsObj.close
Set RscsObj=nothing
end Sub
Call GetSystemCdkey()

'系统配置参数
Function GetConfig(FiledName)
Dim RSconfig
Set RSconfig=Server.CreateObject("ADODB.RECORDSET")
RSconfig.Open "Select " & FiledName & " From SK_SystemConfig",conn,1,1
 If Not RSconfig.Eof Then
  GetConfig=RSconfig(0)
 Else
  GetConfig=""
 End If
 RSconfig.Close
 Set RSconfig=Nothing
End Function

'取得下拉选项参数
Function GetSel(FiledName)
Dim RSSel
Set RSSel=Server.CreateObject("ADODB.RECORDSET")
RSSel.Open "Select " & FiledName & " From SK_Option",conn,1,1
 If Not RSSel.Eof Then
  GetSel=RSSel(0)
 Else
  GetSel=""
 End If
 RSSel.Close
 Set RSSel=Nothing
End Function

'将下拉选项数组变为下拉值
Function AutoOption(Arr,Sel)
 Dim AI
 for AI=0 to ubound(arr)
   If Sel=arr(AI) then
  AutoOption= AutoOption & "<option value="""& Arr(AI) & """ selected>" & Arr(AI)& "</option>"
   else
  AutoOption= AutoOption & "<option value="""& Arr(AI) & """>" & Arr(AI)& "</option>"
   end if
  next
End Function

'过滤表单项
Function F(Str)
 F=Trim(Replace(Replace(Request(Str),"'",""),"""",""))
End Function

'过滤表单重复字符项
Function RF(Str)
 RF=Replace(Request.Form("Str"),", ",",")
End Function

'获取前一页面URL过来的值
Function RQ(Str)
 RQ=Request.QueryString(Str)
End Function

Function DF(Str)
 DF=Trim(Replace(Replace(Request(Str),"'",""),"""",""))
End Function

'关闭数据源过程
Sub CloseDB()
on error resume next
       if rs.state=1 then RS.Close
       Set RS=Nothing
       if conn.state=1 then Conn.Close
       Set Conn=Nothing
End Sub

'分页函数
Function ToLong(str,defautValue)
	if IsNumeric(str) then
		ToLong = Clng(str)
	else
		ToLong = defautValue
	end if
End Function

'过滤SQL非法字符并格式化html代码
Function checkstr(fString)
        if isnull(fString) then
        checkstr=""
        exit function
        else
        fString=trim(fString)
        fString=replace(fString,"'","''")
        fString=replace(fString,";","；")
        fString=replace(fString,"--","—")
        fString=server.htmlencode(fString)
        checkstr=fString
        end if     
End Function

'判断提交信息是否来自外部
Public Function ChkIsOuter()
 server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
 server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
  If Mid(server_v1,8,len(server_v2))<>server_v2 Then 
	response.Write("<script language=javascript>alert('对不起,请不要从外部提交数据!');window.close();</script>")
        response.end
  end if
End Function

'检测传递的参数是否为数字型
Function JCID(ByVal ParaValue) 
    If ((Not isNumeric(ParaValue)) or (Trim(ParaValue)="")) Then 
            JCID=0 
    Else 
           JCID=ParaValue 
    End If 
End function

'检测传递的参数是否为日期型
Function Chkrequestdate(Para)
Chkrequestdate=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsDate(Para)) Then
   Chkrequestdate=True
End If
End Function

'得到当前页面的地址 
Function Get_Url() 
'on error resume next 
Dim strTemp 
If LCase(Request.ServerVariables("HTTPS")) = "off" Then 
strTemp = "http://" 
Else 
strTemp = "https://" 
End If 
strTemp = strTemp & CheckStr(Request.ServerVariables("SERVER_NAME")) 
If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & CheckStr(Request.ServerVariables("SERVER_PORT")) 
strTemp = strTemp & CheckStr(Request.ServerVariables("URL")) 
If Trim(Request.QueryString) <> "" Then strTemp = strTemp & "?" & CheckStr(Trim(Request.QueryString)) 
Get_Url = strTemp 
End Function

'检查用户是否在浏览器里输入了本页的地址
Function CheckReferer()
    Dim sReferer, Icheck
    CheckReferer = True
    sReferer = Request.ServerVariables("HTTP_REFERER")
    ServerIP = Request.ServerVariables("LOCAL_ADDR")
    Icheck = InStr(sReferer, "ServerIP")
    If Icheck = 0 Then
    CheckReferer = False
    End If
End Function

'检测提交的文本框是否有非法字符
Function NoCSSHackInput(Str) '过滤跨站脚本和HTML标签
	Dim regEx
	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Pattern = "<|>|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|url|eval|\t"
	If regEx.Test(LCase(Str)) Then
		Response.Write "<script>alert('你的输入含有非法字符(<,>,tab,script等)，请检查后再提交！');history.back();</script>"
		Response.End
	End If
	Set regEx = Nothing
	NoCSSHackInput = Str
End Function

'检测提交的多行文本是否有非法字符
Function NoCSSHackContent(Str) '过滤跨站脚本，只过滤脚本，对HTML不过滤
	Dim regEx
	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Pattern = "iframe|object|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|(url\()|eval"
	If regEx.Test(LCase(Str)) Then
		Response.Write "<script>alert('你提交的内容含有非法字符(不能包含脚本)，请检查后再提交！');history.back();</script>"
		Response.End
	End If
	Set regEx = Nothing
	NoCSSHackContent = Str
End Function

'检测网址IP全称
Function CheckAllowDomain()
 CheckAllowDomain=true:exit function
	Dim CurrentDomain,I,AllowDomainArr, CurrSiteSN
	   CurrentDomain = Replace(Request.ServerVariables("SERVER_NAME"), "www.", "") '取得当前域名
	   If (SiteSN = "" Or SiteSN = "0") And (CurrentDomain = "localhost" Or CurrentDomain = "127.0.0.1") Then
		 CheckAllowDomain = True
		 Exit Function
	   ElseIf (LCase(CurrentDomain) = "localhost" Or CurrentDomain = "127.0.0.1") Then
		  CheckAllowDomain = True
		  Exit Function
	   End If
	   CurrSiteSN = GetSiteSys(CurrentDomain)
	  If InStr(1, Trim(SiteSN), Trim(CurrSiteSN), 1) <> 0 Then
		CheckAllowDomain = True
	  Else
		CheckAllowDomain = False
	End If
End Function

'Email检测
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 then
   IsValidEmail = false
   exit function
end if
if InStr(email, "..") > 0 then
   IsValidEmail = false
end if
end function

'转成百分比
Function Fnum(Str)
 Fnum=FormatPercent(Str,0,-1)
End Function

'转成两位的小数
Function Fnum1(Str)
 Fnum1=FormatNumber(Str,2,-1) '2表示保留两位
End Function

'检测是否从word里面复制过来的文档并格式化
Function FormatDoc(byval theDoc)
    If IsNull(theDoc) Then theDoc = ""
    theDoc = Replace(theDoc,"<","&lt;")
    theDoc = Replace(theDoc,">","&gt;")
    theDoc = Replace(theDoc, vbCrLf, "<br>")
    theDoc = Replace(theDoc," ","&nbsp;")
    FormatDoc=theDoc
End Function

'检查空间是否支持邮件发送功能
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function

'群发邮件参数
function sentemail(email) 
'修改收信人电子邮件地址，表单里的内容将发送到这个信箱中
toemail=email
'修改收信人姓名
Dim jMail
set jmail=server.CreateObject ("jmail.message")
jmail.Silent = true
jmail.Charset = "gb2312"
jmail.Encoding= "base64 "
JMail.ContentType = "text/html" '没有附件时显示页面内容
jmail.From = smtpemail '发送的邮箱
jmail.FromName = myname '发件人姓名
jmail.ReplyTo = Replyemail '回复的邮箱
jmail.Subject = title '发送的主题
jmail.Body = content '邮件内容
JMail.appendText "--------------------------------------<BR>"&Sign&"<BR>------------------------------------"  '个性化签名
jmail.AddRecipient toemail
jmail.Priority = 5 '邮件发送等级
jmail.ReturnReceipt = True '是否需要回执
jmail.MailServerUserName = smtpuser 'SMTP服务器用户名
jmail.MailServerPassWord = smtppwd 'SMTP服务器密码
isgo = jmail.Send(smtpserver)  'SMTP服务器

set rs3=server.createobject("adodb.recordset")
sql3="select * from SK_OfficeMail"
rs3.open sql3,conn,3,3
rs3.AddNew

rs3("SK_ReCC")=F("S_ReCC")
rs3("SK_BCC")=F("S_ReBCC")
rs3("SK_From")=Replyemail
rs3("SK_FromName")= F("S_MyName")
rs3("SK_Type")=0
rs3("SK_Subject")=F("S_Title")
rs3("SK_Body")=F("S_Content")
rs3("SK_Date")=Now()
rs3("SK_Time")=Now()
rs3("SK_SalesID")=Session("UID")
rs3("SK_Read")="0"
rs3("SK_Feet")="0"
rs3("SK_Class")="0"
rs3("SK_Del")="0"

if isgo then
msg="发送成功!"
rs3("SK_Success")=0
else
msg = "邮件发送失败,以下为出错原因！\r\n\r\n\一、收件人邮箱错误\r\n\r\n\二、SMTP相关配置有问题，或者该SMTP服务器不支持\r\n\r\n\三、可能是短时间发送太多邮件，SMTP临时关闭了。"
rs3("SK_Success")=1
end if
rs3.Update
rs3.close
set rs3=nothing
jmail.Close
set jmail=nothing
end function

'**************************************************
'函数名：ReplaceBadChar
'作  用：过滤非法的SQL字符
'参  数：strChar-----要过滤的字符
'返回值：过滤后的字符
'**************************************************
function ReplaceBadChar(strChar)
if strChar="" then
   ReplaceBadChar=""
else
   ReplaceBadChar=replace(replace(replace(replace(replace(replace(replace(strChar,"'",""),"*",""),"?",""),"(",""),")",""),"<",""),".","")
end if
end function
%>