Search code examples
vb.nettimerremote-registry

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


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:

  1. Attempted to perform an unauthorized operation

  2. 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

Solution

  • 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