ASP Function in common use 1

' =======================
' 检测上页是否从本站提交
' 返回: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&" onmouseover='this.focus();this.select()' NAME=PGNumber> <INPUT TYPE=button id=button1 name=button1 class=bot 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

本文地址：http://com.8s8s.com/it/it7684.htm