myfunction.asp

相册（（ flash加ASP

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<!--#INCLUDE FILE="MyConfig.asp"-->
<%
'====================================================================
'以下为数据库连接函数
'====================================================================
Const FPV_FileName=0
Const FPV_FileSize=1
Const FPV_FileModified=2
Const FPV_bPicName=3
Const FPV_sPicName=4
Dim Conn
' -----------------------------------------------
' 功能:打开数据库连接
' -----------------------------------------------
Sub DBConnBegin()
	If IsObject(Conn) = True Then Exit Sub	 
	Set Conn = Server.CreateObject("ADODB.Connection")
	Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(C_MdbName)	
	If Err.Number > 0 Then
		Response.Write "读取数据库出错,请联系管理员!"
		Response.End
	End If
End Sub

' -----------------------------------------------
' 功能:释放数据库连接对象
' -----------------------------------------------
Sub DBConnEnd()
	On Error Resume Next
	Conn.Close
	Set Conn = Nothing
	oRs.Close
	Set oRs=Nothing
End Sub

'====================================================================
'以下为系统常用函数
'====================================================================

' -----------------------------------------------
' 功能: 通用安全字符串输入函数
' -----------------------------------------------
Function HTMLEncode(Str)
 If Isnull(Str) Then
	 HTMLEncode = ""
	 Exit Function 
 End If
 Str = Replace(Str,Chr(0),"", 1, -1, 1)
 Str = Replace(Str, """", "&quot;", 1, -1, 1)
 Str = Replace(Str,"<","&lt;", 1, -1, 1)
 Str = Replace(Str,">","&gt;", 1, -1, 1) 
 Str = Replace(Str, "script", "&#115;cript", 1, -1, 0)
 Str = Replace(Str, "SCRIPT", "&#083;CRIPT", 1, -1, 0)
 Str = Replace(Str, "Script", "&#083;cript", 1, -1, 0)
 Str = Replace(Str, "script", "&#083;cript", 1, -1, 1)
 Str = Replace(Str, "object", "&#111;bject", 1, -1, 0)
 Str = Replace(Str, "OBJECT", "&#079;BJECT", 1, -1, 0)
 Str = Replace(Str, "Object", "&#079;bject", 1, -1, 0)
 Str = Replace(Str, "object", "&#079;bject", 1, -1, 1)
 Str = Replace(Str, "applet", "&#097;pplet", 1, -1, 0)
 Str = Replace(Str, "APPLET", "&#065;PPLET", 1, -1, 0)
 Str = Replace(Str, "Applet", "&#065;pplet", 1, -1, 0)
 Str = Replace(Str, "applet", "&#065;pplet", 1, -1, 1)
 Str = Replace(Str, "[", "&#091;")
 Str = Replace(Str, "]", "&#093;")
 Str = Replace(Str, """", "", 1, -1, 1)
 Str = Replace(Str, "=", "&#061;", 1, -1, 1)
 Str = Replace(Str, "'", "''", 1, -1, 1)
 Str = Replace(Str, "select", "sel&#101;ct", 1, -1, 1)
 Str = Replace(Str, "execute", "&#101xecute", 1, -1, 1)
 Str = Replace(Str, "exec", "&#101xec", 1, -1, 1)
 Str = Replace(Str, "join", "jo&#105;n", 1, -1, 1)
 Str = Replace(Str, "union", "un&#105;on", 1, -1, 1)
 Str = Replace(Str, "where", "wh&#101;re", 1, -1, 1)
 Str = Replace(Str, "insert", "ins&#101;rt", 1, -1, 1)
 Str = Replace(Str, "delete", "del&#101;te", 1, -1, 1)
 Str = Replace(Str, "update", "up&#100;ate", 1, -1, 1)
 Str = Replace(Str, "like", "lik&#101;", 1, -1, 1)
 Str = Replace(Str, "drop", "dro&#112;", 1, -1, 1)
 Str = Replace(Str, "create", "cr&#101;ate", 1, -1, 1)
 Str = Replace(Str, "rename", "ren&#097;me", 1, -1, 1)
 Str = Replace(Str, "count", "co&#117;nt", 1, -1, 1)
 Str = Replace(Str, "chr", "c&#104;r", 1, -1, 1)
 Str = Replace(Str, "mid", "m&#105;d", 1, -1, 1)
 Str = Replace(Str, "truncate", "trunc&#097;te", 1, -1, 1)
 Str = Replace(Str, "nchar", "nch&#097;r", 1, -1, 1)
 Str = Replace(Str, "char", "ch&#097;r", 1, -1, 1)
 Str = Replace(Str, "alter", "alt&#101;r", 1, -1, 1)
 Str = Replace(Str, "cast", "ca&#115;t", 1, -1, 1)
 Str = Replace(Str, "exists", "e&#120;ists", 1, -1, 1)
 Str = Replace(Str,Chr(13),"<br>", 1, -1, 1)
 HTMLEncode = Replace(Str,"'","''", 1, -1, 1)
End Function

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

Function IIf(condition,value1,value2)
	If condition Then IIf = value1 Else IIf = value2
End Function

'====================================================================
'以下为FSO操作函数
'====================================================================
' -----------------------------------------------
' 功能:判断文件是否存在
' 参数:文件详细路径及名称
' 返回:1:文件存在  -1:文件不存在
' -----------------------------------------------
Function ReportFileStatus(FileName)
    Dim FSO,msg
	msg = -1
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If (FSO.FileExists(FileName)) Then
        msg =1
    Else
        msg = -1
    End If
	Set FSO=nothing
    ReportFileStatus = msg
End Function

' -----------------------------------------------
' 功能:删除指定路径的文件
' 参数:文件详细路径及名称
' 返回:1:删除成功  -1:删除失败
' -----------------------------------------------
Function deleteAFile(filespec)
	dim fso
	set fso=server.CreateObject("Scripting.FileSystemObject") 
	If ReportFileStatus(filespec) = 1 Then
		fso.deleteFile(filespec)
		deleteAFile = 1
	Else
		deleteAFile = -1
	End if
	Set fso=nothing
End Function

' -----------------------------------------------
' 功能:利用FSO创建目录 如果有多级目录，则一级一级的创建
' 参数:要创建目录的详细信息
' 返回:1:创建成功  -1:创建失败
' -----------------------------------------------
Function CreateDIR(byval LocalPath)
	On Error Resume Next
	Dim Patharr,Path_level,RootPath,Pathtmp,Fso,i
	RootPath=replace(Server.MapPath("/"),"\","/")  '取得根目录并转换成网页格式
	LocalPath=replace(LocalPath,"\","/")		   '转成网页路径格式
	LocalPath=replace(LocalPath,RootPath,"")	   '去掉根目录路径 注:根目录格式:E:\Website 后面没有"\"
	Patharr = split(LocalPath,"/")
	Path_level = ubound(Patharr)
	Pathtmp=RootPath
	Set Fso = server.createobject("Scripting.FileSystemObject")
	For i=1 to path_level					  '循环创建目录 注:从1开始,0这个数组为空
		Pathtmp = Pathtmp&"/"&Patharr(i)
		If not Fso.FolderExists(Pathtmp) Then '假如此目录不存在,则创建
			Fso.CreateFolder Pathtmp
		End If
	Next
	set Fso = nothing
	If err.number<>0 then
	  CreateDIR = -1
	  err.Clear
	Else
	  CreateDIR =1
	End If
End Function

' -----------------------------------------------
' 功能:判断路径的最后一个目录是否是 C_SPicFolder
' 参数:路径(URL格式) 如: "../photo/abc/b/s/"
' 返回:1:是  -1:否
' -----------------------------------------------
Function CheckIfSPicFolder(byval Path)
	Dim a,b
	Path=Trim(Path)
	If Len(Path)<=1 Then
		CheckIfSPicFolder=-1
		Exit Function
	End If
	If Right(Path,1)="/" Then Path=Left(Path,Len(Path)-1) End If '去掉最后一个"/"
	a=Split(Path,"/")
	b=a(UBound(a)) 
	If LCase(b)=LCase(C_SPicFolder) Then
		CheckIfSPicFolder=1
	Else
		CheckIfSPicFolder=-1
	End If
End Function


' ------------------------------------------------------------------------
' 功能: 取指定文件夹图片资料,并根据参数进行相应排序
' 作者: 深山老熊  [e-mail]
' 参数说明:
' 1: Path			取图片文件的相对路径
' 2: ViewPath		前台查看相对路径
' 2: SortBy			排序方法 (0:文件名称 1:文件大小 2:修改日期 )
' 3: SortType		排序方式 (asc or 0 升序     desc or 1 降序 )
' 返回: 排序好的文件列表二维数组
' [0:文件名称,1:文件尺寸,2:文件最后修改日期,3:大图路径名称,4:小图路径名称]
' ------------------------------------------------------------------------
Function GetFolderImagesFiles(byval Path,byval ViewPath,byval Sortby,byval SortType)
	Dim slot,objFile,sFileExt,bPicName,sPicName,Reverse,kind
	Dim i,j,mark,minmax,minmaxSlot
	slot=-1
	Dim theFiles() 
	Redim theFiles(100)
	'-------------------------------------------
	'把图片资料读取到theFiles这个数组中
	'-------------------------------------------
	Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
	Set objFolder = objFSO.GetFolder(Server.MapPath(Path))
	For Each objFile In objFolder.Files
		sFileExt = LCase(Mid(objFile.Name, InStrRev(objFile.Name, ".", -1, 1) + 1))
		If sFileExt = "jpg" Or sFileExt = "jpeg"  or sFileExt = "png"  or sFileExt = "gif"  Then
			If  CheckIfSPicFolder(Path)<>1 Then  
				Makeimg  Path,objFile.Name,C_SmallImageWidth,C_SmallImageHeight,0  
				bPicName=ViewPath&objFile.Name
				sPicName=Left(objFile.Name,Len(objFile.Name)-Len(sFileExt))&"jpg"  
				sPicName=ViewPath&C_SPicFolder&"/"&sPicName 	
			Else '当前目录为小图目录时,不再生成缩小图片
				bPicName=ViewPat&objFile.Name
				sPicName=bPicName
			End If
			'将文件信息存到当前数组中
			'0:文件名称,1:文件尺寸,2:文件最后修改日期,3:大图路径名称,4:小图路径名称 (前三项位置请不要作变更)
			slot = slot + 1 
			theFiles(slot)=Array(objFile.Name,objFile.size,objFile.DateLastModIfied,bPicName,sPicName)			
			If slot >= UBound(theFiles) Then 
				ReDim Preserve theFiles(Slot+100) 
			End If 
		End If
	Next 
	ReDim Preserve theFiles(slot)  
	'-------------------------------------------
	'现在给数组进行排序
	'-------------------------------------------
	SortBy=Cint(SortBy)
	If SortBy>2 or SortBy<0 Then SortBy=2	'默认按修改日期排序
	Reverse=IIf((LCase(CStr(SortType))="0" or LCase(CStr(SortType))="asc"),False,True)
	kind=IIf((VarType(theFiles(0)(SortBy))=8),IIf(Reverse,1,2),IIf(Reverse,3,4))	'返回8为字符串,7为日期
	
	For i = slot TO  0 Step -1
		minmax = theFiles( 0 )( sortBy )
		minmaxSlot = 0
		For j = 1 To i
			Select Case kind 
				Case 1 
					mark = (strComp( theFiles(j)(sortBy), minmax, vbTextCompare ) < 0)
				Case 2 
					mark = (strComp( theFiles(j)(sortBy), minmax, vbTextCompare ) > 0)
				Case 3