Таймер для пропуска подключения к следующему компьютеру для каждого цикла при удаленном подключении с использованием RegistryKey.OpenRemoteBaseKey

Я создал инструмент (в Visual Studio 2015 Express - Visual Basic), который будет проверять версию и дату mcafee dat из реестра на компьютерах, вводимых вручную, в текстовом файле или выбранных из активного каталога. Инструмент работает, он успешно вернул всю информацию для 714 из 970 компьютеров / ноутбуков. Большинство сбоев были либо потому, что они не могли быть решены в DNS, либо не были проверены, и инструменты идентифицировали их и успешно регистрировали их. Инструменту понадобилось чуть более 15 минут, чтобы получить информацию и записать ее в электронную таблицу. Проблема в том, что в 19 из сбоев я получил одну из двух следующих ошибок, и эти 19 заняли большинство из 15 минут, чтобы инструмент получил и зарегистрировал всю информацию:

  1. Попытка выполнить несанкционированную операцию

  2. Сетевой путь не найден

    Есть ли способ использования таймера, чтобы программа попыталась подключиться к реестру на этом этапе... rk1 = RegistryKey.OpenRemoteBaseKey(RegistryHive.LocalMachine, strComputer, RegistryView.Registry64), а затем после определенного количества времени остановить и перейти к следующему компьютеру в для каждого цикла? Я программировал только чуть больше года, и я учился исключительно методом проб / ошибок и Google, поэтому, пожалуйста, наберитесь терпения, поскольку я не опытный программист. Вот код:

Программа работает хорошо, моя цель в том, чтобы улучшить ее, заставив перейти к следующему компьютеру, когда он зависает в течение длительного периода времени. Я отфильтровал компьютеры, которые не могут быть разрешены в DNS или не могут быть проверены.

   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
Источник

4 ответа

Решение

Вы должны поместить свой запрос в другой теме. Эта тема может быть прервана.

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

Надеюсь это поможет.

'***** РЕДАКТИРОВАТЬ *** Ваш код может выглядеть следующим образом (я не проверял, есть ли переменные для передачи в 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
Источник

Это прекрасно работает, но я уверен, что это может быть улучшено, поэтому, пожалуйста, отвечайте на предложения, если они есть. Вот код:

Пытаться

Dim source1 As New CancellationTokenSource

Тусклый токен как CancellationToken = source1.Token

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

T20.Wait (30)

Если T20.Status = TaskStatus.Running, то

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)

Конец, если

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)

Если T21.Status = TaskStatus.Running, то

source2.Cancel()

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

Конец, если

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)

Если T22.Status = TaskStatus.Running, то

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)

Конец, если

IPAddr = reply.Address.ToString ()

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

objExcel.Cells (y, 2) = IPAddr

objExcel.Cells (y, 3) = комод

objExcel.Cells (y, 4) = comuser

objExcel.Cells (y, 5) = "Номер версии DAT: " & mAV

objExcel.Cells (y, 6) = "Дата DAT: " & MAD

у = у + 1

IPAddr = ничего

ответить = ничего

commodel = ничего

comuser = ничего

sel = ничего

Thread.Sleep(10)

Поймать как исключение

Конец попробовать

Источник

Я попробую это, и время это оба пути. Я добавил здесь продолжение, и оно сократило его с 6 с половиной минут до 3 с половиной минут (если это не было доступно для проверки, тогда перейдите к следующему компьютеру вместо выполнения двух других задач).

Если T20.Status = TaskStatus.Running, то

source1.Cancel()

Продолжить для

Конец, если

Источник

Я начал менять ожидание на цикл, и я вспомнил, что для успешного извлечения удаленной информации и ее передачи в Excel требуется много времени без пропуска данных в электронной таблице Excel. Например, я сократил время до 10 мс, и некоторые компьютеры не реагировали на эхо-запрос достаточно быстро, чтобы этот компьютер и его информация не были добавлены в электронную таблицу. Кроме того, я сократил количество мс на задачу реестра, и информация о реестре для этого компьютера отсутствовала в электронной таблице.

Источник
Другие вопросы по тегам