VFP编程技巧擂台赛[三] - VFP论坛

| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛 |

编程论坛 → 数据库技术 → 『 VFP论坛』 → VFP编程技巧擂台赛[三]

我的收件箱(0)

共有 5390 人关注过本帖， 1 人收藏

标题：VFP编程技巧擂台赛[三]

只看楼主加入收藏

hgfeng1984

等　级：黑侠
威　望：5
帖　子：139
专家分：513
注　册：2006-3-26

第 11 楼

得分:5

占楼编辑。
循环也挺麻烦的。下载数据库什么的最方便了。

2012-10-26 16:41

bccn201203

等　级：蜘蛛侠
威　望：3
帖　子：680
专家分：1140
注　册：2012-3-14

第 12 楼

得分:0

回复 7楼 taohua300

速度不理想，代码不是太简练。

2012-10-27 16:44

月沐庭轩

来　自：京城
等　级：贵宾
威　望：17
帖　子：393
专家分：1106
注　册：2011-7-24

第 13 楼

得分: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

月沐庭轩

来　自：京城
等　级：贵宾
威　望：17
帖　子：393
专家分：1106
注　册：2011-7-24

第 14 楼

得分: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

月沐庭轩

来　自：京城
等　级：贵宾
威　望：17
帖　子：393
专家分：1106
注　册：2011-7-24

第 15 楼

得分: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

来　自：神界
等　级：贵宾
威　望：423
帖　子：13688
专家分：53332
注　册：2012-10-18

第 16 楼

得分:0

真厉害 vfp还能解析网页以前到真没见到

DO IT YOURSELF !

2012-10-27 23:00

sdta

来　自：江苏省连云港市
等　级：版主
威　望：335
帖　子：9855
专家分：27275
注　册：2012-2-5

第 17 楼

得分: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

来　自：江苏省连云港市
等　级：版主
威　望：335
帖　子：9855
专家分：27275
注　册：2012-2-5

第 18 楼

得分:0

回复 15楼月沐庭轩

运行没反应。

坚守VFP最后的阵地

2012-10-27 23:53

月沐庭轩

来　自：京城
等　级：贵宾
威　望：17
帖　子：393
专家分：1106
注　册：2011-7-24

第 19 楼

得分:0

回复 17楼 sdta

在我电脑上运行速度，17.多秒。第二次运行，有了缓存，0.280秒。我的第二次运行，164毫秒。

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

坚持学习vfp，QQ：306805680

2012-10-28 09:12

月沐庭轩

来　自：京城
等　级：贵宾
威　望：17
帖　子：393
专家分：1106
注　册：2011-7-24

第 20 楼

得分: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编程技巧擂台赛[三]