tool_ztpic1.asp

REM 管理栏目设置 dim menu(4,10) menu(0,0)="信息及常规管理" menu(0,1)="<a target=main href=admin_config.asp&

<!--#include file="conn.asp"-->
<!--#include file="check.asp"--><%Response.Expires = 0  
Response.expiresabsolute = Now() - 1  
Response.addHeader "pragma", "no-cache"  
Response.addHeader "cache-control", "private"  
Response.CacheControl = "no-cache" 
Response.Buffer = True 
Response.Clear
Server.ScriptTimeOut=999999999

'for i=14 to 20
'response.write("<iframe border=0 vspace=0 hspace=0 marginwidth=0 marginheight=0 framespacing=0 frameborder=0 scrolling=no width=100% height=20 src=DownData.asp?url=http://myhome.apbb.com.tw/tim0421/noa5"&i&".jpg></iframe>"&vbCr)
'next
Response.Write "<LINK href=""admin.css"" type=text/css rel=stylesheet>"
FromUrl=request("url")
if FromUrl="" or left(FromUrl,7)<>"http://" then
response.write"请输入正确定的地址，形如DownData.asp?url=http://*********.gif"
response.end
end if

flName=request("path")
If Len(flName)<10 Then 
response.write"无图片下载或地址错误"
response.End
End If 
fldr=""
If IsExists(flName)=True then 
response.write"<a target=_blank href="&flName&">"&flName&"</a>文件已存在<BR>"
response.Flush
else
GetNewsFold=split(flName,"/")
For i=0 to Ubound(GetNewsFold)-1
    if fldr="" then
	    fldr=GetNewsFold(i)
    else
	    fldr=fldr&"\"&GetNewsFold(i)
    end if
	If IsFolder(fldr)=false then
		CreateFolder fldr
	End if
Next
	SaveFiles FromUrl,flName
End if

Function GetImg(url) 
	set oSend=createobject("Microsoft.XMLHTTP")
	SourceCode = oSend.open ("GET",url,false) 
	oSend.send()
	GetImg = oSend.responseBody
End Function

function savefiles(from,tofile)
dim geturl,objStream,imgs
geturl=trim(from)
imgs=GetImg(from)
Response.Write "<a target=_blank href="&tofile&">"&tofile&"</a>保存成功：<font color=red>"&formatnumber(len(imgs)/1024*2,2)&"</font>Kb<BR>"
response.Flush
if formatnumber(len(imgs)/1024*2,2)>1 then
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type =1
objStream.Mode=3  
objStream.Open
objstream.write imgs
objstream.SaveToFile server.mappath(tofile),2
objstream.Close()
set objstream=nothing
else
Response.Write "保存失败：<font color=red>文件大小"&formatnumber(len(imgs)/1024*2,2)&"Kb，小于1K</font><BR>"
response.Flush
end if
end function

'检测文件是否存在
Function IsExists(filespec) 
	Dim fso
	Set fso = CreateObject("Scripting.FileSystemObject")
	If (fso.FileExists(server.MapPath(filespec))) Then
	IsExists = True
	Else
	IsExists = False
	End If
End Function

'检测文件夹是否存在
Function IsFolder(Folder)
    Set fso = CreateObject("Scripting.FileSystemObject")
	If FSO.FolderExists(server.MapPath(Folder)) Then  
	IsFolder = True
	Else
	IsFolder = False
	End If
End Function

'新建文件夹
Function CreateFolder(fldr) 
on error resume next
	Dim fso, f
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set f = fso.CreateFolder(Server.MapPath(fldr))
	CreateFolder = f.Path
	Set f=nothing
	Set fso=nothing
End Function
%>