network.frm

不错的一个VB菜单设计 界面和功能都不错

Private Sub Form_Load()
  Dim objResource As flwnetwork.IFWNetResource
  Dim objServer   As flwnetwork.IFWNetServer
  
  txtUser.Text = "WorkStation Info" & vbCrLf & _
                 "  Platform ID: " & objNet.PlatformId & vbCrLf & _
                 "  Machine: " & objNet.ComputerName & vbCrLf & _
                 "  Domain: " & objNet.Domain & vbCrLf & _
                 "  Lan Version: " & objNet.VerMajor & "." & objNet.VerMinor & vbCrLf & _
                 "  Lan Root: " & objNet.LanRoot & vbCrLf & _
                 "  Logged-On Users: " & objNet.LoggedOnUsers & vbCrLf & _
                 "WorkStation User Info" & vbCrLf & _
                 "  User Name: " & objNet.User & vbCrLf & _
                 "  Novel User Name: " & objNet.NovellUser & vbCrLf & _
                 "  Logon Domain: " & objNet.LogonDomain & vbCrLf & _
                 "  Other Domains: " & objNet.OtherDomains & vbCrLf & _
                 "  Logon Server: " & objNet.LogonServer

  For Each objServer In objNet.NetServers
    Call lstServers.AddItem(objServer.Name)
  Next
  If objNet.ServersCount > 0 Then
    lstServers.ListIndex = 0
  End If
  
  For Each objResource In objNet.NetResources
    With objResource
      If .ResourceType = flwnetwork.flwNetResourcePrinter Then
        Call lstResources.AddItem(.RemoteName & " captured on " & .LocalName)
      Else
        Call lstResources.AddItem(.RemoteName & " on drive " & .LocalName)
      End If
    End With
  Next
  If objNet.ResourcesCount > 0 Then
    lstResources.ListIndex = 0
  End If
End Sub

Private Sub lstResources_Click()
  Dim objResource As flwnetwork.IFWNetResource
  Dim strDisplay  As String
  Dim strResource As String
  
  If lstResources.ListIndex >= 0 Then
    Set objResource = objNet.NetResource(lstResources.ListIndex + 1)
    With objResource
      Select Case .ResourceType
        Case flwnetwork.flwNetResourceUnknown
          strResource = "Unknown"
        Case flwnetwork.flwNetResourcePrinter
          strResource = "Printer"
        Case flwnetwork.flwNetResourceDisk
          strResource = "Disk"
      End Select
      Select Case .DisplayType
        Case flwnetwork.flwNetDisplayResTypeShare
          strDisplay = "Resource Share"
        Case flwnetwork.flwNetDisplayResTypeServer
          strDisplay = "Server"
        Case flwnetwork.flwNetDisplayResTypeGroup
          strDisplay = "Group"
        Case flwnetwork.flwNetDisplayResTypeGeneric
          strDisplay = "Generic"
        Case flwnetwork.flwNetDisplayResTypeFile
          strDisplay = "File"
        Case flwnetwork.flwNetDisplayResTypeDomain
          strDisplay = "Domain"
      End Select
      txtProperties = "Provider     : " & .Provider & vbCrLf & _
                      "Comment      : " & .Comment & vbCrLf & _
                      "Type         : " & strResource & vbCrLf & _
                      "Display Type : " & strDisplay
    End With
  End If
End Sub

Private Sub lstServers_Click()
  Dim objServer As flwnetwork.IFWNetServer
  Dim lngInd    As Long
  
  Set objServer = objNet.NetServer(lstServers.ListIndex + 1)
  
  Screen.MousePointer = vbHourglass
  
  Call lstUsers.Clear
  For lngInd = 1 To objServer.UserGroupCount
    If objServer.UserGroup(lngInd).UserGroupType = flwnetwork.flwGroupType Then
      Call lstUsers.AddItem("Group " & objServer.UserGroup(lngInd).Name)
    Else
      Call lstUsers.AddItem("User " & objServer.UserGroup(lngInd).Name)
    End If
  Next
  
  txtServers = ""
  txtServers = "Domain " & objServer.PrimaryDCName & vbCrLf
  txtServers = AddText(txtServers, flwnetwork.flwServerWorkstation, "Net workstation")
  txtServers = AddText(txtServers, flwnetwork.flwServerServer, "Net server")
  txtServers = AddText(txtServers, flwnetwork.flwServerSQLServer, "Server running with Microsoft SQL Server")
  txtServers = AddText(txtServers, flwnetwork.flwServerDomainCtrl, "Primary domain controller")
  txtServers = AddText(txtServers, flwnetwork.flwServerDomainBackup, "Backup domain controller")
  txtServers = AddText(txtServers, flwnetwork.flwServerTimeSource, "Server running the Timesource service")
  txtServers = AddText(txtServers, flwnetwork.flwServerAFP, "Apple File Protocol server")
  txtServers = AddText(txtServers, flwnetwork.flwServerNovell, "Novell server")
  txtServers = AddText(txtServers, flwnetwork.flwServerDomainMember, "LAN Manager 2.x Domain Member")
  txtServers = AddText(txtServers, flwnetwork.flwServerLocalListOnly, "Server maintained by the browser")
  txtServers = AddText(txtServers, flwnetwork.flwServerPrint, "Server sharing print queue")
  txtServers = AddText(txtServers, flwnetwork.flwServerDialing, "Server running dial-in service")
  txtServers = AddText(txtServers, flwnetwork.flwServerXenix, "Xenix server")
  txtServers = AddText(txtServers, flwnetwork.flwServerMFPN, "Microsoft File and Print for Netware")
  txtServers = AddText(txtServers, flwnetwork.flwServerNT, "Windows NT (either Workstation or Server)")
  txtServers = AddText(txtServers, flwnetwork.flwServerWFW, "Server running Windows for Workgroups")
  txtServers = AddText(txtServers, flwnetwork.flwServerServerNT, "Windows NT Non-DC server")
  txtServers = AddText(txtServers, flwnetwork.flwServerPotentialBrowser, "Server that can run the Browser service")
  txtServers = AddText(txtServers, flwnetwork.flwServerBackupBrowser, "Server running a Browser service as backup")
  txtServers = AddText(txtServers, flwnetwork.flwServerMasterBrowser, "Server running the master Browser service")
  txtServers = AddText(txtServers, flwnetwork.flwServerDomainMaster, "Server running the domain master Browser")
  txtServers = AddText(txtServers, flwnetwork.flwServerDomainEnum, "Primary Domain")
  txtServers = AddText(txtServers, flwnetwork.flwServerWindows, "Windows 95 or later")
  
  Screen.MousePointer = vbArrow
  
  Set objServer = Nothing
End Sub

Private Function AddText(ByVal strBuffer As String, _
                         ByVal intType As flwnetwork.flwServerTypes, _
                         ByVal strText As String) As String
  Dim objServer As flwnetwork.IFWNetServer
  
  Set objServer = objNet.NetServer(lstServers.ListIndex + 1)
  If objServer.SrvType(intType) Then
    AddText = strBuffer & strText & vbCrLf
  Else
    AddText = strBuffer
  End If
  Set objServer = Nothing
End Function



