Forums

window 540,760
WindowTitle "Hvide Sande Sluse"
usermessages 16
@Set("ErrorLevel", 2)
 $H Windows.ph
 $H ocx3a.ph
 $I ocx3a.inc
Declare x%
x% = @MessageBox("Soll dieses Programm\n\nauf Ihrem Gerät gestartet werden?\n\nDie Ausführung erfolgt\nunter Ausschluß jeglicher Ansprüche!","Hvide-Sande",4096+4+32+256)
Case x%=7 : END//Abbrechen
var font&=CreateFont("Arial",18,0,0,0,0)
SetDialogFont Font&
declare File$,Edit&,WebControl&,WebObject&,Document&,Body&,da&,fehl%,wert&,zeit$
Declare start%,neu%,Knopf%,ende%,alt$
File$="https://hyde.dk"
//per den Quelltext
Edit&=create("Multiedit",%hwnd,"",610,10,800,660)
SetFont Edit&,Font&
//Datendatei vorhanden, sonst neu

Ifnot @FileExists(($ProgDir+"HVIDE.dbf"))

    Assign #1, "hvide.STR"
    Rewrite #1
    Print #1, "Datum; C; 10; 0"
    Print #1, "Zeit; C; 10; 0"
    Print #1, "Strom; C; 10; 0"
    Print #1, "Havn; C; 10; 0"
    Print #1, "Fjord; C; 10; 0"
    Close #1
    db("Create", "hvide.STR", "hvide.DBF")

endif

//Listbox per die Datenanzeige
wert& = @Create("GridBox",  %hwnd,"Datum;0;100;Zeit;0;70;Strømning;1;110;Havn;1;80;Sluse;1;80", 2, 10,10,500,660)
//alte Werte einlesen
@db("Open", #1, "Hvide.DBF")

WhileNot %dbEoF=1

    zeit$=@Trim$(@DB("Get", "DATUM"))
    zeit$=zeit$+"|"+@Trim$(@DB("Get", "ZEIT"))
    zeit$=zeit$+"|"+@Trim$(@DB("Get", "STROM"))
    zeit$=zeit$+"|"+@Trim$(@DB("Get", "HAVN"))
    zeit$=zeit$+"|"+@Trim$(@DB("Get", "FJORD"))
    @Insertstring(wert&,0,zeit$)
    @db("Go", "NEXT")

ENDWHILE

@db("Close", #1)
//letzter Strom
alt$= @Trim$(@gettext$(wert&,0,4))//Vergleich per lukket- åben Abfrage
start%=1
WERTE//zur Prozedur Webseite laden und Werte in die erste Zeile schreiben
start%=0
neu%=0

while 1

    Waitinput 10000// nach Millisecunden wird Waitinput durchbrochen
    case %umessage=16:break
    zeit$=@dt("getTime", 0)

    SELECT val(@SUBSTR$(zeit$,2,":"))

        CASEOF 0,10,20,30,40,50

        //alle 10 Minuten Web neu laden
        Case neu%=0
        WERTE// neue auslesen ---
        neu%=1
        OTHERWISE
        neu%=0

    ENDSELECT

    Case ende%=1:BREAK

endwhile

DeleteObject font&
End
//Prozedur Werte auslesen #####################################################

Proc WERTE

    ocxInit()
    WebControl&=create("HTMLWin",%hwnd,file$,1,330,10,0,0)
    WebObject&=HTMLWin("QueryInterface",WebControl&)

    while ocxGet(WebObject&,"Busy")//'--warten, bis File geladen ist

        sleep 5

    endwhile

    Document&=ocxGet(WebObject&,"Document")
    Body&=ocxGet(Document&,"Body")
    settext Edit&,ocxGet(Body&,"outerHTML")//'--HTML-Quelltext
    //FEHLER?-------z.Z. nicht aktiv
    ' whileloop @GetCount(edit&)-1
    '  if @InStr("Die Navigation zu der Webseite wurde abgebrochen",@GetString$(edit&,&loop))> 0
    '    Knopf% = @MessageBox("Programm wird beendet","Kein WEB-Zugriff",0)
    '    Ende% = 1
    '    ocxRelease(Body&,Document&,WebObject&)
    '    WebObject&=HTMLWin("QueryInterface",WebControl&)
    '   RETURN
    ' endif
    ' endwhile
    var Startpos%=0
    Var tex$=""
    Var Strom$=""
    Var Sluse$=""
    Var Havn$=""
    Var tex1$=Date$(0)+"|"+@dt("getTime", 0)'+"|"
    //' Quelltext durchsuchen

    whileloop @GetCount(edit&)-1

        if @InStr("Gennemstrømning",@GetString$(edit&,&loop))> 0

            tex$= @GetString$(edit&,&loop)
            tex$=@Translate$(tex$,"<","")
            tex$=@Translate$(tex$,">","")
            tex$=@Translate$(tex$,"H2","")
            tex$=@Translate$(tex$,"SPAN","")
            tex$=@Translate$(tex$,"mSUP3/SUP/s//","m³")
            tex$=@Translate$(tex$,"class=floatright","")
            tex$=@Translate$(tex$,"Gennemstrømning","")
            Strom$=tex$

        endif

    EndWhile

    Tex$=""
    //' Quelltext durchsuchen

    whileloop @GetCount(edit&)-1

        if @InStr("Havnen",@GetString$(edit&,&loop))> 0

            tex$= @GetString$(edit&,&loop+1)
            tex$=@Translate$(tex$,"<TD class=alignright>","")
            tex$=@Translate$(tex$,"</TD>","")
            tex$=@Translate$(tex$,"</TR>","")
            Havn$=tex$

        endif

    endwhile

    Tex$=""
    //' Quelltext durchsuchen

    whileloop @GetCount(edit&)-1

        if @InStr("<TD>Slusedrift</TD>",@GetString$(edit&,&loop))> 0

            tex$= @GetString$(edit&,&loop+1)
            tex$=@Translate$(tex$,"<TD class=alignright>","")
            tex$=@Translate$(tex$,"</TD></TR></TBODY></TABLE>","")
            Sluse$=tex$

        endif

    EndWhile

    If start%=1

        @Insertstring(wert&,0,tex1$+"|"+strom$+"|"+havn$+"|"+sluse$)

    Else

        If @Trim$(sluse$)<>""

            If alt$<>@Trim$(sluse$)// val(strom$)<>0'

                @db("Open", #1, $ProgDir+"Hvide.DBF")
                @db("AppendBlank")
                @db("Put", "DATUM", Date$(0))
                @db("Put", "ZEIT", @dt("getTime",0))
                @db("Put", "STROM", Strom$)
                @db("Put", "HAVN", Havn$)
                @db("Put", "FJORD", sluse$)
                @db("PutRec", 0)
                @db("Close", #1)
                @Insertstring(wert&,0,tex1$+"|"+strom$+"|"+havn$+"|"+sluse$)
                alt$= @Trim$(sluse$)

            else

                '			  If val(gettext$(wert&,0,2))=0
                settext wert&,0,0, Date$(0)
                settext wert&,0,1, @dt("getTime",0)
                settext wert&,0,2, strom$
                settext wert&,0,3, havn$
                settext wert&,0,4, sluse$
                '					Else
                '					@Insertstring(wert&,0,tex1$+"|"+strom$+"|"+havn$+"|"+sluse$)
                '				endif

            EndIf

        endif

    endif

    destroywindow(WebControl&)
    ocxRelease(Body&,Document&,WebObject&)
    ocxDeInit()

endproc