frmpostscnwp.frm

全面网络扫描器VB源代码 很实用

                              ctime = Timer  'code for time out
                              Do
                              DoEvents
                              Sleep 1
                              Loop Until ctime + 2 < Timer + txtdelay.Text / 1000
                              
                            End If
                    
                Next l
            GoTo endcode:
            End If
          
          
          If Option1(1).value = True Then  'all selected port code
                   TreeView1.Nodes.Add , , List1.List(J), List1.List(J)
                
                 
                
                For l = 1 To lstports.ListItems.Count
                      
                  If lstports.ListItems(l).Checked = True Then
                        
                        pseek = InStr(1, lstports.ListItems(l).Text, ",")
                        pnumber = Mid(lstports.ListItems(l).Text, 1, pseek - 1)
                          If pnumber = Val(pnumber) Then
                            ' for http request
                       machin(I) = CStr(List1.List(J)) + ":" + CStr(pnumber)
                     
                             wsckClient(I).Close
                             wsckClient(I).Connect Trim(txtipaddr.Text), CStr(CInt(Trim(txtportnum.Text)))
                              
                              I = I + 1
                              If I >= 200 Then I = 0
                              
                              
                              ctime = Int(Timer)  'code for time out
                              Do
                              Sleep 1
                              Loop Until ctime + Int(txtdelay.Text / 1000) < Int(Timer)
                              DoEvents
                         End If
                       End If
                Next l
            GoTo endcode:
            End If
          
          
           If Option1(2).value = True Then  'all deselected port code
                TreeView1.Nodes.Add , , List1.List(J), List1.List(J)
                For l = 1 To lstports.ListItems.Count
                   If lstports.ListItems(l).Checked = False Then
                         pseek = InStr(1, lstports.ListItems(l).Text, ",")
                    
                         pnumber = Mid(lstports.ListItems(l).Text, 1, pseek)
                           If pnumber = Val(pnumber) Then
                             ' for http request
                       machin(I) = CStr(List1.List(J)) + ":" + CStr(pnumber)
                     
                              wsckClient(I).Close
                              wsckClient(I).Connect Trim(txtipaddr.Text), CStr(CInt(Trim(txtportnum.Text)))
                               
                              I = I + 1
                              If I >= 200 Then I = 0
                              
                              
                              ctime = Int(Timer)  'code for time out
                              Do
                              Sleep 1
                              Loop Until ctime + Int(txtdelay.Text / 1000) < Int(Timer)
                              DoEvents
                          End If
                   End If
                Next l
              GoTo endcode:
            End If
          
          
            If Option1(3).value = True Then  'all port from
                TreeView1.Nodes.Add , , List1.List(J), List1.List(J)
                If txtportstart.Text = Val(txtportstart.Text) And txtportend.Text = Val(txtportend.Text) And Val(txtportstart.Text) < Val(txtportend.Text) Then
                       spn = Val(txtportstart.Text)
                       epn = Val(txtportend.Text)
                          For l = spn To epn
                                  pnumber = l
                                ' for http request
                       machin(I) = CStr(List1.List(J)) + ":" + CStr(pnumber)
                       
                                   wsckClient(I).Close
                                   wsckClient(I).Connect Trim(txtipaddr.Text), CStr(CInt(Trim(txtportnum.Text)))
                                  
                                  I = I + 1
                                  If I >= 200 Then I = 0
                                  ctime = Int(Timer)  'code for time out
                                  Do
                                  Sleep 1
                                  DoEvents
                                  Loop Until ctime + 2 < Int(Timer) + Int(txtdelay.Text / 1000)
                                   DoEvents
                          Next l
                 End If
            End If
          
          
          
          
   DoEvents
endcode:
    If alarm = 1 Then Exit Sub
 Next J

MsgBox "Scannig Compelete "
cmdSend.Enabled = True
'Call cl
End Sub