Private Sub lstUsers_Click()
  Dim objUserGroup As flwnetwork.IFWNetUserGroup
  Dim intInd       As Integer
  Dim strGroups    As String
  
  txtUserInfo = ""
  Set objUserGroup = objNet.NetServer(lstServers.ListIndex + 1).UserGroup(lstUsers.ListIndex + 1)
  If objUserGroup.UserGroupType = flwnetwork.flwUserType Then
    Call objUserGroup.Refresh
   
    txtUserInfo = txtUserInfo & "PasswordAge: " & Format(objUserGroup.PasswordAge / 86400, "0.0") & " days" & vbCrLf
    Select Case objUserGroup.Privilege
      Case flwnetwork.flwUserPrivUser
        txtUserInfo = txtUserInfo & "Privilege       : User" & vbCrLf
      Case flwnetwork.flwUserPrivGuest
        txtUserInfo = txtUserInfo & "Privilege       : Guest" & vbCrLf
      Case flwnetwork.flwUserPrivAdmin
        txtUserInfo = txtUserInfo & "Privilege       : Administrator" & vbCrLf
    End Select
    txtUserInfo = txtUserInfo & "HomeDir         : " & objUserGroup.HomeDir & vbCrLf
    txtUserInfo = txtUserInfo & "Comment         : " & objUserGroup.Comment & vbCrLf
    txtUserInfo = txtUserInfo & "Flags           : &h" & Hex(objUserGroup.Flags) & vbCrLf
    txtUserInfo = txtUserInfo & "Script Path     : " & objUserGroup.ScriptPath & vbCrLf
    txtUserInfo = txtUserInfo & "Auth Flags      : &h" & Hex(objUserGroup.AuthFlags) & vbCrLf
    txtUserInfo = txtUserInfo & "FullName        : " & objUserGroup.FullName & vbCrLf
    txtUserInfo = txtUserInfo & "User Comment    : " & objUserGroup.UserComment & vbCrLf
    txtUserInfo = txtUserInfo & "Parms           : " & objUserGroup.Parms & vbCrLf
    txtUserInfo = txtUserInfo & "Workstations    : " & objUserGroup.Workstations & vbCrLf
    txtUserInfo = txtUserInfo & "Last Logon      : " & Format(objUserGroup.LastLogonDate, "mm/dd/yyyy Hh:Nn:Ss") & vbCrLf
    txtUserInfo = txtUserInfo & "Last Logoff     : " & Format(objUserGroup.LastLogoffDate, "mm/dd/yyyy Hh:Nn:Ss") & vbCrLf
    txtUserInfo = txtUserInfo & "Acct Expires    : " & IIf(objUserGroup.AcctExpires = -1, "Never", Format(objUserGroup.AcctExpiresDate, "long date")) & vbCrLf
    txtUserInfo = txtUserInfo & "Max Storage     : " & IIf(objUserGroup.MaxStorage = -1, "Unlimited", objUserGroup.MaxStorage) & vbCrLf
    txtUserInfo = txtUserInfo & "Units Per Week  : " & objUserGroup.UnitsPerWeek & vbCrLf
    txtUserInfo = txtUserInfo & "Logon Hours     : "
    For intInd = 0 To 20
      txtUserInfo = txtUserInfo & Right("0" & Hex(objUserGroup.LogonHours(intInd)), 2)
    Next
    txtUserInfo = txtUserInfo & vbCrLf
    txtUserInfo = txtUserInfo & "Bad Pwd Count   : " & objUserGroup.BadPasswordCount & vbCrLf
    txtUserInfo = txtUserInfo & "Num Logons      : " & objUserGroup.NumLogons & vbCrLf
    txtUserInfo = txtUserInfo & "Logon Server    : " & objUserGroup.LogonServer & vbCrLf
    txtUserInfo = txtUserInfo & "Country Code    : " & objUserGroup.CountryCode & vbCrLf
    txtUserInfo = txtUserInfo & "Code Page       : " & objUserGroup.CodePage & vbCrLf
    txtUserInfo = txtUserInfo & "UserID          : " & objUserGroup.UserID & vbCrLf
    txtUserInfo = txtUserInfo & "Primary Group ID: " & objUserGroup.PrimaryGroupID & vbCrLf
    txtUserInfo = txtUserInfo & "Profile         : " & objUserGroup.Profile & vbCrLf
    txtUserInfo = txtUserInfo & "Home Dir Drive  : " & objUserGroup.HomeDirDrive & vbCrLf
    txtUserInfo = txtUserInfo & "Pwd Expired     : " & objUserGroup.PasswordExpired & vbCrLf
    txtUserInfo = txtUserInfo & "Groups          : " & objUserGroup.GroupCount
    For intInd = 0 To objUserGroup.GroupCount - 1
      txtUserInfo = txtUserInfo & ", " & objUserGroup.Group(intInd)
    Next
    txtUserInfo = txtUserInfo & vbCrLf
    txtUserInfo = txtUserInfo & "LocalGroups     : " & objUserGroup.LocalGroupCount
    For intInd = 0 To objUserGroup.LocalGroupCount - 1
      txtUserInfo = txtUserInfo & ", " & objUserGroup.LocalGroup(intInd)
    Next
  End If
End Sub