start.asp

来自「本程序系统完全实现了医院网站程序的全部功能的前台和后台程序」· ASP 代码 · 共 396 行 · 第 1/2 页

<%@language="vbscript" codepage="936" %>
<%
Option Explicit
'**************************************************************
' Software name: PowerEasy SiteWeaver
' Web: http://www.powereasy.net
' Copyright (C) 2005－2008 佛山市动易网络科技有限公司 版权所有
'**************************************************************

Response.Buffer = True
Dim BeginTime
BeginTime = Timer
%>
<!--#include file="Conn.asp"-->
<!--#include file="Config.asp"-->
<!--#include file="Include/PowerEasy.Common.All.asp"-->
<!--#include file="Include/PowerEasy.Common.Security.asp"-->
<%
Dim UserTrueIP
Dim ScriptName
Dim Site_Sn
Dim InstallDir, strInstallDir

'网站配置相关的变量
Dim SiteName, SiteTitle, SiteUrl, LogoUrl, BannerUrl, WebmasterName, WebmasterEmail, Copyright, Meta_Keywords, Meta_Description
Dim ShowSiteChannel, ShowAdminLogin, EnableSaveRemote, EnableLinkReg, EnableCountFriendSiteHits, EnableSoftKey, IsCustom_Content, objName_FSO, AdminDir, ADDir, AnnounceCookieTime, SiteHitsOfHot
Dim FileExt_SiteIndex, FileExt_SiteSpecial, SiteUrlType, LockIPType, LockIP, AllModules
Dim EnableUserReg, EmailCheckReg, AdminCheckReg, EnableMultiRegPerEmail, EnableCheckCodeOfLogin, EnableCheckCodeOfReg, EnableQAofReg, QAofReg
Dim UserNameLimit, UserNameMax, UserName_RegDisabled, RegFields_MustFill
Dim PresentExp, PresentMoney, PresentPoint, PresentValidNum, PresentValidUnit, MoneyExchangePoint, MoneyExchangeValidDay, UserExpExchangePoint, UserExpExchangeValidDay
Dim PointName, PointUnit, EmailOfRegCheck
Dim MailObject, MailServer, MailServerUserName, MailServerPassWord, MailDomain
Dim PhotoObject, Thumb_DefaultWidth, Thumb_DefaultHeight, Thumb_Arithmetic, PhotoQuality, Thumb_BackgroundColor, Watermark_Type, Watermark_Text, Watermark_Text_FontName, Watermark_Text_FontSize, Watermark_Text_FontColor, Watermark_Text_Bold
Dim Watermark_Images_FileName, Watermark_Images_Transparence, Watermark_Images_BackgroundColor, Watermark_Position_X, Watermark_Position_Y, Watermark_Position
Dim SearchInterval, SearchResultNum, MaxPerPage_SearchResult, SearchContent
Dim EnableGuestBuy, IncludeTax, TaxRate, Prefix_OrderFormNum, Prefix_PaymentNum
Dim MyCountry, MyProvince, MyCity, MyPostcode
Dim EmailOfOrderConfirm, EmailOfSendCard, EmailOfReceiptMoney, EmailOfRefund, EmailOfInvoice, EmailOfDeliver
Dim GuestBook_EnableVisitor, EnableGuestBookCheck, GuestBook_EnableManageRubbish, PresentExpPerLogin, GuestBook_ManageRubbish, GuestBook_ShowIP, GuestBook_IsAssignSort, GuestBook_MaxPerPage
Dim EnableRss, RssCodeType
Dim EnableWap, WapLogo, EnableWapPl, ShowWapShop, ShowWapAppendix, ShowWapManage
Dim EnableSMS, SMSUserName, SMSKey, SendMessageToAdminWhenOrder, SendMessageToMemberWhenPaySuccess, Mobiles, MessageOfOrder, MessageOfOrderConfirm, MessageOfSendCard, MessageOfReceiptMoney, MessageOfRefund, MessageOfInvoice, MessageOfDeliver
Dim MessageOfAddRemit, MessageOfAddIncome, MessageOfAddPayment, MessageOfExchangePoint, MessageOfAddPoint, MessageOfMinusPoint, MessageOfExchangeValid, MessageOfAddValid, MessageOfMinusValid
Dim ObjInstalled_FSO, fso, hf
Dim FileName_SiteIndex

'用户相关的变量
Dim UserLogined, UserID, UserName, GroupID, GroupName, GroupType, Discount_Member, IsOffer, LoginTimes, RegTime, JoinTime, LastLoginTime, LastLoginIP
Dim ClientID, CompanyID, ContacterID, UserType, email
Dim Balance, UserPoint, UserExp, ValidNum, ValidUnit, ValidDays, SpecialPermission, UserSetting, ChargeType, UserChargeType
Dim UnsignedItems, UnreadMsg, NeedlessCheck, EnableModifyDelete, MaxPerDay, PresentExpTimes, MaxSendNum, MaxFavorite, BlogFlag

'用户权限相关的几个变量
Dim arrClass_Browse, arrClass_View, arrClass_Input, arrClass_Check, arrClass_Manage

'分页时所用变量
Dim FileName, strFileName, MaxPerPage, CurrentPage, totalPut

'搜索用变量
Dim SearchType, strField, Keyword

Dim arrSubDomains
Dim Action, FoundErr, ErrMsg, ComeUrl
Dim arrCardUnit, arrUserType
Dim arrFileExt

Dim SkinID, TemplateID

'XML相关的变量
Dim XmlDoc, XMLDOM, Node


'正则表达式相关的变量
Dim regEx, Match, Match2, Matches, Matches2
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
regEx.MultiLine = True

ScriptName = Trim(Request.ServerVariables("SCRIPT_NAME"))
UserTrueIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If UserTrueIP = "" Then UserTrueIP = Request.ServerVariables("REMOTE_ADDR")
UserTrueIP = ReplaceBadChar(UserTrueIP)
If EnableStopInjection = True Then
    If Request.QueryString <> "" Then Call StopInjection(Request.QueryString)
    If Request.Cookies <> "" Then Call StopInjection(Request.Cookies)
    If LCase(Mid(ScriptName, InStrRev(ScriptName, "/") + 1)) <> "upfile.asp" Then
        Call StopInjection2(Request.Form)
    End If
End If
FoundErr = False
ErrMsg = ""


Call OpenConn
Call GetSiteConfig
Call InitVar
Call IsIPlock
FileName_SiteIndex = "Index" & arrFileExt(FileExt_SiteIndex)

Sub InitVar()
    If Request("page") <> "" Then
        CurrentPage = PE_CLng(Request("page"))
    Else
        CurrentPage = 1
    End If
    MaxPerPage = PE_CLng(Trim(Request("MaxPerPage")))
    If MaxPerPage <= 0 Then MaxPerPage = 20
    SearchType = PE_CLng(Trim(Request("SearchType")))
    strField = Trim(Request("Field"))
    Keyword = ReplaceBadChar(Trim(Request("keyword")))

    arrSubDomains = Split("|" & strSubDomains, "|")

    ObjInstalled_FSO = IsObjInstalled(objName_FSO)
    If ObjInstalled_FSO = True Then
        Set fso = Server.CreateObject(objName_FSO)
    Else
        Response.Write "<li>FSO组件不可用，各种与FSO相关的功能都将出错！请运行Install.asp或者到后台网站配置处设置好FSO组件名称。</li>"
    End If
        
    ComeUrl = FilterJs(Trim(Request("ComeUrl")))
    If ComeUrl = "" Then
        ComeUrl = FilterJs(Trim(Request.ServerVariables("HTTP_REFERER")))
    End If
    Action = Trim(Request("Action"))
    FoundErr = False
    ErrMsg = ""

    Site_Sn = Replace(Replace(LCase(Request.ServerVariables("SERVER_NAME") & InstallDir), "/", ""), ".", "")
    
    arrCardUnit = Array("点", "天", "月", "年", "元", "卡")
    arrUserType = Array("个人会员", "企业会员（创建者）", "企业会员（管理员）", "企业会员（普通成员）", "企业会员（待审核成员）")
    arrFileExt = Array(".html", ".htm", ".shtml", ".shtm", ".asp")

    Set XmlDoc = CreateObject("Microsoft.XMLDOM")
    XmlDoc.async = False

End Sub

Sub StopInjection(Values)
    Dim FoundInjection
    regEx.Pattern = "'|;|#|([\s\b+()]+(select|update|insert|delete|declare|@|exec|dbcc|alter|drop|create|backup|if|else|end|and|or|add|set|open|close|use|begin|retun|as|go|exists)[\s\b+]*)"
    Dim sItem, sValue
    For Each sItem In Values
        sValue = Values(sItem)
        If regEx.Test(sValue) Then
            FoundInjection = True
            Response.Write "很抱歉，由于您提交的内容中含有危险的SQL注入代码，致使本次操作无效！ "
            Response.Write "<br>字段名：" & sItem
            Response.Write "<br>字段值：" & sValue
            Response.Write "<br>关键字："
            Set Matches = regEx.Execute(sValue)
            For Each Match In Matches
                Response.Write FilterJS(Match.value)
            Next
            Response.Write "<br><br>如果您是正常提交仍出现上面的提示，请联系站长修改Config.asp文件的第7行，暂时禁用掉防SQL注入功能，操作完成后再打开。"
            
        End If
    Next
    If FoundInjection = True Then
        Response.End
    End If
End Sub

Sub StopInjection2(Values)
    Dim FoundInjection
    regEx.Pattern = "[';#()][\s+()]*(select|update|insert|delete|declare|@|exec|dbcc|alter|drop|create|backup|if|else|end|and|or|add|set|open|close|use|begin|retun|as|go|exists)[\s+]*"
    Dim sItem, sValue
    For Each sItem In Values
        sValue = Values(sItem)
        If regEx.Test(sValue) Then
            FoundInjection = True
            Response.Write "很抱歉，由于您提交的内容中含有危险的SQL注入代码，致使本次操作无效！ "
            Response.Write "<br>字段名：" & sItem
            Response.Write "<br>字段值：" & sValue
            Response.Write "<br>关键字："
            Set Matches = regEx.Execute(sValue)
            For Each Match In Matches
                Response.Write FilterJS(Match.value)
            Next
            Response.Write "<br><br>如果您是正常提交仍出现上面的提示，请联系站长修改Config.asp文件的第7行，暂时禁用掉防SQL注入功能，操作完成后再打开。"
            
        End If
    Next
    If FoundInjection = True Then
        Response.End
    End If
End Sub
    


Sub GetSiteConfig()
    On Error Resume Next
    Dim rsConfig
    Set rsConfig = Conn.Execute("select * from PE_Config")
    If rsConfig.BOF And rsConfig.EOF Then
        rsConfig.Close