<%
'==================================================
'函数名：GetPage
'作  用：获取网页源码
'==================================================
Function GetPage(url,bianma) 
     on error resume next 
     dim oSend,Rurl
    'set oSend=createobject("MSXML2.XMLHTTP")
     set oSend=createobject("Microsoft.XMLHTTP")
     Randomize() :QvodCmsError()
     Rurl = url & "&qvodcms=" & Int((9999) * Rnd(Now())+1)
     oSend.open "GET",Rurl,false 
     oSend.send() 
     if oSend.readystate<>4 then exit function 
     GetPage = BytesToBstr(oSend.responseBody,bianma)
     set oSend=nothing:QvodCmsError()
End Function  

'==================================================
'函数名：BytesToBstr
'作  用：将获取的源码转换为中文
'参  数：Body ------要转换的变量
'参  数：bianma ------要转换的类型
'==================================================
Function BytesToBstr(body,bianma)
	dim objstream
	set objstream = Server.CreateObject("adodb.stream")
	objstream.Type = 1
	objstream.Mode =3
	objstream.Open
	objstream.Write body
	objstream.Position = 0
	objstream.Type = 2
	objstream.Charset = bianma
	BytesToBstr = objstream.ReadText 
	objstream.Close
	set objstream = nothing
End Function

'截取字符串
Function GetContent(str,start,last,n)
	If Instr(lcase(str),lcase(start))>0 then
		select case n
		case 0	'左右都截取（都取前面）（去处关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
		GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))-1)
		case 1	'左右都截取（都取前面）（保留关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
		GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))+Len(last)-1)
		case 2	'只往右截取（取前面的）（去除关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
		case 3	'只往右截取（取前面的）（包含关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
		case 4	'只往左截取（取后面的）（包含关键字）
		GetContent=Left(str,InstrRev(lcase(str),lcase(start))+Len(start)-1)
		case 5	'只往左截取（取后面的）（去除关键字）
		GetContent=Left(str,InstrRev(lcase(str),lcase(start))-1)
		case 6	'只往左截取（取前面的）（包含关键字）
		GetContent=Left(str,Instr(lcase(str),lcase(start))+Len(start)-1)
		case 7	'只往右截取（取后面的）（包含关键字）
		GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start))+1)
		case 8	'只往左截取（取前面的）（去除关键字）
		GetContent=Left(str,Instr(lcase(str),lcase(start))-1)
		case 9	'只往右截取（取后面的）（包含关键字）
		GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start)))
		end select
	Else
		GetContent=""
	End if
End function


 '根据原文件名，自动以日期YYYY-MM-DD-RANDOM格式生成新文件名
Function GenerateRandomFileName(szFilename)
    Randomize
    ranNum = Int(90000 * Rnd) + 10000
    If Month(Now) < 10 Then c_month = "0" & Month(Now) Else c_month = Month(Now)
    If Day(Now) < 10 Then c_day = "0" & Day(Now) Else c_day = Day(Now)
    If Hour(Now) < 10 Then c_hour = "0" & Hour(Now) Else c_hour = Hour(Now)
    If Minute(Now) < 10 Then c_minute = "0" & Minute(Now) Else c_minute = Minute(Now)
    If Second(Now) < 10 Then c_second = "0" & Second(Now) Else c_second = Minute(Now)
    fileExt_a = Split(szFilename, ".")
    FileExt = LCase(fileExt_a(UBound(fileExt_a)))
    GenerateRandomFileName = Year(Now) & c_month & c_day & c_hour & c_minute & c_second & ranNum & "." & FileExt
End Function

Function GetXmlImg(url) 
	Set OSend=createobject("Microsoft.XMLHTTP")
	SourceCode = oSend.open ("GET",url,False) 
	OSend.send()
	GetXmlImg = OSend.ResponseBody
End Function

'==================================================
'函数名：SaveRemoteFile
'作  用：保存远程的文件到本地
'参  数：LocalFileName ------ 本地文件名
'        RemoteFileUrl ------ 远程文件URL
'返回值：True ----- 保存成功
'        False ----- 保存失败
'==================================================
Function SaveRemoteFile(RemoteFileUrl, LocalFileName)
    On Error Resume Next
    Dim Imgs, GetRemoteData
	GetRemoteData = GetXmlImg(RemoteFileUrl) 
    Set Imgs = Server.CreateObject("Adodb.Stream")
    With Imgs
        .Type = 1
        .Open
        .Write GetRemoteData
        .SaveToFile Server.MapPath(LocalFileName), 2
        .Cancel
        .Close
    End With
    Set Imgs = Nothing
    If Err.Number <> 0 Then
        Err.Clear
        Response.Write "<br>" & LocalFileName & " Save Failed"
        SaveRemoteFile = False
    Else
	    Response.Write"预览图片：<a href='" &LocalFileName& "' target='_blank'>" &LocalFileName& "</a> <font color=red>"&formatnumber(len(GetRemoteData)/1024*2,2)&"</font>Kb<br>"
        SaveRemoteFile = True
    End If
End Function

'AspJpeg生成缩略图功能
Function ImgAspJpeg(basepic,newpic,sl_width,sl_height)
    On error resume next 
    Dim todojpeg,sj_width,sj_height,yg_width,yg_height,zz_width,zz_height,cq_type,x,y,w,h,basefolder,basefile
	Set todojpeg = server.createobject("persits.jpeg")
    todojpeg.open server.mappath(basepic) 
    sj_width=todojpeg.width
    sj_height=todojpeg.height
    yg_width=((sl_width*sj_height)/sl_height)
    yg_height=((sl_height*sj_width)/sl_width)
    if sj_width>yg_width then '横向裁切
    zz_width=yg_width:zz_height=sj_height:cq_type=-1
    elseif sj_width=yg_width then '不裁切
    zz_width=yg_width:zz_height=yg_height:cq_type=0
    elseif sj_width<yg_width then '竖向裁切
    zz_width=sj_width:zz_height=yg_height:cq_type=1
    end if
    x=0:y=0:w=zz_width:h=zz_height
    if cq_type=-1 then
    x=cint((sj_width-yg_width)/2)
    elseif cq_type=1 then
    y=cint((sj_height-yg_height)/2)
    end if
    todojpeg.crop x,y,x+w,y+h '裁切 
    todojpeg.width=sl_width
    todojpeg.height=sl_height
    basepic=replace(basepic,"/","\")
    basefolder=left(basepic,instrrev(basepic,"\"))
    basefile=right(basepic,len(basepic)-instrrev(basepic,"\"))
    if basefolder<>"" then
    newpic=basefolder&syssmallfix&basefile
    else
    newpic=syssmallfix&basefile
    end if
    todojpeg.save server.mappath(newpic)
    set todojpeg = nothing 
    ImgAspJpeg=newpic 
End Function
%>