Forums

window 540,760
Window Title "Hvide Sande Sluse"
usermessages 16
@Set("ErrorLevel", 2)
 $H windows.ph
 $H ocx3a.ph
 $I ocx3a.inc
Declare x%
x% = @MessageBox("Soll this program\n\nauf their unit launched go?\n\nDie process results\nunter exclusion jeglicher Ansprüche!","Hvide-Sande",4096+4+32+256)
Case x%=7 : END//Cancel
var font&=CreateFont("Arial",18,0,0,0,0)
SetDialogFont Font&
declare File$,Edit&,WebControl&,WebObject&,Document&,Body&,da&,fehl%,wert&,time$
Declare start%,new%,button%,end%,old$
File$="https://hyde.dk"
//for View source
Edit&=create("Multiedit",%hwnd,"",610,10,800,660)
SetFont Edit&,Font&
//Datendatei present, otherwise new

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 for 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)
//old values reading
@db("Open", #1, "Hvide.DBF")

WhileNot %dbEoF=1

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

ENDWHILE

@db("Close", #1)
//last power
alt$= @Trim $(@gettext$(wert&,0,4))//comparison for lukket- åben request
start%=1
WERTE//to procedure Website loading and values into first row write
start%=0
neu%=0

while 1

    Waitinput 10000// to Millisecunden becomes Waitinput durchbrochen
    case %umessage=16:break
    time$=@dt("getTime", 0)

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

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

        //any 10 minutes Web new loading
        Case new%=0
        WERTE// new read ---
        new%=1
        OTHERWISE
        new%=0

    ENDSELECT

    Case end%=1:BREAK

endwhile

DeleteObject font&
End
//procedure values read #####################################################

Proc WERTE

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

    while ocxGet(WebObject&,"Busy")//'--Waiting, To File loaded is

        sleep 5

    endwhile

    Document&=ocxGet(WebObject&,"Document")
    Body&=ocxGet(Document&,"Body")
    settext Edit&,ocxGet(Body&,"outerHTML")//'--HTML-View source
    //FEHLER?-------z.Z. not active
    ' whileloop @GetCount(edit&)-1
    '  if @InStr("Die piloting to the Website watts abgebrochen",@GetString$(edit&,&loop))> 0
    '    button% = @MessageBox("Programm becomes beendet","No WEB-Zugriff",0)
    '    end% = 1
    '    ocxRelease(Body&,Document&,WebObject&)
    '    WebObject&=HTMLWin("QueryInterface",WebControl&)
    '   RETURN
    ' endif
    ' endwhile
    var Startpos%=0
    Var tex$=""
    Var power$=""
    Var Sluse$=""
    Var Havn$=""
    Var tex1$=Date$(0)+"|"+@dt("getTime", 0)'+"|"
    //' View source search

    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","")
            power$=tex$

        endif

    EndWhile

    Tex$=""
    //' View source search

    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$=""
    //' View source search

    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$+"|"+power$+"|"+havn$+"|"+sluse$)

    Else

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

            If old$<>@Trim $(sluse$)// val(power$)<>0'

                @db("Open", #1, $PROGDIR+"Hvide.DBF")
                @db("AppendBlank")
                @db("Put", "DATUM", Date$(0))
                @db("Put", "ZEIT", @dt("getTime",0))
                @db("Put", "STROM", power$)
                @db("Put", "HAVN", Havn$)
                @db("Put", "FJORD", sluse$)
                @db("PutRec", 0)
                @db("Close", #1)
                @Insertstring(wert&,0,tex1$+"|"+power$+"|"+havn$+"|"+sluse$)
                old$= @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, power$
                settext wert&,0,3, havn$
                settext wert&,0,4, sluse$
                '					Else
                '					@Insertstring(wert&,0,tex1$+"|"+power$+"|"+havn$+"|"+sluse$)
                '				endif

            EndIf

        endif

    endif

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

endproc