Timer to skip to connect to next computer in for each loop while connecting remotely using RegistryKey.OpenRemoteBaseKey

Question

I built a tool (with Visual Studio 2015 Express - Visual Basic) that will check the mcafee dat version and date from the registry on computers input either manually, in a text file, or selected from active directory. The tool works it successfully returned all the information for 714 out of 970 computers/laptops. The majority of the failures were either because they could not be resolved in DNS or weren't pingable and the tools identifies those and successfully logs them. It took a little over 15 minutes for the tool to retrieve the information and log it in a spreadsheet. The issue is that on 19 of the failures I got one of the two following errors and those 19 took the majority of the 15 minutes for the tool get and log all the information:

Attempted to perform an unauthorized operation
The network path was not found

Is there a way of using a timer so that the program will attempt to connect to the registry at this point... rk1 = RegistryKey.OpenRemoteBaseKey(RegistryHive.LocalMachine, strComputer, RegistryView.Registry64) and then after a certain amount of time stop and move to the next computer in the for each loop? I have only been programming for a little over a year and I have learned exclusively through trial/error and google so please have patience with me as I am not a seasoned programmer. Here is the code:

The program works well my objective here is to improve it by making it skip to the next computer when it hangs for an extended period of time. I have filtered out the computers that can't be resolved in DNS or aren't pingable.

   For Each sel In picker.SelectedObjects
      Try
         If HostIsResolvable(sel.Name) Then
            Try
               reply = ping.Send(sel.Name, 1)
               If reply.Status = IPStatus.Success Then
                  IPAddr = reply.Address.ToString()
                  Try
                     comsys(sel.Name)
                     Dim rk1 As RegistryKey
                     Dim rk2 As RegistryKey
                     rk1 = RegistryKey.OpenRemoteBaseKey
                     (RegistryHive.LocalMachine, sel.Name, 
                     RegistryView.Registry64)
                     rk2 = rk1.OpenSubKey
                     ("SOFTWARE\Wow6432Node\McAfee\AVEngine")
                     mAV = rk2.GetValue("AVDatVersion").ToString
                     mAD = rk2.GetValue("AVDatDate").ToString
                     objExcel.Cells(y, 1) = sel.Name
                     objExcel.Cells(y, 2) = IPAddr
                     objExcel.Cells(y, 3) = commodel
                     objExcel.Cells(y, 4) = comuser
                     objExcel.Cells(y, 5) = "DAT Version Number: " & mAV
                     objExcel.Cells(y, 6) = "DAT Date: " & mAD
                     y = y + 1
                  Catch ex As Exception
                     My.Computer.FileSystem.WriteAllText(Dell
                     & "\McAfeeDATeNumFailed.txt", sel.Name & "-Unable to
                     connect.  Make sure this computer is on the network,
                     has remote administration enabled, and that both 
                     computers are running the remote registry service.
                     Error message:  " & ex.Message & vbCrLf, True)
                  End Try
               Else
                  My.Computer.FileSystem.WriteAllText(Dell 
                  & "\McAfeeDATeNumFailed.txt", sel.Name & " is not
                  pingable! " & vbCrLf, True)
               End If

             Catch ex As Exception
                    My.Computer.FileSystem.WriteAllText(Dell
                    & "\McAfeeDATeNumFailed.txt", sel.Name & "Ping error: 
                    Unable to connect.  Make sure this computer is on the 
                    network, has remote administration enabled, and that
                    both computers are running the remote registry 
                    service.  Error message:  " & ex.Message & vbCrLf, True)
             End Try
          Else
             My.Computer.FileSystem.WriteAllText(Dell 
             & "\McAfeeDATeNumFailed.txt", sel.Name & " could not be
             resolved in DNS! " & vbCrLf, True)
          End If
       Catch ex As Exception
          My.Computer.FileSystem.WriteAllText(Dell 
          & "\McAfeeDATeNumFailed.txt", sel.Name & "DNS error:  Unable to
          connect.  Make sure this computer is on the network, has remote 
          administration enabled, andd that both computers are running the
          remote registry service.  Error message:  " & ex.Message & 
          vbCrLf, True)
       End Try
       sel = Nothing
    Next

pLurchi · Accepted Answer · 2016-07-28T06:39:10.897

You need to put your request in another thread. This thread can be aborted.

Sub Main()
    Dim thrd As New Thread(AddressOf endlessLoop) 'thread with your sub
    thrd.Start() 'Start thread
    thrd.Join(1000) 'Block until completion or timeout

    If thrd.IsAlive Then
        thrd.Abort() 'abort thread
    Else
        'thread finished already
    End If

End Sub

Sub endlessLoop()
    Try
        While True
            'Your Code
        End While
    Catch ex As ThreadAbortException
        'Your code when thread is killed
    End Try
End Sub

Hope this helps.

'***** EDIT *** Your code could look like this (I didn't checked if there are any variables to pass in Sub)

    For Each sel In picker.SelectedObjects
    Try
        If HostIsResolvable(sel.Name) Then
            Try
                reply = ping.Send(sel.Name, 1)
                If reply.Status = IPStatus.Success Then
                    IPAddr = reply.Address.ToString()
                    call timerThread 'New
                Else
                    My.Computer.FileSystem.WriteAllText(Dell 
                    & "\McAfeeDATeNumFailed.txt", sel.Name & " is not
                    pingable! " & vbCrLf, True)
                End If

            Catch ex As Exception
                My.Computer.FileSystem.WriteAllText(Dell
                & "\McAfeeDATeNumFailed.txt", sel.Name & "Ping error: 
                Unable to connect.  Make sure this computer is on the 
                network, has remote administration enabled, and that
                both computers are running the remote registry 
                service.  Error message:  " & ex.Message & vbCrLf, True)
            End Try
        Else
         My.Computer.FileSystem.WriteAllText(Dell 
         & "\McAfeeDATeNumFailed.txt", sel.Name & " could not be
         resolved in DNS! " & vbCrLf, True)
        End If
    Catch ex As Exception
      My.Computer.FileSystem.WriteAllText(Dell 
      & "\McAfeeDATeNumFailed.txt", sel.Name & "DNS error:  Unable to
      connect.  Make sure this computer is on the network, has remote 
      administration enabled, andd that both computers are running the
      remote registry service.  Error message:  " & ex.Message & 
      vbCrLf, True)
    End Try
    sel = Nothing
Next



Sub timerThread()
    Dim thrd As New Thread(AddressOf registryRequest) 'thread with your sub
    thrd.Start() 'Start thread
    thrd.Join(15000) 'Block until completion or timeout (15 seconds)

    If thrd.IsAlive Then
        thrd.Abort() 'abort thread
    Else
        'thread finished already
    End If
End Sub

Sub registryRequest()
    Try
        comsys(sel.Name)
        Dim rk1 As RegistryKey
        Dim rk2 As RegistryKey
        rk1 = RegistryKey.OpenRemoteBaseKey
        (RegistryHive.LocalMachine, sel.Name, 
        RegistryView.Registry64)
        rk2 = rk1.OpenSubKey
        ("SOFTWARE\Wow6432Node\McAfee\AVEngine")
        mAV = rk2.GetValue("AVDatVersion").ToString
        mAD = rk2.GetValue("AVDatDate").ToString
        objExcel.Cells(y, 1) = sel.Name
        objExcel.Cells(y, 2) = IPAddr
        objExcel.Cells(y, 3) = commodel
        objExcel.Cells(y, 4) = comuser
        objExcel.Cells(y, 5) = "DAT Version Number: " & mAV
        objExcel.Cells(y, 6) = "DAT Date: " & mAD
        y = y + 1
    Catch ex As ThreadAbortException
        My.Computer.FileSystem.WriteAllText(Dell
        & "\McAfeeDATeNumFailed.txt", sel.Name & "-Unable to
        connect.  Make sure this computer is on the network,
        has remote administration enabled, and that both 
        computers are running the remote registry service.
        Error message:  " & ex.Message & vbCrLf, True)
    End Try
End Sub

Thanks for the response. should this be a function so that it can return the registry value and update the spreadsheet? — Chet Horton, Jul 27 '16 at 15:40
Hi, I think the long taking part of you code is inside the second try statement. You could copy this inside 'endlessLoop' replacing the 'Your code' comment. Then call 'Main' instead of the try statement. The catch part of try could be copied to catch part of endlessLoop. Sorry for bad format, but answering by smartphone. — pLurchi, Jul 27 '16 at 17:34
And please manipulate the thrd.join statement. This is the waiting time until request is abort in milliseconds. — pLurchi, Jul 27 '16 at 17:49
Thank you so much for your help. I got your code working but do to my level of programming inexperience I had trouble synchronizing the various things I needed to process. However, your idea allowed me to try something similar that I had done before and it works great. It cut the time to process over 900 computers from 15 to 19 minutes down to 6 and a half minutes. — Chet Horton, Jul 28 '16 at 14:31

score 0 · Answer 2 · answered Jul 28 '16 at 14:43

This works great but I am sure it can be improved so please respond with suggestions if you have them. Here is the code:

Try

Dim source1 As New CancellationTokenSource

Dim token As CancellationToken = source1.Token

Dim T20 As Task = Task.Factory.StartNew(Function() getping((sel.Name), token))

T20.Wait(30)

If T20.Status = TaskStatus.Running Then

source1.Cancel()

My.Computer.FileSystem.WriteAllText(Dell & "\McAfeeDATeNumFailed.txt", sel.Name & " Ping timed out.  The task was disposed of at " & ex_time & "." & vbCrLf & vbCrLf, True)

End If

Dim source2 As New CancellationTokenSource

Dim token2 As CancellationToken = source2.Token

Dim T21 As Task = Task.Factory.StartNew(Function() comsys((sel.Name), token2))

T21.Wait(500)

If T21.Status = TaskStatus.Running Then

source2.Cancel()

My.Computer.FileSystem.WriteAllText(Dell & "\McAfeeDATeNumFailed.txt", sel.Name & " RPC error.  The task was disposed of at " & ex_time & "." & vbCrLf & vbCrLf, True)

End If

Dim source3 As New CancellationTokenSource

Dim token3 As CancellationToken = source3.Token

Dim T22 As Task = Task.Factory.StartNew(Function() getregvalues((sel.Name), token3))

T22.Wait(600)

If T22.Status = TaskStatus.Running Then

source3.Cancel()

My.Computer.FileSystem.WriteAllText(Dell & "\McAfeeDATeNumFailed.txt", sel.Name & " Error retrieving registry value.  The task was disposed of at " & ex_time & "." & vbCrLf & vbCrLf, True)

End If

IPAddr = reply.Address.ToString()

objExcel.Cells(y, 1) = sel.Name

objExcel.Cells(y, 2) = IPAddr

objExcel.Cells(y, 3) = commode

objExcel.Cells(y, 4) = comuser

objExcel.Cells(y, 5) = "DAT Version Number: " & mAV

objExcel.Cells(y, 6) = "DAT Date: " & mAD

y = y + 1

IPAddr = Nothing

reply = Nothing

commodel = Nothing

comuser = Nothing

sel = Nothing

Thread.Sleep(10)

Catch ex As Exception

End Try

You could write a loop instead of waiting first. Decrease the waiting time and loop several times. if running = true then exit loop. This will decrease your time. — pLurchi, Jul 29 '16 at 18:01

score 0 · Answer 3 · answered Jul 29 '16 at 18:20

I will try that and time it both ways. I added a continue for here and it cut it from 6 and a half minutes down to 3 and a half minutes (if it wasn't pingable then move on to the next computer instead of running the other 2 tasks).

If T20.Status = TaskStatus.Running Then

source1.Cancel()

Continue For

End If

score 0 · Answer 4 · answered Jul 29 '16 at 18:29

I started to change the wait to a loop and I remembered that it takes that amount of time to successfully retrieve the remote information and get it into excel without missing data in the excel spreadsheet. For example I dropped the time to 10 ms and some of the computers didn't respond to the ping fast enough so that computer and it's information wasn't added to the spreadsheet. Likewise, I reduced the ms on the registry task and the registry information for that computer was missing in the spreadsheet.

Timer to skip to connect to next computer in for each loop while connecting remotely using RegistryKey.OpenRemoteBaseKey

4 Answers4