Announcement

Collapse
No announcement yet.

HTTP-Request

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • HTTP-Request

    I have this code to show HTML-Code. Now it works. But somethimes it does not show full HTML code of a webpage. What can be the problem?

    Greetings




    '****************************************************************
    'It's pretty trivial with MSXML. Here's a crude example (I don't have
    'PBCC, so used WriteFile for STDOUT). Since this particular RSS format
    'is simple, I just used XPATH queries instead of XSLT. More comples
    'XML will be greatly simpler with the use of XSLT, though.
    'BTW, you'll need to generate "msxml4.inc" using PB's COM Browser.
    'Open Registered Library/Microsoft XML,v4.0
    'File/Select All Interfaces
    'File/Save Interface To File


    '#COMPILE EXE "race_results.exe"
    #INCLUDE "win32api.inc"
    #INCLUDE "msxml4.inc"
    #INCLUDE "countries.inc"



    DECLARE FUNCTION mciSendString LIB "WINMM.DLL" ALIAS "mciSendStringA"_
    (lpstrCommand AS ASCIIZ, lpstrReturnString AS ASCIIZ, _
    BYVAL uReturnLength AS LONG, BYVAL hwndCallback AS LONG) AS LONG

    GLOBAL laune AS LONG
    GLOBAL objXMLHTTP AS DISPATCH
    GLOBAL objXMLDoc AS DISPATCH
    GLOBAL datenNr AS BYTE
    GLOBAL ttag AS STRING
    GLOBAL mmonat AS STRING
    GLOBAL jahr AS STRING

    GLOBAL error1 AS BYTE
    GLOBAL error2 AS BYTE
    GLOBAL error3 AS BYTE

    GLOBAL objXMLHTTP AS DISPATCH
    GLOBAL objXMLDoc AS DISPATCH
    GLOBAL datenNr AS BYTE
    GLOBAL tag_ AS STRING
    GLOBAL monat_ AS STRING
    GLOBAL jahr_ AS STRING
    GLOBAL eingelesen_start AS STRING

    GLOBAL flag_1 AS LONG
    GLOBAL strURL AS STRING
    GLOBAL once AS BYTE
    GLOBAL dok AS LONG

    GLOBAL error1 AS BYTE
    GLOBAL error2 AS BYTE
    GLOBAL error3 AS BYTE
    GLOBAL datum_dummy AS STRING



    'SUB STDOUT (SOut AS STRING)
    ' STATIC hConsole AS LONG, cWritten AS LONG
    ' IF hConsole = 0 THEN AllocConsole : hConsole = GetStdHandle(%STD_OUTPUT_HANDLE)
    ' WriteFile hConsole, BYVAL STRPTR(sOut), LEN(sOut), cWritten, BYVAL 0&
    'END SUB
    FUNCTION GetResults(URL AS STRING) AS LONG
    GLOBAL dok AS LONG
    GLOBAL springen AS LONG
    LOCAL oItems AS Msxml2IXMLDOMNodeList
    LOCAL oItem AS Msxml2IXMLDOMElement
    LOCAL vItems AS VARIANT
    LOCAL vItem AS VARIANT
    LOCAL v1 AS VARIANT
    LOCAL v2 AS VARIANT
    LOCAL v3 AS VARIANT
    LOCAL v4 AS VARIANT
    LOCAL v5 AS VARIANT

    DIM readTitel AS STRING
    DIM readLink AS STRING
    DIM readDescription AS STRING


    GLOBAL dd AS STRING
    GLOBAL ddd AS STRING
    GLOBAL check AS LONG
    GLOBAL s AS LONG
    DIM ausblenden AS GLOBAL STRING
    DIM nummer(50) AS CUR
    DIM pferdNAME_(50) AS STRING
    GLOBAL datum_dummy AS STRING
    GLOBAL laune AS LONG
    DIM KZBZ_Ort AS GLOBAL STRING
    DIM KZBZ_Land AS GLOBAL STRING
    DIM Result AS STRING

    123:
    v1 = "GET"
    v2 = URL
    v3 = 0
    v4 = ""
    v5 = ""
    ' STDOUT "Connecting..." & $CRLF
    OBJECT CALL objXMLHTTP.open(v1, v2, v3, v4, v5)


    IF OBJRESULT OR ERR THEN
    OPEN "C:\Horses\Fehlerprotokoll_Startnummern_einlesen.txt" FOR OUTPUT AS #100
    LOCATE 1,1
    fehlermeldung$="Fehler bei Startnummern einlesen"' + "Connection Error " + time$ + " " + date$
    WRITE #100, fehlermeldung$, TIME$
    CLOSE #100
    STDOUT "Connection Error" & $CRLF
    fehler3&=fehler3&+1
    'SLEEP 500
    'IF fehler3& <=5 THEN GOTO 123
    fehler3&=0

    SET objXMLHTTP = NOTHING
    FUNCTION = 3
    error1=1

    EXIT FUNCTION
    END IF
    ' STDOUT "Retrieving Result..." & $CRLF


    v1 = ""
    OBJECT CALL objXMLHTTP.send(v1)
    IF OBJRESULT OR ERR THEN
    OPEN "C:\Horses\Fehlerprotokoll_Startnummern_einlesen.txt" FOR OUTPUT AS #100
    LOCATE 1,1
    fehlermeldung$="Fehler bei Startnummern einlesen"' + "Send Error " + TIME$ + " " + DATE$
    WRITE #100, fehlermeldung$, TIME$
    CLOSE #100
    LOCATE 1,1
    STDOUT "Send Error" & $CRLF
    fehler4&=fehler4&+1
    'SLEEP 500
    'IF fehler4& <=5 THEN GOTO 123
    fehler4&=0
    SET objXMLHTTP = NOTHING
    error2=1
    FUNCTION = 4

    EXIT FUNCTION
    END IF



    OBJECT GET objXMLHTTP.status TO v1
    ' STDOUT "Status:" & STR$(VARIANT#(v1)) & $CRLF
    OBJECT GET objXMLHTTP.ResponseText TO v1
    IF VARIANTVT(v1) = %VT_EMPTY THEN
    OPEN "C:\Horses\Fehlerprotokoll_Startnummern_einlesen.txt" FOR OUTPUT AS #100
    LOCATE 1,1
    fehlermeldung$="Fehler bei Startnummern einlesen"' + "Retrieve Error" + TIME$ + " " + DATE$
    WRITE #100, fehlermeldung$, TIME$
    CLOSE #100
    LOCATE 1,1
    STDOUT "Retrieve Error" & $CRLF
    'fehler5&=fehler5&+1
    'SLEEP 500
    'IF fehler5& <=5 THEN GOTO 123
    fehler5&=0
    FUNCTION = 5
    error3=1

    EXIT FUNCTION
    END IF



    '-- PB bug??? need to init Response string or it won't accept data from variant
    Result = SPACE$(LEN(VARIANT$(v1)))
    Result = VARIANT$(v1)
    ' WAITKEY$

    ' "valign="top"><b>" ???? "(GB)&nbsp;&nbsp;" )</font></b></td>
    v1=""

    y$=Result
    ' PRINT "WWWWWWWWW"
    ' waitkey$


    PRINT y$ "Shows HTML !!!
    WAITKEY$


    END FUNCTION




    '___________________________________________________________________________________________________________________________________________-
    FUNCTION PBMAIN()

    CURSOR OFF
    COLOR 0,7

    'CLS

    GLOBAL check AS LONG
    GLOBAL springen AS LONG
    GLOBAL s AS LONG
    GLOBAL TAG__ AS STRING
    GLOBAL Monat__ AS STRING
    GLOBAL dok AS LONG

    GLOBAL error1 AS BYTE
    GLOBAL error2 AS BYTE
    GLOBAL error3 AS BYTE

    GLOBAL datum_dummy AS STRING
    GLOBAL laune AS LONG
    DIM abbruch AS GLOBAL STRING
    DIM zahl(500) AS LONG


    error1=0
    error2=0
    error3=0
    datum_dummy=""

    datenNr=0
    'LOCATE 13,64
    'PRINT "Startnummern + neue Resultate anzeigen .... "
    COLOR 0,7
    'CLS
    'CLS
    'LOCATE 13,64
    'PRINT "Startinformationen einlesen: " TIME$
    LOCAL strData AS STRING
    LOCAL ret AS LONG
    LOCAL Result AS STRING
    ' DO
    SET objXMLHTTP = NEW DISPATCH IN "Msxml2.xmlhttp"
    IF ISNOTHING(objXMLHTTP) THEN
    STDOUT "Error Creating objXMLHTTP" & $CRLF
    FUNCTION = 1
    EXIT FUNCTION
    END IF
    SET objXMLDoc = NEW DISPATCH IN "Msxml2.DOMDocument"
    IF ISNOTHING(objXMLDoc) THEN
    STDOUT "Error Creating objXMLDoc" & $CRLF
    FUNCTION = 1
    EXIT FUNCTION
    END IF

    'strURL = "http://horses.sportinglife.com/Racecards/0,12495,"+FORMAT$(zahl(x&))+",00.html"
    strURL = "http://horses.sportinglife.com/Full_Results/0,12493,253616,00.html"
    ret = GetResults(strURL)

    WAITKEY$

    SET objXMLHTTP = NOTHING
    SET objXMLDoc = NOTHING

    error1=0
    error2=0
    error3=0
    datum_dummy=""
    END FUNCTION

  • #2
    Have you tried setting (higher) timeouts with SetTimeOuts?

    Comment

    Working...
    X