当前位置: 首页 > 图文教程 > 网络编程 > ASP > ASP采集入库生成本地文件的几个函数

ASP
asp分页(自己整理的2个分页程序)
ASP常用的系统配置函数
雨哲防采集策略之列表篇
雨哲浅谈关于防采集而不影响收录内容篇
asp数据库连接函数
ajax XMLHTTP Post Form时的表单乱码综合解决
ASP注入详细命令40条
用ASP实现MSSQL用户密码破解
ASP创建对象的两种方法比较
ASP字符串转换为整形、双精度型、布尔
ASP计算str2在str1中出现的次数
asp采集抓取网上房产信息的代码
ASP注册登陆实例代码
ASP中使用FileSystemObject时提高性能的方法
分享一个好东东,动态Include文件 (Dynamic File Includes)
解决 JScript 中使用日期类型数据时出现类型错误的问题
在ASP里面创建GUID
在JScript中使用缓存技术的实际代码
ASP javascript Application对象的Contents和StaticObjects做Cache的一些经验
海阳2006+功能中的潜水王

ASP采集入库生成本地文件的几个函数


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-09-13   浏览: 159 ::
收藏到网摘: n/a

'*****************************************************************
' function
' 作用 :利用流保存文件
' 参数 :from(远程文件地址),tofile(保存文件位置)
'*****************************************************************
Private Function SaveFiles(byref from,byref tofile)
Dim Datas
Datas=GetData(from,0)
Response.Write "保存成功:"&formatnumber(len(Datas)/1024*2,2)&"Kb"
response.Flush
if formatnumber(len(Datas)/1024*2,2)>1 then
ADOS.Type = 1
ADOS.Mode =3
ADOS.Open
ADOS.write Datas
ADOS.SaveToFile server.mappath(tofile),2
ADOS.Close()
else
Response.Write "保存失败:文件大小"&formatnumber(len(imgs)/1024*2,2)&"Kb,小于1K"
response.Flush
end if
end function

'*****************************************************************
' function(私有)
' 作用 :利用fso检测文件是否存在,存在返回true,不存在返回false
' 参数 :filespes(文件位置)
'*****************************************************************
Private Function IsExists(byref filespec)
If (FSO.FileExists(server.MapPath(filespec))) Then
IsExists = True
Else
IsExists = False
End If
End Function

'*****************************************************************
' function(私有)
' 作用 :利用fso检测文件夹是否存在,存在返回true,不存在返回false
' 参数 :folder(文件夹位置)
'*****************************************************************
Private Function IsFolder(byref Folder)
If FSO.FolderExists(server.MapPath(Folder)) Then
IsFolder = True
Else
IsFolder = False
End If
End Function

'*****************************************************************
' function(私有)
' 作用 :利用fso创建文件夹
' 参数 :fldr(文件夹位置)
'*****************************************************************
Private Function CreateFolder(byref fldr)
Dim f
Set f = FSO.CreateFolder(Server.MapPath(fldr))
CreateFolder = f.Path
Set f=nothing
End Function

'*****************************************************************
' function(公有)
' 作用 :保存文件,并自动创建多级文件夹
' 参数 :fromurl(远程文件地址),tofiles (保存位置)
'*****************************************************************
Public Function SaveData(byref FromUrl,byref ToFiles)
ToFiles=trim(Replace(ToFiles,"//","/"))
flName=ToFiles
fldr=""
If IsExists(flName)=false then
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
End function
'*****************************************************************
' function(公有)
' 作用 :取得远程数据
' 参数 :url(远程文件地址),getmode (模式:0为二进制,1为中文编码)
'*****************************************************************
Public Function GetData(byref url,byref GetMode)
'on error resume next
SourceCode = OXML.open ("GET",url,false)
OXML.send()
if OXML.readystate<>4 then exit function
if GetMode=0 then
GetData = OXML.responseBody
else
GetData = BytesToBstr(OXML.responseBody)
end if
if err.number<>0 then err.Clear
End Function

'*****************************************************************
' function(公有)
' 作用 :格式化远程图片地址为本地位置
' 参数 :imgurl(远程图片地址),imgfolder (本地图片目录),fristname(加入的前缀名称)
'*****************************************************************
Public Function FormatImgPath(byref ImgUrl,byref ImgFolder,byref FristName,byref noimg)
strpath=""
ImgUrl=ImgUrl
if instr(ImgUrl,"Nophoto") or lenb(GetData(ImgUrl,0))<=0 then
strpath=noimg
Response.Write ""&strpath&"" &vbcrlf
else
if Instr(ImgUrl,".asp") then
strpath=FristName&"_"&Mid(ImgUrl, InStrRev(ImgUrl, "=")+1)&".jpg"
else
strpath=FristName&"_"&Mid(ImgUrl, InStrRev(ImgUrl, "/")+1)
end if
strpath = ImgFolder&"/"&strpath
strpath = Replace(strpath,"//","/")
if left(strpath,1)="/" then strpath=right(strpath,len(strpath)-1)
strpath = trim(strpath)
Response.Write ""&strpath&"" &vbcrlf
savedata ImgUrl,strpath
end if
FormatImgPath = strpath
End function