myfunction.asp

相册（（ flash加ASP

					mark = (theFiles( j )( sortBy ) < minmax)
				Case 4 
					mark = (theFiles( j )( sortBy ) > minmax)
			End Select
			If mark Then 
				minmax = theFiles( j )( sortBy )
				minmaxSlot = j
			End If
		Next
		If minmaxSlot <> i Then 
			temp = theFiles( minmaxSlot )
			theFiles( minmaxSlot ) = theFiles( i )
			theFiles( i ) = temp
		End If
	Next
	GetFolderImagesFiles=theFiles
End Function


'====================================================================
'以下为图像处理函数
'====================================================================

' -----------------------------------------------
' 功能: 等比例缩小图片 (采用ASPJPEG组件)
' 作者: 深山老熊 [e-mail]
' 参数: BPath:   大图路径    'BName:   大图名称
'       S_Width: 小图最宽值  'S_Height:小图最高值
'		write:   1:覆盖       0:不覆盖
' 说明: 小图存放到大图目录下的S目录下,名称与大图
'		相同,后缀为JPG格式
' -----------------------------------------------
Function Makeimg(BPath,BName,S_Width,S_Height,write)
	Dim Jpeg
	Dim SPath,SName,H_Temp,W_Temp
	Dim a,b
	If Right(BPath,1)<>"/" Then '路径后没有"/"则加上
		BPath=BPath&"/" 
	End If 
	SPath=BPath&C_SPicFolder
	CreateDIR(Server.MapPath(SPath))	'创建小图目录

	'取大图文件名,去后缀
	a=Split(BName,".")
	b=a(UBound(a))
	SName=Left(BName,Len(BName)-Len(b))&"jpg"  '注:ASPJPEG只能生成JPG格式的文件
	SName=SPath&"/"&SName

	'判断是否需要覆盖文件
	If write=0 Then   '0为不覆盖,查找文件是否存在,存在则退出
	'response.write "<br><br>"&SName
		If ReportFileStatus(Server.MapPath(SName))=1 Then 
			Exit Function
		End If
	End If

	Set Jpeg = Server.CreateObject("Persits.Jpeg")
	Jpeg.Open Server.MapPath(BPath&BName)			'打开大图

	'判断是否需要进行缩略图处理 [长宽任有一处大于小图尺寸就进行处理]
	If  Jpeg.OriginalWidth>S_Width or Jpeg.OriginalHeight>S_Height Then
		H_Temp=S_Width*Jpeg.OriginalHeight/Jpeg.OriginalWidth    '当把[宽]设为小图最大值时,取得等比例高的尺寸.
		W_Temp=Jpeg.OriginalWidth*S_Height/Jpeg.OriginalHeight   '当把[高]设为小图最大值时,取得等比例宽的尺寸.
		If W_Temp>S_Width Then					    '当宽的临时值大于最大宽时: 即取把小图宽的最大值,高按宽的最大值计算得出
		   Jpeg.Width =S_Width
		   Jpeg.Height=H_Temp	
		Else										'当高的临时值大于最大高时: 即取把小图高的最大值,宽按高的最大值计算得出
		   Jpeg.Width=W_Temp
		   Jpeg.Height=S_Height
		End If
	Else  
	   Jpeg.Width=Jpeg.OriginalWidth
	   Jpeg.Height=Jpeg.OriginalHeight
	End If
	response.write SName
	Jpeg.Save Server.MapPath(SName)
	set Jpeg=nothing
End Function

'====================================================================
'以下为ADODB.Stream函数
'====================================================================

' -----------------------------------------------
' 功能:检查是否支持ADODB.Stream组件,
' 参数:无
' 返回:支持:True 不支持:False
' -----------------------------------------------
Function CheckADODBStream()
    Dim objStream
	On Error Resume Next
    Set objStream = Server.CreateObject("ADODB.Stream")
    If Err.Number=-2147221005 Then 
        Err.Clear
        CheckADODBStream=False
	Else
		CheckADODBStream=True
    End If
End Function

' -----------------------------------------------
' 功能:使用ADODB.Stream保存文件
' 参数:strBody ,File, cSet "GB2312. UTF-8..."
' 返回:无
' -----------------------------------------------
Function SaveToFile(strBody,File,cSet)
    Dim objStream
    Set objStream = Server.CreateObject("ADODB.Stream")
    With objStream
		.Type = 2
		.Open
		.Charset   = cSet
		.Position  = objStream.Size
		.WriteText = strBody
		.SaveToFile Server.MapPath(File),2
		.Close
    End With
    Set objStream = Nothing
End Function

' -----------------------------------------------
' 功能:使用ADODB.Stream读取本地文件
' 参数:File, cSet "GB2312. UTF-8..."
' 返回:读取的文件内容
' -----------------------------------------------
Function LoadFile(File,cSet)
    Dim objStream
    Set objStream = Server.CreateObject("ADODB.Stream")
    If Err.Number=-2147221005 Then 
        Response.Write "ADODB.Stream does not support"
        Err.Clear
        Response.End
    End If
    With objStream
        .Type = 2
        .Mode = 3
        .Open
        .LoadFromFile Server.MapPath(File)
		If Err.Number<>0 Then
			Response.Write "File="&File&" cannot find"
			Err.Clear
			Response.End
		End If
        .Charset  = cSet
        .Position = 2
         LoadFile = .ReadText
        .Close
    End With
    Set objStream = Nothing
End Function

'晕死,找了半天才找到,感谢代码作者,不过我不知道是谁..谢谢
'解决了传递utf-8的参数时的乱码问题

function U8Decode(enStr)
  '输入一堆有%分隔的字符串，先分成数组，根据utf8规则来判断补齐规则
  '输入:关 E5 85 B3  键  E9 94 AE 字   E5 AD 97
  '输出:关 B9D8  键  BCFC 字   D7D6
  dim c,i,i2,v,deStr,WeiS

  for i=1 to len(enStr)
    c=Mid(enStr,i,1)
    if c="%" then
      v=c16to2(Mid(enStr,i+1,2))
      '判断第一次出现0的位置，
      '可能是1(单字节)，3(3-1字节)，4，5，6，7不可能是2和大于7
      '理论上到7，实际不会超过3。
      WeiS=instr(v,"0")
      v=right(v,len(v)-WeiS)'第一个去掉最左边的WeiS个
      i=i+3
      for i2=2 to WeiS-1
        c=c16to2(Mid(enStr,i+1,2))
        c=right(c,len(c)-2)'其余去掉最左边的两个
        v=v & c
        i=i+3
      next
      if len(c2to16(v)) =4 then
        deStr=deStr & chrw(c2to10(v))
      else
        deStr=deStr & chr(c2to10(v))
      end if
      i=i-1
    else
      if c="+" then
        deStr=deStr&" "
      else
        deStr=deStr&c
      end if
    end if
  next
  U8Decode = deStr
end function

function c16to2(x)
 '这个函数是用来转换16进制到2进制的，可以是任何长度的，一般转换UTF-8的时候是两个长度，比如A9
 '比如：输入“C2”，转化成“11000010”,其中1100是"c"是10进制的12（1100），那么2（10）不足4位要补齐成（0010）。
 dim tempstr
 dim i:i=0'临时的指针

 for i=1 to len(trim(x))
  tempstr= c10to2(cint(int("&h" & mid(x,i,1))))
  do while len(tempstr)<4
   tempstr="0" & tempstr'如果不足4位那么补齐4位数
  loop
  c16to2=c16to2 & tempstr
 next
end function

function c2to16(x)
  '2进制到16进制的转换，每4个0或1转换成一个16进制字母，输入长度当然不可能不是4的倍数了

  dim i:i=1'临时的指针
  for i=1 to len(x)  step 4
   c2to16=c2to16 & hex(c2to10(mid(x,i,4)))
  next
end function

function c2to10(x)
  '单纯的2进制到10进制的转换，不考虑转16进制所需要的4位前零补齐。
  '因为这个函数很有用！以后也会用到，做过通讯和硬件的人应该知道。
  '这里用字符串代表二进制
   c2to10=0
   if x="0" then exit function'如果是0的话直接得0就完事
   dim i:i=0'临时的指针
   for i= 0 to len(x) -1'否则利用8421码计算，这个从我最开始学计算机的时候就会，好怀念当初教我们的谢道建老先生啊！
    if mid(x,len(x)-i,1)="1" then c2to10=c2to10+2^(i)
   next
end function

function c10to2(x)
'10进制到2进制的转换
  dim sign, result
  result = ""
  '符号
  sign = sgn(x)
  x = abs(x)
  if x = 0 then
    c10to2 = 0
    exit function
  end if
  do until x = "0"
    result = result & (x mod 2)
    x = x \ 2
  loop
  result = strReverse(result)
  if sign = -1 then
    c10to2 = "-" & result
  else
    c10to2 = result
  end if
end Function

'XML 转义 by yellow
Function xmlxml(Str)
 If Isnull(Str) Then
	 xmlxml = ""
	 Exit Function 
 End If
 Str = Replace(Str,"&","&amp;")
 Str = Replace(Str,"<","&lt;")
 Str = Replace(Str,">","&gt;")
 Str = Replace(Str,"'","&apos;")
 xmlxml =  Replace(Str,"""","&quot;") 
End Function

%>