Tricks of the Windows Gam…ming Gurus (2nd Edition)/Disc2.iso/msdn_vcb/samples/vc98/sdk/netds/adsi/sampapp/dsbrowse/main.frm

Visual Basic Form | 1997-07-29 | 11.5 KB | 373 lines

VERSION 4.00
Begin VB.Form frmBrwsTree
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Active Directory VB Browser"
   ClientHeight    =   7065
   ClientLeft      =   4125
   ClientTop       =   2790
   ClientWidth     =   7575
   FillStyle       =   0  'Solid
   ForeColor       =   &H00000000&
   Height          =   7470
   Left            =   4065
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7065
   ScaleWidth      =   7575
   Top             =   2445
   Width           =   7695
   Begin VB.CommandButton cmdAbort
      Caption         =   "Stop"
      Height          =   375
      Left            =   6360
      TabIndex        =   4
      Top             =   720
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.CommandButton cmdProperties
      Caption         =   "Properties..."
      Height          =   375
      Left            =   6360
      TabIndex        =   3
      Top             =   240
      Width           =   1095
   End
   Begin VB.CommandButton cmdExit
      Caption         =   "Exit"
      Height          =   375
      Left            =   6360
      TabIndex        =   2
      Top             =   1200
      Width           =   1095
   End
   Begin VB.Label txtPath
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Path"
      BeginProperty Font
         name            =   "Times New Roman"
         charset         =   0
         weight          =   400
         size            =   11.25
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   360
      TabIndex        =   7
      Top             =   6720
      Width           =   405
   End
   Begin VB.Label txtName
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      Caption         =   "ADS:"
      BeginProperty Font
         name            =   "Times New Roman"
         charset         =   0
         weight          =   400
         size            =   12
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   360
      TabIndex        =   6
      Top             =   6000
      Width           =   6255
   End
   Begin VB.Label Label3
      Caption         =   "Path:"
      BeginProperty Font
         name            =   "Times New Roman"
         charset         =   0
         weight          =   400
         size            =   11.25
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   240
      TabIndex        =   5
      Top             =   6360
      Width           =   855
   End
   Begin VB.Label Label1
      Caption         =   "Name:"
      BeginProperty Font
         name            =   "Times New Roman"
         charset         =   0
         weight          =   400
         size            =   12
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   5640
      Width           =   855
   End
   Begin ComctlLib.ImageList ImageList1
      Left            =   11160
      Top             =   6960
      _Version        =   65536
      _ExtentX        =   1005
      _ExtentY        =   1005
      _StockProps     =   1
      BackColor       =   -2147483643
      MaskColor       =   12632256
   End
   Begin ComctlLib.TreeView TreeView1
      Height          =   5535
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   6135
      _Version        =   65536
      _ExtentX        =   10821
      _ExtentY        =   9763
      _StockProps     =   196
      Appearance      =   1
      ImageList       =   ""
      MousePointer    =   1
      PathSeparator   =   "\"
      Sorted          =   -1  'True
      Style           =   7
   End
Attribute VB_Name = "frmBrwsTree"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdAbort_Click()
' Allows the user to cancel a tree expand
    bAbort = True
End Sub
Private Sub cmdExit_Click()
' Allows user to end program
    End
End Sub
Private Sub cmdProperties_Click()
' Allows viewing of Active Directory object properties
    Dim Class As IADsClass
    Dim Property As IADsProperty
    Dim v As Variant
    Dim Value As Variant
    Dim EmptyVar As Variant
    '
    ' Set Error handler
    '
    On Error Resume Next
    '
    ' Don't allow exit while getting properties
    '
    cmdExit.Visible = False
    '
    ' Set cursor to wait/arrow
    '
    Screen.MousePointer = 13
    '
    ' Get the object and its properties
    '
    Set currentADsObj = GetObject(TreeView1.SelectedItem.Key)
    If Err Then
        MsgBox "Could not get object"
        GoTo skip
    End If
    frmProp.lblName.Caption = currentADsObj.Name
    frmProp.lblPath.Caption = currentADsObj.ADsPath
    frmProp.lblClass.Caption = currentADsObj.Class
    '
    ' Namespaces object and Schema object are the only two objects that
    ' do not have an associated schema
    '
    If currentADsObj.Class = "Schema" Or _
            currentADsObj.Class = "NameSpaces" Then
        MsgBox "Please chose non schema object"
        GoTo skip
    End If
    '
    ' Load the form
    '
    Load frmProp
    Set Class = GetObject(currentADsObj.Schema)
    If Err Then
        MsgBox "Could not get schema object"
        GoTo skip
    End If
    If Class.Container Then
        frmProp.lblIsContainer.Caption = "Yes"
    Else
        frmProp.lblIsContainer.Caption = "No"
    End If
    For Each v In Class.MandatoryProperties
        Set Property = GetObject(Class.Parent + "\" + v)
        Value = EmptyVar
        Value = currentADsObj.Get(Property.Name)
        If VarType(Value) = vbEmpty Then
            frmProp.lstProperties.AddItem Property.Name & "(" & Property.Syntax & _
            "):" & "<Empty>"
        Else
            frmProp.lstProperties.AddItem Property.Name & "(" & Property.Syntax & _
            "):" & Value
        End If
    Next v
    '
    'Make form visible
    '
    frmProp.Visible = True
skip:
    cmdExit.Visible = True
    '
    'Set cursor to default
    '
    Screen.MousePointer = 0
End Sub
Private Sub Form_Load()
' Sets up the application main form
    '
    ' Define indexs for LoadResPicture API
    '
    Const idxComputer = 101
    Const idxUser = 102
    Const idxDomain = 103
    Const idxSyntax = 104
    Const idxService = 105
    Const idxGroup = 106
    Const idxPrintQueue = 107
    Const idxOU = 108
    Const idxFileShare = 109
    Const idxOrganization = 110
    Const idxCountry = 111
    Const idxTop = 112
    Const idxNamespace = 113
    Const idxDefault = 114
    Const idxNamespaces = 115
    ' App icon index
    Const idxApp = 101
    '
    ' Create temp Node variable
    '
    Dim nodX As Node
    '
    ' Load pictures into ImageList control.
    '
    'Dim pic As Picture
    '
    'Create Image variable
    '
    Dim imgI As ListImage
    '
    ' Set Error handler
    '
    On Error GoTo ErrorHandler
    '
    ' Each image/icon is loaded from the resource file.  If the image
    ' is not present, the default image is used.
    '
    Set imgI = ImageList1.ListImages.Add(, _
        "imgComputer", LoadResPicture(idxComputer, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgUser", LoadResPicture(idxUser, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgDomain", LoadResPicture(idxDomain, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgSchema", LoadResPicture(idxSyntax, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgService", LoadResPicture(idxService, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgGroup", LoadResPicture(idxGroup, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgPrintQueue", LoadResPicture(idxPrintQueue, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgFileShare", LoadResPicture(idxFileShare, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgOrganization", LoadResPicture(idxOrganization, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgCountry", LoadResPicture(idxCountry, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgNameSpace", LoadResPicture(idxNamespace, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgNamespaces", LoadResPicture(idxNamespaces, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgFileService", LoadResPicture(idxDefault, vbResBitmap))
    Set imgI = ImageList1.ListImages.Add(, _
        "imgDefault", LoadResPicture(idxDefault, vbResBitmap))
    frmBrwsTree.Icon = LoadResPicture(idxApp, vbResIcon)
    '
    ' Set TreeView control properties.
    '
    TreeView1.ImageList = ImageList1    ' Initialize ImageList
    TreeView1.Style = tvwTreelinesPlusMinusPictureText ' Style 7
    TreeView1.LineStyle = tvwRootLines
    TreeView1.Indentation = 50
    strPath = "ADS:" ' Default start of browse
    Call enumerate_path(nodX)
    GoTo finish
ErrorHandler:
    errstring = "Had an error:" & Err.Number
    ERRNUMB = Err.Number
    MsgBox errstring
    Resume Next
finish:
End Sub
Private Sub TreeView1_Collapse(ByVal Node As Node)
' To do when collapsing a node
    txtName.Caption = Node.Text
    txtPath.Caption = Node.Key
End Sub
Private Sub TreeView1_Expand(ByVal Node As Node)
' Process a node expand
    Dim ChildNode As Node
    On Error GoTo ErrorHandler
    TreeView1.MousePointer = 13
    ' Only expand once so check for "Dummy" child
    If Node.Child = "Dummy" Then
        Node.Sorted = True
        If bStartup = False Then

            cmdExit.Visible = False
            txtName.Caption = Node.Text
            txtPath.Caption = Node.Key

            Set ChildNode = Node.Child
            If ChildNode.Text = "Dummy" Then
                TreeView1.Nodes.Remove (ChildNode.Key)
            End If
            cmdAbort.Visible = True
            cmdAbort.SetFocus
            DoEvents

            strPath = Node.Key

            Call enumerate_path(Node)

        End If
    End If
GoTo finish
ErrorHandler:
    errstring = "Had an error:" & Err.Number
    ERRNUMB = Err.Number
    MsgBox errstring
finish:
    cmdExit.Visible = True
    Node.Sorted = True
    cmdAbort.Visible = False
    TreeView1.MousePointer = 0
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As Node)
' Process a node click
    txtName.Caption = Node.Text
    txtPath.Caption = Node.Key
End Sub