Diskuze: korektne ukoncenie HTA aplikacie s progresbarom (kombinacia s vbscriptom)

TomasT

Člen

TomasT:24.8.2018 22:40

Ahojte,

mam hlavny formular, ktory po spusteni vytvori timer s progresbarom (window.SetInterval) - zobrazuje proces zistovania statusu online/offline zoznamu pocitacov nacitaneho z txt suboru.

Okno ma aj gombik exit, ktory ked stlacim, mal by vsetko korektne ukoncit - zavriet formular a vsetko ukoncit, lenze mi to stale niekde spadne (vo funkcii, kde zistujem samotny stav).
Je mi uplne jasne, ze okno sice zavrie, clearInterval zrusi timer ale napr. samotna funkcia na zistovanie statusu PC este dobieha.

Moje otazky by boli:

1. ako korektne vsetko ukoncit - clearInterval nestaci ani self.close(), zase nechcem davat do kazdeho jedneho riadka danej funkcie podmienku, ze ked uz timer neexistuje, tak to uz nerob a exit function

2. ktory event formulara nastane, ked okno zavriem krizikom na formulary ?

Chci docílit: Ide mi o korektne kompletne ukoncenie mojej aplikacie, ked user klikne na gombik exit alebo zavrie aplikaciu krizikom, aby to nezahucalo - robim self.close a clearinterval, ale nestaci ...

Odpovědět

24.8.2018 22:40

Jirka Jr

Člen

Jirka Jr:25.8.2018 13:17

Strejda Google nabízí toto

U HTA moc korektnich postupů neočekávát, zklamání je pak veliké :-P

Nahoru Odpovědět

25.8.2018 13:17

TomasT

Člen

TomasT:25.8.2018 17:02

dakujem, uz som to poznal :-)

no, to sa potom da kludne napisat o celom MS, ked zachadzame do detaillov :-(

Nahoru Odpovědět

25.8.2018 17:02

Jirka Jr

Člen

Jirka Jr:27.8.2018 13:20

ted koukam, ze moje odpoved byla rychlejsi nez muj textovy scanner a analyzator ....

toz sorry za link na vynalez kola :-)

odpovedi na tve otazky:

1. nedaval bych tu podminku do kazdeho radku, ale treba na konec cyklu, ve kterem zpracovavas jednotlive kompy z toho souboru...
a samozrejme pred exit function bych pomoci promenna = Nothing uvolnil vsechny promenne, ktere drzi nejake objekty - obzvlaste activex objekty, kterezto lezi mimo proces te hta aplikace

2. onunload event objektu window .... vice treba tady: https://stackoverflow.com/…ing-vbscript

kdyby se stale nedarilo, pastni sem ten hta a muzeme nad tim dumat dva

Nahoru Odpovědět

27.8.2018 13:20

TomasT

Člen

TomasT:30.8.2018 21:23

dakujem, este 1 otazka:

ked to zavriem gombikom na formulari, ktory zavola self.close(), tak to spravi ako ma bez problemov (spusti onbeforeunload kde spravi co treba, zavrie formular, spusti onunload a pekne skonci)
ked to ale zavriem krizikom v title bare, tak opticky vsetko spravi ako ma (spusti onbeforeunload, kde spravi co treba, zavrie formular ale onunload uz nepusti a zostane tam visiet)

co sa spravi v 1. a 2. pripade inak ?? ked uz tam ale hockde dam self.close(), tak to neprejde

Nahoru Odpovědět

30.8.2018 21:23

Jirka Jr

Člen

Jirka Jr:2.9.2018 11:43

maly test:

<html>
    <head>
    <title>Window Closing Game</title>
    <hta:application
      applicationname="window closing game"
      id="wcgame"
      version="1.0"/>


        <script language="VBScript">

            Sub  Window_onUnload

                Dim objFS, objFile

                Set objFS = CreateObject("Scripting.FileSystemObject")
                Set objFile = objFS.CreateTextFile("D:\onunload.txt")

                objFile.WriteLine("onunload")
                objFile.Close

                Set objFile = Nothing
                Set objFS = Nothing

                MsgBox "onUnload: " & document.title

            end sub

            Sub  Window_onBeforeUnload

                Dim objFS, objFile

                Set objFS = CreateObject("Scripting.FileSystemObject")
                Set objFile = objFS.CreateTextFile("D:\onbeforeunload.txt")

                objFile.WriteLine("onbeforeunload")
                objFile.Close

                Set objFile = Nothing
                Set objFS = Nothing

                MsgBox "onBeforeUnload: " & document.title

            end sub

        </script>
    </head>

    <body bgcolor="white">

    </body>

</html>

tento kod mi funguje, jak ma .... tedy po kliknuti na zaviratko v titulku se vytvori oba soubory na D:\ a vyskoci jedna zprava pred zavrenim okna a druha po zavreni okna

tedy vidim zakopaneho psa nekde v necem v tvem kodu .... a pokud za to tvuj kod nemuze, tak bez tveho kodu tezko odhalit

jeste hypoteticky me napadlo, jestli nemuze byt problem ve verzi windows (ja si hraju na windows 10)

ale pokud ti bude fungovat muj kod (nezapomen zmenit cestu u tech vytvarenych souboru), tak potom sem kopni svuj zdrojak, at muzem zkusit najit problem

Nahoru Odpovědět

2.9.2018 11:43

TomasT

Člen

TomasT:2.9.2018 20:07

ano, funguje, mam takyto priklad, ktory tiez funguje presne ako ma - popisal som vyssie, cely zdrojak dam do dalsieho prispevku aj s komentarom,

zatial dakujem pekne

<html>
<head>
<title>My HTML application</title>
<HTA:APPLICATION
APPLICATIONNAME="My HTML application"
ID="MyHTMLapplication"
VERSION="1.0"/>
</head>

Sub Window_OnLoad
'This method will be called when the application loads
'Add your code here
End Sub

Sub Window_onbeforeunload
MsgBox "onbeforeunload"
End Sub

Sub Window_onkeydown
'MsgBox "onkeydown"
If Window.Event.KeyCode = 116 Then
window.event.KeyCode = 0
window.event.returnValue = 0
End If
End sub

Sub Window_onkeypress
'MsgBox "onkeypress"
If Window.Event.KeyCode = 116 Then
window.event.KeyCode = 0
window.event.returnValue = 0
return False
End if

If Window.Event.KeyCode = 13 Then
MsgBox "ENTER"
Else
MsgBox "INeee"
End If
End Sub

Sub Window_onunload
MsgBox "onunload"
End Sub

</script>

</body>
</html>

Nahoru Odpovědět

2.9.2018 20:07

TomasT

Člen

TomasT:2.9.2018 21:28

no tak uz neviem velmi co s tym, million testov, vstup je txt vo forme (co riadok to meno pocitaca)

pc1
pc2
pc3

pointa je, ze ked to zavries gombikom exit, vsetko skonci ako ma,
ked to ale zavries krizikom (alt+F4), tak to opticky skonci, ale stale to pokracuje (pouzivam htaedit/vbsedit od Adersoftu) kde to proste vidim, ze bezi dalej, proste sa vobec nedostane do "onunload" procedury v tomto pripade

tu je zdrojak - len som ho nevedel dat tak pekne ako Ty:

tak dakujem ( mozno tam budu nejake komenty, ale sak debaguj podla seba

<HTML>
<HEAD>
<TITLE>Open file, display progress</title>
<HTA:APPLICATION
APPLICATIONNAME="test"
CAPTION="yes"
ID="TENTO"
MAXIMIZEBUTTON="no"
SCROLL="no"
VERSION="1.0"/>
</head>

Public nazovOkna, pole(), pocet, hotove, IDcasovaca
Const nazov = "Otvor vstup..."
Const sFilter = "txt files (.txt)|.txt"
Const sirka = 80
kde = Replace(TENTO.commandLine, Chr(34), "")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")

'*******************
Function id(kt)
Set id = document.getElementById(kt)
End Function

'*********************
Sub Window_onLoad
nazovOkna = " " & document.title
width = 705
height = 405
Self.resizeTo width, height
Self.MoveTo (Screen.Width - width) / 2, (Screen.Height - height) / 2
startPauseContinue
End Sub

'**************
Sub cancel
BtnCancel.disabled = True
BtnStartPauseContinue.value = "Start !"
window.clearInterval(IDcasovaca)
IDcasovaca = Null
End Sub

'*****************************
Sub window_onBeforeUnload
'MsgBox "onBeforeUnload" & "ID: " & IDcasovaca
'If IsEmpty(IDcasovaca) Then MsgBox "Casovac NEexistuje"
If IDcasovaca > "" Then
'MsgBox "rusim casovac"
window.clearInterval(IDcasovaca)
IDcasovaca = Null
End If
'If IsNull(IDcasovaca) Then MsgBox "prazdny"
End Sub

'***********************
Sub window_onUnload
'MsgBox "onUnload"
Set objShell = Nothing
Set objFSO = Nothing
End Sub

'**************************
Sub startPauseContinue
Select Case BtnStartPauseContinue.value
Case "Start !"
subor = Dlg.OpenFileDlg(CStr(kde), , CStr(sFilter), CStr(nazov))
If subor = "" Then
MsgBox "Subor nevybrany !!!", vbCritical
Else
Set vstup = objFSO.OpenTextFile(subor, 1)
pocet = 0
Do Until vstup.AtEndOfStream
strPC = UCase(Trim(vstup.Readline))
If strPC <> "" Then
ReDim Preserve pole(pocet)
pole(pocet) = strPC
pocet = pocet + 1
End If
Loop
id("progresZvysne").innerText = String(sirka * 1.5, " ")
'id("progresZvysne").innerText = String(sirka, "_") & "|"
BtnStartPauseContinue.value = "Pause.."
BtnCancel.disabled = False
hotove = 0
progres(1)
Do
jeON(pole(hotove))
hotove = hotove + 1
Loop Until (hotove = pocet) Or IsNull(IDcasovaca)
If IsNull(IDcasovaca) Then
'MsgBox "Casovac NEexistuje"
End If
If(hotove = pocet) Then progres(0)
End If
Case "Pause.."
BtnStartPauseContinue.value = "Continue.."
Case "Continue"
BtnStartPauseContinue.value = "Pause.."
End Select
End Sub

'*******************
Sub progres(co)
If Not StrComp(BtnStartPauseContinue.value, "Pause..") Then
Select Case co
Case 0
window.clearInterval(IDcasovaca)
IDcasovaca = ""
progres(2)
MsgBox "Koniec..", vbInformation, nazovOkna
BtnStartPauseContinue.value = "Start !"
Case 1
IDcasovaca = window.setInterval("progres(2)", 1000)
progres(2)
Case 2
document.title = FormatPercent(hotove / pocet, 0) & nazovOkna
id("progresText").innerText = hotove & "/" & pocet
pom = Round(hotove / (pocet / sirka), 0)
id("progresHotove").innerText = String(pom, " ")
If pom < sirka Then
id("progresZvysne").innerText = String((sirka - pom) * 1.5, " ")
'id("progresZvysne").innerText = String(sirka - pom, "_") & "|"
Else
id("progresZvysne").innerText = ""
'id("progresZvysne").innerText = "|"
End If
End Select
End If
End Sub

'*********************
Function jeON(pc)
On Error Resume Next
Dim tf, objPingFile, strAll

tf = objFSO.GetTempname
objShell.Run "%comspec% /c ping.exe -n 2 " & pc & " > " & tf, 0, True

Set objPingFile = objFSO.OpenTextFile(tf)
strAll = objPingFile.ReadAll
objPingFile.Close
objFSO.DeleteFile tf

If InStr(strAll, "Pinging ") Then
IPadr = Mid(strAll, InStr(strAll,"[") + 1, InStr(strAll,"]") - InStr(strAll,"[") - 1)
tf = objFSO.GetTempName
objShell.Run "%comspec% /c ping.exe -a -n 1 " & IPadr & " > " & tf, 0, True
Set objPingFile = objFSO.OpenTextFile(tf)
strAll = UCase(objPingFile.ReadAll)
objPingFile.Close
objFSO.DeleteFile tf
If InStr(strAll, pc) Then
jeON = 1
Else
jeON = 2
revIP = ""
For i = 1 To 3
revIP = revIP & Right(IPadr, Len(IPadr) - InStrRev(IPadr, ".")) & "."
IPadr = Left(IPadr, InStrRev(IPadr, ".") - 1)
Next
End If
Else
If InStr(strAll, "could not find") Then jeON = 3
End If
Set objPingFile = Nothing
End Function

</script>

<BR>

Done: <SPAN id="progresText">?</span><BR><BR>
<SPAN id="progresHotove" style="background-color:blue"></span> 
<SPAN id="progresZvysne" style="background-color:yellow"></span>

<INPUT id="BtnStartPauseContinue" type="button" value="Start !" onclick="startPauseContinue">&nbsp&nbsp&nbsp
<INPUT id="BtnCancel" type="button" value="Cancel" onclick="cancel" disabled="True">&nbsp&nbsp&nbsp
<INPUT id="BtnExit" type="button" value="Exit" onclick="Self.close()">

</body>
</html>

Nahoru Odpovědět

2.9.2018 21:28

Jirka Jr

Člen

Jirka Jr:3.9.2018 10:49

Muzes to prosimte vlozit pomoci tlacidla pro vkladani kodu?

Takhle se tam zkopirovaly neviditelny paznaky, nemuze to najit funkci uz pri kliknuti na "Start !" a neni tudiz na takovy kod spolehnuti

Nahoru Odpovědět

3.9.2018 10:49

Jirka Jr

Člen

Jirka Jr:3.9.2018 12:11

Sorry, nechal sem se unyst prvnim pohledem na vlozenou smesici znaku ;-)

formatovani kodu zajistis tlacitkem '</>'

to kodovani by to nakonec stejne nevyresilo ... to spis vypada, ze ten htaedit/vbsedit to ma v nejakem jednobytovem kodovani a pak se to bud zprasi pri vlozeni sem na itnetwork a nebo to ma itnetwork nejak osefovane a zprasi se to az u me ve visual studio code ... tezko rict

ale uz ty paznaky a kodovani dostavam pomalu pod kontrolu

Nahoru Odpovědět

3.9.2018 12:11

Jirka Jr

Člen

Jirka Jr:3.9.2018 13:58

tak nemam zatim vyreseno, ale dostal jsem se alespon k dobremu debuggeru a ke zjisteni stejneho problemu s pokracovanim kodu na pozadi, o kterem pises

vbsedit jsem poslal na odpocinek jelikoz furt otravuje se zaplacenim a neumi se mi zastavit na breakpointech

podle navodu tady jsem na debugovani pouzil Visual Studio (ano neni to preklep :-) )

staci do kodu hodit

Stop

, spustit soubor hta a pockat na vyzvu ke zvoleni jednoho z nainstalovanych debuggeru ... v mem pripade Visual Studio 2017 Community Edition

A sup, po nejakem chroustani se objevi debugger, ktery zvlada v mshta a vbscriptu aj breakpointy :-)

Tohle zjistit pred par lety v praci ..... :-)

Nahoru Odpovědět

3.9.2018 13:58

TomasT

Člen

TomasT:3.9.2018 14:37

dakujem zatial pekne,
podla mna to mam logicky dobre, co je evidentne, ze to korektne funguje s tym gombikom na ukoncenie
otazne ale je, co ten trulo robi INAK pri zavreti krizikom (Alt+F4), proste on sa uz z toho onbeforeunloadu vobec nedostane do onunloadu ...

netrpezlivo cakam na nejaky zaver, lebo jaco som uz porobil kombinacii a testov a breakpontov a msgboxov to je na X hodin ...

Nahoru Odpovědět

3.9.2018 14:37

Jirka Jr

Člen

Jirka Jr:3.9.2018 16:36

tak snad by tu uz neco bylo, viz popis pod kodem

<HTML>
    <HEAD>
        <TITLE>Open file, display progress</title>
        <HTA:APPLICATION
            APPLICATIONNAME="test"
            CAPTION="yes"
            ID="TENTO"
            MAXIMIZEBUTTON="no"
            SCROLL="no"
            VERSION="1.0"/>
        <SCRIPT language="VBScript">

            Stop

            Public nazovOkna, pole(), pocet, hotove, IDcasovaca
            Const nazov = "Otvor vstup..."
            Const sFilter = "txt files (.txt)|.txt"
            Const sirka = 80


            kde = Replace(TENTO.commandLine, Chr(34), "")

            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set objShell = CreateObject("Wscript.Shell")

            '*******************
            Function id(kt)
                Set id = document.getElementById(kt)
            End Function

            '*********************
            Sub Window_onLoad
                nazovOkna = " " & document.title
                width = 705
                height = 405
                Self.resizeTo width, height
                Self.MoveTo (Screen.Width - width) / 2, (Screen.Height - height) / 2
                startPauseContinue
            End Sub

            '**************
            Sub cancel
                BtnCancel.disabled = True
                BtnStartPauseContinue.value = "Start !"
                window.clearInterval(IDcasovaca)
                IDcasovaca = Null
            End Sub

            '*****************************
            Sub window_onBeforeUnload
                'MsgBox "onBeforeUnload" & "ID: " & IDcasovaca
                'If IsEmpty(IDcasovaca) Then MsgBox "Casovac NEexistuje"
                If IDcasovaca > "" Then
                    'MsgBox "rusim casovac"
                    window.clearInterval(IDcasovaca)
                    IDcasovaca = Null
                End If
                'If IsNull(IDcasovaca) Then MsgBox "prazdny"
                If hotove > 0 Then
                    Set objShell = Nothing
                    Set objFSO = Nothing
                    closeHTA 0
                End If
            End Sub

            '***********************
            Sub window_onUnload
                'MsgBox "onUnload"

            End Sub

            '**************************
            Sub startPauseContinue
                Select Case BtnStartPauseContinue.value
                    Case "Start !"
                        subor = Dlg.OpenFileDlg(CStr(kde), , CStr(sFilter), CStr(nazov))

                        If subor = "" Then
                            MsgBox "Subor nevybrany !!!", vbCritical
                        Else
                            Set vstup = objFSO.OpenTextFile(subor, 1)
                            pocet = 0
                            Do Until vstup.AtEndOfStream
                                strPC = UCase(Trim(vstup.Readline))
                                If strPC <> "" Then
                                    ReDim Preserve pole(pocet)
                                    pole(pocet) = strPC
                                    pocet = pocet + 1
                                End If
                            Loop
                            vstup.Close
                            Set vstup = Nothing

                            id("progresZvysne").innerText = String(sirka * 1.5, " ")
                            'id("progresZvysne").innerText = String(sirka, "_") & "|"
                            BtnStartPauseContinue.value = "Pause.."
                            BtnCancel.disabled = False
                            hotove = 0
                            progres(1)
                            Do
                                jeON(pole(hotove))
                                hotove = hotove + 1
                            Loop Until (hotove = pocet) Or IsNull(IDcasovaca)
                            If IsNull(IDcasovaca) Then
                                'MsgBox "Casovac NEexistuje"
                            End If
                            If(hotove = pocet) Then progres(0)
                            hotove = 0
                        End If
                    Case "Pause.."
                        BtnStartPauseContinue.value = "Continue.."
                    Case "Continue"
                        BtnStartPauseContinue.value = "Pause.."
                End Select
            End Sub

            '*******************
            Sub progres(co)
                If Not StrComp(BtnStartPauseContinue.value, "Pause..") Then
                    Select Case co
                        Case 0
                        window.clearInterval(IDcasovaca)
                        IDcasovaca = ""
                        progres(2)
                        MsgBox "Koniec..", vbInformation, nazovOkna
                        BtnStartPauseContinue.value = "Start !"
                        Case 1
                        IDcasovaca = window.setInterval("progres(2)", 1000)
                        progres(2)
                        Case 2
                        document.title = FormatPercent(hotove / pocet, 0) & nazovOkna
                        id("progresText").innerText = hotove & "/" & pocet
                        pom = Round(hotove / (pocet / sirka), 0)
                        id("progresHotove").innerText = String(pom, " ")
                        If pom < sirka Then
                            id("progresZvysne").innerText = String((sirka - pom) * 1.5, " ")
                            'id("progresZvysne").innerText = String(sirka - pom, "_") & "|"
                        Else
                            id("progresZvysne").innerText = ""
                            'id("progresZvysne").innerText = "|"
                        End If
                    End Select
                End If
            End Sub

            '*********************
            Function jeON(pc)
                On Error Resume Next
                Dim tf, objPingFile, strAll

                tf = objFSO.GetTempname
                objShell.Run "%comspec% /c ping.exe -n 2 " & pc & " > " & tf, 0, True

                Set objPingFile = objFSO.OpenTextFile(tf)
                strAll = objPingFile.ReadAll
                objPingFile.Close
                objPingFile = Nothing
                objFSO.DeleteFile tf

                If InStr(strAll, "Pinging ") Then
                    IPadr = Mid(strAll, InStr(strAll,"[") + 1, InStr(strAll,"]") - InStr(strAll,"[") - 1)
                    tf = objFSO.GetTempName
                    objShell.Run "c:\Windows\System32\ping.exe -a -n 1 " & IPadr & " > " & tf, 0, True
                    Set objPingFile = objFSO.OpenTextFile(tf)
                    strAll = UCase(objPingFile.ReadAll)
                    objPingFile.Close
                    Set objPingFile = Nothing
                    objFSO.DeleteFile tf
                    If InStr(strAll, pc) Then
                        jeON = 1
                    Else
                        jeON = 2
                        revIP = ""
                        For i = 1 To 3
                            revIP = revIP & Right(IPadr, Len(IPadr) - InStrRev(IPadr, ".")) & "."
                            IPadr = Left(IPadr, InStrRev(IPadr, ".") - 1)
                        Next
                    End If
                Else
                    If InStr(strAll, "could not find") Then jeON = 3
                End If
                'Set objPingFile = Nothing
            End Function

        </SCRIPT>

        <SCRIPT language="Javascript">
            function closeWithErrorlevel(errorlevel){
                var colProcesses = GetObject('winmgmts:{impersonationLevel=impersonate}!\\\\.\\root\\cimv2').ExecQuery('Select * from Win32_Process Where Name = \'mshta.exe\'');
                var myPath = (''+location.pathname).toLowerCase();
                var enumProcesses = new Enumerator(colProcesses);
                for ( var process = null ; !enumProcesses.atEnd() ; enumProcesses.moveNext() ) {
                    process = enumProcesses.item();
                    if ( (''+process.CommandLine).toLowerCase().indexOf(myPath) > 0 ){
                        process.Terminate(errorlevel);
                    }
                }
            }

            function closeHTA(value){
                // test close of window. Use default value
                if (typeof value === 'undefined') value = 0;
                try { closeWithErrorlevel(value) } catch (e) {};
            }

        </SCRIPT>

    </head>
    <BODY bgcolor="white">

        <OBJECT id=Dlg classid="CLSID:3050F4E1-98B5-11CF-BB82-00AA00BDCE0B" width=0 height=0></object>

        <!--{{InsertControlsHere}}-Do Not remove this line-->


        <!-- Progress bar -->
        Done: <SPAN id="progresText">?</span>


        <SPAN id="progresHotove" style="background-color:blue"></span> <!-- hotova cast -->
        <SPAN id="progresZvysne" style="background-color:yellow"></span> <!-- chybajuca cast -->
        <!-- Progress bar (End) -->




        <!--- gombiky -->
        <INPUT id="BtnStartPauseContinue" type="button" value="Start !" onclick="startPauseContinue">&nbsp&nbsp&nbsp
        <INPUT id="BtnCancel" type="button" value="Cancel" onclick="cancel" disabled="True">&nbsp&nbsp&nbsp
        <INPUT id="BtnExit" type="button" value="Exit" onclick="Self.close()">

    </body>

</html>

tohle mi pomohlo

v podtstate to spusti dummy proces, podle jeho id ziska objekt parent procesu (mshta.exe) a ten pak ukonci

a ukoncuju to v onbeforeunload, pokud je hotove > 0 (tj. pokud se zrovna pingaji servery)

nejsem si 100% jisty, jestli to uvolni vsechny handly na activex objekty (kterezto z podstaty bezi v jinych procesech), ale kazdopadne zmizi mshta proces a debugger skonci

Nahoru Odpovědět

3.9.2018 16:36

Jirka Jr

Člen

Jirka Jr:3.9.2018 17:09

kdyby ti to jeste blblo, tak zakomentuj tu podminku na hotove > 0

Sub window_onBeforeUnload
    'MsgBox "onBeforeUnload" & "ID: " & IDcasovaca
    'If IsEmpty(IDcasovaca) Then MsgBox "Casovac NEexistuje"
    If IDcasovaca > "" Then
        'MsgBox "rusim casovac"
        window.clearInterval(IDcasovaca)
        IDcasovaca = Null
    End If
    'If IsNull(IDcasovaca) Then MsgBox "prazdny"
    'If hotove > 0 Then
        Set objShell = Nothing
        Set objFSO = Nothing
        closeHTA 0
    'End If
End Sub

Nahoru Odpovědět

3.9.2018 17:09

Jirka Jr

Člen

Jirka Jr:3.9.2018 17:15

mam nejake napady co zkusit, aby se to chovalo, jak ma i bez terminace procesu, ale ted se jdu nazrat a budu zkouset az zase nekdy pozdejc ;-)

Nahoru Odpovědět

3.9.2018 17:15

TomasT

Člen

TomasT:4.9.2018 8:59

dakujem idem to skusit, v inom cisto vbs to dokonca aj pouzivam, len je to take "nesystemove" daco proste zakilovat

mne proste nejde do hlavy, precoto raz skonci a preco nie, nepodarilo sa Ti to vydebagovat, kde to vykape, ked to neskonci ??

len si to prehodim do vbskriptu, s Javou som robil pradaaavno ...

Nahoru Odpovědět

4.9.2018 8:59

Jirka Jr

Člen

Jirka Jr:4.9.2018 10:16

je to z pohledu programátora prasárna ... nicméně z pohledu uvolnění prostředků sedících mimo proces mshta by to mělo být v pohodě ... co jsem koukal v process exploreru, tak ie (mshtml.dll), vbscript engine apod. ma mshta nahrany inproc a tudiz by nemel vyuzivat outproc activex objekty z nejakeho dllhostu apod.

tedy obsah je v poradku, ale forma ceka na doladeni ....

zatim mi to dokrokuje az na konec startPauseContinue a pak se to zasekne stejne jako tobe

drz mi palce, abych u toho ladeni vydrzel :-)

Akceptované řešení
+20 Zkušeností
+2,50 Kč

Nahoru Odpovědět

4.9.2018 10:16

Jirka Jr

Člen

Jirka Jr:4.9.2018 13:15

tak to vypada, podle tohoto dohadovani se v diskuzi , ze by to melo jit tak, ze

1. misto smycky Do Loop ve startPauseContinue pouzijes neco jako

Sub startPauseContinue
    if hotove < pocet then
                pingni
                updatuj progressbar a titulek
                hotove = hotove + 1
                window.setTimeout "startPauseContinue", 10
        end if
End Sub

2. a misto spousteni pingu pak muzes pouzit aj wmi objekt Win32_PingStatus

proste uplne prekopat na retezec rekurzivni volani jedne krokove funkce

a diky setTimeout to neni klasicka rekurze, ale asynchronni spousteni, ktere

umozni v kazdem kroku projevit zmeny ve strance do okna prohlizece
by melo obejit problem se zakousnutim procesu na pozadi

tak to kdyztak zkus a ja to mozna zkusim taky, jestli a az se mi do toho bude chtit ;-)

kazdopadne je to Kolumbova cesta do Indie, nezarucuju, ze to zabere, ale vypada to nadejne

Nahoru Odpovědět

4.9.2018 13:15

TomasT

Člen

TomasT:6.9.2018 14:21

prepac, az teraz som sa k tomu dostal, tu su zavery:

Win32_PingStatus som skusal a testoval, len ten mi nikdy nezisti, ze pc ma zly DNS zaznam (ping -a), co je u nas velmi casty jav, cize testovat to musim, a okrem toho je to moje rokmi tunovane a skalovatelne ako chcem a zistim co potrebujem
ta diskusia v komente nad mojim je presne to co mam ja, ale uplne, dokonca ja pouzivam aj run s waitom
spravil som Terminate procesu (mshta.exe s mojim hta) a to funguje spolahlivo, len este idem zistit, ci sa to run neda dacim nahradit, lebo ako programatorovi sa mi to velmi nepaci (to som uz ale perfekcionista zase..), proste pustit ping nejako inako ...

dakujem pekne

Nahoru Odpovědět

6.9.2018 14:21

Jirka Jr

Člen

Jirka Jr:9.9.2018 13:03

Zdravim, akceptovane reseni zahralo u srdce a nakoplo ego ;-)

a ted k bodum vyse:

1. je fakt, ze tohle funguje az v Powershellu s pomoci [System.Net.DNS], co jsem se rozhlizel po netu

ALE!!! :-)

nasel jsem a lehce upravil toto :

Dim strIPAddress, strHostname
strIPAddress = WScript.Arguments(0)

On Error Resume Next
Set  objIPNetwork = CreateObject( "SScripting.IPNetwork" )
strHostname = objIPNetwork.DNSLookup( strIPAddress )
WScript.Echo "Hostname of (" & strIPAddress & "): " & strHostname
Set objIPNetwork = Nothing

jen k tomu potrebujes nainstalovat na kompu, kde bezi hta, tento activex component .

je to freeware, ale bacha, ac mi to v pohode fachci na Win 10 Pro, tak oficialne podporovano jen na xp/2003

sice pisou, ze na dotazy na news kanale odpovidaji, ale v dokumentaci je copyright do 2007, takze tezko rict, jak moc to myslej vazne :-)

pak je tu jeste tento komponent
nejak by to s tim melo jit a melo by to byt stale supportovane .... ale placene :-(

takze bud dal provozuj ping pres commandline run, nebo pouzij vyse zminene na vlastni riziko, ze to muze do budoucna prestat fachat, pripadne zainvestuj do toho placeneho ....

a nebo zatni zuby, otevri svou dusi novym dovednostem a prejdi na powershell ;-)

2. V te diskusi je to jen jemne naznačeno. Ale v podstate jde o to, ze mas pres casovac nastavený jen kreslení progressu a to přes interval (SetInterval()) a pingani ti jede v dlouhé smyčce, coz, jak tam naznačují, může nějakým zpusobem rozmrvit příjem zprávy wm_close z okna do procesu

To řešení, které tam naznačují je presunout kreslení progressu i pingani do jedné funkce, ktera se spustí pomocí zpozdeneho spuštění a ne pomocí intervalu (tedy setTimeout)

Ta funkce vždycky pingne a zároveň vykresli kousek a přes krátký setTimeout zavolá sama sebe pro další kousek... Az uz není co pingat, tak sama sebe jednoduše nezavola

Tim zůstane okno nezaseknute podobne jako pri kresleni v setInterval, ktere používáš teď a zároveň by to melo obejít problem s tim visicim procesem bez okna zpusobenym tou dlouhou smyčkou

Jak uz jsem psal, nemám to vyzkoušené, ze to na ten zavírací problém zabere, ale uvidim, jestli se k tomu někdy dokopu :-)

3.
vyplyva z 1.

ZAVER: osobne bych se powershellu nebranil ... da se udelat pomoci WPF nebo Winforms krasne rozhrani, provazane s powershell obsluhou udalosti a sitove moznosti .NETu skrz powershell jsou tez nesmirne :-)
a zde resene problemy tam fakt nehrozi

Nahoru Odpovědět

9.9.2018 13:03

TomasT

Člen

TomasT:10.9.2018 16:10

pojdem asi do bodu 2, je to celkom logicke, len musim pozriet SetTimeout najprv

PS zatial uspesne odkladam, lebo nebol dovod - zatial som si vzdy vystacil s WSH + HTA
nebranim sa mu ani ja, ale pokial to nie je totalne nutne, mam ine priority na volny cas :-)

Nahoru Odpovědět

10.9.2018 16:10

TomasT

Člen

TomasT:13.9.2018 10:35

este ma napadla dalsia vec k tomu setTimeout a sice naco ho tam vobec davat a nie rovno spustit seba sa znova (pokial je teda co pingat) ? sak ten ping ho dostatocne zdrzi, to sa nemusim bat ze to rychlo prejde, ci nieco mi uniklo ?

dik

Nahoru Odpovědět

13.9.2018 10:35

Jirka Jr

Člen

Jirka Jr:13.9.2018 11:23

muzes to zkusit s timeout aj bez timeout a uvidis ten rozdil

ja tomu moc do hloubky nerozumim, ale ten setTimeout zpusobi asynchronni (v jinem threadu) exekuci a to by snad mohlo pomoct i s tim problemem se zaviranim okna, jak to psali nekde v te diskusi

ale kazdopadne vykreslovani progressbaru musi byt bud v tom setInterval handleru (tak jak to mas ted) a nebo pres zvlastni setTimeout pro kazdy krok ....

pokud to nechas jen takto

smycka
   ping
   vykresli progressbar
dokud neni posledni komp

nebo rekurzivne

funkce pingni_komp(hotovo)
  ping kompy[hotovo]
  vykresli progressbar
  pingni_komp hotovo+1
konec funkce

tak se vysledek kresleni promitne do okna az po ukonceni top level funkce ... tedy bud funkce, ve ktere je smycka, nebo funkce, ze ktere byla poprve zavolana pingni_komp()

tj. podtrzeno a secteno ....

kresleni progressbaru musi byt asynchronni vuci hlavnimu threadu

a to bud samostatne, jak to mas ted
a nebo spolecne s pingem, ale pres setTimeout, aby se progressbar updatoval okamzite

a co se tyce toho ukonceni mshta.exe po zavreni okna, tak tady by dost pravdepodobne ta asynchronni exekuce pingu misto smycky mela pomoct .... jen si tim nejsem jisty na 100%

tj.

funkce pingni_komp(hotovo)
  ping kompy[hotovo]
  vykresli progressbar
  setTimeout pingni_komp hotovo+1, 10 /* nemusi byt nutne 10ms, ale nejaky co nejmensi cislo tam musi bejt */
konec funkce

setTimeout pingni_komp 1, 10

proste hta je hruzostrasnost a je jen pro lidi ktery ho maj radi :-)

Nahoru Odpovědět

13.9.2018 11:23

Jirka Jr

Člen

Jirka Jr:13.9.2018 17:16

Tak nic, dokopal jsem se k tomu to predelat na ten setTimeout a nepomohlo to

protoze pokud pouziju objShell.Run na ping, tak se to proste zmrvi a zavreni okna nezavre proces at delam co delam

tak jeste posledni zkusit pouzit objShell.Exec, ktery neceka na dokonceni spusteneho pingu a hned vraci objekt spusteneho procesu

ale musi se na to vymyslet nejaka sikovna synchronizace .... nejspis v duchu tveho puvodniho setInterval, ale krome dokoncenych kompu jeste navic monitorovat dokonceni pingprocesu

uz jsem z toho zas otravenej, takze se na to - mozna ;-) - vrhnu az mi zas otrne

Nahoru Odpovědět

13.9.2018 17:16

Jirka Jr

Člen

Jirka Jr:15.9.2018 4:02

Tak to vypada, ze se neco podarilo ... viz tady

Trosku jsem se tam aj kreativne rozjel :-)

V principu to po spusteni pingu hned vraci a neceka to na nej
vyuziva to objekt, ktery vraci Shell.Exec a pravidelne to kontroluje dokonceni pingprocesu
samotny pingproces neni primo ping, ale wscript.exe spoustejici vbscript spoustejici ping ... je to kvuli tomu, ze wscript.exe nevytvari okno, muze cekat na dokonceni pingu a jeste ho spustit taky bez okna
jadrem cele aplikace je funkce Automaton, ktera se spousti pomoci setTimeout a chova se podle aktualniho stavu "pingaciho automatu"

Vysledkem je, ze se ta opakujici se funkce Automaton nikde moc nezdrzuje a tudiz nezablokuje proces mshta.exe a ten tak nezustava viset po zavreni okna

Dokonce by se to dalo upravit, aby to spustilo treba 5-10 "ping automatu" pro 5-10 kompu zaraz, coz by pri vetsich poctech kompu brutalne usetrilo cas ...

ale nevim jak na tom programatorsky jses a jestli me neposles do ritniho otvoru uz ted, ze to mam moc slozity ;-)

Nahoru Odpovědět

15.9.2018 4:02