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) " )</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
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) " )</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
Comment