vb.net - 在使用 RegistryKey.OpenRemoteBaseKey 进行远程连接时，跳过以连接到每个循环中的下一台计算机的计时器

Question

我构建了一个工具（使用 Visual Studio 2015 Express - Visual Basic），它将检查计算机上注册表中的 mcafee dat 版本和日期，手动输入、文本文件输入或从活动目录中选择输入。该工具成功地返回了 970 台计算机/笔记本电脑中 714 台的所有信息。大多数失败要么是因为它们无法在 DNS 中解析，要么是无法 ping 通，而这些工具会识别并成功记录它们。该工具花费了 15 分钟多一点的时间来检索信息并将其记录在电子表格中。问题是，在 19 次失败中，我遇到了以下两个错误之一，而这 19 次错误花费了 15 分钟的大部分时间来获取并记录所有信息：

试图执行未经授权的操作
找不到网络路径

有没有一种使用计时器的方法，以便程序此时将尝试连接到注册表... rk1 = RegistryKey.OpenRemoteBaseKey(RegistryHive.LocalMachine, strComputer, RegistryView.Registry64) 然后在一段时间后停止并移动到 for each 循环中的下一台计算机？我只编程了一年多一点，我完全是通过试错和谷歌学习的，所以请耐心等待我，因为我不是一个经验丰富的程序员。这是代码：

该程序运行良好，我的目标是通过使其在长时间挂起时跳到下一台计算机来改进它。我已过滤掉无法在 DNS 中解析或无法 ping 的计算机。

   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

score 0 · Accepted Answer

您需要将您的请求放在另一个线程中。该线程可以中止。

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

希望这可以帮助。

'***** EDIT *** 你的代码可能看起来像这样（我没有检查是否有任何变量要传入 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

score 0 · Accepted Answer

这很好用，但我相信它可以改进，所以如果你有建议，请回复。这是代码：

尝试

将 source1 调暗为新的 CancellationTokenSource

暗淡令牌 As CancellationToken = source1.Token

将 T20 调暗为 Task = Task.Factory.StartNew(Function() getping((sel.Name), token))

T20.等待(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)

万一

将 source2 调暗为新的 CancellationTokenSource

将 token2 调暗为 CancellationToken = source2.Token

将 T21 调暗为 Task = Task.Factory.StartNew(Function() comsys((sel.Name), token2))

T21.等待(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)

万一

将 source3 调暗为新的 CancellationTokenSource

将 token3 调暗为 CancellationToken = source3.Token

将 T22 调暗为 Task = Task.Factory.StartNew(Function() getregvalues((sel.Name), token3))

T22.等待(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

y = y + 1

IPAddr = 无

回复 = 没有

commodel = 没有

comuser = 没有

sel = 没有

线程.睡眠(10)

抓住前任作为例外

结束尝试

score 0 · Accepted Answer

我会尝试，并以两种方式计时。我在这里添加了一个 continue 并将其从 6 分半钟缩短到 3 分半钟（如果它无法 ping 通，则转到下一台计算机而不是运行其他 2 个任务）。

如果 T20.Status = TaskStatus.Running 那么

source1.Cancel()

继续

万一

score 0 · Accepted Answer

我开始将等待更改为循环，我记得需要花费大量时间才能成功检索远程信息并将其输入 excel，而不会丢失 excel 电子表格中的数据。例如，我将时间降低到 10 毫秒，并且一些计算机对 ping 的响应速度不够快，因此计算机及其信息没有添加到电子表格中。同样，我减少了注册表任务的毫秒数，并且电子表格中缺少该计算机的注册表信息。

vb.net - 在使用 RegistryKey.OpenRemoteBaseKey 进行远程连接时，跳过以连接到每个循环中的下一台计算机的计时器

4 回答 4

Related

Reference