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

  '*****************************************************************

  ' 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