没有合适的资源?快使用搜索试试~ 我知道了~
asp采集图片保存并缩略第一张图片
需积分: 12 32 下载量 186 浏览量
2008-10-22
11:21:37
上传
评论
收藏 10KB TXT 举报
温馨提示
试读
12页
asp采集图片保存并缩略第一张图片,asp采集图片,你可能经常用到吧,本系统具有保存第一张图片的缩略图的功能,需要jpeg支持
资源推荐
资源详情
资源评论
采集中 或者 在线添加文章中 都可以用到此功能
俺自己在baidu上搜索的保存远程图片到本地的代码 感觉比较难用点 而且没有现成的比较全的代码 俺也看不懂
俺从 SNA新闻采集系统 For 3.62 (程序制作:ansir)里提取了点函数 用下 比较简单好用
以下是函数
程序代码
<%
'==================================================
'函数名:CheckDir2
'作 用:检查文件夹是否存在
'参 数:FolderPath ------文件夹地址
'==================================================
Function CheckDir2(byval FolderPath)
dim fso
folderpath=Server.MapPath(".")&"\"&folderpath
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(FolderPath) then
'存在
CheckDir2 = True
Else
'不存在
CheckDir2 = False
End if
Set fso = nothing
End Function
'==================================================
'函数名:MakeNewsDir2
'作 用:创建新的文件夹
'参 数:foldername ------文件夹名称
'==================================================
Function MakeNewsDir2(byval foldername)
俺自己在baidu上搜索的保存远程图片到本地的代码 感觉比较难用点 而且没有现成的比较全的代码 俺也看不懂
俺从 SNA新闻采集系统 For 3.62 (程序制作:ansir)里提取了点函数 用下 比较简单好用
以下是函数
程序代码
<%
'==================================================
'函数名:CheckDir2
'作 用:检查文件夹是否存在
'参 数:FolderPath ------文件夹地址
'==================================================
Function CheckDir2(byval FolderPath)
dim fso
folderpath=Server.MapPath(".")&"\"&folderpath
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(FolderPath) then
'存在
CheckDir2 = True
Else
'不存在
CheckDir2 = False
End if
Set fso = nothing
End Function
'==================================================
'函数名:MakeNewsDir2
'作 用:创建新的文件夹
'参 数:foldername ------文件夹名称
'==================================================
Function MakeNewsDir2(byval foldername)
dim fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.CreateFolder(Server.MapPath(".") &"\" &foldername)
If fso.FolderExists(Server.MapPath(".") &"\" &foldername) Then
MakeNewsDir2 = True
Else
MakeNewsDir2 = False
End If
Set fso = nothing
End Function
'==================================================
'函数名:DefiniteUrl
'作 用:将相对地址转换为绝对地址
'参 数:PrimitiveUrl ------要转换的相对地址
'参 数:ConsultUrl ------当前网页地址
'==================================================
Function DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
Dim ConTemp,PriTemp,Pi,Ci,PriArray,ConArray
If PrimitiveUrl="" or ConsultUrl="" or PrimitiveUrl="$False$" Then
DefiniteUrl="$False$"
Exit Function
End If
If Left(ConsultUrl,7)<>"HTTP://" And Left(ConsultUrl,7)<>"http://" Then
ConsultUrl= "http://" & ConsultUrl
End If
ConsultUrl=Replace(ConsultUrl,"://",":\\")
If Right(ConsultUrl,1)<>"/" Then
If Instr(ConsultUrl,"/")>0 Then
If Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 then
Else
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.CreateFolder(Server.MapPath(".") &"\" &foldername)
If fso.FolderExists(Server.MapPath(".") &"\" &foldername) Then
MakeNewsDir2 = True
Else
MakeNewsDir2 = False
End If
Set fso = nothing
End Function
'==================================================
'函数名:DefiniteUrl
'作 用:将相对地址转换为绝对地址
'参 数:PrimitiveUrl ------要转换的相对地址
'参 数:ConsultUrl ------当前网页地址
'==================================================
Function DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
Dim ConTemp,PriTemp,Pi,Ci,PriArray,ConArray
If PrimitiveUrl="" or ConsultUrl="" or PrimitiveUrl="$False$" Then
DefiniteUrl="$False$"
Exit Function
End If
If Left(ConsultUrl,7)<>"HTTP://" And Left(ConsultUrl,7)<>"http://" Then
ConsultUrl= "http://" & ConsultUrl
End If
ConsultUrl=Replace(ConsultUrl,"://",":\\")
If Right(ConsultUrl,1)<>"/" Then
If Instr(ConsultUrl,"/")>0 Then
If Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 then
Else
剩余11页未读,继续阅读
资源评论
meteor8245
- 粉丝: 1
- 资源: 7
上传资源 快速赚钱
- 我的内容管理 展开
- 我的资源 快来上传第一个资源
- 我的收益 登录查看自己的收益
- 我的积分 登录查看自己的积分
- 我的C币 登录后查看C币余额
- 我的收藏
- 我的下载
- 下载帮助
安全验证
文档复制为VIP权益,开通VIP直接复制
信息提交成功