📄 cls_public.asp
字号:
<%
Class Cls_Public
Public TW_Config,TW_Header,TW_Footer,TW_OutPut,RequestLang,Reloadtime,CacheData,QueryTotal,SkinPath
Private Rs,SQL,LockIp,LocalCacheName,Cache_Data,i
'初始化类
Private Sub Class_Initialize()
Set Rs=Server.CreateObject(ServerObject_002)
Reloadtime=14000
End Sub
'注销类
Private Sub Class_Terminate()
Set Rs = Nothing
End Sub
'输出处理后的页面
Public Sub OutPutPage(Page)
SysConfig()
LoadTempCache()
LoadTemplate(Page)
Response.Write TW_OutPut
End Sub
'系统缓存处理过程
Public Property Let Name(ByVal vNewValue)
LocalCacheName=LCase(vNewValue)
End Property
Public Property Let Value(ByVal vNewValue)
If LocalCacheName<>"" Then
ReDim Cache_Data(2)
Cache_Data(0)=vNewValue
Cache_Data(1)=Now()
Application.Lock
Application(CacheName & "_" & LocalCacheName) = Cache_Data
Application.unLock
Else
Err.Raise vbObjectError + 1, "CacheServer", " please change the CacheName."
End If
End Property
Public Property Get Value()
If LocalCacheName<>"" Then
Cache_Data=Application(CacheName & "_" & LocalCacheName)
If IsArray(Cache_Data) Then
Value=Cache_Data(0)
Else
Err.Raise vbObjectError + 1, "CacheServer", " The Cache_Data("&LocalCacheName&") Is Empty."
End If
Else
Err.Raise vbObjectError + 1, "CacheServer", " please change the CacheName."
End If
End Property
Public Function ObjIsEmpty()
ObjIsEmpty=True
Cache_Data=Application(CacheName & "_" & LocalCacheName)
If Not IsArray(Cache_Data) Then Exit Function
If Not IsDate(Cache_Data(1)) Then Exit Function
If DateDiff("s",CDate(Cache_Data(1)),Now()) < (60*Reloadtime) Then ObjIsEmpty=False
End Function
Public Sub DelCahe(MyCaheName)
Application.Lock
Application.Contents.Remove(CacheName&"_"&MyCaheName)
Application.unLock
End Sub
'加载系统配置
Public Sub SysConfig()
Name="SysConfig"
If ObjIsEmpty() Then LoadConfig()
CacheData=Value
Name="Date"
If ObjIsEmpty() Then
Value=Date()
End If
Name="Date"
If Cstr(Value) <> Cstr(Date()) Then
Name="SysConfig"
Value=Date()
LoadConfig()
CacheData=Value
End If
TW_Config=CacheData(0,0)
LockIp=CacheData(1,0)
TW_Config=Split(TW_Config,"|||")
SkinPath=SysPath&"Templates/"&TW_Config(10)&"/"
End Sub
'加载模板，替换标签
Public Sub LoadTemplate(Page)
If TW_Config(11)=0 Then
SysMsg=TW_Config(12)
Call ShowMsg("","")
Call CloaseAll()
End If
If TW_Config(13)=1 Then Call IsLockIp()
ClsTemp.SetTemplatesDir(SkinPath)
ClsTemp.SetTemplateFile Page
Select Case Page
Case "index.html"
Call ClsTag.GetIndex()
Case "link.html"
Call ClsTag.GetLink()
Case "get.html"
Call ClsTag.GetGet()
Case "myfiles.html"
Call ClsTag.GetMyFiles()
Case "help.html"
Call ClsTag.GetHelp()
End Select
End Sub
'取得系统配置数据
Private Sub LoadConfig()
Dim SQL
SQL = "Select SysConfig,LockIps From [TW_Config]"
Value = DB_Query(SQL)
End Sub
Public Sub LoadTempCache()
Name="Header"
If ObjIsEmpty() Then ReloadHeader()
TW_Header=Value
Name="Footer"
If ObjIsEmpty() Then ReloadFooter()
TW_Footer=Value
End Sub
Public Sub ReloadHeader()
ClsTemp.SetTemplatesDir(SkinPath)
ClsTemp.SetTemplateFile "header.html"
Value=ClsTemp.GetOutput
End Sub
Public Sub ReloadFooter()
ClsTemp.SetTemplatesDir(SkinPath)
ClsTemp.SetTemplateFile "footer.html"
Value=ClsTemp.GetOutput
End Sub
'执行SQL Execute
Public Function DB_Execute(SQL)
On Error Resume Next
Err.Clear
Conn.Execute(SQL)
ExecuteTotal=ExecuteTotal+1
If Err Then
If IsDeBug=1 Then
SysMsg=Language("Public",0)&"<br>"
SysMsg=SysMsg&" <font color=800000>"&SQL&"</font><br>"
SysMsg=SysMsg&Language("Public",1)&"<br>"
SysMsg=SysMsg&" <font color=800000>"&Err.Description&"</font>"
Else
SysMsg=Language("Public",2)
End If
Call ShowMsg("Back","")
Else
DB_Execute=0
End If
End Function
'执行SQL Query
Public Function DB_Query(SQL)
On Error Resume Next
Err.Clear
Set Rs=Conn.Execute(SQL)
If Not Rs.EOF And Not Rs.BOF Then
DB_Query=Rs.GetRows()
Else
DB_Query=0
End If
Rs.Close
QueryTotal=QueryTotal+1
If Err Then
If IsDeBug=1 Then
SysMsg=Language("Public",0)&"<br>"
SysMsg=SysMsg&" <font color=800000>"&SQL&"</font><br>"
SysMsg=SysMsg&Language("Public",1)&"<br>"
SysMsg=SysMsg&" <font color=800000>"&Err.Description&"</font>"
Else
SysMsg=Language("Public",2)
End If
Call ShowMsg("Back","")
End If
End Function
Public Sub Chk_Id(IdValue,ShowType,Para1,Para2)
If IdValue=0 Or IdValue="" Then
SysMsg=Language("Public",14)
If ShowType=0 Then
Call Alert(Para1,Para2)
Else
Call ShowMsg(Para1,Para2)
End If
End If
End Sub
Public Sub Chk_Array(ArrayValue,ShowType,ShowStr,Para1,Para2)
If Not IsArray(ArrayValue) Then
If ShowType=0 Then
SysMsg=ShowStr
Call Alert(Para1,Para2)
Else
SysMsg=ShowStr
Call ShowMsg(Para1,Para2)
End If
End If
End Sub
'检查锁定的IP
Private Sub IsLockIp()
Dim IPlock
Dim i,UserTrueIP,StrKillIP
IPlock = False
UserTrueIP=Get_UserIp()
StrUserIP=Split(UserTrueIP,".")
locklist=Split(LockIp,"|")
If Ubound(StrUserIP)<>3 Then Exit Sub
For i= 0 to UBound(locklist)
locklist(i)=Trim(locklist(i))
If locklist(i)<>"" Then
StrKillIP = Split(locklist(i),".")
If Ubound(StrKillIP)<>3 Then Exit For
IPlock = True
If (StrUserIP(0) <> StrKillIP(0)) And Instr(StrKillIP(0),"*")=0 Then IPlock=False
If (StrUserIP(1) <> StrKillIP(1)) And Instr(StrKillIP(1),"*")=0 Then IPlock=False
If (StrUserIP(2) <> StrKillIP(2)) And Instr(StrKillIP(2),"*")=0 Then IPlock=False
If (StrUserIP(3) <> StrKillIP(3)) And Instr(StrKillIP(3),"*")=0 Then IPlock=False
If IPlock Then Exit For
End If
Next
If IPlock Then
SysMsg=Language("Public",10)
Call ShowMsg("","")
End If
End Sub
'检查Email是否合法
Public 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
Property Get Get_ScriptNameUrl()
If request.servervariables("SERVER_PORT")="80" Then
Get_ScriptNameUrl="http://" & request.servervariables("server_name")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
Else
Get_ScriptNameUrl="http://" & request.servervariables("server_name")&":"&request.servervariables("SERVER_PORT")&replace(lcase(request.servervariables("script_name")),ScriptName,"")
End If
End Property
'显示验证码
Public Function GetCode()
GetCode="<img src='"&SysPath&"Include/GetCode.asp' alt= "&Language("Public",5)&" style=""cursor : pointer;height : 20px;"" onclick=""this.src='"&SysPath&"Include/GetCode.asp'""/> "
End Function
'检查验证码是否正确
Public Function CodeIsTrue()
Dim CodeStr
CodeStr=Lcase(Trim(Request("CodeStr")))
If CStr(Session("GetCode"))=CStr(CodeStr) And CodeStr<>"" Then
CodeIsTrue=True
Session("GetCode")=empty
Else
CodeIsTrue=False
SysMsg=Language("Public",9)
Call Alert("Back",0)
Session("GetCode")=empty
End If
End Function
'系统提示页
Function ShowMsg(Jump,Sec)
Response.Clear
Dim Temp,Str
If Jump="Back" Then Jump="javascript:history.go(-1)"
If Sec="" Then
Str=""
Else
Str=Language("Public",4)
End If
Temp="<html><head>"&Chr(10)
Temp=Temp&"<meta http-equiv=""Refresh"" content="""&Sec&";URL="&Jump&""">"&Chr(10)
Temp=Temp&"<META HTTP-EQUIV=""Pragma"" CONTENT=""no-cache"">"&Chr(10)
Temp=Temp&"<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">"&Chr(10)
Temp=Temp&"<style><!--body {font-size: 12px; color: #333333; font-family: 宋体; background-color: #B5BCC7; scrollbar-highlight-color: #98A0AD; scrollbar-arrow-color: #FFFFFF; scrollbar-base-color: #7D899D; margin: 0;}--></style></head><body>"&Chr(10)
Temp=Temp&"<table cellspacing='1' cellpadding='2' width='500' align='center' Style='border: 1px #335EA8 solid ; background-color: #C9C9C3; font: 12px; width: 98%'><tr><th align='center' nowrap style='background-color: #335EA8; color: white; font-size: 12px; font-weight:bold; height: 26;'><b>"&Language("Public",3)&"</b></th></tr><tr><td style='background-color: #EEEEE6; height: 25; padding-right: 5px; padding-left: 5px; text-align:center;'><br><br><font color='#ff0000'><li>"&SysMsg&"</font><br><br><a href='"&Jump&"'>"&Sec&" "&Str&"</a><br><br><a href='#' onClick='history.go(-1);'>"&Language("Public",7)&"</a> </td></tr></table>"&Chr(10)
Temp=Temp&"</body><html>"
Response.Write Temp
Response.End
End Function
'输出编辑器
Public Sub OutPutEditor(sValue)
Dim sOutStr
sOutStr="<input type=hidden name=d_originalfilename>"&VBCrlf
sOutStr=sOutStr&"<input type=hidden name=d_savefilename>"&VBCrlf
sOutStr=sOutStr&"<input type=hidden name=d_savepathfilename onchange=""doChange(this,document.myform.d_picture)"">"&VBCrlf
sOutStr=sOutStr&"<textarea name=""content"" style=""display:none"">"&Server.HTMLEncode(sValue)&"</textarea>"&VBCrlf
sOutStr=sOutStr&"<iframe ID=""content1"" src="""&SysPath&"editor/ewebeditor/ewebeditor.asp?id=content&style=s_newssystem&originalfilename=d_originalfilename&savefilename=d_savefilename &savepathfilename=d_savepathfilename"" frameborder=""0"" scrolling=""no"" width=""750"" HEIGHT=""450""></iframe>"&VBCrlf
Response.write sOutStr
End Sub
'分页函数
Public Function PageList (iPageValue,iRetCount,iCurrentPage,FieldName,FieldValue)
Dim Url
Dim PageCount '页总数
Dim PageRoot '页列表头
Dim PageFoot '页列表尾
Dim OutStr
Dim i '输出字符串
Const StepNum=3 '页码步长
Url=URLStr(FieldName,FieldValue)
If iRetCount = 0 Then iRetCount = 1
If (iRetCount Mod iPageValue)=0 Then
PageCount= iRetCount \ iPageValue
Else
PageCount= (iRetCount \ iPageValue)+1
End If
If iCurrentPage-StepNum<=1 Then
PageRoot=1
Else
PageRoot=iCurrentPage-StepNum
End If
If iCurrentPage+StepNum>=PageCount Then
PageFoot=PageCount
Else
PageFoot=iCurrentPage+StepNum
End If
OutStr=iCurrentPage&"/"&PageCount&"页 "
If PageRoot=1 Then
If iCurrentPage=1 Then
OutStr=OutStr&"<font color=888888 face=webdings>9</font></a>"
OutStr=OutStr&"<font color=888888 face=webdings>7</font></a> "
Else
OutStr=OutStr&"<a href='?page=1"
OutStr=OutStr&Url
OutStr=OutStr&"' title=""首页""><font face=webdings>9</font></a>"
OutStr=OutStr&"<a href='?page="&iCurrentPage-1
OutStr=OutStr&Url
OutStr=OutStr&"' title=""上页""><font face=webdings>7</font></a> "
End If
Else
OutStr=OutStr&"<a href='?page=1"
OutStr=OutStr&Url
OutStr=OutStr&"' title=""首页""><font face=webdings>9</font></a>"
OutStr=OutStr&"<a href='?page="&iCurrentPage-1
OutStr=OutStr&Url
OutStr=OutStr&"' title=""上页""><font face=webdings>7</font></a>..."
End If
For i=PageRoot To PageFoot
If i=Cint(iCurrentPage) Then
OutStr=OutStr&"<font color='red'>["+Cstr(i)+"]</font> "
Else
OutStr=OutStr&"<a href='?page="&Cstr(i)
OutStr=OutStr&Url
OutStr=OutStr&"'>["+Cstr(i)+"]</a> "
End If
If i=PageCount Then Exit For
Next
If PageFoot=PageCount Then
If Cint(iCurrentPage)=Cint(PageCount) Then
OutStr=OutStr&"<font color=888888 face=webdings>8</font></a>"
OutStr=OutStr&"<font color=888888 face=webdings>:</font></a>"
Else
OutStr=OutStr&"<a href='?page="&iCurrentPage+1
OutStr=OutStr&Url
OutStr=OutStr&"' title=""下页""><font face=webdings>8</font></a>"
OutStr=OutStr&"<a href='?page="&PageCount
OutStr=OutStr&Url
OutStr=OutStr&"' title=""尾页""><font face=webdings>:</font></a>"
End If
Else
OutStr=OutStr&"... <a href='?page="&iCurrentPage+1
OutStr=OutStr&Url
OutStr=OutStr&"' title=""下页""><font face=webdings>8</font></a>"
OutStr=OutStr&"<a href='?page="&PageCount
OutStr=OutStr&Url
OutStr=OutStr&"' title=""尾页""><font face=webdings>:</font></a>"
End If
OutStr="共有 "&iRetCount&" 个记录 "&OutStr&" <INPUT TYPE=text class=iptA size=3 value="&iCurrentPage&" onmouseover='this.focus();this.select()' NAME=PGNumber> <INPUT TYPE=button id=button1 name=button1 class=btnA value=GO onclick="&""""&"if(document.all.PGNumber.value>0 && document.all.PGNumber.value<="&PageCount&"){window.location='?Page='+document.all.PGNumber.value+'"&Url&"'}"&""""&" onmouseover='this.focus()' onfocus='this.blur()'> "
PageList=OutStr
End Function
Private Function URLStr(FieldName,FieldValue)
If IsArray(FileName) Then
Dim i
For i=0 to Ubound(FieldName)
URLStr=URLStr&"&"&CStr(FieldName(i))&"="&CStr(FieldValue(i))
Next
Else
URLStr=""
End If
End Function
'********************
'检测是否外部提交数据过程
'********************
Public Sub Chk_Post()
Dim Server_V1,Server_V2
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
SysMsg=Language("Public",8)
Call ShowMsg("Back","")
End If
End Sub
Public Function CreateId(cType,LengthNum)
Dim Ran,i,TempValue
For i=1 To LengthNum
Randomize
Ran = CInt(Rnd * 2)
Randomize
If Ran = 0 Then
Ran = CInt(Rnd * 25) + 97
TempValue =TempValue& UCase(Chr(Ran))
ElseIf Ran = 1 Then
Ran = CInt(Rnd * 9)
TempValue = TempValue & Ran
ElseIf Ran = 2 Then
Ran = CInt(Rnd * 25) + 97
TempValue=TempValue& Chr(Ran)
End If
Next
Select Case cType
Case 0
CreateId=FormatMyDate(Now(),"[y][m][d][h][mi][s]")&TempValue
Case 1
CreateId=FormatMyDate(Now(),"[Y][M][D][H][MI][S]")&TempValue
Case 2
CreateId=FormatIp(Get_UserIp)&TempValue
End Select
End Function
'IP/来源
Public Function IpAddress(sip)
Dim aConnStr,aConn,adb
Dim str1,str2,str3,str4
Dim num
Dim country,city
Dim irs,SQL
IpAddress="未知"
If IsNumeric(Left(sip,2)) Then
If sip="127.0.0.1" Then sip="192.168.0.1"
str1=Left(sip,InStr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str2=Left(sip,instr(sip,".")-1)
sip=Mid(sip,InStr(sip,".")+1)
str3=Left(sip,instr(sip,".")-1)
str4=Mid(sip,instr(sip,".")+1)
If isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 Then
Else
num=CLng(str1)*16777216+CLng(str2)*65536+CLng(str3)*256+CLng(str4)-1
adb = Sysroot&"DataBase/ipaddress.mdb"
aConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(adb)
Set AConn = Server.CreateObject("ADODB.Connection")
aConn.Open aConnStr
country="亚洲"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -