home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Fast_multi2153365272009.psc / frm_MultiPing.frm < prev    next >
Text File  |  2009-05-25  |  12KB  |  342 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
  3. Begin VB.Form frm_MultiPing 
  4.    Caption         =   "MultiPing"
  5.    ClientHeight    =   5685
  6.    ClientLeft      =   60
  7.    ClientTop       =   450
  8.    ClientWidth     =   5235
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    ScaleHeight     =   5685
  12.    ScaleWidth      =   5235
  13.    StartUpPosition =   3  'Windows-Standard
  14.    Begin MSComctlLib.ImageList ILState 
  15.       Left            =   3960
  16.       Top             =   3720
  17.       _ExtentX        =   1005
  18.       _ExtentY        =   1005
  19.       BackColor       =   -2147483643
  20.       ImageWidth      =   16
  21.       ImageHeight     =   16
  22.       MaskColor       =   12632256
  23.       _Version        =   393216
  24.       BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
  25.          NumListImages   =   4
  26.          BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  27.             Picture         =   "frm_MultiPing.frx":0000
  28.             Key             =   ""
  29.          EndProperty
  30.          BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  31.             Picture         =   "frm_MultiPing.frx":17D3A
  32.             Key             =   ""
  33.          EndProperty
  34.          BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  35.             Picture         =   "frm_MultiPing.frx":2FA74
  36.             Key             =   ""
  37.          EndProperty
  38.          BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
  39.             Picture         =   "frm_MultiPing.frx":362D6
  40.             Key             =   ""
  41.          EndProperty
  42.       EndProperty
  43.    End
  44.    Begin VB.CommandButton btnPingAsync 
  45.       Caption         =   "Ping Check"
  46.       Height          =   735
  47.       Left            =   3720
  48.       TabIndex        =   6
  49.       Top             =   1560
  50.       Width           =   1335
  51.    End
  52.    Begin MSComctlLib.ListView LV_IPs 
  53.       Height          =   4215
  54.       Left            =   120
  55.       TabIndex        =   5
  56.       Top             =   1320
  57.       Width           =   3495
  58.       _ExtentX        =   6165
  59.       _ExtentY        =   7435
  60.       View            =   3
  61.       LabelEdit       =   1
  62.       LabelWrap       =   -1  'True
  63.       HideSelection   =   0   'False
  64.       FullRowSelect   =   -1  'True
  65.       _Version        =   393217
  66.       Icons           =   "ILState"
  67.       SmallIcons      =   "ILState"
  68.       ForeColor       =   -2147483640
  69.       BackColor       =   -2147483643
  70.       BorderStyle     =   1
  71.       Appearance      =   1
  72.       NumItems        =   3
  73.       BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  74.          Object.Width           =   2540
  75.       EndProperty
  76.       BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  77.          SubItemIndex    =   1
  78.          Object.Width           =   2540
  79.       EndProperty
  80.       BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  81.          SubItemIndex    =   2
  82.          Object.Width           =   2540
  83.       EndProperty
  84.    End
  85.    Begin VB.CommandButton btnPingList 
  86.       Caption         =   "Ping loop"
  87.       Height          =   615
  88.       Left            =   3720
  89.       TabIndex        =   4
  90.       Top             =   840
  91.       Visible         =   0   'False
  92.       Width           =   1335
  93.    End
  94.    Begin VB.CommandButton btnPing 
  95.       Caption         =   "Ping"
  96.       Height          =   495
  97.       Left            =   3000
  98.       TabIndex        =   2
  99.       Top             =   240
  100.       Width           =   855
  101.    End
  102.    Begin VB.TextBox txtIP 
  103.       Height          =   285
  104.       Left            =   1560
  105.       TabIndex        =   1
  106.       Text            =   "10.10.10.10"
  107.       Top             =   360
  108.       Width           =   1215
  109.    End
  110.    Begin VB.Timer TmrPingS 
  111.       Left            =   240
  112.       Top             =   2520
  113.    End
  114.    Begin VB.Label lblHosts 
  115.       Alignment       =   1  'Rechts
  116.       Caption         =   "Hosts"
  117.       Height          =   255
  118.       Index           =   1
  119.       Left            =   840
  120.       TabIndex        =   8
  121.       Top             =   960
  122.       Width           =   735
  123.    End
  124.    Begin VB.Label lblHosts 
  125.       Caption         =   "Hosts"
  126.       Height          =   255
  127.       Index           =   0
  128.       Left            =   240
  129.       TabIndex        =   7
  130.       Top             =   960
  131.       Width           =   495
  132.    End
  133.    Begin VB.Label lblPResult 
  134.       Alignment       =   2  'Zentriert
  135.       Caption         =   "X"
  136.       Height          =   255
  137.       Left            =   3960
  138.       TabIndex        =   3
  139.       Top             =   360
  140.       Width           =   495
  141.    End
  142.    Begin VB.Label lblIP 
  143.       Caption         =   "IP-Address"
  144.       Height          =   255
  145.       Left            =   240
  146.       TabIndex        =   0
  147.       Top             =   360
  148.       Width           =   1095
  149.    End
  150. End
  151. Attribute VB_Name = "frm_MultiPing"
  152. Attribute VB_GlobalNameSpace = False
  153. Attribute VB_Creatable = False
  154. Attribute VB_PredeclaredId = True
  155. Attribute VB_Exposed = False
  156. Option Explicit
  157. Private Declare Function GetTickCount Lib "kernel32" () As Long
  158. Private WithEvents m_clsPingBase As ClassPingBase
  159. Attribute m_clsPingBase.VB_VarHelpID = -1
  160.  
  161. Private m_bFirstRun As Boolean
  162.  
  163. Private Sub btnPing_Click()
  164. Dim res As Long
  165.     btnPing.Enabled = False
  166.     res = m_clsPingBase.PingHostSingle(txtIP, 100)
  167.     If res < 0 Then
  168.         lblPResult.Caption = ""
  169.         lblPResult.BackColor = vbRed
  170.     Else
  171.         lblPResult.Caption = res
  172.         lblPResult.BackColor = vbGreen
  173.         
  174.     End If
  175.     btnPing.Enabled = True
  176. End Sub
  177.  
  178. Private Sub btnPingAsync_Click()
  179. Dim saAdresses() As String, n As Integer
  180. Dim tm1 As Long, tm2 As Long
  181.     
  182.     btnPingAsync.Enabled = False
  183.     ReDim saAdresses(LV_IPs.ListItems.Count)
  184.     For n = 1 To LV_IPs.ListItems.Count
  185.         '//Store value
  186.         If LV_IPs.ListItems(n).SubItems(1) = "---" Then
  187.             LV_IPs.ListItems(n).ListSubItems(1).Tag = -1
  188.         Else
  189.             If Len(LV_IPs.ListItems(n).SubItems(1)) Then
  190.                 LV_IPs.ListItems(n).ListSubItems(1).Tag = LV_IPs.ListItems(n).ListSubItems(1).Text
  191.             End If
  192.         End If
  193.         LV_IPs.ListItems(n).SubItems(1) = ""
  194.         saAdresses(n - 1) = LV_IPs.ListItems(n).Text
  195.     Next
  196.     tm1 = GetTickCount()
  197.     m_clsPingBase.NumParalellActions = 1000
  198.     m_clsPingBase.PingHostList saAdresses, 100, (LV_IPs.ListItems.Count * 100) / 2
  199.     btnPingAsync.Enabled = True
  200.     tm2 = GetTickCount()
  201.     m_bFirstRun = True
  202. '    MsgBox Format((tm2 - tm1) / 1000, "0.00") & " secs", , "Time needed"
  203. End Sub
  204.  
  205. Private Sub btnPingList_Click()
  206. Dim n As Long, res As Long
  207. Dim tm1 As Long, tm2 As Long
  208.     tm1 = GetTickCount()
  209.     btnPingList.Enabled = False
  210.     For n = 1 To LV_IPs.ListItems.Count
  211.         LV_IPs.ListItems(n).Selected = True
  212.         LV_IPs.ListItems(n).EnsureVisible
  213.         res = m_clsPingBase.PingHostSingle(LV_IPs.ListItems(n).Text, 100)
  214.         If res < 0 Then
  215.             LV_IPs.ListItems(n).SubItems(1) = "---"
  216.         Else
  217.             LV_IPs.ListItems(n).SubItems(1) = res
  218.         End If
  219.     Next
  220.     btnPingList.Enabled = True
  221.     tm2 = GetTickCount()
  222.     MsgBox Format((tm2 - tm1) / 1000, "0.00") & " secs", , "Time needed"
  223. End Sub
  224.  
  225. Private Sub Form_Load()
  226. Dim n As Integer, m As Integer, k As Integer
  227. Dim lfd As Long, sreturn As String
  228. Dim sxIPfrom() As String, sxIPTo() As String
  229. Dim i1 As Integer, i2 As Integer, i3 As Integer, i4 As Integer, sData As String
  230. Dim BoundsL() As Integer, BoundsH() As Integer
  231.     lblPResult.Caption = ""
  232.     m_bFirstRun = False
  233. '    For m = 1 To 15
  234. '        For n = 1 To 255
  235. '            LV_IPs.ListItems.Add , , "10.49." & m & "." & n
  236. '        Next
  237. '    Next
  238.  
  239.     lfd = FreeFile
  240.     Open App.Path & "\iplist.txt" For Input As #lfd
  241.         Do While Not EOF(lfd)
  242.             Line Input #lfd, sreturn
  243.             If Len(sreturn) Then
  244.                 If Left(sreturn, 1) <> "#" Then
  245.                     k = InStr(sreturn, "-")
  246.                     m = InStr(sreturn, ":")
  247.                     If k Then   '//Komplete network
  248.                         sxIPfrom = Split(Left(sreturn, k - 1), ".")
  249.                         sxIPTo = Split(Mid(sreturn, k + 1), ".")
  250.                         ReDim Preserve sxIPfrom(3)
  251.                         ReDim Preserve sxIPTo(3)
  252.                         ReDim BoundsH(3)
  253.                         ReDim BoundsL(3)
  254.                         For n = 0 To 3
  255.                             BoundsL(n) = Val(sxIPfrom(n))
  256.                             If BoundsL(n) > 255 Then BoundsL(n) = 255
  257.                             BoundsH(n) = Val(sxIPTo(n))
  258.                             If BoundsH(n) > 255 Then BoundsH(n) = 255
  259.                         Next
  260.                         For i1 = BoundsL(0) To BoundsH(0)
  261.                             For i2 = BoundsL(1) To BoundsH(1)
  262.                                 For i3 = BoundsL(2) To BoundsH(2)
  263.                                     For i4 = BoundsL(3) To BoundsH(3)
  264.                                         sData = i1 & "." & i2 & "." & i3 & "." & i4
  265.                                         LV_IPs.ListItems.Add , , sData
  266.                                     Next
  267.                                 Next
  268.                             Next
  269.                         Next
  270.                     ElseIf m Then
  271.                         sxIPfrom = Split(Left(sreturn, m - 1), ".")   '//The Base adress
  272.                         ReDim Preserve sxIPfrom(2)
  273.                         sxIPTo = Split(Mid(sreturn, m + 1), ",")
  274.                         For n = 0 To UBound(sxIPTo)
  275.                             sData = sxIPfrom(0) & "." & sxIPfrom(1) & "." & sxIPfrom(2) & "." & sxIPTo(n)
  276.                             LV_IPs.ListItems.Add , , sData
  277.                         Next
  278.                     Else
  279.                         n = InStr(sreturn, " ")
  280.                         m = InStr(sreturn, vbTab)
  281.                         If n Then
  282.                             sreturn = Left(sreturn, n - 1)
  283.                         ElseIf m Then
  284.                             sreturn = Left(sreturn, m - 1)
  285.                         End If
  286.                         LV_IPs.ListItems.Add , , sreturn
  287.                     End If
  288.                 End If
  289.             End If
  290.         Loop
  291.     Close #lfd
  292.     lblHosts(1) = LV_IPs.ListItems.Count
  293.     Set m_clsPingBase = New ClassPingBase
  294. End Sub
  295.  
  296. Private Sub Form_Resize()
  297. Dim x As Single
  298.     x = Me.ScaleHeight - LV_IPs.Top - 150
  299.     If x > 0 Then LV_IPs.Height = x
  300. End Sub
  301.  
  302. Private Sub m_clsPingBase_PingFail(sIPAdress As String, lNewStatus As Long, ArrayIndex As Long)
  303.     LV_IPs.ListItems(ArrayIndex + 1).SubItems(1) = "---"
  304.     LV_IPs.ListItems.Item(ArrayIndex + 1).SmallIcon = 2
  305.     If m_bFirstRun Then
  306.         If LV_IPs.ListItems(ArrayIndex + 1).ListSubItems(1).Tag <> -1 Then
  307.             '//Notify state change
  308.             LV_IPs.ListItems(ArrayIndex + 1).ListSubItems(1).ReportIcon = 4
  309.         End If
  310.     End If
  311. End Sub
  312.  
  313. 'Private Sub m_clsPingBase_PingFail(sIPAdress As String, lNewStatus As Long)
  314. 'Dim lvitem As ListItem
  315. '    Set lvitem = LV_IPs.FindItem(sIPAdress)
  316. '    If Not lvitem Is Nothing Then
  317. '        lvitem.SubItems(1) = "--"
  318. '        lvitem.EnsureVisible
  319. '    End If
  320. 'End Sub
  321. '
  322. 'Private Sub m_clsPingBase_PingSuccess(sIPAdress As String, lNewStatus As Long)
  323. 'Dim lvitem As ListItem
  324. '    Set lvitem = LV_IPs.FindItem(sIPAdress)
  325. '    If Not lvitem Is Nothing Then
  326. '        lvitem.SubItems(1) = lNewStatus
  327. '        lvitem.EnsureVisible
  328. '    End If
  329. 'End Sub
  330. Private Sub m_clsPingBase_PingSuccess(sIPAdress As String, lNewStatus As Long, ArrayIndex As Long)
  331.     LV_IPs.ListItems(ArrayIndex + 1).SubItems(1) = lNewStatus
  332.     LV_IPs.ListItems(ArrayIndex + 1).EnsureVisible
  333.     LV_IPs.ListItems.Item(ArrayIndex + 1).SmallIcon = 1
  334.     If m_bFirstRun Then
  335.         If LV_IPs.ListItems(ArrayIndex + 1).ListSubItems(1).Tag = -1 Then
  336.             '//Notify state change
  337.             LV_IPs.ListItems(ArrayIndex + 1).ListSubItems(1).ReportIcon = 3
  338.         End If
  339.     
  340.     End If
  341. End Sub
  342.