使用 RegistryKey.OpenRemoteBaseKey 进行远程连接时，计时器会跳过连接到每个循环中的下一台计算机
Timer to skip to connect to next computer in for each loop while connecting remotely using RegistryKey.OpenRemoteBaseKey
我构建了一个工具（使用 Visual Studio 2015 Express - Visual Basic），用于检查计算机注册表中的 mcafee dat 版本和日期，无论是手动输入、文本文件输入还是从活动目录中选择.该工具成功返回了 970 computers/laptops 中 714 的所有信息。大多数故障要么是因为它们无法在 DNS 中解析，要么是不可 ping 的，工具会识别这些故障并成功记录它们。该工具花了 15 分钟多一点的时间来检索信息并将其记录在电子表格中。问题是，在 19 次失败中，我遇到了以下两个错误之一，而这 19 次失败花费了该工具 15 分钟的大部分时间来获取并记录所有信息：
试图执行未经授权的操作
找不到网络路径
有没有办法使用定时器，让程序在此时尝试连接注册表... rk1 = RegistryKey.OpenRemoteBaseKey(RegistryHive.LocalMachine, strComputer, RegistryView.Registry64)然后在一定时间后停止并移动到每个循环中的下一台计算机？我编程才一年多一点，我完全是通过 trial/error 和 google 学习的，所以请耐心等待我，因为我不是一个经验丰富的程序员。这是代码：
该程序运行良好，我的 objective 此处是通过使其在长时间挂起时跳到下一台计算机来改进它。我已过滤掉无法在 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
您需要将您的请求放在另一个线程中。该线程可以中止。
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
效果很好，但我相信它可以改进，所以如果您有建议，请回复。这是代码：
尝试
将 source1 调暗为新的 CancellationTokenSource
Dim token As CancellationToken = source1.Token
Dim T20 作为任务 = 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)
如果
结束
将 source2 调暗为新的 CancellationTokenSource
Dim token2 As CancellationToken = source2.Token
Dim T21 作为任务 = 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)
如果
结束
将 source3 调暗为新的 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) = 用户
objExcel.Cells(y, 5) = "DAT Version Number: " & mAV
objExcel.Cells(y, 6) = "DAT Date: " & mAD
y = y + 1
IPAddr = 无
回复=无
commodel = 无
comuser = 无
sel = 无
Thread.Sleep(10)
将 ex 作为异常捕获
结束尝试
我会尝试并用两种方式计时。我在这里添加了一个 continue 并将它从 6 分半钟缩短到 3 分半钟（如果它不能 ping 通然后移动到下一台计算机而不是 运行 其他 2 个任务）。
如果T20.Status = TaskStatus.Running 那么
source1.Cancel()
继续
如果
结束
我开始将等待更改为循环，我记得成功检索远程信息并将其放入 excel 而不会丢失 excel 电子表格中的数据需要花费大量时间.例如，我将时间减少到 10 毫秒，一些计算机没有足够快地响应 ping，因此计算机及其信息没有添加到电子表格中。同样，我减少了注册表任务的 ms，但电子表格中缺少该计算机的注册表信息。
我构建了一个工具（使用 Visual Studio 2015 Express - Visual Basic），用于检查计算机注册表中的 mcafee dat 版本和日期，无论是手动输入、文本文件输入还是从活动目录中选择.该工具成功返回了 970 computers/laptops 中 714 的所有信息。大多数故障要么是因为它们无法在 DNS 中解析，要么是不可 ping 的，工具会识别这些故障并成功记录它们。该工具花了 15 分钟多一点的时间来检索信息并将其记录在电子表格中。问题是，在 19 次失败中，我遇到了以下两个错误之一，而这 19 次失败花费了该工具 15 分钟的大部分时间来获取并记录所有信息：
试图执行未经授权的操作
找不到网络路径
有没有办法使用定时器，让程序在此时尝试连接注册表... rk1 = RegistryKey.OpenRemoteBaseKey(RegistryHive.LocalMachine, strComputer, RegistryView.Registry64)然后在一定时间后停止并移动到每个循环中的下一台计算机？我编程才一年多一点，我完全是通过 trial/error 和 google 学习的，所以请耐心等待我，因为我不是一个经验丰富的程序员。这是代码：
该程序运行良好，我的 objective 此处是通过使其在长时间挂起时跳到下一台计算机来改进它。我已过滤掉无法在 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
您需要将您的请求放在另一个线程中。该线程可以中止。
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
效果很好，但我相信它可以改进，所以如果您有建议，请回复。这是代码：
尝试
将 source1 调暗为新的 CancellationTokenSource
Dim token As CancellationToken = source1.Token
Dim T20 作为任务 = 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)
如果
结束将 source2 调暗为新的 CancellationTokenSource
Dim token2 As CancellationToken = source2.Token
Dim T21 作为任务 = 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)
如果
结束将 source3 调暗为新的 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) = 用户
objExcel.Cells(y, 5) = "DAT Version Number: " & mAV
objExcel.Cells(y, 6) = "DAT Date: " & mAD
y = y + 1
IPAddr = 无
回复=无
commodel = 无
comuser = 无
sel = 无
Thread.Sleep(10)
将 ex 作为异常捕获
结束尝试
我会尝试并用两种方式计时。我在这里添加了一个 continue 并将它从 6 分半钟缩短到 3 分半钟（如果它不能 ping 通然后移动到下一台计算机而不是 运行 其他 2 个任务）。
如果T20.Status = TaskStatus.Running 那么
source1.Cancel()
继续
如果
结束我开始将等待更改为循环，我记得成功检索远程信息并将其放入 excel 而不会丢失 excel 电子表格中的数据需要花费大量时间.例如，我将时间减少到 10 毫秒，一些计算机没有足够快地响应 ping，因此计算机及其信息没有添加到电子表格中。同样，我减少了注册表任务的 ms，但电子表格中缺少该计算机的注册表信息。