日期:2013-11-29  浏览次数:20800 次

' =======================
' 检测上页是否从本站提交
' 返回: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"
Out