=======================
' 检测上页是否从本站提交
' 返回:True,False
' =======================
Function IsSelfRefer()
Dim sHttp_Referer, sServer_Name
sHttp_Referer = CStr(Request.ServerVariables("HTTP_REFERER"))
sServer_Name = CStr(Request.ServerVariables("SERVER_NAME"))
If Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name Then
IsSelfRefer = True
Else
IsSelfRefer = False
End If
End Function
'*****************************
'创建文件目录
'*****************************
Dim Fs,NewPath,DelPath,FPath,DelFPath
Function FsFolder(TName)
NewPath=Server.MapPath(""&Tname&"")
Set Fs=Server.CreateObject("Scripting.FileSystemObject")
If Fs.FolderExists(NewPath)=True Then
Response.Write "<script language='JavaScript'>"&_
"alert('有此文件夹名请重新命名');"&_
"history.go(-1);"&_
"</script>"
Response.End
Else
Fs.CreateFolder(NewPath)
Set Fs=Nothing
End If
End Function
'*****************************
'删除文件目录
'*****************************
Function DelFolder(TName)
DelPath=Server.MapPath(""&TName&"")
Set Fs=Server.CreateObject("Scripting.FileSystemObject")
If Fs.FolderExists(DelPath)=True Then
Fs.DeleteFolder DelPath,True
End If
Set Fs=Nothing
End Function
'***************************************
'创建文件
'***************************************
Function CreateFile(FName,strFile)
Dim FPath,Os,Fs
FPath=Server.MapPath(""&FName&"")
Set Fs=Server.CreateObject("Scripting.FileSystemObject")
Set Os=Fs.CreateTextFile(FPath,True,False)
Os.Write strFile
Os.Close
Set Os=Nothing
Set Fs=Nothing
End Function
'***************************************
'删除文件
'***************************************
Function DelFile(Fname)
Set Fs=Server.CreateObject("Scripting.FileSystemObject")
Fname=Server.MapPath(Fname)
'Response.Write Fname
If Fs.FileExists(Fname)=False Then
Exit Function
Else
Fs.DeleteFile Fname,True
End If
Set Fs=Nothing
End Function
'*****************************
'读取文件
'*****************************
Function ReadFile(Fname)
Dim StrFile,Fs,Os
Set Fs=Server.CreateObject("Scripting.FileSystemObject")
Fname=Server.MapPath(Fname)
If Fs.FileExists(Fname)=False Then
ReadFile=""
Exit Function
Else
Set Os=Fs.OpenTextFile(Fname,1,False,False)
StrFile=Os.ReadAll
Os.Close
Set Os=Nothing
'Response.Write StrFile
ReadFile=StrFile
End If
Set Fs=Nothing
End Function
'***------分页开始------
Function URLStr(FieldName,FieldValue)
Dim i
If Not IsArray(FieldName) Then Exit Function
For i=0 to Ubound(FieldName)
URLStr=URLStr&"&"&Cstr(FieldName(i))&"="&Cstr(FieldValue(i))
Next
End Function
Function PageList (iPageValue,iRetCount,iCurrentPage,FieldName,FieldValue)
Dim Url
Dim PageCount '页总数
Dim PageRoot '页列表头
Dim PageFoot '页列表尾
Dim OutStr
Url=URLStr(FieldName,FieldValue)
If (iRetCount Mod iPageValue)=0 Then
PageCount= iRetCount \ iPageValue
Else
PageCount= (iRetCount \ iPageValue)+1
End If
If iCurrentPage-4<=1 Then
PageRoot=1
Else
PageRoot=iCurrentPage-4
End If
If iCurrentPage+4>=PageCount Then
PageFoot=PageCount
Else
PageFoot=iCurrentPage+4
End If
OutStr="分页："&iCurrentPage&"/"&PageCount&"页 共"&iRetCount&"条 "
If PageRoot=1 Then
If iCurrentPage=1 Then
OutStr=OutStr&"
9"
OutStr=OutStr&"
7 "
Else
OutStr=OutStr&"<a href='?page=1"
OutStr=OutStr&Url
OutStr=OutStr&"' title=""首页"">
9"
OutStr=OutStr&"<a href='?page="&iCurrentPage-1
OutStr=OutStr&Url
OutStr=OutStr&"' title=""上页"">
7 "
End If
Else
OutStr=OutStr&"<a href='?page=1"
OutStr=OutStr&Url
OutStr=OutStr&"' title=""首页"">
9"
OutStr=OutStr&"<a href='?page="&iCurrentPage-1
OutStr=OutStr&Url
OutStr=OutStr&"' title=""上页"">
7..."
End If
For i=PageRoot To PageFoot
If i=Cint(iCurrentPage) Then
OutStr=OutStr&"
["+Cstr(i)+"] "
Else
OutStr=OutStr&"<a href='?page="&Cstr(i)
OutStr=OutStr&Url
OutStr=OutStr&"'>["+Cstr(i)+"] "
End If
If i=PageCount Then Exit For
Next
If PageFoot=PageCount Then
If Cint(iCurrentPage)=Cint(PageCount) Then
OutStr=OutStr&"
8"
OutStr=OutStr&"
:"
Else
OutStr=OutStr&"<a href='?page="&iCurrentPage+1
OutStr=OutStr&Url
OutStr=OutStr&"' title=""下页"">
8"
OutStr=OutStr&"<a href='?page="&PageCount
OutStr=OutStr&Url
OutStr=OutStr&"' title=""尾页"">
:"
End If
Else
OutStr=OutStr&"... <a href='?page="&iCurrentPage+1
OutStr=OutStr&Url
OutStr=OutStr&"' title=""下页"">
8"
OutStr=OutStr&"<a href='?page="&PageCount
OutStr=OutStr&Url
OutStr=OutStr&"' title=""尾页"">
:"
End If
OutStr=OutStr&" <INPUT TYPE=text class=in size=3 value="&iCurrentPage&" """&"if(document.all.PGNumber.value>0 && document.all.PGNumber.value<="&PageCount&"){window.location='?Page='+document.all.PGNumber.value+'"&Url&"'}"&""""&" >"
PageList=OutStr
End Function
减小字体
增大字体