Fox4um RSS Reader

clea
clear all
set dele on
set safety off
_screen.visible=.f.
public oform1
oform1=createobject("CFORM1")
oform1.show()
oform1.windowstate=0
oform1.height=sysmetric(22)-6
oform1.visible=.t.
oform1.addobject("oGR1","cGR1")
oform1.addobject("oWEB2","cWEB2")
oform1.addobject("oTX1","cTX1")
oform1.addobject("oBT01","cBT01")
oform1.addobject("oBT02","cBT02")
oform1.addobject("oBT03","cBT03")
oform1.obt01.click()
return


***************************
define class cform1 as form
    top=0
    left=0
    width=920
    height=750
    docreate=.t.
    name="CFORM1"
    showwindow=2
    backcolor=0
    caption="Fox4um RSS Okuyucu Test"
    windowstate=1

    procedure unload
        close all
        clear dlls
        _screen.visible=.t.
        return
    endproc
enddefine


****************************
define class cgr1 as listbox
    enable=.t.
    visible=.t.
    top=5
    left=5
    width=300
    height=100
    name="CGR1"
    columncount=1
    columnlines=.f.
    highlightrowlinewidth=1
    recordmark=.f.
    allowcellselection=.f.
    gridlines=0
    readonly=.t.
    highlightstyle=1
    highlightbackcolor=rgb(40,40,255)
    fontname="verdana"
    fontsize=7
    itembackcolor=rgb(80,80,80)
    itemforecolor=rgb(255,255,255)

    procedure interactivechange
        xdsc1=chdesc(xmlcurs2.xdesc)
        oform1.otx1.value=xdsc1
    endproc
enddefine


**********************************
define class cbt01 as commandbutton
    top=80
    left=310
    width=50
    height=25
    caption="Yenile"
    visible=.t.

    procedure click
        create cursor xmlcurs2(xtitle c(40),xlink c(60),xdesc m)
        oxml=createobject("msxml2.domdocument")
        oxml.async=.f.
        oxml.load("http://feeds2.feedburner.com/fox4um")
        xmlkatoku(oxml,1)
        go top
        dele
        oform1.ogr1.rowsource=space(0)
        oform1.ogr1.rowsourcetype=2
        oform1.ogr1.rowsource="xmlcurs2"
        oform1.ogr1.listitemid=1
        oform1.ogr1.interactivechange()
        oform1.ogr1.setfocus()
    endproc
enddefine


**********************************
define class cbt02 as commandbutton
    top=80
    left=365
    width=50
    height=25
    caption="Aç"
    visible=.t.

    procedure click
        oform1.oweb2.navigate(xmlcurs2.xlink)
    endproc
enddefine


**********************************
define class cbt03 as commandbutton
    top=80
    left=420
    width=50
    height=25
    caption="IE'de Aç"
    visible=.t.

    procedure click
        ieac(xmlcurs2.xlink)
    endproc
enddefine


****************************
define class ctx1 as textbox
    top=5
    left=310
    width=345
    height=60
    backstyle=1
    borderstyle=0
    backcolor=rgb(80,80,80)
    forecolor=rgb(200,200,200)
    fontname="verdana"
    fontsize=8
    visible=.t.
    value=""
enddefine


********************************
define class cweb2 as olecontrol
    visible=.t.
    oleclass="shell.explorer.2"
    top=110
    left=5
    width=oform1.width-10
    height=oform1.height-115
    anchor=75

    procedure refresh
        nodefault
    endproc
enddefine


***********************
procedure ieac(iexaurl)
    oie=createobject("InternetExplorer.Application")
    oie.visible=.t.
    oie.left=200
    oie.width=920
    oie.height=750
    oie.toolbar=.f.
    oie.addressbar=.t.
    oie.navigate(iexaurl)
    oie.visible=.t.
    oie=null
endproc


************************
proc xmlkatoku(okat,xmc)
    for each mkat in okat.childnodes
        if mkat.nodetype<3 and mkat.childnodes.length=1
            do case
                case mkat.nodename="title"
                    append blank
                    replace xtitle with mkat.text
                case mkat.nodename="link"
                    replace xlink with mkat.text
                case mkat.nodename="description"
                    replace xdesc with mkat.text
            endcase
        endif

        if (mkat.haschildnodes)
            xmlkatoku(mkat,xmc+1)
        endif
    next
endproc


******************
func chdesc(xxlf)
    ara1="<br />"
    xpos1=atc(ara1,xxlf,1)
    xpos2=atc(ara1,xxlf,2)
    xpos3=atc(ara1,xxlf,3)
    xstr1=substr(xxlf,xpos1+7,(xpos2-xpos1)-7)
    xstr2=substr(xxlf,xpos2+6,(xpos3-xpos2)-6)
    xstr3=substr(xxlf,xpos3+6,80)
    xstr4=xstr1+chr(13)+xstr2+chr(13)+xstr3+chr(13)
    return xstr4
endfunc