| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 5390 人关注过本帖, 1 人收藏
标题:VFP编程技巧擂台赛[三]
只看楼主 加入收藏
hgfeng1984
Rank: 7Rank: 7Rank: 7
等 级:黑侠
威 望:5
帖 子:139
专家分:513
注 册:2006-3-26
收藏
得分:5 
占楼编辑。
循环也挺麻烦的。下载数据库什么的最方便了。
2012-10-26 16:41
bccn201203
Rank: 9Rank: 9Rank: 9
等 级:蜘蛛侠
威 望:3
帖 子:680
专家分:1140
注 册:2012-3-14
收藏
得分:0 
回复 7楼 taohua300
速度不理想,代码不是太简练。
2012-10-27 16:44
月沐庭轩
Rank: 9Rank: 9Rank: 9
来 自:京城
等 级:贵宾
威 望:17
帖 子:393
专家分:1106
注 册:2011-7-24
收藏
得分:0 
程序代码:
test=CREATEOBJECT("msxml2.Serverxmlhttp")
mn=FCREATE("aa.txt")
func1("http://www.stats./tjbz/cxfldm/2011/41/4101.html")
FCLOSE(mn)
FUNCTION func1(website)
LOCAL tempstr,websites,daima, mingcheng
test.OPEN("get", website,0)
test.SEND
tempstr=test.responsetext
tempstr=STREXTRACT(tempstr,[href='])
IF EMPTY(tempstr)
    func2(website)
ELSE
    DO WHILE .T.
        websites=STREXTRACT(tempstr,"","'>")
        websites=LEFT(website,RATC('/',website))+websites
        tempstr=STREXTRACT(tempstr,"'>")
        daima=STREXTRACT(tempstr,"","<")
        tempstr=STREXTRACT(tempstr,"'>")
        mingcheng=STREXTRACT(tempstr,"","<")
        tempstr=STREXTRACT(tempstr,[href='])
        FPUTS(mn,daima+SPACE(1)+mingcheng)
        FPUTS(mn,"")
        func1(websites)
        IF EMPTY(tempstr)
            EXIT
        ENDIF
    ENDDO
ENDIF
ENDFUNC
FUNCTION func2(website)
LOCAL tempstr,websites,daima, mingcheng,daima4
test.OPEN("get", website,0)
test.SEND
tempstr=test.responsetext
DO WHILE .T.
    tempstr=STREXTRACT(tempstr,[villagetr'><td>])
    IF EMPTY(tempstr)
        EXIT
    ENDIF
    daima=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,"<td>")
    daima4=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,"<td>")
    mingcheng=STREXTRACT(tempstr,"","<")
    FPUTS(mn,daima+SPACE(1)+daima4+SPACE(1)+mingcheng)
ENDDO

 FPUTS(mn,"")
ENDFUNC

func1用了递归调用。

[ 本帖最后由 月沐庭轩 于 2012-10-27 23:11 编辑 ]

坚持学习vfp,QQ:306805680
2012-10-27 21:27
月沐庭轩
Rank: 9Rank: 9Rank: 9
来 自:京城
等 级:贵宾
威 望:17
帖 子:393
专家分:1106
注 册:2011-7-24
收藏
得分:0 
*!*    程序分为一个主程序模块,三个次程序模块
*!*    主程序模块*****************************************************
test=CREATEOBJECT("msxml2.Serverxmlhttp")
mn=FCREATE("aa.txt")
xiazai("http://www.stats.)
FCLOSE(mn)
*!*    主程序模块结束**************************************************
*!*    下载HTML代码程序块*********************************************
FUNCTION xiazai(website)
LOCAL tempstr
test.OPEN("get", website,0)
test.SEND
tempstr=test.responsetext
tempstr=STREXTRACT(tempstr,[href='])
IF EMPTY(tempstr)
    func2(test.responsetext)
ELSE
    func1(tempstr,website)
ENDIF
ENDFUNC
*!*    下载HTML代码程序块结束**************************************
*!*    分析有链接的网页代码程序块即1、县区市2、街道办事处和乡镇*******************************
FUNCTION func1(tempstr,website)
LOCAL  tempstr,websites,daima, mingcheng
DO WHILE .T.
    websites=STREXTRACT(tempstr,"","'>")
    websites=LEFT(website,RATC('/',website))+websites
    tempstr=STREXTRACT(tempstr,"'>")
    daima=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,"'>")
    mingcheng=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,[href='])
    FPUTS(mn,daima+SPACE(1)+mingcheng)
    FPUTS(mn,"")
    xiazai(websites)
    IF EMPTY(tempstr)
        EXIT
    ENDIF
ENDDO
ENDFUNC
*!*    分析有链接的网页代码程序块结束*******************************
*!*    分析无链接的网页代码程序块即居委会和村*******************************
FUNCTION func2(tempstr)
LOCAL tempstr,daima, mingcheng,daima4
DO WHILE .T.
    tempstr=STREXTRACT(tempstr,[villagetr'><td>])
    IF EMPTY(tempstr)
        EXIT
    ENDIF
    daima=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,"<td>")
    daima4=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,"<td>")
    mingcheng=STREXTRACT(tempstr,"","<")
    FPUTS(mn,daima+SPACE(1)+daima4+SPACE(1)+mingcheng)
ENDDO
FPUTS(mn,"")
ENDFUNC
*!*    分析无链接的网页代码程序块结束*******************************
****在我的电脑上测试:费时:15079毫秒,回复不多,不会回复,就回复了三个,早知道可以编辑,我就只回复一个了。这是结果:
aa.rar (21.78 KB)


[ 本帖最后由 月沐庭轩 于 2012-10-27 23:11 编辑 ]

坚持学习vfp,QQ:306805680
2012-10-27 22:18
月沐庭轩
Rank: 9Rank: 9Rank: 9
来 自:京城
等 级:贵宾
威 望:17
帖 子:393
专家分:1106
注 册:2011-7-24
收藏
得分:0 
程序代码:
*!*    程序分为一个主程序模块,三个次程序模块
*!*    主程序模块*****************************************************
test=CREATEOBJECT("msxml2.Serverxmlhttp")
mn=FCREATE("aa.txt")
xiazai("http://www.stats./tjbz/cxfldm/2011/41/4101.html")
FCLOSE(mn)
*!*    主程序模块结束**************************************************
*!*    下载HTML代码程序块*********************************************
FUNCTION xiazai(website)
LOCAL tempstr
test.OPEN("get", website,0)
test.SEND
tempstr=test.responsetext
tempstr=STREXTRACT(tempstr,[href='])
IF EMPTY(tempstr)
    func2(test.responsetext)
ELSE
    func1(tempstr,website)
ENDIF
ENDFUNC
*!*    下载HTML代码程序块结束**************************************
*!*    分析有链接的网页代码程序块即1、县区市2、街道办事处和乡镇*******************************
FUNCTION func1(tempstr,website)
LOCAL  tempstr,websites,daima, mingcheng
DO WHILE .T.
    websites=STREXTRACT(tempstr,"","'>")
    websites=LEFT(website,RATC('/',website))+websites
    tempstr=STREXTRACT(tempstr,"'>")
    daima=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,"'>")
    mingcheng=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,[href='])
    FPUTS(mn,daima+SPACE(1)+mingcheng)
    FPUTS(mn,"")
    xiazai(websites)
    IF EMPTY(tempstr)
        EXIT
    ENDIF
ENDDO
ENDFUNC
*!*    分析有链接的网页代码程序块结束*******************************
*!*    分析无链接的网页代码程序块即居委会和村*******************************
FUNCTION func2(tempstr)
LOCAL tempstr,daima, mingcheng,daima4
DO WHILE .T.
    tempstr=STREXTRACT(tempstr,[villagetr'><td>])
    IF EMPTY(tempstr)
        EXIT
    ENDIF
    daima=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,"<td>")
    daima4=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,"<td>")
    mingcheng=STREXTRACT(tempstr,"","<")
    FPUTS(mn,daima+SPACE(1)+daima4+SPACE(1)+mingcheng)
ENDDO
FPUTS(mn,"")
ENDFUNC
*!*    分析无链接的网页代码程序块结束*******************************


[ 本帖最后由 月沐庭轩 于 2012-10-27 23:12 编辑 ]

坚持学习vfp,QQ:306805680
2012-10-27 22:18
wp231957
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:神界
等 级:贵宾
威 望:423
帖 子:13688
专家分:53332
注 册:2012-10-18
收藏
得分:0 
真厉害 vfp还能解析网页  以前到真没见到

DO IT YOURSELF !
2012-10-27 23:00
sdta
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:江苏省连云港市
等 级:版主
威 望:335
帖 子:9841
专家分:27213
注 册:2012-2-5
收藏
得分:0 
程序代码:
CLEAR
T1=SECONDS()
CREATE CURSOR TQHDM (层次 N(1),代码 C(12),分类 C(3),名称 C(40),网址 C(150))
LOCAL DM,MC
DM=[4101.html]
MC=[郑州市]
URL=[http://www.stats.]+DM
CC=2
INSERT INTO TQHDM VALUES (CC,LEFT(DM,4),[],MC,URL)
DO WHILE .T.
   SELECT * FROM TQHDM INTO CURSOR TEMP WHERE 层次=CC
   IF EOF()
      EXIT
   ENDIF
   SCAN FOR NOT EMPTY(网址)
      CSTR=CWY(SUBSTR(ALLTRIM(网址),RAT([/],网址)+ICASE(CC=2,1,CC=3,-2,CC=4,-5)),ICASE(CC=2,'countytr',CC=3,'towntr',CC=4,'villagetr'))
      NROW=ALINES(AA,CSTR,[</td></tr>])
      FOR I=1 TO NROW
          =ALINES(BB,AA(I),[</td><td>])
          DM=RIGHT(BB(1),12)
          FL=IIF(CC+1=5,BB(2),[])
          MC=IIF(CC+1=5,BB(3),SUBSTR(BB(2),AT([>],BB(2))+1))
          URL=IIF([.html]$AA(I),SUBSTR(ALLTRIM(网址),1,RAT([/],网址))+SUBSTR(BB(2),1,AT([>],BB(2))-1),[])
          INSERT INTO TQHDM VALUES (CC+1,DM,FL,MC,URL)
      ENDFOR
   ENDSCAN
   CC=CC+1
ENDDO
MESSAGEBOX(SECONDS()-T1)
SELECT TQHDM
BROWSE
*----------------------------------
FUNCTION CWY
PARAMETERS WY,BZ
LCURL = [http://www.stats.]+WY
OHTML = CREATEOBJECT("MICROSOFT.XMLHTTP")
OHTML.OPEN([GET], LCURL, .F.)
OHTML.SEND
CSTRA=STRTRAN(STRTRAN(STRTRAN(STRTRAN(STREXTRACT(STRCONV(OHTML.RESPONSEBODY,2),[名称</td></tr>],[</table></TD></TR>]),;
      [<tr class='&BZ'><td>],[]),[</a>],[]),[<a href=],[]),['],[])
RETURN CSTRA
请大家帮忙测试一下

坚守VFP最后的阵地
2012-10-27 23:50
sdta
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
来 自:江苏省连云港市
等 级:版主
威 望:335
帖 子:9841
专家分:27213
注 册:2012-2-5
收藏
得分:0 
回复 15楼 月沐庭轩
运行没反应。

坚守VFP最后的阵地
2012-10-27 23:53
月沐庭轩
Rank: 9Rank: 9Rank: 9
来 自:京城
等 级:贵宾
威 望:17
帖 子:393
专家分:1106
注 册:2011-7-24
收藏
得分:0 
回复 17楼 sdta
在我电脑上运行速度,17.多秒。第二次运行,有了缓存,0.280秒。我的第二次运行,164毫秒。

[ 本帖最后由 月沐庭轩 于 2012-10-28 09:20 编辑 ]

坚持学习vfp,QQ:306805680
2012-10-28 09:12
月沐庭轩
Rank: 9Rank: 9Rank: 9
来 自:京城
等 级:贵宾
威 望:17
帖 子:393
专家分:1106
注 册:2011-7-24
收藏
得分:0 
也许是msxml2.Serverxmlhttp不兼容,用上MICROSOFT.XMLHTTP吧。
程序代码:
starttime=SECONDS()*1000
test=CREATEOBJECT("MICROSOFT.XMLHTTP")
mn=FCREATE("aa.txt")
xiazai("http://www.stats./tjbz/cxfldm/2011/41/4101.html")
FCLOSE(mn)
endtime=SECONDS()*1000
TIMES=endtime-starttime
MESSAGEBOX("你所花费的时间为"+ALLTRIM(STR(TIMES,20))+"毫秒",64,"测试")
MODIFY FILE aa.txt
*!*    主程序模块结束**************************************************
*!*    下载HTML代码程序块*********************************************
FUNCTION xiazai(website)
LOCAL tempstr
test.OPEN("get", website,0)
test.SEND
tempstr=test.responsetext
tempstr=STREXTRACT(tempstr,[href='])
IF EMPTY(tempstr)
    func2(test.responsetext)
ELSE
    func1(tempstr,website)
ENDIF
ENDFUNC
*!*    下载HTML代码程序块结束**************************************
*!*    分析有链接的网页代码程序块即1、县区市2、街道办事处和乡镇*******************************
FUNCTION func1(tempstr,website)
LOCAL  tempstr,websites,daima, mingcheng
DO WHILE .T.
    websites=STREXTRACT(tempstr,"","'>")
    websites=LEFT(website,RATC('/',website))+websites
    tempstr=STREXTRACT(tempstr,"'>")
    daima=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,"'>")
    mingcheng=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,[href='])
    FPUTS(mn,daima+SPACE(1)+mingcheng)
    FPUTS(mn,"")
    xiazai(websites)
    IF EMPTY(tempstr)
        EXIT
    ENDIF
ENDDO
ENDFUNC
*!*    分析有链接的网页代码程序块结束*******************************
*!*    分析无链接的网页代码程序块即居委会和村*******************************
FUNCTION func2(tempstr)
LOCAL tempstr,daima, mingcheng,daima4
DO WHILE .T.
    tempstr=STREXTRACT(tempstr,[villagetr'><td>])
    IF EMPTY(tempstr)
        EXIT
    ENDIF
    daima=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,"<td>")
    daima4=STREXTRACT(tempstr,"","<")
    tempstr=STREXTRACT(tempstr,"<td>")
    mingcheng=STREXTRACT(tempstr,"","<")
    FPUTS(mn,daima+SPACE(1)+daima4+SPACE(1)+mingcheng)
ENDDO
FPUTS(mn,"")
ENDFUNC
*!*    分析无链接的网页代码程序块结束*******************************


[ 本帖最后由 月沐庭轩 于 2012-10-28 09:37 编辑 ]

坚持学习vfp,QQ:306805680
2012-10-28 09:18
快速回复:VFP编程技巧擂台赛[三]
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.059483 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved