frmgetnetinfo.frm

局域网用户屏幕的控制和查看程序

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmGetNetinfo 
   Caption         =   "Form1"
   ClientHeight    =   6615
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10485
   LinkTopic       =   "Form1"
   ScaleHeight     =   6615
   ScaleWidth      =   10485
   StartUpPosition =   3  '窗口缺省
   Begin VB.OptionButton Option2 
      Caption         =   "工作组内的计算机"
      Height          =   375
      Left            =   3990
      TabIndex        =   3
      Top             =   855
      Value           =   -1  'True
      Width           =   1950
   End
   Begin VB.OptionButton Option1 
      Caption         =   "网段内的计算机"
      Height          =   300
      Left            =   1905
      TabIndex        =   2
      Top             =   900
      Width           =   2265
   End
   Begin VB.CommandButton Command1 
      Caption         =   "搜索"
      Height          =   915
      Left            =   330
      TabIndex        =   1
      Top             =   495
      Width           =   1095
   End
   Begin MSComctlLib.ListView lstLan 
      Height          =   4515
      Left            =   195
      TabIndex        =   0
      Top             =   1830
      Width           =   10005
      _ExtentX        =   17648
      _ExtentY        =   7964
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   5
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "计算机名"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "IP地址"
         Object.Width           =   3246
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "工作组"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   3
         Text            =   "MAC地址"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   4
         Text            =   "用户"
         Object.Width           =   2540
      EndProperty
   End
End
Attribute VB_Name = "frmGetNetinfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2007/08/12
'描    述：利用VNC控制和查看局域网用户屏幕 V0.2  (稳定beta版)
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit

Private Sub Command1_Click()
'On Error Resume Next
Dim ServerCollection As Collection, i As Long
Dim ipAddress As Collection
Dim FirstCount As Integer
Dim pcOn As Boolean
    
    Me.MousePointer = vbArrowHourglass
    lstLan.ListItems.Clear
    Set ServerCollection = GetServers(NTBased)
        For i = 1 To ServerCollection.Count
            lstLan.ListItems.Add i, , ServerCollection.Item(i)
            lstLan.ListItems.Item(i).ForeColor = vbBlue
            'If chkLanInfo.Value = vbChecked Then
               'pcOn = Ping(ServerCollection.Item(i))
                Set ipAddress = GetIPAddresses(ServerCollection.Item(i))
                If ipAddress.Count = 0 Then
                    lstLan.ListItems.Item(i + FirstCount).ListSubItems.Add , , ""
                    lstLan.ListItems.Item(i + FirstCount).ListSubItems.Add , , "未知"
                Else
                    'ChkForVncR ipAddress(1), CInt(i)
                  '  lstLan.ListItems.Item(i).ListSubItems.Add , , "" 'check for vnc
                    lstLan.ListItems.Item(i).ListSubItems.Add , , ipAddress(1)
                    'lstLan.ListItems.Item(i).ListSubItems(2).ForeColor = vbBlue
                End If
                
            'End If
        Next i
    FirstCount = (ServerCollection.Count)
    Set ServerCollection = GetServers(Windows9x)
        For i = 1 To ServerCollection.Count
            lstLan.ListItems.Add i + FirstCount, , ServerCollection.Item(i)
            'If chkLanInfo.Value = vbChecked Then
                Set ipAddress = GetIPAddresses(ServerCollection.Item(i))
                If ipAddress.Count = 0 Then
                    lstLan.ListItems.Item(i + FirstCount).ListSubItems.Add , , ""
                    lstLan.ListItems.Item(i + FirstCount).ListSubItems.Add , , "未知"
                Else
                    'ChkForVncR ipAddress(1), CInt(i + FirstCount)
                    lstLan.ListItems.Item(i + FirstCount).ListSubItems.Add , , "" ' check for vnc
                    lstLan.ListItems.Item(i + FirstCount).ListSubItems.Add , , ipAddress(1)
                End If
                
            'End If
        Next i
    Me.MousePointer = vbArrow

End Sub