📄 cls_public.asp
字号:
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 style=""border: 1px solid #BABABA; padding-left: 4; padding-right: 4; padding-top: 1; padding-bottom: 1; background-color: #F5F5F5"" 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(FieldName) Then
Dim i,TempUrlStr
For i=0 to Ubound(FieldName)
TempURLStr=TempURLStr&"&"&CStr(FieldName(i))&"="&CStr(FieldValue(i))
Next
Else
TempURLStr=""
End If
URLStr=TempUrlStr
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="亚洲"
city=""
sql="select top 1 country,city from dv_address where ip1 <="& num &" and ip2 >="& num
Set irs=aConn.execute(sql)
If Not(irs.EOF And irs.bof) Then
country=irs(0)
city=irs(1)
End If
Set irs=Nothing
Set aConn = Nothing
End If
IpAddress=country&city
End If
End Function
'*********************************
'根据指定名称生成目录
'*********************************
Public Function MakeDir(FolderName)
FolderPath=Server.MapPath(FolderName)
Dim Fso1
Dim F
Set Fso1 = CreateObject(ServerObject_005)
Set F = Fso1.CreateFolder(FolderPath)
If Err.Number = 0 Then
MakeDir=FolderPath
Else
Err.Clear
MakeDir=False
End If
Set Fso1 = Nothing
End Function
'**************************************************
'函数名：tsoleft----------------dongtso
'作 用：截字符串，汉字一个算两个字符，英文算一个字符
'参 数：str ----原字符串
' strlen ----截取长度
'返回值：截取后的字符串
'**************************************************
Public function tsoleft(str,strlen)
if str="" then
tsoleft=""
exit function
end if
dim l,t,c, i
str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")
l=len(str)
t=0
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
if t>=strlen then
tsoleft=left(str,i) & "..."
exit for
else
tsoleft=str
end if
next
tsoleft=replace(replace(replace(replace(tsoleft," "," "),chr(34),"""),">",">"),"<","<")
end function
'***********************************
'检查某一目录是否存在
'***********************************
Public Function CheckDir(Byref FolderPath)
Dim fso1
dim folderpath1
folderpath1=Server.MapPath(FolderPath)
Set fso1 = CreateObject(ServerObject_005)
If fso1.FolderExists(folderpath1) Then
CheckDir=True
Else
CheckDir=False
End If
Set fso1 = Nothing
End Function
'***********************************
'删除文件
'***********************************
Public Function DeleteFile(Byref oPath)
Dim oFSO,FilePath,IsDeleted
FilePath=Server.MapPath(oPath)
IsDeleted=False
Set oFSO= CreateObject(ServerObject_005)
If oFSO.FileExists(FilePath) Then
oFSO.DeleteFile(FilePath)
IsDeleted=True
End If
Set oFSO = Nothing
DeleteFile=IsDeleted
End Function
'删除指定文件夹下的所有文件
Function DeleteUpDateFile(FilePath)
'on error Resume Next
If Right(FilePath, 1) <> "/" Then FilePath = FilePath & "/"
DeleteUpDateFile = False
Dim Fso, F, F1, Fc, S
Set Fso = CreateObject(ServerObject_005)
If Err Then Err.Clear : Exit Function
Set F = Fso.GetFolder(Server.MapPath(FilePath))
Set Fc = F.Files
For Each F1 In Fc
Fso.DeleteFile(Server.MapPath(FilePath & F1.Name))
Next
Set Fc = Nothing
Set Fso = Nothing
DeleteUpDateFile = True
End Function
'************************************
'截取文字长度函数
'输入参数：
' 1、文字内容
' 2、文字最大长度
'************************************
Public Function Cut_Title(Title,TLen)
Dim k,i,d,c
Dim iStr
k=0
d=StrLen(Title)
iStr=""
For i=1 To Len(Title)
c=Abs(Asc(Mid(Title,i,1)))
If c>255 Then
k=k+2
Else
k=k+1
End If
iStr=iStr&Mid(Title,i,1)
If CLng(k)>CLng(TLen) Then
iStr=iStr&".."
Exit For
End If
Next
Cut_Title=iStr
End Function
'*******************************
'检测文字长度函数
'输入参数：
' 1、文字内容
'*******************************
Public Function StrLen(strText)
Dim k,i,c
k=0
For i=1 To Len(strText)
c=Abs(Asc(Mid(strText,i,1)))
If c>255 Then
k=k+2
Else
k=k+1
End If
Next
StrLen=k
End Function
'*****************************************
'简单HTML代码过滤函数
'输入参数：
' 1、待过滤字符串
'*****************************************
Public Function Base_HTMLFilter(sInputStr)
If Len(sInputStr)>0 Then
sInputStr=Replace(sInputStr,Chr(13)&Chr(10),vbcrlf)
End If
Base_HTMLFilter=sInputStr
End Function
'*****************************************
'全HTML代码过滤函数
'输入参数：
' 1、待过滤字符串
'*****************************************
Public Function Full_HTMLFilter(sInputStr)
If Len(sInputStr)>0 Then
sInputStr=Replace(sInputStr, ">", ">")
sInputStr=Replace(sInputStr, "<", "<")
sInputStr=Replace(sInputStr, """", """)
sInputStr=Replace(sInputStr, CHR(32), " ")
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -