Ungewollte Endlosschleife - Access lahmt

[Will1974]

Liebe Formummitglieder,

ich habe folgenden Code, über welchen ich den Onlinestatus mehrerer Hosts im Netzwerk abfrage. Solange alle Hosts online sind funktioniert der Code perfekt. Wenn aber ein oder mehrere Hosts nicht erreichbar sind, läuft der Code in einer Endlosschleife und Access lahmt total. Leider komme ich nicht dahinter wie ich das lösen kann, ich habe schon mit Exit For usw. experiemntiert, leider aber ohne Erfolg. Könnt Ihr mir bitte unter die Arme greifen?

Code [Auswählen] Erweitern

Function SysCheck(ByVal ComputerName As String) As Boolean

     ' This function returns True if the specified host could be pinged.
     ' HostName can be a computer name or IP address.
     ' The Win32_PingStatus class used in this function requires Windows XP or later.
     
     ' Standard housekeeping
    Dim colPingResults As Variant
    Dim oPingResult As Variant
    Dim strQuery As String
   
     ' Define the WMI query
    strQuery = "SELECT * FROM Win32_PingStatus WHERE Address = '" & ComputerName & "'"
       
     ' Run the WMI query
    Set colPingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
   
     ' Translate the query results to either True or False
        For Each oPingResult In colPingResults
               
        If Not IsObject(oPingResult) Then
            SysCheck = False
                                                     
        ElseIf oPingResult.StatusCode = 0 Then
            SysCheck = True
           
        Else
            SysCheck = False
                       
        End If
                     
    Next oPingResult
   
    Set colPingResults = Nothing
                   
End Function

[steffen0815]

Hallo,
ich weiß nicht, ob du den Code in Schleife einsetzt, aber das Standardtimeout beträgt wohl 5 Sekunden. Bei 10 Offlinehosts wären das 50s Wartezeit.

[Will1974]

Hallo Steffen,

Ich habe eine Tabelle tbl_Clients mit der Spalte "Hostname" in welcher ca. 50 Einträge vorhanden sind. Die Funktion rufe ich in einer Abfrage wie folgt auf:

Code [Auswählen] Erweitern

Status: SysCheck([Hostname])

Das Problem ist nicht die Wartezeit, sondern dass die Abfrage in einer Endlosschleife arbeitet und nie endet. Also auch nachdem die Abfrage alle Ergebnisse anzeigt, lahmt Access derartig, dass ich das Programm über den Taskmanager abwürgen muß.
Soweit ich weiß läuft die "For Each" Schleife ja nur einmal durch bis alle Datensätze durch sind oder irre ich da? Ich weiß nicht wo das Problem liegt, siehst du ev. einen Fehler in meinem Code? Und kann ich den Standardtimeout auch definieren, sodass dieser unter 5 Sekunden liegen würde?

[steffen0815]

Hallo,
50 Einträge (Pings) dauern halt ihre Zeit.
Allerdings baut sich das wie von dir beschrieben auf, indem bei jedem Datensatzwechsel neu berechnet (neu gepingt) wird.
Warum das so ist kann ich mir im Moment nicht erklären bzw. weiß nicht was da eventuell eingestellt werden muss.

Zur Not kannst du die Momentaufnahme in eine temporäre Tabelle schreiben und diese zu Anzeige bringen.
Andere Variante wäre ein Zusatzfeld "online" was per Aktualisierungsabfrage gesetzt wird.

[Will1974]

Für 50 Einträge braucht mein Code ca. 10 Sekunden, vorausgesetzt alle Hosts sind online. Doch sobald dazwischen nur 1 Host offline ist, rotiert der Code nach Abarbeitung in der Endlosschleife und legt Access lahm...

Das Schreiben in eine Tabelle wäre natürlich ein Ansatz, ist aber nicht des Rätsels Lösung. Es muss doch einen einfachen Weg geben, die Endlosschleife zu verhindern - Ich habe schon alles mögliche ausprobiert, kann dieses Problem aber einfach nicht lösen...CRY :-((!

[steffen0815]

Hallo,
probiere es doch einfach mal mit einer Tabellenerstellungsabfrage. Läuft die zeitlich akzeptabel kann man weiter denken.

[Will1974]

Hallo Steffen,
habs ausprobiert, mit einer Tabellenerstellungsabfrage funzt die Funktion wie gewünscht OHNE Endlosschleife... hmm... ??

[steffen0815]

Hallo,
also dann spendiere deiner Rechnertabelle ein Feld online (Ja/nein) und starte zunächst eine Aktualisierungsabfrage, bevor du die Auswahlabfrage bzw. das Formular öffnest.
Das schränkt letztendlich die Funktionalität nicht ein. Ein zusätzlicher Aktualisierungsknopf auf dem Form lässt dann auch einen Liveblick zu.

[Will1974]

Hallo Steffen,
über diesen Umweg funktioniert es, ich habe so zumindest keine Endlosschleifen mehr.

Die Performance lässt allerdings zu wünschen übrig, es liegt wie du sagtest an den langen Timeouts, wenn einige Hosts offline sind. Daher habe ich versucht den Timeout anzugeben, leider erfolglos:

Code [Auswählen] Erweitern

strQuery = "SELECT * FROM Win32_PingStatus where TimeOut = 500 and address = '" & ComputerName & "'"

Hast du eine Idee, wie ich im Offlinefall sofort abbrechen und zum nächsten Datensatz springen kann? Oder gibt es vielleicht einen klügeren Ansatz als "PING" um rasch zu prüfen, ob meine Hosts ON oder OFF sind?

[steffen0815]

Hallo,
man könnte ein ping per Shell starten und auswerten.
Das hätte den Vorteil, dass Shell asynchron gestartet wird, dh. die 50 pings laufen zeitgleich.

Hier mal ein grober Ansatz

Code [Auswählen] Erweitern

Option Explicit

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Sub Onlinetest()
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("tblRechner", dbOpenDynaset)
rsPing rs
End Sub

Private Function rsPing(rs As DAO.Recordset)
Dim pdat As String
rs.MoveFirst
While Not rs.EOF
    pdat = Environ("TEMP") & "\" & rs("Rechner") & ".txt"
    If Dir(pdat) <> "" Then Kill pdat
    Shell "cmd /c ping  -n 1 " & rs("Rechner") & " > """ & pdat & """", vbHide
    rs.MoveNext
Wend
' evtl. 5 sekunde warten
Sleep 5000
rs.MoveFirst
While Not rs.EOF
    pdat = Environ("TEMP") & "\" & rs("Rechner") & ".txt"
    rs.Edit
    Debug.Print FileLen(pdat)
    If Dir(pdat) <> "" Then
        rs("online") = chkProt(pdat)
        'Kill pDat
    Else
        Stop ' Datei wurde nicht geschrieben
    End If
    rs.Update
    rs.MoveNext
Wend
End Function

Private Function chkProt(pdat As String) As Boolean
Dim iDatNum As Integer, Zeile As String
iDatNum = FreeFile
Open pdat For Input As iDatNum
While Not EOF(iDatNum)
    Line Input #iDatNum, Zeile
    If Zeile Like "*Verloren = 0*" Then chkProt = True
Wend
Close iDatNum
   
End Function

[Will1974]

Hallo Steffen,

WOW, dass ist der Turbocode schlechthin - genau was ich suchte, vielen lieben Dank!

Eine Kleinigkeit nur: Die Auswertung von "pdat" (0 oder -1) soll ja in die Spalte "Online" geschrieben werden. Stattdessen werden alle Hostnamen der Spalte "Rechner" mit den Ergebnissen überschrieben.

Ich denke der Wurm ist hier drinnen, erkennst du den Fehler vielleicht?:

Code [Auswählen] Erweitern

rs.Edit
    Debug.Print FileLen(pdat)
    If Dir(pdat) <> "" Then
        rs("online") = chkProt(pdat)
        'Kill pDat
    Else
        Stop ' Datei wurde nicht geschrieben
    End If

[steffen0815]

Hallo,
also dein geposter Codeteil schreibt eindeutig nur das "online"-Feld

Code [Auswählen] Erweitern

rs("online") = chkProt(pdat)

Btw:
Die Zeile

Code [Auswählen] Erweitern

' Kill pDatsollte aktiviert werden, damit kein Datenmüll rumliegt.

[Will1974]

Hallo Steffen,

du hast Recht...der Fehler sitzt immer einen Meter vor dem Bildschirm, ich hab's jetzt hinbekommen. Die Zeile "Kill pDat" habe ich deshalb deaktiviert, weil ich zwischendurch die Fehlermeldung "Zugriff verweigert" erhalte.

Vielen herzlichen Dank für deine Hilfe !!! :-) :-)

[steffen0815]

Hallo,

Die Zeile "Kill pDat" habe ich deshalb deaktiviert, weil ich zwischendurch die Fehlermeldung "Zugriff verweigert" erhalte.

Das solltest du nicht tun, denn es zeigt, dass das ping noch nicht fertig war. Hier solltet du entweder das Sleep hochsetzen oder optimaler beim fehlerhaften Lesen der Datei solange weiter versuchen bis die Datei frei ist. Das hätte den Vorteil, dass du auf ein festes sleep verzichten kannst.

[Will1974]

Hallo,

alles klar, ich habe die Zeile wieder aktiviert, dein Code funktioniert wunderbar - nochmals danke! :-)))