我在互联网上找到一个用VB编写的程序，是PING一个计算机的IP是否能通的工具，我改了改，使用ADO重数据库中循环读取IP地址，并将测试后的状态写入到数据库，作完后运行是可以测试，但是速度太慢了，每循环测试一个IP地址都需要接近1秒的时间，如果IP多的话时间就太长了，有其他办法让测试时间缩短吗？多线程如何做呢?谢谢各位帮忙！！！

VB代码：
Option Explicit
Private Const WS_VERSION_REQD As Long = &H101
Private Const INADDR_NONE As Long = &HFFFFFFFF
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const PING_TIMEOUT As Long = 500

Private Type ICMP_OPTIONS
Ttl As Byte
Tos As Byte
Flags As Byte
OptionsSize As Byte
OptionsData As Long
End Type

Private Type ICMP_ECHO_REPLY
Address As Long
status As Long
RoundTripTime As Long
DataSize As Long
DataPointer As Long
Data As String * 250
End Type
Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type

Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long

Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long

Private Declare Function IcmpSendEcho Lib "icmp.dll" (ByVal IcmpHandle As Long, _
ByVal DestinationAddress As Long, ByVal RequestData As String, ByVal RequestSize As Long, _
ByVal RequestOptions As Long, ReplyBuffer As ICMP_ECHO_REPLY, ByVal ReplySize As Long, _
ByVal Timeout As Long) As Long

Private Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long

Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

Private Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As String, _
ByVal dwHostLen As Long) As Long

Private Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As String) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(xDest As Any, xSource As Any, ByVal nbytes As Long)

Private Declare Function inet_addr Lib "WSOCK32.DLL" (ByVal s As String) As Long

Private Sub Command1_Click() 'ping网络计算机
Dim ECHO As ICMP_ECHO_REPLY
Dim pos As Long
Dim success As Long
Dim WSAD As WSADATA
Dim aa As Boolean
Dim mystr As String
Dim Cn As New ADODB.Connection
Dim Re As New ADODB.Recordset
Dim SqlStr As String
Dim Numb As Long
Set Cn = New ADODB.Connection
Set Re = New ADODB.Recordset
Cn.Open "Provider=Microsoft.jet.OLEDb.4.0;Data Source=F:\icmp device manager\db\ipdb.mdb"
Re.CursorLocation = adUseClient
SqlStr = "select * from ip_table "
Re.Open SqlStr, Cn, adOpenStatic, adLockOptimistic
Numb = Re.RecordCount
While Numb < > 0
aa = WSAStartup(WS_VERSION_REQD, WSAD) = 0
If aa Then
Dim hPort As Long
mystr = inet_addr(Re("ipaddress").Value)
If mystr < > INADDR_NONE Then
hPort = IcmpCreateFile()
If hPort Then
Call IcmpSendEcho(hPort, mystr, Text1.Text, Len(Text1.Text), _
0, ECHO, Len(ECHO), PING_TIMEOUT) '发送回响请求报文，返回回响应答报文
Call IcmpCloseHandle(hPort)
End If
If ECHO.status = 0 Then
Re("status").Value = "1"
Re.Update
Else
Re("status").Value = "0"
Re.Update
End If
End If
End If
Re.MoveNext
Numb = Numb - 1
Wend
Re.Close
Text2.Text = "完成"
End Sub