Private Sub txtendip_GotFocus(Index As Integer)
  SendKeys "{HOME}+{END}"
End Sub

Private Sub txtip_Change(Index As Integer)
On Error Resume Next
If txtip(Index) = "" Then txtip(Index) = "0": SendKeys "{HOME}+{END}"
If CInt(txtip(Index).Text) > 255 Then
    MsgBox "Number must be between 0 - 255." & Chr(13) & "Please re-enter number.", vbApplicationModal + vbDefaultButton1 + vbInformation, "Error"
    txtip(Index).Text = "0"
    SendKeys "{HOME}+{END}"
  End If
  
  txtendip(0).Text = txtip(0).Text
  txtendip(1).Text = txtip(1).Text
  txtendip(2).Text = txtip(2).Text

End Sub



Private Sub txtendip_Change(Index As Integer)
On Error Resume Next
If txtendip(Index) = "" Then txtendip(Index) = "0": SendKeys "{HOME}+{END}"
If CInt(txtendip(Index).Text) > 255 Then
    MsgBox "Number must be between 0 - 255." & Chr(13) & "Please re-enter number.", vbApplicationModal + vbDefaultButton1 + vbInformation, "Error"
    txtendip(Index).Text = "0"
    SendKeys "{HOME}+{END}"
  End If
End Sub

Private Sub txtip_GotFocus(Index As Integer)
  SendKeys "{HOME}+{END}"
End Sub

Private Sub VScroll1_Change()
  txtdelay.Text = VScroll1.value
End Sub

Private Sub wsckClient_Connect(Index As Integer)
 
  'TreeView1.Nodes.Add  wsckClient(Index).RemoteHost + "tcp", 4, , CStr(wsckClient(Index).RemotePort) + " Connected !"
    wsckClient(Index).SendData (sendcommands(machin(Index)))
End Sub
  
Private Sub cmdSend_Click()
 cmdSend.Enabled = False
'  Timer1.Interval = CStr(txtdelay.Text)

 
   For co = 0 To List1.ListCount
    For cp = co + 1 To List1.ListCount
       If List1.List(co) = List1.List(cp) Then List1.RemoveItem (cp)
    Next cp
   Next co


 TreeView1.Nodes.Clear
  Timer1.Enabled = True
 alarm = 0
End Sub


'Private Sub wsckClient_Error(Index As Integer, ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
 '   TreeView1.Nodes.Add wsckClient(Index).RemoteHost + CStr(Index), 4, , Description

'End Sub

Sub cl()
  For J = 1 To wsckClient.Count - 1
      'Unload wsckClient(j)
  Next J
 
End Sub



Function createhtml() As String
 Dim b As String
 Const cr = vbCrLf
  createhtml = frmrprt.txtheadhtml1.Text
  'frmrprt
 For keyadd = 0 To List1.ListCount - 1
    For l = 1 To TreeView1.Nodes.Count
     
      If TreeView1.Nodes.item(l).Key = List1.List(keyadd) Then
   
             b = b + frmrprt.txtheadhtml2.Text + TreeView1.Nodes(l).Text + "</span></font><br>"
             
             b = b + frmrprt.txtheadhtml3.Text
                   
             b = b + frmrprt.txtheadhtml4.Text
                   ity1 = TreeView1.Nodes.item(l + 1).Children
                   ity2 = TreeView1.Nodes.item(l + 2).Children
                       fl = False
                       fl2 = False
                           
                    itall = ity1 + ity2
                      For l1 = l + 1 To l + itall + 2
                           On Error GoTo errnext:
                          If TreeView1.Nodes.item(l1).Key <> "" Then
                              For l2 = l1 + 2 To l1 + 2 + TreeView1.Nodes.item(l1).Children
                                 If TreeView1.Nodes.item(l2).Parent.Text = TreeView1.Nodes.item(l1).Text Then
                                     If fl = False And TreeView1.Nodes.item(l2).Parent.Text = "TCP PORTS" Then b = b + "TCP PORTS" + "<br>": fl = True
                                     If fl2 = False And TreeView1.Nodes.item(l2).Parent.Text = "UDP PORTS" Then b = b + "<br>" + "UDP PORTS" + "<br>": fl2 = True
                                       b = b + "&nbsp;&nbsp;&nbsp;&nbsp;" + TreeView1.Nodes.item(l2).Text + "<br>"
                                 
                                 End If
