ASP采集入庫生成本地檔案的幾個FUCTION

  ASP采集入庫生成本地檔案的幾個FUCTION 2008-04-13 15:38

ASP網站資料采集程式制作:一個采集入庫生成本地檔案的幾個FUCTION(可用來生成HTML靜态網頁) 看着一個又一個網站系統裡都帶了采集功能子產品,讓我心動,很想讓自己做的網站裡也帶個采集子產品,可惜一直都不知道如何下手,現在有了這幾個函數,你也可以制作出自己的采集程式,而且可以利用這樣的原理來生成HTML靜态網頁. 本文裡介紹采集程式的方法分成以下幾個函數來實作: 1:SaveFiles(byref from,byref tofile) 作用 ：利用流儲存檔案 ' 參數 ：from（遠端檔案位址），tofile（儲存檔案位置） 2:IsExists(byref filespec) 作用 ：利用fso檢測檔案是否存在,存在傳回true,不存在傳回false ' 參數 ：filespes（檔案位置） 3:IsFolder(byref Folder) 作用 ：利用fso檢測檔案夾是否存在,存在傳回true,不存在傳回false ' 參數 ：folder（檔案夾位置） 4:CreateFolder(byref fldr) 作用 ：利用fso建立檔案夾 ' 參數 ：fldr（檔案夾位置） 5:SaveData(byref FromUrl,byref ToFiles) 作用 ：儲存檔案，并自動建立多級檔案夾 ' 參數 ：fromurl（遠端檔案位址），tofiles （儲存位置） 6:GetData(byref url,byref GetMode) 作用 ：取得遠端資料 ' 參數 ：url（遠端檔案位址），getmode （模式:0為二進制，1為中文編碼） 7:FormatImgPath(byref ImgUrl,byref ImgFolder,byref FristName,byref noimg) 作用 ：格式化遠端圖檔位址為本地位置 ' 參數 ：imgurl（遠端圖檔位址），imgfolder （本地圖檔目錄），fristname（加入的字首名稱） 有了以上這7個函數,你就可以做一個簡單的網站資料采集程式了,下面貼出實作的詳細代碼. '***************************************************************** ' function ' 作用 ：利用流儲存檔案 ' 參數 ：from（遠端檔案位址），tofile（儲存檔案位置） '***************************************************************** Private Function SaveFiles(byref from,byref tofile) Dim Datas Datas=GetData(from,0) Response.Write "儲存成功：<font color=red>"&formatnumber(len(Datas)/1024*2,2)&"</font>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 "儲存失敗：<font color=red>檔案大小"&formatnumber(len(imgs)/1024*2,2)&"Kb，小于1K</font>"    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 "<a href="&strpath&" target="_blank" rel="external nofollow" target="_blank" rel="external nofollow" >"&strpath&"</a>" &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 "<a href="&strpath&" target="_blank" rel="external nofollow" target="_blank" rel="external nofollow" >"&strpath&"</a>" &vbcrlf    savedata ImgUrl,strpath end if FormatImgPath = strpath End function