errnext:
                             Next l2
                          End If
                      
                      Next l1
             b = b + "</div>"
         Exit For
       End If
     Next l
  Next keyadd
  
 
 createhtml = createhtml + b + "</body></html>"
 



End Function
Sub loadp()
 lstports.ListItems.Clear
 Dim file As String
 On Error GoTo err
 Open App.path + "\" + "portlist.st" For Binary As #1
   file = String(LOF(1), " ")
   Get #1, 1, file
        If Len(file) < 1 Then GoTo err
        
    Do
    fl = 0
      
        f1 = InStr(f + 1, file, "-,", vbTextCompare)
        f2 = InStr(f + 1, file, "+,", vbTextCompare)
         
         
         If f1 > f2 And f2 <> 0 Then
             f = f2
             fl = 1
          Else
             f = f1
         End If
         
         If f = 0 Then GoTo a:
         
        'code for extract port number and protocol and details
           g2 = InStr(f + 1, file, ",,,", vbTextCompare)
          saver = Mid(file, f + 2, g2 - f - 2)

         lstports.ListItems.Add , , saver
         If fl = 1 Then lstports.ListItems.item(lstports.ListItems.Count).Checked = True
a:
    
            
    
    Loop Until f = 0
 
 Close #1
Exit Sub
err:
 MsgBox err.Description, , "Tip !"
End Sub

Sub savep()
  
Dim file As String
 On Error GoTo err
 Open App.path + "\" + "portlist.st" For Binary As #1
        
    For J = 1 To lstports.ListItems.Count
         If lstports.ListItems(J).Checked = True Then
           file = file + "+," + lstports.ListItems(J).Text + ",,," + vbCrLf
         Else
           file = file + "-," + lstports.ListItems(J).Text + ",,," + vbCrLf
         End If
    DoEvents
    Next J
    
   Put #1, , file
 Close #1
 
Exit Sub
err:
 MsgBox err.Description, , "Tip !"

End Sub

Function sendcommands(ByVal addr As String) As String

  'strHttpRequest = "GET " & "http://" & CStr(addr) & "/" & " HTTP/1.0" & vbCrLf
  
  'strHttpRequest = strHttpRequest + "Accept: */*" & vbCrLf
   
   
'  strHttpRequest = strHttpRequest + "Host: " + CStr(addr) & vbCrLf
   
'  strHttpRequest = strHttpRequest + "Proxy-Connection: Keep-Alive  " & vbCrLf & vbCrLf & vbCrLf & vbCrLf

   
    
    
    strHttpRequest = "GET " & "http://" & CStr(addr) & " HTTP/1.1" & vbCrLf
    strHttpRequest = strHttpRequest & "Host: " & CStr(addr) & vbCrLf
    strHttpRequest = strHttpRequest & "Connection: close" & vbCrLf
    strHttpRequest = strHttpRequest & "Accept: */*" & vbCrLf
   
   
   Debug.Print strHttpRequest
      
   sendcommands = strHttpRequest

End Function


Private Sub wsckClient_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  'Text3 is show resv
  Dim msg As String
 On Error GoTo er:
  wsckClient(Index).GetData msg
'  MsgBox err.Description
    nameadd = Mid(machin(Index), 1, InStr(1, machin(Index), ":") - 1)
        TreeView1.Nodes.Add nameadd, 4, , machin(Index) + " = " + msg
Exit Sub
er:
    MsgBox "a"
End Sub